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

Commit 7a9d6d1

Browse files
airvinnwaywood
andcommitted
Added more stub functions
Co-authored-by: Nick Waywood <n.waywood@gmail.com> Signed-off-by: Allison Irvin <allison.irvin2@gmail.com>
1 parent ed3a029 commit 7a9d6d1

File tree

6 files changed

+134
-107
lines changed

6 files changed

+134
-107
lines changed

src/Helper.hs

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Helper where
4+
5+
import Data.Bifunctor ( first )
6+
import Proto3.Suite as Suite
7+
import Common.Common as Pb
8+
import Peer.ChaincodeShim as Pb
9+
import Peer.Chaincode as Pb
10+
import Peer.Proposal as Pb
11+
import Peer.ProposalResponse as Pb
12+
import Types ( Error(..)
13+
, ChaincodeStub(..)
14+
, MapTextBytes)
15+
16+
17+
-- These are some helper functions to process the unmarshalling of different types
18+
-- from the chaincode message in order to populate the stub
19+
getChaincodeInput :: ChaincodeMessage -> Either Error Pb.ChaincodeInput
20+
getChaincodeInput mes = first DecodeError $ Suite.fromByteString (chaincodeMessagePayload mes)
21+
22+
getProposal :: Pb.SignedProposal -> Either Error Pb.Proposal
23+
getProposal signedProposal =
24+
first DecodeError $ Suite.fromByteString (signedProposalProposalBytes signedProposal)
25+
26+
getHeader :: Pb.Proposal -> Either Error Pb.Header
27+
getHeader proposal =
28+
first DecodeError $ Suite.fromByteString (proposalHeader proposal)
29+
30+
getChannelHeader :: Pb.Header -> Either Error Pb.ChannelHeader
31+
getChannelHeader header =
32+
first DecodeError $ Suite.fromByteString (headerChannelHeader header)
33+
34+
getChaincodeProposalPayload :: Pb.Proposal -> Either Error Pb.ChaincodeProposalPayload
35+
getChaincodeProposalPayload proposal =
36+
first DecodeError $ Suite.fromByteString (proposalPayload proposal)
37+
38+
getSignatureHeader :: Pb.Header -> Either Error Pb.SignatureHeader
39+
getSignatureHeader header =
40+
first DecodeError $ Suite.fromByteString (headerSignatureHeader header)
41+
42+
-- -- TODO: Use ChannelHeader and SignatureHeader to implement getBinding
43+
createBinding :: Pb.Proposal -> Maybe MapTextBytes
44+
createBinding _ = Nothing

src/Interfaces.hs

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,13 @@ class ChaincodeStubInterface ccs where
3030
getArgsSlice :: ccs -> Either Error ByteString
3131
getTxId :: ccs -> Text
3232
getChannelId :: ccs -> Text
33-
-- invokeChaincode :: ccs -> String -> [ByteArray] -> String -> Pb.Response
33+
getSignedProposal :: ccs -> Maybe Pb.SignedProposal
34+
getCreator :: ccs -> Maybe ByteString
35+
getTransient :: ccs -> Maybe MapTextBytes
36+
getDecorations :: ccs -> MapTextBytes
37+
getBinding :: ccs -> Maybe MapTextBytes
38+
getTxTimestamp :: ccs -> Either Error GooglePb.Timestamp
39+
3440
getState :: ccs -> Text -> IO (Either Error ByteString)
3541
putState :: ccs -> Text -> ByteString -> IO (Either Error ByteString)
3642
delState :: ccs -> Text -> IO (Either Error ByteString)
@@ -56,12 +62,6 @@ class ChaincodeStubInterface ccs where
5662
-- getPrivateDataByRange :: ccs -> String -> String -> String -> Either Error StateQueryIterator
5763
-- getPrivateDataByPartialCompositeKey :: ccs -> String -> String -> [String] -> Either Error StateQueryIterator
5864
-- getPrivateDataQueryResult :: ccs -> String -> String -> Either Error StateQueryIterator
59-
-- getCreator :: ccs -> Either Error ByteString
60-
-- getTransient :: ccs -> Either Error MapStringBytes
61-
-- getBinding :: ccs -> Either Error MapStringBytes
62-
-- getDecorations :: ccs -> MapStringBytes
63-
-- getSignedProposal :: ccs -> Either Error Pb.SignedProposal
64-
-- getTxTimestamp :: ccs -> Either Error GooglePb.Timestamp
6565
-- setEvent :: ccs -> String -> ByteArray -> Maybe Error
6666

6767

