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

Commit 0f57360

Browse files
airvinnwaywood
airvin
and
nwaywood
committed
Implemented fetchNextQueryResult
Co-authored-by: Nick Waywood: <n.waywood@gmail.com> Signed-off-by: Allison Irvin <allison.irvin2@gmail.com>
1 parent a846116 commit 0f57360

File tree

3 files changed

+76
-31
lines changed

3 files changed

+76
-31
lines changed

‎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/Stub.hs‎

Lines changed: 62 additions & 27 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
@@ -25,7 +32,7 @@ import Network.GRPC.HighLevel
2532
import Google.Protobuf.Timestamp as Pb
2633
import Peer.Proposal as Pb
2734
import Proto3.Suite
28-
import Proto3.Wire.Decode
35+
import Proto3.Wire.Decode
2936

3037
import Interfaces
3138
import Messages
@@ -116,7 +123,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
116123

117124
-- TODO: Implement better error handling/checks etc
118125
-- getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)
119-
getStateByRange ccs startKey endKey =
126+
getStateByRange ccs startKey endKey =
120127
let payload = getStateByRangePayload startKey endKey
121128
message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
122129
-- We have listenForResponse a :: IO (Either Error ByteString)
@@ -126,34 +133,37 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
126133
bsToSqi :: ByteString -> ExceptT Error IO StateQueryIterator
127134
bsToSqi bs = let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse in
128135
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
136+
-- TODO: refactor out pattern matching, e.g. using >>= or <*>
137+
Left _ -> ExceptT $ pure $ Left ParseError
138+
Right queryResponse -> ExceptT $ do
139+
-- queryResponse and currentLoc are IORefs as they need to be mutated
140+
-- as a part of the next() function
141+
queryResponseIORef <- newIORef queryResponse
142+
currentLocIORef <- newIORef 0
143+
pure $ Right StateQueryIterator
144+
{ sqiChaincodeStub = ccs
145+
, sqiChannelId = getChannelId ccs
146+
, sqiTxId = getTxId ccs
147+
, sqiResponse = queryResponseIORef
148+
, sqiCurrentLoc = currentLocIORef
149+
}
150+
in do
151+
e <- (sendStream ccs) message
152+
case e of
153+
Left err -> error ("Error while streaming: " ++ show err)
154+
Right _ -> pure ()
155+
runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= bsToSqi
147156

148-
-- TODO : implement all these interface functions
157+
-- TODO : implement all these interface functions
149158
instance StateQueryIteratorInterface StateQueryIterator where
150-
-- hasNext :: sqi -> Bool
159+
-- hasNext :: sqi -> Bool
151160
hasNext sqi = True
152161
-- close :: sqi -> IO (Maybe Error)
153162
close _ = pure Nothing
154163
-- next :: sqi -> IO (Either Error Pb.KV)
155164
next _ = pure $ Left $ Error "not implemented"
156165

166+
157167
nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes)
158168
nextResult sqi = do
159169
currentLoc <- readIORef $ sqiCurrentLoc sqi
@@ -171,12 +181,37 @@ nextResult sqi = do
171181
queryResult
172182
else pure $ Left $ Error "Invalid iterator state"
173183

174-
-- TODO : this function is only called when the local result list has been
184+
185+
-- This function is only called when the local result list has been
175186
-- 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
187+
-- It makes a call to get the next QueryResponse back from the peer
188+
-- and mutates the sqi with the new QueryResponse and sets currentLoc back to 0
178189
fetchNextQueryResult :: StateQueryIterator -> IO (Either Error StateQueryIterator)
179-
fetchNextQueryResult sqi = pure $ Left $ Error "not yet implemented"
190+
fetchNextQueryResult sqi = do
191+
queryResponse <- readIORef $ sqiResponse sqi
192+
let
193+
payload = queryNextStatePayload $ TL.toStrict $ Pb.queryResponseId queryResponse
194+
message = buildChaincodeMessage QUERY_STATE_NEXT payload (sqiTxId sqi) (sqiChannelId sqi)
195+
bsToQueryResponse :: ByteString -> ExceptT Error IO StateQueryIterator
196+
bsToQueryResponse bs =
197+
let eeaQueryResponse =
198+
parse (decodeMessage (FieldNumber 1)) bs :: Either
199+
ParseError
200+
Pb.QueryResponse
201+
in case eeaQueryResponse of
202+
-- TODO: refactor out pattern matching, e.g. using >>= or <*>
203+
Left _ -> ExceptT $ pure $ Left ParseError
204+
Right queryResponse -> ExceptT $ do
205+
-- Need to put the new queryResponse in the sqi queryResponse
206+
writeIORef (sqiCurrentLoc sqi) 0
207+
writeIORef (sqiResponse sqi) queryResponse
208+
pure $ Right sqi
209+
in do
210+
e <- (sendStream $ sqiChaincodeStub sqi) message
211+
case e of
212+
Left err -> error ("Error while streaming: " ++ show err)
213+
Right _ -> pure ()
214+
runExceptT $ ExceptT (listenForResponse (recvStream $ sqiChaincodeStub sqi)) >>= bsToQueryResponse
180215

181216
--
182217
-- -- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
@@ -249,4 +284,4 @@ fetchNextQueryResult sqi = pure $ Left $ Error "not yet implemented"
249284
-- getTxTimestamp ccs = Right txTimestamp
250285
--
251286
-- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
252-
-- setEvent ccs = Right notImplemented
287+
-- setEvent ccs = Right notImplemented

‎src/Types.hs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ data DefaultChaincodeStub = DefaultChaincodeStub {
5858
}
5959

6060
data StateQueryIterator = StateQueryIterator {
61+
sqiChaincodeStub :: DefaultChaincodeStub,
6162
sqiChannelId :: Text,
6263
sqiTxId :: Text,
6364
sqiResponse :: IORef Pb.QueryResponse,
@@ -67,8 +68,12 @@ data StateQueryIterator = StateQueryIterator {
6768
instance (Show a) => Show (IORef a) where
6869
show a = show (unsafePerformIO (readIORef a))
6970

71+
-- TODO: Implement this properly
72+
instance (Show DefaultChaincodeStub) where
73+
show ccs = "Chaincode stub"
74+
7075
-- MapStringBytes is a synonym for the Map type whose keys are String and values
7176
type MapStringBytes = Map String ByteString
7277

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

0 commit comments

Comments
 (0)