Merge pull request #22 from airvin/iterator-methods

Iterator methods

Author: airvin

brittany.yaml

@@ -0,0 +1,19 @@
+conf_layout:
+  lconfig_reformatModulePreamble: true
+  lconfig_altChooser:
+    tag: AltChooserBoundedSearch
+    contents: 3
+  lconfig_allowSingleLineExportList: false
+  lconfig_importColumn: 50
+  lconfig_hangingTypeSignature: false
+  lconfig_importAsColumn: 50
+  lconfig_alignmentLimit: 30
+  lconfig_indentListSpecial: true
+  lconfig_indentAmount: 4
+  lconfig_alignmentBreakOnMultiline: true
+  lconfig_cols: 120
+  lconfig_indentPolicy: IndentPolicyFree
+  lconfig_indentWhereSpecial: true
+  lconfig_columnAlignMode:
+    tag: ColumnAlignModeMajority
+    contents: 0.7

examples/Marbles.hs

@@ -15,7 +15,7 @@ import           Peer.ProposalResponse         as Pb
 
 import           Data.Text                      ( Text )
 import           Data.Text.Encoding             ( encodeUtf8 )
-import           Data.ByteString.UTF8          as BSU
+import Data.ByteString.UTF8 as BSU ( ByteString, toString )
 import           Debug.Trace
 
 main :: IO ()

examples/Sacc.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
-    
+
 module Helper where
 
-import           Data.Bifunctor                ( first )
+import           Data.Bifunctor                 ( first )
 import           Proto3.Suite                  as Suite
 import           Common.Common                 as Pb
 import           Peer.ChaincodeShim            as Pb
@@ -11,33 +11,29 @@ import           Peer.Proposal                 as Pb
 import           Peer.ProposalResponse         as Pb
 import           Types                          ( Error(..)
                                                 , ChaincodeStub(..)
-                                                , MapTextBytes)
-                                              
+                                                , MapTextBytes
+                                                )
+
 
 -- These are some helper functions to process the unmarshalling of different types
 -- from the chaincode message in order to populate the stub
 getChaincodeInput :: ChaincodeMessage -> Either Error Pb.ChaincodeInput
 getChaincodeInput mes = first DecodeError $ Suite.fromByteString (chaincodeMessagePayload mes)
 
 getProposal :: Pb.SignedProposal -> Either Error Pb.Proposal
-getProposal signedProposal =
-  first DecodeError $ Suite.fromByteString (signedProposalProposalBytes signedProposal)
+getProposal signedProposal = first DecodeError $ Suite.fromByteString (signedProposalProposalBytes signedProposal)
 
 getHeader :: Pb.Proposal -> Either Error Pb.Header
-getHeader proposal = 
-  first DecodeError $ Suite.fromByteString (proposalHeader proposal)
+getHeader proposal = first DecodeError $ Suite.fromByteString (proposalHeader proposal)
 
 getChannelHeader :: Pb.Header -> Either Error Pb.ChannelHeader
-getChannelHeader header = 
-  first DecodeError $ Suite.fromByteString (headerChannelHeader header)
+getChannelHeader header = first DecodeError $ Suite.fromByteString (headerChannelHeader header)
 
 getChaincodeProposalPayload :: Pb.Proposal -> Either Error Pb.ChaincodeProposalPayload
-getChaincodeProposalPayload proposal =
-  first DecodeError $ Suite.fromByteString (proposalPayload proposal)
+getChaincodeProposalPayload proposal = first DecodeError $ Suite.fromByteString (proposalPayload proposal)
 
 getSignatureHeader :: Pb.Header -> Either Error Pb.SignatureHeader
-getSignatureHeader header =
-  first DecodeError $ Suite.fromByteString (headerSignatureHeader header)
+getSignatureHeader header = first DecodeError $ Suite.fromByteString (headerSignatureHeader header)
 
 -- -- TODO: Use ChannelHeader and SignatureHeader to implement getBinding
 createBinding :: Pb.Proposal -> Maybe MapTextBytes

src/Helper.hs

@@ -85,6 +85,7 @@ biDiRequestFn chaincodeStub _call _mmap recv send _done = do
   chatWithPeer recv send chaincodeStub
 
 -- main loop listening for messages from the peer
