Work in progress to refactor getStateByRange stub function

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

Author: airvin

examples/Marbles.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 
 -- Example invocations:
+-- peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc -o orderer:7050
 -- peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc
 -- peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble2","blue","large","Nick"]}' -C myc
 -- peer chaincode invoke -n mycc -c '{"Args":["readMarble","marble1"]}' -C myc

package.yaml

@@ -28,6 +28,7 @@ dependencies:
   - containers
   - utf8-string
   - aeson
+  - mtl
 
 library:
   source-dirs:

src/Interfaces.hs

@@ -70,9 +70,9 @@ class StateQueryIteratorInterface sqi where
 --     -- more elements in the collection key-value pairs returned by the result.
     hasNext :: sqi -> Bool
 --     -- close terminantes the iteration.
-    close :: sqi -> Maybe Error
+    close :: sqi -> IO (Maybe Error)
 --     -- Provides the next key-value pair pointed by the iterator
-    next :: sqi -> Either Error Pb.KV
+    next :: sqi -> IO (Either Error Pb.KV)
 
 -- The type class HistoryQueryIterator defines the behaviour of the types that expose functionalities
 -- for iteratogin over a set of key modifications that are associated to the history of a key.

src/Stub.hs

@@ -16,6 +16,8 @@ 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
 
@@ -111,27 +113,71 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
     -- -- getStateValiationParameter :: ccs -> String -> Either Error [ByteString]
     -- getStateValiationParameter ccs key = Left notImplemented
     --
+
+  -- 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) 
-        bsToSqi :: ByteString -> Either Error StateQueryIterator
+        -- We have listenForResponse a :: IO (Either Error ByteString)
+        -- and the function bsToSqi :: ByteString -> IO (Either Error StateQueryIterator)
+        -- And want IO (Either Error StateQueryIterator)
+        -- 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
-            Left _ -> Left ParseError
-            Right queryResponse -> Right StateQueryIterator {
-                sqiChannelId = getChannelId ccs
-                , sqiTxId = getTxId ccs
-                , sqiResponse = queryResponse
-                , sqiCurrentLoc = 0
-              }
+            Left _ -> ExceptT $ pure $ Left ParseError
+            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 {
+              sqiChannelId = getChannelId ccs
+              , sqiTxId = getTxId ccs
+              , sqiResponse = queryResponseIORef
+              , sqiCurrentLoc = currentLocIORef
+            }
     in do 
       e <- (sendStream ccs) message
       case e of
         Left err -> error ("Error while streaming: " ++ show err)
         Right _ -> pure ()
-      (bsToSqi =<<) <$> listenForResponse (recvStream ccs)
+      runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= bsToSqi
+
+-- TODO : implement all these interface functions
+instance StateQueryIteratorInterface StateQueryIterator where
+  -- hasNext :: sqi -> Bool
+  hasNext sqi = True
+  -- close :: sqi -> IO (Maybe Error)
+  close _ = pure Nothing
+  -- next :: sqi -> IO (Either Error Pb.KV)
+  next _ = pure $ Left $ Error "not implemented"
 
+nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes)
+nextResult sqi = do
+  currentLoc <- readIORef $ sqiCurrentLoc sqi
+  queryResponse <- readIORef $ sqiResponse sqi
+  -- Checking if there are more local results
+  if (currentLoc < Prelude.length (Pb.queryResponseResults $ queryResponse)) then
+    let queryResult = pure $ Right $ (Pb.queryResponseResults $ queryResponse) ! currentLoc in
+      do
+        modifyIORef (sqiCurrentLoc sqi) (+ 1)
+        if ((currentLoc + 1) == Prelude.length (Pb.queryResponseResults $ queryResponse)) then
+          do
+            fetchNextQueryResult sqi
+            queryResult
+        else
+          queryResult
+  else pure $ Left $ Error "Invalid iterator state"
+
+-- TODO : this function is only called when the local result list has been
+-- iterated through and there are more results to get from the peer
+-- It makes a call to get the next QueryResponse back from the peer
+-- and mutates the response with the new QueryResponse and set currentLoc back to 0
+fetchNextQueryResult :: StateQueryIterator -> IO (Either Error StateQueryIterator)
+fetchNextQueryResult sqi =  pure $ Left $ Error "not yet implemented"
+    
     --
     -- -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
     -- getStateByRangeWithPagination ccs startKey endKey pageSize bookmark = Left notImplemented
@@ -203,28 +249,4 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
     -- getTxTimestamp ccs = Right txTimestamp
     --
     -- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
-    -- setEvent ccs = Right notImplemented
-
-instance StateQueryIteratorInterface StateQueryIterator where
-    -- hasNext :: sqi -> Bool
-    hasNext sqi = True
-    -- close :: sqi -> Maybe Error
-    close _ = Nothing
-    -- next :: sqi -> Either Error Pb.KV
-    next _ = Left $ Error "not implemented"
-
-nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes)
-nextResult sqi = let x = _one =<< (fetchNextQueryResult sqi) in _two
-  -- if (sqiCurrentLoc sqi) < Prelude.length (Pb.queryResponseResults $ sqiResponse sqi) then
-  --   pure $ Right $  (Pb.queryResponseResults $ sqiResponse sqi) ! (sqiCurrentLoc sqi)
-  -- else pure $ Left $ Error "what"     
-  --   if Pb.queryResponseHasMore $ sqiResponse sqi then 
-  --     x
-  --     -- (nextResult =<<) =<< (fetchNextQueryResult sqi)
-  --     -- _ <$> (fetchNextQueryResult sqi)
-  --   else pure $ Left $ Error "Error retrieving next queryResult"
-
-
-  -- x = fetchNextQueryResult sqi >>= (\eeSqi -> pure $ eeSqi >>= (\a -> pure $ nextResult a))
-fetchNextQueryResult :: StateQueryIterator -> IO (Either Error StateQueryIterator)
-fetchNextQueryResult sqi =  pure $ Left $ Error "not yet implemented"
+    -- setEvent ccs = Right notImplemented

src/Types.hs

@@ -4,6 +4,8 @@ import           Data.ByteString
 import           Data.Map
 import           Data.Vector
 import           Data.Text
+import           Data.IORef
+import           System.IO.Unsafe
 
 import           Network.GRPC.HighLevel.Generated
 import           Proto3.Suite
@@ -58,10 +60,13 @@ data DefaultChaincodeStub = DefaultChaincodeStub {
 data StateQueryIterator = StateQueryIterator {
     sqiChannelId :: Text,
     sqiTxId :: Text,
-    sqiResponse :: Pb.QueryResponse,
-    sqiCurrentLoc :: Int
+    sqiResponse :: IORef Pb.QueryResponse,
+    sqiCurrentLoc :: IORef Int
 } deriving (Show)
 
+instance (Show a) => Show (IORef a) where
+    show a = show (unsafePerformIO (readIORef a))
+
 -- MapStringBytes is a synonym for the Map type whose keys are String and values
 type MapStringBytes = Map String ByteString