Skip to content
This repository was archived by the owner on Apr 13, 2022. It is now read-only.

Iterator methods #13

Closed
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 22 additions & 3 deletions examples/Marbles.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
-- 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", "2", ""]}' -C myc

module Marbles where

Expand All @@ -25,6 +26,7 @@ import Shim ( start
)

import Peer.ProposalResponse as Pb
import Ledger.Queryresult.KvQueryResult as Pb

import Data.Text ( Text
, unpack
Expand All @@ -35,6 +37,7 @@ 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
import qualified Data.Text.Lazy as TL

import Data.Aeson ( ToJSON
, FromJSON
Expand Down Expand Up @@ -93,8 +96,8 @@ invokeFunc s =
-- Right ("getHistoryForMarble", parameters) ->
-- getHistoryForMarble s parameters
Right ("getMarblesByRange", parameters) -> getMarblesByRange s parameters
-- Right ("getMarblesByRangeWithPagination", parameters) ->
-- getMarblesByRangeWithPagination s parameters
Right ("getMarblesByRangeWithPagination", parameters) ->
getMarblesByRangeWithPagination s parameters
-- Right ("queryMarblesWithPagination", parameters) ->
-- queryMarblesWithPagination s parameters
Right (fn , _ ) -> pure
Expand Down Expand Up @@ -183,14 +186,30 @@ 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"

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"
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
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".
generateResultBytes sqi (append text "abc")
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
generateResultBytes sqi (append text (makeKVString kv))
else pure $ Right $ TSE.encodeUtf8 text

parseMarble :: [Text] -> Marble
Expand Down
5 changes: 2 additions & 3 deletions src/Interfaces.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ import qualified Google.Protobuf.Timestamp as GooglePb
import qualified Peer.Proposal as Pb
import qualified Peer.ProposalResponse as Pb
import qualified Peer.Chaincode as Pb
import qualified Peer.ChaincodeShim as Pb


import Types
Expand All @@ -37,9 +38,7 @@ class ChaincodeStubInterface ccs where
-- setStateValidationParameter :: ccs -> String -> [ByteString] -> Maybe Error
-- getStateValiationParameter :: ccs -> String -> Either Error [ByteString]
getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)

-- 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 -> Text -> Text -> Int -> Text -> IO (Either Error (StateQueryIterator, Pb.QueryResponseMetadata))

-- getStateByPartialCompositeKey :: ccs -> String -> [String] -> Either Error StateQueryIterator
-- getStateByPartialCompositeKeyWithPagination :: ccs -> String -> [String] -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
Expand Down
185 changes: 93 additions & 92 deletions src/Stub.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,34 +127,37 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
getStateByRange ccs startKey endKey =
let payload = getStateByRangePayload startKey endKey
message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
-- 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
-- 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
}
in do
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
}
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

-- 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"

-- TODO : implement all these interface functions
instance StateQueryIteratorInterface StateQueryIterator where
-- hasNext :: sqi -> IO Bool
Expand Down Expand Up @@ -221,75 +224,73 @@ fetchNextQueryResult sqi = do
Right _ -> pure ()
runExceptT $ ExceptT (listenForResponse (recvStream $ sqiChaincodeStub sqi)) >>= bsToQueryResponse

--
-- -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
-- getStateByRangeWithPagination ccs startKey endKey pageSize bookmark = Left notImplemented
--
-- -- getStateByPartialCompositeKey :: ccs -> String -> [String] -> Either Error StateQueryIterator
-- getStateByPartialCompositeKey ccs objectType keys = Left notImplemented
--
-- --getStateByPartialCompositeKeyWithPagination :: ccs -> String -> [String] -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
-- getStateByPartialCompositeKeyWithPagination ccs objectType keys pageSize bookmark = Left notImplemented
--
-- --createCompositeKey :: ccs -> String -> [String] -> Either Error String
-- createCompositeKey ccs objectType keys = Left notImplemented
--
-- --splitCompositeKey :: ccs -> String -> Either Error (String, [String])
-- splitCompositeKey ccs key = Left notImplemented
--
-- --getQueryResult :: ccs -> String -> Either Error StateQueryIterator
-- getQueryResult ccs query = Left notImplemented
--
-- --getQueryResultWithPagination :: ccs -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
-- getQueryResultWithPagination ccs key pageSize bookmark = Left notImplemented
--
-- --getHistoryForKey :: ccs -> String -> Either Error HistoryQueryIterator
-- getHistoryForKey ccs key = Left notImplemented
--
-- --getPrivateData :: ccs -> String -> String -> Either Error ByteString
-- getPrivateData ccs collection key = Left notImplemented
--
-- --getPrivateDataHash :: ccs -> String -> String -> Either Error ByteString
-- getPrivateDataHash ccs collection key = Left notImplemented
--
-- --putPrivateData :: ccs -> String -> String -> ByteString -> Maybe Error
-- putPrivateData ccs collection string value = Right notImplemented
--
-- --delPrivateData :: ccs -> String -> String -> Maybe Error
-- delPrivateData ccs collection key = Right notImplemented
--
-- --setPrivateDataValidationParameter :: ccs -> String -> String -> ByteArray -> Maybe Error
-- setPrivateDataValidationParameter ccs collection key params = Right notImplemented
--
-- --getPrivateDataValidationParameter :: ccs -> String -> String -> Either Error ByteString
-- getPrivateDataValidationParameter ccs collection key = Left notImplemented
--
-- --getPrivateDataByRange :: ccs -> String -> String -> String -> Either Error StateQueryIterator
-- getPrivateDataByRange ccs collection startKey endKey = Left notImplemented
--
-- --getPrivateDataByPartialCompositeKey :: ccs -> String -> String -> [String] -> Either Error StateQueryIterator
-- getPrivateDataByPartialCompositeKey ccs collection objectType keys = Left notImplemented
--
-- -- getPrivateDataQueryResult :: ccs -> String -> String -> Either Error StateQueryIterator
-- getPrivateDataQueryResult ccs collection query = Left notImplemented
--
-- -- getCreator :: ccs -> Either Error ByteArray
-- getCreator ccs = Right creator
--
-- -- getTransient :: ccs -> Either Error MapStringBytes
-- getTransient ccs = Right transient
--
-- -- getBinding :: ccs -> Either Error MapStringBytes
-- getBinding ccs = Right binding
--
-- -- getDecorations :: ccs -> MapStringBytes
-- getDecorations ccs = Right decorations
--
-- -- getSignedProposal :: ccs -> Either Error Pb.SignedProposal
-- getSignedProposal ccs = Right signedProposal
--
-- -- getTxTimestamp :: ccs -> Either Error Pb.Timestamp
-- getTxTimestamp ccs = Right txTimestamp
--
-- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
-- setEvent ccs = Right notImplemented

