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

Commit 7fa0ed7

Browse files
airvinairvin
authored
Merge pull request #11 from airvin/iterator-methods
Iterator methods
2 parents bf8067f + 32f0822 commit 7fa0ed7

File tree

7 files changed

+141
-43
lines changed

7 files changed

+141
-43
lines changed

‎.gitignore‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,6 @@ fabric-chaincode-haskell.cabal
33
*~
44
dist-newstyle
55
cabal.project.local
6+
7+
.vscode
8+
hie.yaml

‎examples/Marbles.hs‎

Lines changed: 27 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -19,14 +19,19 @@ import Shim ( start
1919
, ChaincodeStub(..)
2020
, ChaincodeStubInterface(..)
2121
, DefaultChaincodeStub
22+
, StateQueryIterator(..)
23+
, StateQueryIteratorInterface(..)
24+
, Error(..)
2225
)
2326

2427
import Peer.ProposalResponse as Pb
2528

2629
import Data.Text ( Text
2730
, unpack
2831
, pack
32+
, append
2933
)
34+
import qualified Data.Text.Encoding as TSE
3035
import qualified Data.ByteString as BS
3136
import qualified Data.ByteString.UTF8 as BSU
3237
import qualified Data.ByteString.Lazy as LBS
@@ -61,8 +66,14 @@ instance ToJSON Marble where
6166
instance FromJSON Marble
6267

6368
initFunc :: DefaultChaincodeStub -> IO Pb.Response
64-
initFunc _ = pure $ successPayload Nothing
65-
69+
initFunc s =
70+
let e = getFunctionAndParameters s
71+
in
72+
case e of
73+
Left _ -> pure $ errorPayload ""
74+
Right ("initMarble" , parameters) -> initMarble s parameters
75+
Right (fn , _ ) -> pure
76+
$ errorPayload (pack ("Invoke did not find function: " ++ unpack fn))
6677

6778
invokeFunc :: DefaultChaincodeStub -> IO Pb.Response
6879
invokeFunc s =
@@ -167,9 +178,20 @@ getMarblesByRange s params = if Prelude.length params == 2
167178
e <- getStateByRange s (params !! 0) (params !! 1)
168179
case e of
169180
Left _ -> pure $ errorPayload "Failed to get marbles"
170-
Right a -> trace (show a) (pure $ successPayload Nothing)
171-
else pure $ errorPayload
172-
"Incorrect arguments. Need a start key and an end key"
181+
Right sqi -> do
182+
resultBytes <- generateResultBytes sqi ""
183+
trace (show resultBytes) (pure $ successPayload Nothing)
184+
else pure $ errorPayload "Incorrect arguments. Need a start key and an end key"
185+
186+
generateResultBytes :: StateQueryIterator -> Text -> IO (Either Error BSU.ByteString)
187+
generateResultBytes sqi text = do
188+
hasNextBool <- hasNext sqi
189+
if hasNextBool then do
190+
eeKV <- next sqi
191+
-- TODO: We need to check that the Either Error KV returned from next
192+
-- is correct and append the showable version of KVs instead of "abc".
193+
generateResultBytes sqi (append text "abc")
194+
else pure $ Right $ TSE.encodeUtf8 text
173195

174196
parseMarble :: [Text] -> Marble
175197
parseMarble params = Marble { objectType = "marble"

‎src/Interfaces.hs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,10 @@ class ChaincodeStubInterface ccs where
3737
-- setStateValidationParameter :: ccs -> String -> [ByteString] -> Maybe Error
3838
-- getStateValiationParameter :: ccs -> String -> Either Error [ByteString]
3939
getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)
40+
41+
-- TODO: We need to implement this so we can test the fetchNextQueryResult functionality
4042
-- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
43+
4144
-- getStateByPartialCompositeKey :: ccs -> String -> [String] -> Either Error StateQueryIterator
4245
-- getStateByPartialCompositeKeyWithPagination :: ccs -> String -> [String] -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
4346
-- createCompositeKey :: ccs -> String -> [String] -> Either Error String
@@ -68,10 +71,12 @@ class ChaincodeStubInterface ccs where
6871
class StateQueryIteratorInterface sqi where
6972
-- -- hasNext provides information on current status of the iterator and whether there are
7073
-- -- more elements in the collection key-value pairs returned by the result.
71-
hasNext :: sqi -> Bool
74+
hasNext :: sqi -> IO Bool
7275
-- -- close terminantes the iteration.
7376
close :: sqi -> IO (Maybe Error)
7477
-- -- Provides the next key-value pair pointed by the iterator
78+
-- TODO: Change this to an ExceptT type to make handling the next function
79+
-- easier on the user chaincode side
7580
next :: sqi -> IO (Either Error Pb.KV)
7681