+chatWithPeer :: IO (Either GRPCIOError (Maybe ChaincodeMessage)) -> StreamSend ChaincodeMessage -> ChaincodeStub -> IO b
 chatWithPeer recv send chaincodeStub = do
   res <- recv
   case res of

src/Interfaces.hs

@@ -102,39 +102,34 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
         Nothing -> Left $ Error "ChannelHeader doesn't have a timestamp"
         Just timestamp -> Right timestamp
     Nothing -> Left $ Error "Chaincode stub doesn't has a proposal to get the timestamp from"
-  
-  -- invokeChaincode :: ccs -> String -> [ByteString] -> String -> Pb.Response
-  -- invokeChaincode ccs cc params = Pb.Response{ responseStatus = 500, responseMessage = message(notImplemented), responsePayload = Nothing }
-  --
-  -- getState :: ccs -> Text -> IO (Either Error ByteString)
+
+  -- getState :: ccs -> Text ->  ExceptT Error IO ByteString
   getState ccs key =
     let payload = getStatePayload key
         message =
             buildChaincodeMessage GET_STATE payload (txId ccs) (channelId ccs)
-    in  do
+    in ExceptT $ do
           e <- (sendStream ccs) message
           case e of
-            Left  err -> error ("Error while streaming: " ++ show err)
-            Right _   -> pure ()
-          listenForResponse (recvStream ccs)
+            Left  err -> pure $ Left $ Error $ "Error while streaming: " ++ show err
+            Right _   -> listenForResponse (recvStream ccs)
 
-  -- putState :: ccs -> Text -> ByteString -> Maybe Error
+  -- putState :: ccs -> Text -> ByteString -> ExceptT Error IO ByteString
   putState ccs key value =
     let payload = putStatePayload key value
         message =
             buildChaincodeMessage PUT_STATE payload (txId ccs) (channelId ccs)
-    in  do
+    in ExceptT $ do
           e <- (sendStream ccs) message
           case e of
-            Left  err -> error ("Error while streaming: " ++ show err)
-            Right _   -> pure ()
-          listenForResponse (recvStream ccs)
-
+            Left  err -> pure $ Left $ Error $ "Error while streaming: " ++ show err
+            Right _   -> listenForResponse (recvStream ccs)
+          
   -- delState :: ccs -> Text -> IO (Maybe Error)
   delState ccs key =
       let payload = delStatePayload key
           message = buildChaincodeMessage DEL_STATE payload (txId ccs) (channelId ccs)
-      in do
+      in ExceptT $ do
         e <- (sendStream ccs) message
         case e of
           Left err -> error ("Error while streaming: " ++ show err)
@@ -154,7 +149,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
   getStateByRange ccs startKey endKey =
     let payload = getStateByRangePayload startKey endKey Nothing
         message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
-    in do
+    in ExceptT $ do
           e <- (sendStream ccs) message
           case e of
             Left  err -> error ("Error while streaming: " ++ show err)
@@ -170,7 +165,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
       }
         payload = (trace "Building getStateByRangeWithPagination payload") getStateByRangePayload startKey endKey $ Just metadata
         message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
-    in do
+    in ExceptT $ do
           e <- (sendStream ccs) message
           case e of
             Left  err -> error ("Error while streaming: " ++ show err)
@@ -190,7 +185,7 @@ instance StateQueryIteratorInterface StateQueryIterator where
   -- close :: sqi -> IO (Maybe Error)
   close _ = pure Nothing
   -- next :: sqi -> IO (Either Error Pb.KV)
-  next sqi = do
+  next sqi = ExceptT $ do
     eeQueryResultBytes <- nextResult sqi 
     case eeQueryResultBytes of
       Left _ -> pure $ Left $ Error "Error getting next queryResultBytes"

src/Shim.hs

@@ -17,7 +17,7 @@ import           Network.GRPC.HighLevel
 import           Peer.ChaincodeShim            as Pb
 import           Google.Protobuf.Timestamp     as Pb
 import           Peer.Proposal                 as Pb
-import           Peer.ProposalResponse         as Pb
+import Peer.ProposalResponse as Pb ( Response )
 
 data Error = GRPCError GRPCIOError
     | InvalidArgs