--
-- -- getStateByPartialCompositeKey :: ccs -> String -> [String] -> Either Error StateQueryIterator
-- getStateByPartialCompositeKey ccs objectType keys = Left notImplemented
--
-- --getStateByPartialCompositeKeyWithPagination :: ccs -> String -> [String] -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
-- getStateByPartialCompositeKeyWithPagination ccs objectType keys pageSize bookmark = Left notImplemented
--
-- --createCompositeKey :: ccs -> String -> [String] -> Either Error String
-- createCompositeKey ccs objectType keys = Left notImplemented
--
-- --splitCompositeKey :: ccs -> String -> Either Error (String, [String])
-- splitCompositeKey ccs key = Left notImplemented
--
-- --getQueryResult :: ccs -> String -> Either Error StateQueryIterator
-- getQueryResult ccs query = Left notImplemented
--
-- --getQueryResultWithPagination :: ccs -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
-- getQueryResultWithPagination ccs key pageSize bookmark = Left notImplemented
--
-- --getHistoryForKey :: ccs -> String -> Either Error HistoryQueryIterator
-- getHistoryForKey ccs key = Left notImplemented
--
-- --getPrivateData :: ccs -> String -> String -> Either Error ByteString
-- getPrivateData ccs collection key = Left notImplemented
--
-- --getPrivateDataHash :: ccs -> String -> String -> Either Error ByteString
-- getPrivateDataHash ccs collection key = Left notImplemented
--
-- --putPrivateData :: ccs -> String -> String -> ByteString -> Maybe Error
-- putPrivateData ccs collection string value = Right notImplemented
--
-- --delPrivateData :: ccs -> String -> String -> Maybe Error
-- delPrivateData ccs collection key = Right notImplemented
--
-- --setPrivateDataValidationParameter :: ccs -> String -> String -> ByteArray -> Maybe Error
-- setPrivateDataValidationParameter ccs collection key params = Right notImplemented
--
-- --getPrivateDataValidationParameter :: ccs -> String -> String -> Either Error ByteString
-- getPrivateDataValidationParameter ccs collection key = Left notImplemented
--
-- --getPrivateDataByRange :: ccs -> String -> String -> String -> Either Error StateQueryIterator
-- getPrivateDataByRange ccs collection startKey endKey = Left notImplemented
--
-- --getPrivateDataByPartialCompositeKey :: ccs -> String -> String -> [String] -> Either Error StateQueryIterator
-- getPrivateDataByPartialCompositeKey ccs collection objectType keys = Left notImplemented
--
-- -- getPrivateDataQueryResult :: ccs -> String -> String -> Either Error StateQueryIterator
-- getPrivateDataQueryResult ccs collection query = Left notImplemented
--
-- -- getCreator :: ccs -> Either Error ByteArray
-- getCreator ccs = Right creator
--
-- -- getTransient :: ccs -> Either Error MapStringBytes
-- getTransient ccs = Right transient
--
-- -- getBinding :: ccs -> Either Error MapStringBytes
-- getBinding ccs = Right binding
--
-- -- getDecorations :: ccs -> MapStringBytes
-- getDecorations ccs = Right decorations
--
-- -- getSignedProposal :: ccs -> Either Error Pb.SignedProposal
-- getSignedProposal ccs = Right signedProposal
--
-- -- getTxTimestamp :: ccs -> Either Error Pb.Timestamp
-- getTxTimestamp ccs = Right txTimestamp
--
-- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
-- setEvent ccs = Right notImplemented