7782
-- The type class HistoryQueryIterator defines the behaviour of the types that expose functionalities

‎src/Messages.hs‎

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ import Peer.Chaincode as Pb
2020
import Peer.ProposalResponse as Pb
2121

2222

23-
data CCMessageType = GET_STATE | PUT_STATE | DEL_STATE | REGISTER | COMPLETED | GET_STATE_BY_RANGE
23+
data CCMessageType = GET_STATE | PUT_STATE | DEL_STATE | REGISTER | COMPLETED | GET_STATE_BY_RANGE | QUERY_STATE_NEXT
2424

2525
regMessage :: ChaincodeMessage
2626
regMessage = buildChaincodeMessage REGISTER regPayload "" ""
@@ -74,6 +74,10 @@ getStateByRangePayload startKey endKey = Pb.GetStateByRange {
7474
, getStateByRangeMetadata = BSU.fromString ""
7575
}
7676

77+
queryNextStatePayload :: Text -> Pb.QueryStateNext
78+
queryNextStatePayload id =
79+
Pb.QueryStateNext { queryStateNextId = fromStrict id }
80+
7781
-- buildChaincodeMessage
7882
-- :: Enumerated Pb.ChaincodeMessage_Type
7983
-- -> a
@@ -84,8 +88,8 @@ buildChaincodeMessage mesType payload txid chanID = ChaincodeMessage
8488
{ chaincodeMessageType = getCCMessageType mesType
8589
, chaincodeMessageTimestamp = Nothing
8690
, chaincodeMessagePayload = LBS.toStrict
87-
$ Wire.toLazyByteString
88-
$ encodeMessage (FieldNumber 1) payload
91+
$ Wire.toLazyByteString
92+
$ encodeMessage (FieldNumber 1) payload
8993
, chaincodeMessageTxid = fromStrict txid
9094
, chaincodeMessageProposal = Nothing
9195
, chaincodeMessageChaincodeEvent = Nothing
@@ -101,3 +105,4 @@ getCCMessageType ccMessageType = case ccMessageType of
101105
COMPLETED -> Enumerated $ Right ChaincodeMessage_TypeCOMPLETED
102106
GET_STATE_BY_RANGE ->
103107
Enumerated $ Right ChaincodeMessage_TypeGET_STATE_BY_RANGE
108+
QUERY_STATE_NEXT -> Enumerated $ Right ChaincodeMessage_TypeQUERY_STATE_NEXT

‎src/Shim.hs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,8 @@ module Shim
1010
, errorPayload
1111
, successPayload
1212
, ChaincodeStubInterface(..)
13+
, StateQueryIterator(..)
14+
, StateQueryIteratorInterface(..)
1315
)
1416
where
1517

@@ -36,12 +38,15 @@ import Peer.Proposal as Pb
3638
import Peer.ProposalResponse as Pb
3739

3840
import Stub
39-
import Interfaces ( ChaincodeStubInterface(..) )
41+
import Interfaces ( ChaincodeStubInterface(..)
42+
, StateQueryIteratorInterface(..)
43+
)
4044
import Messages
4145
import Types ( DefaultChaincodeStub(..)
4246
, Error(..)
4347
, ChaincodeStub(..)
4448
, MapTextBytes
49+
, StateQueryIterator(..)
4550
)
4651

4752
import Debug.Trace

‎src/Stub.hs‎