src/Messages.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,7 @@ getStateByRangePayload startKey endKey metaData = Pb.GetStateByRange {
7474
, getStateByRangeMetadata = case metaData of
7575
-- This is an example of how to encode a Pb type into a bytestring
7676
-- https://hackage.haskell.org/package/proto3-wire-1.2.0/docs/Proto3-Wire-Tutorial.html
77+
-- TODO: Use Suite.toLazyByteString
7778
Just metaData -> LBS.toStrict $ Wire.toLazyByteString $ encodeMessage (FieldNumber 1) metaData
7879
Nothing -> BSU.fromString ""
7980
}
@@ -91,6 +92,7 @@ queryNextStatePayload id =
9192
buildChaincodeMessage mesType payload txid chanID = ChaincodeMessage
9293
{ chaincodeMessageType = getCCMessageType mesType
9394
, chaincodeMessageTimestamp = Nothing
95+
-- TODO: Use Suite.toLazyByteString
9496
, chaincodeMessagePayload = LBS.toStrict
9597
$ Wire.toLazyByteString
9698
$ encodeMessage (FieldNumber 1) payload

src/Shim.hs

Lines changed: 44 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ module Shim
1414
, StateQueryIteratorInterface(..)
1515
)
1616
where
17-
17+
import Data.Bifunctor ( first )
1818
import qualified Data.ByteString.Lazy as LBS
1919
import qualified Data.ByteString.Char8 as BC
2020
import Data.Map ( mapKeys )
@@ -28,10 +28,8 @@ import Network.GRPC.HighLevel.Generated
2828
import Network.GRPC.HighLevel
2929
import qualified Network.GRPC.LowLevel.Client as Client
3030
import Proto3.Suite as Suite
31-
import Proto3.Wire.Encode as Wire
32-
import Proto3.Wire.Decode as Wire
33-
import Proto3.Wire
3431

32+
import Common.Common as Pb
3533
import Peer.ChaincodeShim as Pb
3634
import Peer.Chaincode as Pb
3735
import Peer.Proposal as Pb
@@ -48,6 +46,7 @@ import Types ( DefaultChaincodeStub(..)
4846
, MapTextBytes
4947
, StateQueryIterator(..)
5048
)
49+
import Helper
5150

5251
import Debug.Trace
5352

@@ -166,70 +165,44 @@ newChaincodeStub
166165
-> StreamRecv ChaincodeMessage
167166
-> StreamSend ChaincodeMessage
168167
-> Either Error DefaultChaincodeStub
169-
newChaincodeStub mes recv send =
170-
let eErrInput = getChaincodeInput mes
171-
in
172-
case eErrInput of
173-
Left err -> Left $ error (show err)
174-
Right Pb.ChaincodeInput { chaincodeInputArgs = args, chaincodeInputDecorations = decorations }
175-
-> let maybeSignedProposal = chaincodeMessageProposal mes
176-
in case maybeSignedProposal of
177-
-- If the SignedProposal is empty, populate the stub with just the
178-
-- args, txId, channelId, decorations, send and recv
179-
Nothing -> Right $ DefaultChaincodeStub
180-
args
181-
(toStrict $ chaincodeMessageTxid mes)
182-
(toStrict $ chaincodeMessageChannelId mes)
183-
Nothing
184-
Nothing
185-
Nothing
186-
Nothing
187-
Nothing
188-
(mapKeys toStrict decorations)
189-
recv
190-
send
191-
-- If SignedProposal is not empty, get the proposal from it
192-
-- and the creator, transient and binding from the proposal
193-
Just signedProposal ->
194-
let eErrProposal = getProposal signedProposal
195-
in case eErrProposal of
196-
Left err -> Left $ error (show err)
197-
Right proposal -> Right $ DefaultChaincodeStub
198-
args
199-
(toStrict $ chaincodeMessageTxid mes)
200-
(toStrict $ chaincodeMessageChannelId mes)
201-
(getCreator proposal)
202-
(Just signedProposal)
203-
(Just proposal)
204-
(getTransient proposal)
205-
(getBinding proposal)
206-
(mapKeys toStrict decorations)
207-
recv
208-
send
209-
210-
211-
-- These are some helper functions to process the unmarshalling of different types
212-
-- from the chaincode message in order to populate the stub
213-
getChaincodeInput :: ChaincodeMessage -> Either ParseError Pb.ChaincodeInput
214-
getChaincodeInput mes = Suite.fromByteString (chaincodeMessagePayload mes)
215-
216-
getProposal :: Pb.SignedProposal -> Either ParseError Pb.Proposal
217-
getProposal signedProposal =
218-
Suite.fromByteString (signedProposalProposalBytes signedProposal)
219-
220-
-- -- TODO: Get SignatureHeader and implement getCreator
221-
-- -- and then get creator from the header.
222-
getCreator :: Pb.Proposal -> Maybe BC.ByteString
223-
getCreator _ = Nothing
224-
225-
getTransient :: Pb.Proposal -> Maybe MapTextBytes
226-
getTransient proposal =
227-
let eErrPayload = Suite.fromByteString (proposalPayload proposal)
228-
in case eErrPayload of
229-
Left _ -> Nothing
230-
Right payload ->
231-
Just (mapKeys toStrict $ chaincodeProposalPayloadTransientMap payload)
232-
233-
-- -- TODO: Get ChannelHeader and SignatureHeader and implement getBinding
234-
getBinding :: Pb.Proposal -> Maybe MapTextBytes
235-
getBinding _ = Nothing
168+
newChaincodeStub mes recv send = do
169+
input <- getChaincodeInput mes
170+
let maybeSignedProposal = chaincodeMessageProposal mes
171+
in case maybeSignedProposal of
172+
-- If the SignedProposal is empty, populate the stub with just the
173+
-- args, txId, channelId, decorations, send and recv
174+
Nothing -> Right $ DefaultChaincodeStub{
175+
args = chaincodeInputArgs input
176+
, txId = toStrict $ chaincodeMessageTxid mes
177+
, channelId = toStrict $ chaincodeMessageChannelId mes
178+
, creator = Nothing
179+
, signedProposal = Nothing
180+
, proposal = Nothing
181+
, transient = Nothing
182+
, binding = Nothing
183+
, decorations = chaincodeInputDecorations input
184+
, recvStream = recv
185+
, sendStream = send
186+
}
187+
-- If SignedProposal is not empty, get the proposal from it
188+
-- and the creator, transient and binding from the proposal
189+
Just signedProposal -> do
190+
proposal <- getProposal signedProposal
191+
header <- getHeader proposal
192+
chaincodeProposalPayload <- getChaincodeProposalPayload proposal
193+
channelHeader <- getChannelHeader header
194+
signatureHeader <- getSignatureHeader header
195+
Right $ DefaultChaincodeStub{
196+
args = chaincodeInputArgs input
197+
, txId = toStrict $ chaincodeMessageTxid mes
198+
, channelId = toStrict $ chaincodeMessageChannelId mes
199+
, creator = Just $ signatureHeaderCreator signatureHeader
200+
, signedProposal = Just signedProposal
201+
, proposal = Just proposal
202+
, transient = Just $ chaincodeProposalPayloadTransientMap chaincodeProposalPayload
203+
, binding = createBinding proposal
204+
, decorations = chaincodeInputDecorations input
205+
, recvStream = recv
206+
, sendStream = send
207+
}
208+

