Implemented the stateQueryIterator functions hasNext and next

Co-authored-by: Nick Waywood <n.waywood@github.com>
Signed-off-by: Allison Irvin <allison.irvin2@gmail.com>

Author: airvin

.gitignore

@@ -3,3 +3,6 @@ fabric-chaincode-haskell.cabal
 *~
 dist-newstyle
 cabal.project.local
+
+.vscode
+hie.yaml

examples/Marbles.hs

@@ -19,14 +19,19 @@ import           Shim                           ( start
                                                 , ChaincodeStub(..)
                                                 , ChaincodeStubInterface(..)
                                                 , DefaultChaincodeStub
+                                                , StateQueryIterator(..)
+                                                , StateQueryIteratorInterface(..)
+                                                , Error(..)
                                                 )
 
 import           Peer.ProposalResponse         as Pb
 
 import           Data.Text                      ( Text
                                                 , unpack
                                                 , pack
+                                                , append
                                                 )
+import qualified Data.Text.Encoding            as TSE
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.UTF8          as BSU
 import qualified Data.ByteString.Lazy          as LBS
@@ -167,9 +172,18 @@ getMarblesByRange s params = if Prelude.length params == 2
     e <- getStateByRange s (params !! 0) (params !! 1)
     case e of
       Left  _ -> pure $ errorPayload "Failed to get marbles"
-      Right a -> trace (show a) (pure $ successPayload Nothing)
-  else pure $ errorPayload
-    "Incorrect arguments. Need a start key and an end key" 
+      Right sqi -> do 
+        resultBytes <- generateResultBytes sqi ""
+        trace (show resultBytes) (pure $ successPayload Nothing) 
+  else pure $ errorPayload "Incorrect arguments. Need a start key and an end key"
+
+generateResultBytes :: StateQueryIterator -> Text -> IO (Either Error BSU.ByteString)
+generateResultBytes sqi text = do 
+  hasNextBool <- hasNext sqi
+  if hasNextBool then do 
+      eeKV <- next sqi
+      generateResultBytes sqi (append text "abc")
+  else pure $ Right $ TSE.encodeUtf8 text
 
 parseMarble :: [Text] -> Marble
 parseMarble params = Marble { objectType = "marble"

src/Interfaces.hs

@@ -68,7 +68,7 @@ class ChaincodeStubInterface ccs where
 class StateQueryIteratorInterface sqi where
 --     -- hasNext provides information on current status of the iterator and whether there are
 --     -- more elements in the collection key-value pairs returned by the result.
-    hasNext :: sqi -> Bool
+    hasNext :: sqi -> IO Bool
 --     -- close terminantes the iteration.
     close :: sqi -> IO (Maybe Error)
 --     -- Provides the next key-value pair pointed by the iterator

src/Shim.hs

@@ -10,6 +10,8 @@ module Shim
   , errorPayload
   , successPayload
   , ChaincodeStubInterface(..)
+  , StateQueryIterator(..)
+  , StateQueryIteratorInterface(..)
   )
 where
 
@@ -36,12 +38,15 @@ import           Peer.Proposal                 as Pb
 import           Peer.ProposalResponse         as Pb
 
 import           Stub
-import           Interfaces                     ( ChaincodeStubInterface(..) )
+import           Interfaces                     ( ChaincodeStubInterface(..)
+                                                , StateQueryIteratorInterface(..)
+                                                )
 import           Messages
 import           Types                          ( DefaultChaincodeStub(..)
                                                 , Error(..)
                                                 , ChaincodeStub(..)
                                                 , MapTextBytes
+                                                , StateQueryIterator(..)
                                                 )
 
 import           Debug.Trace

src/Stub.hs