Lines changed: 72 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,19 @@
11
{-# LANGUAGE OverloadedStrings #-}
2+
{-# OPTIONS_GHC -fno-warn-orphans #-}
23

34
module Stub where
45

56

67
import Data.Bifunctor
78
import Data.ByteString as BS
89
import Data.Text
10+
import Data.Text.Lazy as TL
911
import Data.Text.Encoding
12+
import Data.IORef ( readIORef
13+
, newIORef
14+
, modifyIORef
15+
, writeIORef
16+
)
1017
import Data.Vector as Vector
1118
( Vector
1219
, length
@@ -20,12 +27,13 @@ import Data.IORef (readIORef, newIORef, modifyIORef
2027
import Control.Monad.Except (ExceptT(..), runExceptT)
2128

2229
import qualified Peer.ChaincodeShim as Pb
30+
import qualified Ledger.Queryresult.KvQueryResult as Pb
2331

2432
import Network.GRPC.HighLevel
2533
import Google.Protobuf.Timestamp as Pb
2634
import Peer.Proposal as Pb
2735
import Proto3.Suite
28-
import Proto3.Wire.Decode
36+
import Proto3.Wire.Decode
2937

3038
import Interfaces
3139
import Messages
@@ -116,7 +124,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
116124

117125
-- TODO: Implement better error handling/checks etc
118126
-- getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)
119-
getStateByRange ccs startKey endKey =
127+
getStateByRange ccs startKey endKey =
120128
let payload = getStateByRangePayload startKey endKey
121129
message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
122130
-- We have listenForResponse a :: IO (Either Error ByteString)
@@ -126,33 +134,43 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
126134
bsToSqi :: ByteString -> ExceptT Error IO StateQueryIterator
127135
bsToSqi bs = let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse in
128136
case eeaQueryResponse of
129-
Left _ -> ExceptT $ pure $ Left ParseError
130-
Right queryResponse -> ExceptT $ do
131-
-- queryResponse and currentLoc are IORefs as they need to be mutated
132-
-- as a part of the next() function
133-
queryResponseIORef <- newIORef queryResponse
134-
currentLocIORef <- newIORef 0
135-
pure $ Right StateQueryIterator {
136-
sqiChannelId = getChannelId ccs
137-
, sqiTxId = getTxId ccs
138-
, sqiResponse = queryResponseIORef
139-
, sqiCurrentLoc = currentLocIORef
140-
}
141-
in do
142-
e <- (sendStream ccs) message
143-
case e of
144-
Left err -> error ("Error while streaming: " ++ show err)
145-
Right _ -> pure ()
146-
runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= bsToSqi
137+
-- TODO: refactor out pattern matching, e.g. using >>= or <*>
138+
Left err -> ExceptT $ pure $ Left $ DecodeError err
139+
Right queryResponse -> ExceptT $ do
140+
-- queryResponse and currentLoc are IORefs as they need to be mutated
141+
-- as a part of the next() function
142+
queryResponseIORef <- newIORef queryResponse
143+
currentLocIORef <- newIORef 0
144+
pure $ Right StateQueryIterator
145+
{ sqiChaincodeStub = ccs
146+
, sqiChannelId = getChannelId ccs
147+
, sqiTxId = getTxId ccs
148+
, sqiResponse = queryResponseIORef
149+
, sqiCurrentLoc = currentLocIORef
150+
}
151+
in do
152+
e <- (sendStream ccs) message
153+
case e of
154+
Left err -> error ("Error while streaming: " ++ show err)
155+
Right _ -> pure ()
156+
runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= bsToSqi
147157

148-
-- TODO : implement all these interface functions
158+
-- TODO : implement all these interface functions
149159
instance StateQueryIteratorInterface StateQueryIterator where
150-
-- hasNext :: sqi -> Bool
151-
hasNext sqi = True
160+
-- hasNext :: sqi -> IO Bool
161+
hasNext sqi = do
162+
queryResponse <- readIORef $ sqiResponse sqi
163+
currentLoc <- readIORef $ sqiCurrentLoc sqi
164+
pure $ currentLoc < Prelude.length (Pb.queryResponseResults queryResponse) || (Pb.queryResponseHasMore queryResponse)
152165
-- close :: sqi -> IO (Maybe Error)
153166
close _ = pure Nothing
154167
-- next :: sqi -> IO (Either Error Pb.KV)
155-
next _ = pure $ Left $ Error "not implemented"
168+
next sqi = do
169+
eeQueryResultBytes <- nextResult sqi
170+
case eeQueryResultBytes of
171+
Left _ -> pure $ Left $ Error "Error getting next queryResultBytes"
172+
Right queryResultBytes -> pure $ first DecodeError (parse (decodeMessage (FieldNumber 1)) (Pb.queryResultBytesResultBytes queryResultBytes) :: Either ParseError Pb.KV)
173+
156174

157175
nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes)
158176
nextResult sqi = do
@@ -171,12 +189,37 @@ nextResult sqi = do
171189
queryResult
172190
else pure $ Left $ Error "Invalid iterator state"
173191

174-
-- TODO : this function is only called when the local result list has been
192+
193+
-- This function is only called when the local result list has been
175194
-- iterated through and there are more results to get from the peer
176-
-- It makes a call to get the next QueryResponse back from the peer
177-
-- and mutates the response with the new QueryResponse and set currentLoc back to 0
195+
-- It makes a call to get the next QueryResponse back from the peer
196+
-- and mutates the sqi with the new QueryResponse and sets currentLoc back to 0
178197
fetchNextQueryResult :: StateQueryIterator -> IO (Either Error StateQueryIterator)
179-
fetchNextQueryResult sqi = pure $ Left $ Error "not yet implemented"
198+
fetchNextQueryResult sqi = do
199+
queryResponse <- readIORef $ sqiResponse sqi
200+
let
201+
payload = queryNextStatePayload $ TL.toStrict $ Pb.queryResponseId queryResponse
202+
message = buildChaincodeMessage QUERY_STATE_NEXT payload (sqiTxId sqi) (sqiChannelId sqi)
203+
bsToQueryResponse :: ByteString -> ExceptT Error IO StateQueryIterator
204+
bsToQueryResponse bs =
205+
let eeaQueryResponse =
206+
parse (decodeMessage (FieldNumber 1)) bs :: Either
207+
ParseError
208+
Pb.QueryResponse
209+
in case eeaQueryResponse of
210+
-- TODO: refactor out pattern matching, e.g. using >>= or <*>
211+
Left err -> ExceptT $ pure $ Left $ DecodeError err
212+
Right queryResponse -> ExceptT $ do
213+
-- Need to put the new queryResponse in the sqi queryResponse
214+
writeIORef (sqiCurrentLoc sqi) 0
215+
writeIORef (sqiResponse sqi) queryResponse
216+
pure $ Right sqi
217+
in do
218+
e <- (sendStream $ sqiChaincodeStub sqi) message
219+
case e of
220+
Left err -> error ("Error while streaming: " ++ show err)
221+
Right _ -> pure ()
222+
runExceptT $ ExceptT (listenForResponse (recvStream $ sqiChaincodeStub sqi)) >>= bsToQueryResponse
180223

181224
--
182225
-- -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
@@ -249,4 +292,4 @@ fetchNextQueryResult sqi = pure $ Left $ Error "not yet implemented"
249292
-- getTxTimestamp ccs = Right txTimestamp
250293
--
251294
-- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
252-
-- setEvent ccs = Right notImplemented
295+
-- setEvent ccs = Right notImplemented

‎src/Types.hs‎

Lines changed: 19 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,15 @@ module Types where
22

33
import Data.ByteString
44
import Data.Map
5-
import Data.Vector
5+
import qualified Data.Vector
66
import Data.Text
77
import Data.IORef
88
import System.IO.Unsafe
99

1010
import Network.GRPC.HighLevel.Generated
1111
import Proto3.Suite
12+
import Proto3.Wire.Decode
13+
1214
import Network.GRPC.HighLevel
1315

1416
import Peer.ChaincodeShim as Pb
@@ -19,7 +21,7 @@ import Peer.ProposalResponse as Pb
1921
data Error = GRPCError GRPCIOError
2022
| InvalidArgs
2123
| Error String
22-
| ParseError
24+
| DecodeError ParseError
2325
deriving (Eq, Show)
2426

2527
data ChaincodeStub = ChaincodeStub {
@@ -34,7 +36,7 @@ data ChaincodeStub = ChaincodeStub {
3436
-- TODO: remove all these maybes when the stub is being created properly
3537
data DefaultChaincodeStub = DefaultChaincodeStub {
3638
-- chaincode invocation arguments. serialised as arrays of bytes.
37-
args :: Vector ByteString,
39+
args :: Data.Vector.Vector ByteString,
3840
-- -- name of the function being invoked.
3941
-- function :: Maybe Text,
4042
-- -- arguments of the function idenfied by the chaincode invocation.
@@ -58,6 +60,7 @@ data DefaultChaincodeStub = DefaultChaincodeStub {
5860
}
5961

6062
data StateQueryIterator = StateQueryIterator {
63+
sqiChaincodeStub :: DefaultChaincodeStub,
6164
sqiChannelId :: Text,
6265
sqiTxId :: Text,
6366
sqiResponse :: IORef Pb.QueryResponse,
@@ -67,8 +70,20 @@ data StateQueryIterator = StateQueryIterator {
6770
instance (Show a) => Show (IORef a) where
6871
show a = show (unsafePerformIO (readIORef a))
6972

73+
instance (Show DefaultChaincodeStub) where
74+
show ccs = "Chaincode stub { "
75+
++ show (args ccs) ++ ", "
76+
++ show (txId ccs) ++ ", "
77+
++ show (channelId ccs) ++ ", "
78+
++ show (creator ccs) ++ ", "
79+
++ show (signedProposal ccs) ++ ", "
80+
++ show (proposal ccs) ++ ", "
81+
++ show (transient ccs) ++ ", "
82+
++ show (binding ccs) ++ ", "
83+
++ show (decorations ccs) ++ " }"
84+
7085
-- MapStringBytes is a synonym for the Map type whose keys are String and values
7186
type MapStringBytes = Map String ByteString
7287

7388
-- MapTextBytes is a synonym for the Map type whose keys are Text and values
74-
type MapTextBytes = Map Text ByteString
89+
type MapTextBytes = Map Text ByteString

0 commit comments

Comments
 (0)