src/Stub.hs

Lines changed: 35 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ import Data.Vector as Vector
2525
import qualified Data.ByteString.Lazy as LBS
2626
import Control.Monad.Except (ExceptT(..), runExceptT)
2727

28-
import qualified Peer.ChaincodeShim as Pb
28+
import qualified Common.Common as Pb
29+
import qualified Peer.ChaincodeShim as Pb
2930
import qualified Ledger.Queryresult.KvQueryResult as Pb
3031

3132
import Network.GRPC.HighLevel
@@ -37,6 +38,7 @@ import Proto3.Wire.Decode
3738
import Interfaces
3839
import Messages
3940
import Types
41+
import Helper
4042

4143
import Debug.Trace
4244
-- NOTE: When support for concurrency transaction is added, this function will no longer be required
@@ -71,11 +73,36 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
7173
getArgsSlice ccs = Right $ Vector.foldr BS.append BS.empty $ getArgs ccs
7274

7375
-- getTxId :: css -> String
74-
getTxId css = txId css
76+
getTxId = txId
7577

7678
-- getChannelId :: ccs -> String
77-
getChannelId ccs = channelId ccs
79+
getChannelId = channelId
7880

81+
-- getSignedProposal :: ccs -> Maybe Pb.SignedProposal
82+
getSignedProposal = signedProposal
83+
84+
-- getCreator :: ccs -> Maybe ByteString
85+
getCreator = creator
86+
87+
-- getTransient :: ccs -> Maybe MapTextBytes
88+
getTransient = transient
89+
90+
-- getDecorations :: ccs -> MapTextBytes
91+
getDecorations = decorations
92+
93+
-- getBinding :: ccs -> Maybe MapTextBytes
94+
getBinding = binding
95+
96+
-- getTxTimestamp :: ccs -> Either Error Pb.Timestamp
97+
getTxTimestamp ccs = case (proposal ccs) of
98+
Just prop -> do
99+
header <- getHeader $ prop
100+
channelHeader <- getChannelHeader header
101+
case (Pb.channelHeaderTimestamp channelHeader) of
102+
Nothing -> Left $ Error "ChannelHeader doesn't have a timestamp"
103+
Just timestamp -> Right timestamp
104+
Nothing -> Left $ Error "Chaincode stub doesn't has a proposal to get the timestamp from"
105+
79106
-- invokeChaincode :: ccs -> String -> [ByteString] -> String -> Pb.Response
80107
-- invokeChaincode ccs cc params = Pb.Response{ responseStatus = 500, responseMessage = message(notImplemented), responsePayload = Nothing }
81108
--
@@ -167,12 +194,14 @@ instance StateQueryIteratorInterface StateQueryIterator where
167194
eeQueryResultBytes <- nextResult sqi
168195
case eeQueryResultBytes of
169196
Left _ -> pure $ Left $ Error "Error getting next queryResultBytes"
197+
-- TODO: use Suite.fromByteString
170198
Right queryResultBytes -> pure $ first DecodeError (parse (decodeMessage (FieldNumber 1)) (Pb.queryResultBytesResultBytes queryResultBytes) :: Either ParseError Pb.KV)
171199