@@ -27,6 +27,7 @@ import           Data.IORef                    (readIORef, newIORef, modifyIORef
 import           Control.Monad.Except          (ExceptT(..), runExceptT)
 
 import qualified Peer.ChaincodeShim            as Pb
+import qualified Ledger.Queryresult.KvQueryResult as Pb
 
 import           Network.GRPC.HighLevel
 import           Google.Protobuf.Timestamp     as Pb
@@ -134,7 +135,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
         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  _             -> ExceptT $ pure $ Left ParseError
+                  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 
@@ -156,12 +157,19 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
 
   -- TODO : implement all these interface functions
 instance StateQueryIteratorInterface StateQueryIterator where
-    -- hasNext :: sqi -> Bool
-  hasNext sqi = True
+    -- 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)
   -- close :: sqi -> IO (Maybe Error)
   close _ = pure Nothing
   -- next :: sqi -> IO (Either Error Pb.KV)
-  next _ = pure $ Left $ Error "not implemented"
+  next sqi = do
+    eeQueryResultBytes <- nextResult sqi 
+    case eeQueryResultBytes of
+      Left _ -> pure $ Left $ Error "Error getting next queryResultBytes"
+      Right queryResultBytes -> pure $ first DecodeError (parse (decodeMessage (FieldNumber 1)) (Pb.queryResultBytesResultBytes queryResultBytes) :: Either ParseError Pb.KV)
 
 
 nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes)
@@ -200,7 +208,7 @@ fetchNextQueryResult sqi = do
                   Pb.QueryResponse
       in  case eeaQueryResponse of
             -- TODO: refactor out pattern matching, e.g. using >>= or <*>
-            Left  _             -> ExceptT $ pure $ Left ParseError
+            Left  err             -> ExceptT $ pure $ Left $ DecodeError err
             Right queryResponse -> ExceptT $ do
             -- Need to put the new queryResponse in the sqi queryResponse
               writeIORef (sqiCurrentLoc sqi) 0

src/Types.hs

@@ -2,13 +2,15 @@ module Types where
 
 import           Data.ByteString
 import           Data.Map
-import           Data.Vector
+import qualified Data.Vector
 import           Data.Text
 import           Data.IORef
 import           System.IO.Unsafe
 
 import           Network.GRPC.HighLevel.Generated
 import           Proto3.Suite
+import           Proto3.Wire.Decode
+
 import           Network.GRPC.HighLevel
 
 import           Peer.ChaincodeShim            as Pb
@@ -19,7 +21,7 @@ import           Peer.ProposalResponse         as Pb
 data Error = GRPCError GRPCIOError
     | InvalidArgs
     | Error String
-    | ParseError
+    | DecodeError ParseError
    deriving (Eq, Show)
 
 data ChaincodeStub = ChaincodeStub {
@@ -34,7 +36,7 @@ data ChaincodeStub = ChaincodeStub {
 -- TODO: remove all these maybes when the stub is being created properly
 data DefaultChaincodeStub = DefaultChaincodeStub {
     -- chaincode invocation arguments. serialised as arrays of bytes.
-    args :: Vector ByteString,
+    args :: Data.Vector.Vector ByteString,
     -- -- name of the function being invoked.
     -- function :: Maybe Text,
     -- -- arguments of the function idenfied by the chaincode invocation.
@@ -68,9 +70,17 @@ data StateQueryIterator = StateQueryIterator {
 instance (Show a) => Show (IORef a) where
     show a = show (unsafePerformIO (readIORef a))
 
--- TODO: Implement this properly
 instance (Show DefaultChaincodeStub) where
-    show ccs = "Chaincode stub"
+    show ccs = "Chaincode stub { "
+        ++ show (args ccs) ++ ", "
+        ++ show (txId ccs) ++ ", "
+        ++ show (channelId ccs) ++  ", "
+        ++ show (creator ccs) ++ ", "
+        ++ show (signedProposal ccs) ++ ", "
+        ++ show (proposal ccs) ++ ", "
+        ++ show (transient ccs) ++ ", "
+        ++ show (binding ccs) ++ ", "
+        ++ show (decorations ccs) ++ " }"
 
 -- MapStringBytes is a synonym for the Map type whose keys are String and values
 type MapStringBytes = Map String ByteString