Merge pull request #17 from airvin/iterator-methods

Iterator methods

Author: airvin

examples/Marbles.hs

@@ -16,6 +16,7 @@ import           Shim                           ( start
                                                 )
 
 import           Peer.ProposalResponse         as Pb
+import           Peer.ChaincodeShim            as Pb
 import        Ledger.Queryresult.KvQueryResult as Pb
 
 import           Data.Text                      ( Text
@@ -177,22 +178,23 @@ getMarblesByRange s params = if Prelude.length params == 2
         trace (show resultBytes) (pure $ successPayload Nothing) 
   else pure $ errorPayload "Incorrect arguments. Need a start key and an end key"
 
+-- TODO: include retrieval of next set of results using the returned bookmark (next TODO)
 getMarblesByRangeWithPagination :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
 getMarblesByRangeWithPagination s params = if Prelude.length params == 4
   then do 
     e <- getStateByRangeWithPagination s (params !! 0) (params !! 1) (read (unpack $ params !! 2) :: Int) (params !! 3)
     case e of
       Left  _ -> pure $ errorPayload "Failed to get marbles"
-      Right _ -> pure $ successPayload $ Just "The payload"
+      Right (sqi, metadata) -> do
+        resultBytes <- generateResultBytesForPagination (sqi, metadata) ""
+        trace (show resultBytes) (pure $ successPayload Nothing) 
   else pure $ errorPayload "Incorrect arguments. Need start key, end key, pageSize and bookmark"
 
 generateResultBytes :: StateQueryIterator -> Text -> IO (Either Error BSU.ByteString)
 generateResultBytes sqi text = do 
   hasNextBool <- hasNext sqi
-  if hasNextBool then do 
+  if (trace $ "hasNext in generateResultBytes: " ++ show hasNextBool) hasNextBool then do 
       eeKV <- next sqi
-      -- TODO: We need to check that the Either Error KV returned from next 
-      -- is correct and append the showable version of KVs instead of "abc".
       case eeKV of 
         Left e -> pure $ Left e
         Right kv -> 
@@ -203,6 +205,21 @@ generateResultBytes sqi text = do
             generateResultBytes sqi (append text (makeKVString kv))
   else pure $ Right $ TSE.encodeUtf8 text
 
+generateResultBytesForPagination:: (StateQueryIterator, Pb.QueryResponseMetadata) -> Text -> IO (Either Error BSU.ByteString)
+generateResultBytesForPagination (sqi, md) text = do 
+  hasNextBool <- hasNext sqi
+  if (trace $ "hasNext in generateResultBytesForPagination: " ++ show hasNextBool) hasNextBool then do 
+      eeKV <- next sqi
+      case eeKV of 
+        Left e -> pure $ Left e
+        Right kv -> 
+            let 
+                makeKVString :: Pb.KV -> Text
+                makeKVString kv_ = pack "Key: " <> TL.toStrict (Pb.kvKey kv_) <> pack ", Value: " <> TSE.decodeUtf8  (kvValue kv_) 
+            in
+            generateResultBytesForPagination (sqi, md) (append text (makeKVString kv))
+  else pure $ Right $ TSE.encodeUtf8 text
+
 parseMarble :: [Text] -> Marble
 parseMarble params = Marble { objectType = "marble"
                             , name       = params !! 0

examples/readme.md

@@ -32,6 +32,7 @@ peer chaincode invoke -n mycc -c '{"Args":["readMarble","marble1"]}' -C myc
 peer chaincode invoke -n mycc -c '{"Args":["deleteMarble","marble1"]}' -C myc
 peer chaincode invoke -n mycc -c '{"Args":["transferMarble","marble1", "Nick"]}' -C myc
 peer chaincode invoke -n mycc -c '{"Args":["getMarblesByRange","marble1", "marble3"]}' -C myc
+peer chaincode invoke -n mycc -c '{"Args":["getMarblesByRangeWithPagination","marble1", "marble3", "1", ""]}' -C myc
 ```
 
 ## Fabcar Chaincode

readme.md

@@ -88,4 +88,4 @@ peer chaincode invoke -n mycc -c '{"Args":["del","a"]}' -C myc
 - [ ] Add support for concurrent transactions
 - [ ] Finish implementing all stub functions
 - [ ] Publish to Hackage
-- [ ] Add traces throughout the chaincode examples
+- [ ] Improve logging

src/Messages.hs

@@ -66,12 +66,16 @@ delStatePayload :: Text -> Pb.DelState
 delStatePayload key =
   Pb.DelState {delStateKey = fromStrict key, delStateCollection = ""}
 
-getStateByRangePayload :: Text -> Text -> Pb.GetStateByRange
-getStateByRangePayload startKey endKey = Pb.GetStateByRange {
+getStateByRangePayload :: Text -> Text -> Maybe Pb.QueryMetadata -> Pb.GetStateByRange
+getStateByRangePayload startKey endKey metaData = Pb.GetStateByRange {
     getStateByRangeStartKey = fromStrict startKey
     , getStateByRangeEndKey = fromStrict endKey
     , getStateByRangeCollection = ""
-    , getStateByRangeMetadata = BSU.fromString ""
+    , getStateByRangeMetadata = case metaData of 
+    -- This is an example of how to encode a Pb type into a bytestring
+    -- https://hackage.haskell.org/package/proto3-wire-1.2.0/docs/Proto3-Wire-Tutorial.html
+      Just metaData -> LBS.toStrict $ Wire.toLazyByteString $ encodeMessage (FieldNumber 1) metaData
+      Nothing -> BSU.fromString ""
 }
 
 queryNextStatePayload :: Text -> Pb.QueryStateNext

src/Stub.hs

@@ -3,7 +3,7 @@
 
 module Stub where
 
-
+-- import           Data.Int                      (fromIntegral)
 import           Data.Bifunctor
 import           Data.ByteString               as BS
 import           Data.Text
@@ -23,7 +23,6 @@ import           Data.Vector                   as Vector
                                                 , (!)
                                                 )
 import qualified Data.ByteString.Lazy          as LBS
-import           Data.IORef                    (readIORef, newIORef, modifyIORef)
 import           Control.Monad.Except          (ExceptT(..), runExceptT)
 
 import qualified Peer.ChaincodeShim            as Pb
@@ -39,6 +38,7 @@ import           Interfaces
 import           Messages
 import           Types
 
+import           Debug.Trace
 -- NOTE: When support for concurrency transaction is added, this function will no longer be required
 -- as the stub function will block and listen for responses over a channel when the code is concurrent
 listenForResponse :: StreamRecv Pb.ChaincodeMessage -> IO (Either Error ByteString)
@@ -125,47 +125,41 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
   -- TODO: Implement better error handling/checks etc
   -- getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)
   getStateByRange ccs startKey endKey =
-    let payload = getStateByRangePayload startKey endKey
-        message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs) 
-        -- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
-        bsToSqi :: ByteString -> ExceptT Error IO StateQueryIterator
-        bsToSqi bs = 
-            let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse
-            in
-                case eeaQueryResponse of
-                        -- TODO: refactor out pattern matching, e.g. using >>= or <*>
-                        Left  err             -> ExceptT $ pure $ Left $ DecodeError err
-                        Right queryResponse -> ExceptT $ do
-                            -- queryResponse and currentLoc are IORefs as they need to be mutated
-                            -- as a part of the next() function 
-                            queryResponseIORef <- newIORef queryResponse
-                            currentLocIORef    <- newIORef 0
-                            pure $ Right StateQueryIterator { 
-                            sqiChaincodeStub = ccs 
-                            , sqiChannelId     = getChannelId ccs
-                            , sqiTxId          = getTxId ccs
-                            , sqiResponse      = queryResponseIORef
-                            , sqiCurrentLoc    = currentLocIORef
-                            }
+    let payload = getStateByRangePayload startKey endKey Nothing
+        message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
     in do
           e <- (sendStream ccs) message
           case e of
             Left  err -> error ("Error while streaming: " ++ show err)
             Right _   -> pure ()
-          runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= bsToSqi
+          runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= (bsToSqi ccs)
 
   -- TODO: We need to implement this so we can test the fetchNextQueryResult functionality
-  -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
-  getStateByRangeWithPagination ccs startKey endKey pageSize bookmark = pure $ Left $ Error "Not implemented"
+    -- getStateByRangeWithPagination :: ccs -> Text -> Text -> Int -> Text -> IO (Either Error (StateQueryIterator, Pb.QueryResponseMetadata))
+  getStateByRangeWithPagination ccs startKey endKey pageSize bookmark = 
+    let metadata = Pb.QueryMetadata {
+        Pb.queryMetadataPageSize = fromIntegral pageSize
+        , Pb.queryMetadataBookmark = TL.fromStrict bookmark
+      }
+        payload = (trace "Building getStateByRangeWithPagination payload") getStateByRangePayload startKey endKey $ Just metadata
+        message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
+    in do
+          e <- (sendStream ccs) message
+          case e of
+            Left  err -> error ("Error while streaming: " ++ show err)
+            Right _   -> pure ()
+          runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= (bsToSqiAndMeta ccs)
+
 
   -- TODO : implement all these interface functions
 instance StateQueryIteratorInterface StateQueryIterator where
 -- TODO: remove the IO from this function (possibly with the State monad)
     -- hasNext :: sqi -> IO Bool
   hasNext sqi = do
     queryResponse <- readIORef $ sqiResponse sqi
-    currentLoc <- readIORef $ sqiCurrentLoc sqi
-    pure $ currentLoc < Prelude.length (Pb.queryResponseResults queryResponse) || (Pb.queryResponseHasMore queryResponse)
+    currentLoc <- (trace $ "Query response: " ++ show queryResponse) readIORef $ sqiCurrentLoc sqi
+    pure $ (currentLoc < Prelude.length (Pb.queryResponseResults queryResponse)) 
+      || (Pb.queryResponseHasMore queryResponse)
   -- close :: sqi -> IO (Maybe Error)
   close _ = pure Nothing
   -- next :: sqi -> IO (Either Error Pb.KV)
@@ -176,6 +170,53 @@ instance StateQueryIteratorInterface StateQueryIterator where
       Right queryResultBytes -> pure $ first DecodeError (parse (decodeMessage (FieldNumber 1)) (Pb.queryResultBytesResultBytes queryResultBytes) :: Either ParseError Pb.KV)
 
 
+-- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
+bsToSqi :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO StateQueryIterator
+bsToSqi ccs bs = 
+    let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse
+    in
+        case eeaQueryResponse of
+                -- TODO: refactor out pattern matching, e.g. using >>= or <*>
+                Left  err             -> ExceptT $ pure $ Left $ DecodeError err
+                Right queryResponse -> ExceptT $ do
+                        -- queryResponse and currentLoc are IORefs as they need to be mutated
+                        -- as a part of the next() function 
+                        queryResponseIORef <- newIORef queryResponse
+                        currentLocIORef    <- newIORef 0
+                        pure $ Right StateQueryIterator { 
+                        sqiChaincodeStub = ccs 
+                        , sqiChannelId     = getChannelId ccs
+                        , sqiTxId          = getTxId ccs
+                        , sqiResponse      = queryResponseIORef
+                        , sqiCurrentLoc    = currentLocIORef
+                        }
+
+-- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
+bsToSqiAndMeta :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO (StateQueryIterator, Pb.QueryResponseMetadata)
+bsToSqiAndMeta ccs bs = 
+    let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse
+    in
+        case eeaQueryResponse of
+                -- TODO: refactor out pattern matching, e.g. using >>= or <*>
+                Left  err             -> ExceptT $ pure $ Left $ DecodeError err
+                Right queryResponse -> 
+                  let eeMetadata = parse (decodeMessage (FieldNumber 1)) (Pb.queryResponseMetadata queryResponse) :: Either ParseError Pb.QueryResponseMetadata
+                  in
+                    case eeMetadata of
+                      Left err -> ExceptT $ pure $ Left $ DecodeError err
+                      Right metadata -> (trace $ "Metadata from bsToSqiAndMeta: " ++ show metadata) ExceptT $ do
+                        -- queryResponse and currentLoc are IORefs as they need to be mutated
+                        -- as a part of the next() function 
+                        queryResponseIORef <- newIORef queryResponse
+                        currentLocIORef    <- newIORef 0
+                        pure $ Right (StateQueryIterator { 
+                        sqiChaincodeStub = ccs 
+                        , sqiChannelId     = getChannelId ccs
+                        , sqiTxId          = getTxId ccs
+                        , sqiResponse      = queryResponseIORef
+                        , sqiCurrentLoc    = currentLocIORef
+                        }, metadata)
+
 nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes)
 nextResult sqi = do
   currentLoc <- readIORef $ sqiCurrentLoc sqi
@@ -187,10 +228,10 @@ nextResult sqi = do
         modifyIORef (sqiCurrentLoc sqi) (+ 1)
         if ((currentLoc + 1) == Prelude.length (Pb.queryResponseResults $ queryResponse)) then
           do
-            fetchNextQueryResult sqi
+            (trace "Fetching next query result from the peer") fetchNextQueryResult sqi
             queryResult
         else
-          queryResult
+          (trace "Returning local query result") queryResult
   else pure $ Left $ Error "Invalid iterator state"