Added implementation of getStateByRange

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

Author: airvin

examples/Marbles.hs

@@ -3,9 +3,11 @@
 
 -- Example invocations:
 -- 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
 -- 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
 
 module Marbles where
 
@@ -78,8 +80,7 @@ invokeFunc s =
       -- Right ("queryMarbles", parameters) -> queryMarbles s parameters
       -- Right ("getHistoryForMarble", parameters) ->
       --   getHistoryForMarble s parameters
-      -- Right ("getMarblesByRange", parameters) ->
-      --   getMarblesByRange s parameters
+      Right ("getMarblesByRange", parameters) -> getMarblesByRange s parameters
       -- Right ("getMarblesByRangeWithPagination", parameters) ->
       --   getMarblesByRangeWithPagination s parameters
       -- Right ("queryMarblesWithPagination", parameters) ->
@@ -159,6 +160,16 @@ readMarble s params = if Prelude.length params == 1
   else pure $ errorPayload
     "Incorrect arguments. Need a marble name, color, size and owner"
 
+getMarblesByRange :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
+getMarblesByRange s params = if Prelude.length params == 2
+  then do 
+    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" 
+
 parseMarble :: [Text] -> Marble
 parseMarble params = Marble { objectType = "marble"
                             , name       = params !! 0

src/Interfaces.hs

@@ -1,6 +1,6 @@
 module Interfaces
   ( ChaincodeStubInterface(..)
-  , StateQueryIterator(..)
+  , StateQueryIteratorInterface(..)
   )
 where
 
@@ -36,7 +36,7 @@ class ChaincodeStubInterface ccs where
 
     -- setStateValidationParameter :: ccs -> String -> [ByteString] -> Maybe Error
     -- getStateValiationParameter :: ccs -> String -> Either Error [ByteString]
-    getStateByRange :: ccs -> Text -> Text -> Either Error StateQueryIterator
+    getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)
     -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
     -- getStateByPartialCompositeKey :: ccs -> String -> [String] -> Either Error StateQueryIterator
     -- getStateByPartialCompositeKeyWithPagination :: ccs -> String -> [String] -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)

src/Messages.hs

@@ -2,6 +2,7 @@
 
 module Messages where
 
+import qualified Data.ByteString.UTF8          as BSU
 import qualified Data.ByteString.Lazy          as LBS
 import           Data.ByteString               as BS
 import           Data.Text
@@ -65,6 +66,14 @@ delStatePayload :: Text -> Pb.DelState
 delStatePayload key =
   Pb.DelState {delStateKey = fromStrict key, delStateCollection = ""}
 
+getStateByRangePayload :: Text -> Text -> Pb.GetStateByRange
+getStateByRangePayload startKey endKey = Pb.GetStateByRange {
+    getStateByRangeStartKey = fromStrict startKey
+    , getStateByRangeEndKey = fromStrict endKey
+    , getStateByRangeCollection = ""
+    , getStateByRangeMetadata = BSU.fromString ""
+}
+
 -- buildChaincodeMessage
 --   :: Enumerated Pb.ChaincodeMessage_Type
 --   -> a

src/Stub.hs

@@ -3,6 +3,7 @@
 module Stub where
 
 
+import           Data.Bifunctor
 import           Data.ByteString               as BS
 import           Data.Text
 import           Data.Text.Encoding
@@ -13,19 +14,20 @@ import           Data.Vector                   as Vector
                                                 , foldr
                                                 , empty
                                                 )
+import qualified Data.ByteString.Lazy          as LBS
 
 import           Peer.ChaincodeShim
 
 import           Network.GRPC.HighLevel
 import           Google.Protobuf.Timestamp     as Pb
 import           Peer.Proposal                 as Pb
 import           Proto3.Suite
+import           Proto3.Wire.Decode            
 
 import           Interfaces
 import           Messages
 import           Types
 
-
 -- 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 ChaincodeMessage -> IO (Either Error ByteString)
@@ -66,7 +68,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
   -- 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 -> IO (Either Error ByteString)
   getState ccs key =
     let payload = getStatePayload key
         message =
@@ -78,7 +80,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
             Right _   -> pure ()
           listenForResponse (recvStream ccs)
 
-  -- -- putState :: ccs -> Text -> ByteString -> Maybe Error
+  -- putState :: ccs -> Text -> ByteString -> Maybe Error
   putState ccs key value =
     let payload = putStatePayload key value
         message =
@@ -108,16 +110,27 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
     -- -- getStateValiationParameter :: ccs -> String -> Either Error [ByteString]
     -- getStateValiationParameter ccs key = Left notImplemented
     --
-    -- getStateByRange :: ccs -> Text -> Text -> Either Error StateQueryIterator
-    getStateByRange ccs startKey endKey = 
-      let payload = getStateByRangePayload startKey endKey
-          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 ()
-        listenForResponse (recvStream ccs) 
+  -- 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
+        bsToSqi bs = let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError QueryResponse in
+          case eeaQueryResponse of
+            Left _ -> Left ParseError
+            Right queryResponse -> Right StateQueryIterator {
+                sqiChannelId = getChannelId ccs
+                , sqiTxId = getTxId ccs
+                , sqiResponse = queryResponse
+                , sqiCurrentLoc = 0
+              }
+    in do 
+      e <- (sendStream ccs) message
+      case e of
+        Left err -> error ("Error while streaming: " ++ show err)
+        Right _ -> pure ()
+      (bsToSqi =<<) <$> listenForResponse (recvStream ccs)
+
     --
     -- -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
     -- getStateByRangeWithPagination ccs startKey endKey pageSize bookmark = Left notImplemented
@@ -191,10 +204,10 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
     -- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
     -- setEvent ccs = Right notImplemented
 
-instance StateQueryIteratorInterface DefaultStateQueryIterator where
+instance StateQueryIteratorInterface StateQueryIterator where
     -- hasNext :: sqi -> Bool
     hasNext sqi = True
     -- close :: sqi -> Maybe Error
     close _ = Nothing
     -- next :: sqi -> Either Error Pb.KV
-    next _ = Left _
+    next _ = Left $ Error "not implemented"

src/Types.hs

@@ -9,14 +9,15 @@ import           Network.GRPC.HighLevel.Generated
 import           Proto3.Suite
 import           Network.GRPC.HighLevel
 
-import           Peer.ChaincodeShim
+import           Peer.ChaincodeShim            as Pb
 import           Google.Protobuf.Timestamp     as Pb
 import           Peer.Proposal                 as Pb
 import           Peer.ProposalResponse         as Pb
 
 data Error = GRPCError GRPCIOError
     | InvalidArgs
     | Error String
+    | ParseError
    deriving (Eq, Show)
 
 data ChaincodeStub = ChaincodeStub {
@@ -54,12 +55,12 @@ data DefaultChaincodeStub = DefaultChaincodeStub {
     sendStream :: StreamSend ChaincodeMessage
 }
 
-data DefaultStateQueryIterator = DefaultStateQueryIterator {
-    channelId :: Text
-    txId :: Text
-    response :: Pb.QueryResponse
-	currentLoc :: Int
-}   
+data StateQueryIterator = StateQueryIterator {
+    sqiChannelId :: Text,
+    sqiTxId :: Text,
+    sqiResponse :: Pb.QueryResponse,
+	sqiCurrentLoc :: Int
+} deriving (Show)
 
 -- MapStringBytes is a synonym for the Map type whose keys are String and values
 type MapStringBytes = Map String ByteString