172200

173201
-- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
174202
bsToSqi :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO StateQueryIterator
175203
bsToSqi ccs bs =
204+
-- TODO: use Suite.fromByteString
176205
let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse
177206
in
178207
case eeaQueryResponse of
@@ -194,12 +223,14 @@ bsToSqi ccs bs =
194223
-- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
195224
bsToSqiAndMeta :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO (StateQueryIterator, Pb.QueryResponseMetadata)
196225
bsToSqiAndMeta ccs bs =
226+
-- TODO: use Suite.fromByteString
197227
let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse
198228
in
199229
case eeaQueryResponse of
200230
-- TODO: refactor out pattern matching, e.g. using >>= or <*>
201231
Left err -> ExceptT $ pure $ Left $ DecodeError err
202232
Right queryResponse ->
233+
-- TODO: use Suite.fromByteString
203234
let eeMetadata = parse (decodeMessage (FieldNumber 1)) (Pb.queryResponseMetadata queryResponse) :: Either ParseError Pb.QueryResponseMetadata
204235
in
205236
case eeMetadata of
@@ -248,6 +279,7 @@ fetchNextQueryResult sqi = do
248279
bsToQueryResponse :: ByteString -> ExceptT Error IO StateQueryIterator
249280
bsToQueryResponse bs =
250281
let eeaQueryResponse =
282+
-- TODO: Suite.fromByteString
251283
parse (decodeMessage (FieldNumber 1)) bs :: Either
252284
ParseError
253285
Pb.QueryResponse
@@ -316,23 +348,5 @@ fetchNextQueryResult sqi = do
316348
-- -- getPrivateDataQueryResult :: ccs -> String -> String -> Either Error StateQueryIterator
317349
-- getPrivateDataQueryResult ccs collection query = Left notImplemented
318350
--
319-
-- -- getCreator :: ccs -> Either Error ByteArray
320-
-- getCreator ccs = Right creator
321-
--
322-
-- -- getTransient :: ccs -> Either Error MapStringBytes
323-
-- getTransient ccs = Right transient
324-
--
325-
-- -- getBinding :: ccs -> Either Error MapStringBytes
326-
-- getBinding ccs = Right binding
327-
--
328-
-- -- getDecorations :: ccs -> MapStringBytes
329-
-- getDecorations ccs = Right decorations
330-
--
331-
-- -- getSignedProposal :: ccs -> Either Error Pb.SignedProposal
332-
-- getSignedProposal ccs = Right signedProposal
333-
--
334-
-- -- getTxTimestamp :: ccs -> Either Error Pb.Timestamp
335-
-- getTxTimestamp ccs = Right txTimestamp
336-
--
337351
-- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
338352
-- setEvent ccs = Right notImplemented

src/Types.hs

Lines changed: 2 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Types where
33
import Data.ByteString
44
import Data.Map
55
import qualified Data.Vector
6+
import qualified Data.Text.Lazy as TL
67
import Data.Text
78
import Data.IORef
89
import System.IO.Unsafe
@@ -37,10 +38,6 @@ data ChaincodeStub = ChaincodeStub {
3738
data DefaultChaincodeStub = DefaultChaincodeStub {
3839
-- chaincode invocation arguments. serialised as arrays of bytes.
3940
args :: Data.Vector.Vector ByteString,
40-
-- -- name of the function being invoked.
41-
-- function :: Maybe Text,
42-
-- -- arguments of the function idenfied by the chaincode invocation.
43-
-- parameters :: Maybe [String],
4441
-- transaction identifier.
4542
txId :: Text,
4643
-- channel identifier
@@ -82,8 +79,5 @@ instance (Show DefaultChaincodeStub) where
8279
++ show (binding ccs) ++ ", "
8380
++ show (decorations ccs) ++ " }"
8481

85-
-- MapStringBytes is a synonym for the Map type whose keys are String and values
86-
type MapStringBytes = Map String ByteString
87-
8882
-- MapTextBytes is a synonym for the Map type whose keys are Text and values
89-
type MapTextBytes = Map Text ByteString
83+
type MapTextBytes = Map TL.Text ByteString

0 commit comments

Comments
 (0)