Added more stub functions

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

Author: airvin

src/Helper.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+    
+module Helper where
+
+import           Data.Bifunctor                ( first )
+import           Proto3.Suite                  as Suite
+import           Common.Common                 as Pb
+import           Peer.ChaincodeShim            as Pb
+import           Peer.Chaincode                as Pb
+import           Peer.Proposal                 as Pb
+import           Peer.ProposalResponse         as Pb
+import           Types                          ( Error(..)
+                                                , ChaincodeStub(..)
+                                                , MapTextBytes)
+                                              
+
+-- These are some helper functions to process the unmarshalling of different types
+-- from the chaincode message in order to populate the stub
+getChaincodeInput :: ChaincodeMessage -> Either Error Pb.ChaincodeInput
+getChaincodeInput mes = first DecodeError $ Suite.fromByteString (chaincodeMessagePayload mes)
+
+getProposal :: Pb.SignedProposal -> Either Error Pb.Proposal
+getProposal signedProposal =
+  first DecodeError $ Suite.fromByteString (signedProposalProposalBytes signedProposal)
+
+getHeader :: Pb.Proposal -> Either Error Pb.Header
+getHeader proposal = 
+  first DecodeError $ Suite.fromByteString (proposalHeader proposal)
+
+getChannelHeader :: Pb.Header -> Either Error Pb.ChannelHeader
+getChannelHeader header = 
+  first DecodeError $ Suite.fromByteString (headerChannelHeader header)
+
+getChaincodeProposalPayload :: Pb.Proposal -> Either Error Pb.ChaincodeProposalPayload
+getChaincodeProposalPayload proposal =
+  first DecodeError $ Suite.fromByteString (proposalPayload proposal)
+
+getSignatureHeader :: Pb.Header -> Either Error Pb.SignatureHeader
+getSignatureHeader header =
+  first DecodeError $ Suite.fromByteString (headerSignatureHeader header)
+
+-- -- TODO: Use ChannelHeader and SignatureHeader to implement getBinding
+createBinding :: Pb.Proposal -> Maybe MapTextBytes
+createBinding _ = Nothing

src/Interfaces.hs

@@ -30,7 +30,13 @@ class ChaincodeStubInterface ccs where
     getArgsSlice :: ccs -> Either Error ByteString
     getTxId :: ccs -> Text
     getChannelId :: ccs -> Text
-    -- invokeChaincode :: ccs -> String -> [ByteArray] -> String -> Pb.Response
+    getSignedProposal :: ccs -> Maybe Pb.SignedProposal
+    getCreator :: ccs -> Maybe ByteString
+    getTransient :: ccs -> Maybe MapTextBytes
+    getDecorations :: ccs -> MapTextBytes
+    getBinding :: ccs -> Maybe MapTextBytes
+    getTxTimestamp :: ccs -> Either Error GooglePb.Timestamp
+
     getState :: ccs -> Text -> IO (Either Error ByteString)
     putState :: ccs -> Text -> ByteString -> IO (Either Error ByteString)
     delState :: ccs -> Text -> IO (Either Error ByteString)
@@ -56,12 +62,6 @@ class ChaincodeStubInterface ccs where
     -- getPrivateDataByRange :: ccs -> String -> String -> String -> Either Error StateQueryIterator
     -- getPrivateDataByPartialCompositeKey :: ccs -> String -> String -> [String] -> Either Error StateQueryIterator
     -- getPrivateDataQueryResult :: ccs -> String -> String -> Either Error StateQueryIterator
-    -- getCreator :: ccs -> Either Error ByteString
-    -- getTransient :: ccs -> Either Error MapStringBytes
-    -- getBinding :: ccs -> Either Error MapStringBytes
-    -- getDecorations :: ccs -> MapStringBytes
-    -- getSignedProposal :: ccs -> Either Error Pb.SignedProposal
-    -- getTxTimestamp :: ccs -> Either Error GooglePb.Timestamp
     -- setEvent :: ccs -> String -> ByteArray -> Maybe Error
 
 

src/Messages.hs

@@ -74,6 +74,7 @@ getStateByRangePayload startKey endKey metaData = Pb.GetStateByRange {
     , getStateByRangeMetadata = case metaData of 
     -- This is an example of how to encode a Pb type into a bytestring
     -- https://hackage.haskell.org/package/proto3-wire-1.2.0/docs/Proto3-Wire-Tutorial.html
+    -- TODO: Use Suite.toLazyByteString
       Just metaData -> LBS.toStrict $ Wire.toLazyByteString $ encodeMessage (FieldNumber 1) metaData
       Nothing -> BSU.fromString ""
 }
@@ -91,6 +92,7 @@ queryNextStatePayload id =
 buildChaincodeMessage mesType payload txid chanID = ChaincodeMessage
   { chaincodeMessageType           = getCCMessageType mesType
   , chaincodeMessageTimestamp      = Nothing
+    -- TODO: Use Suite.toLazyByteString
   , chaincodeMessagePayload        = LBS.toStrict
                                      $ Wire.toLazyByteString
                                      $ encodeMessage (FieldNumber 1) payload

src/Shim.hs

@@ -14,7 +14,7 @@ module Shim
   , StateQueryIteratorInterface(..)
   )
 where
-
+import           Data.Bifunctor                ( first )
 import qualified Data.ByteString.Lazy          as LBS
 import qualified Data.ByteString.Char8         as BC
 import           Data.Map                       ( mapKeys )
@@ -28,10 +28,8 @@ import           Network.GRPC.HighLevel.Generated
 import           Network.GRPC.HighLevel
 import qualified Network.GRPC.LowLevel.Client  as Client
 import           Proto3.Suite                  as Suite
-import           Proto3.Wire.Encode            as Wire
-import           Proto3.Wire.Decode            as Wire
-import           Proto3.Wire
 
+import           Common.Common                 as Pb
 import           Peer.ChaincodeShim            as Pb
 import           Peer.Chaincode                as Pb
 import           Peer.Proposal                 as Pb
@@ -48,6 +46,7 @@ import           Types                          ( DefaultChaincodeStub(..)
                                                 , MapTextBytes
                                                 , StateQueryIterator(..)
                                                 )
+import          Helper
 
 import           Debug.Trace
 
@@ -166,70 +165,44 @@ newChaincodeStub
   -> StreamRecv ChaincodeMessage
   -> StreamSend ChaincodeMessage
   -> Either Error DefaultChaincodeStub
-newChaincodeStub mes recv send =
-  let eErrInput = getChaincodeInput mes
-  in
-    case eErrInput of
-      Left err -> Left $ error (show err)
-      Right Pb.ChaincodeInput { chaincodeInputArgs = args, chaincodeInputDecorations = decorations }
-        -> let maybeSignedProposal = chaincodeMessageProposal mes
-           in  case maybeSignedProposal of
-                --  If the SignedProposal is empty, populate the stub with just the
-                -- args, txId, channelId, decorations, send and recv
-                 Nothing -> Right $ DefaultChaincodeStub
-                   args
-                   (toStrict $ chaincodeMessageTxid mes)
-                   (toStrict $ chaincodeMessageChannelId mes)
-                   Nothing
-                   Nothing
-                   Nothing
-                   Nothing
-                   Nothing
-                   (mapKeys toStrict decorations)
-                   recv
-                   send
-                  --  If SignedProposal is not empty, get the proposal from it
-                  -- and the creator, transient and binding from the proposal
-                 Just signedProposal ->
-                   let eErrProposal = getProposal signedProposal
-                   in  case eErrProposal of
-                         Left  err      -> Left $ error (show err)
-                         Right proposal -> Right $ DefaultChaincodeStub
-                           args
-                           (toStrict $ chaincodeMessageTxid mes)
-                           (toStrict $ chaincodeMessageChannelId mes)
-                           (getCreator proposal)
-                           (Just signedProposal)
-                           (Just proposal)
-                           (getTransient proposal)
-                           (getBinding proposal)
-                           (mapKeys toStrict decorations)
-                           recv
-                           send
-
-
--- These are some helper functions to process the unmarshalling of different types
--- from the chaincode message in order to populate the stub
-getChaincodeInput :: ChaincodeMessage -> Either ParseError Pb.ChaincodeInput
-getChaincodeInput mes = Suite.fromByteString (chaincodeMessagePayload mes)
-
-getProposal :: Pb.SignedProposal -> Either ParseError Pb.Proposal
-getProposal signedProposal =
-  Suite.fromByteString (signedProposalProposalBytes signedProposal)
-
--- -- TODO: Get SignatureHeader and implement getCreator
--- -- and then get creator from the header.
-getCreator :: Pb.Proposal -> Maybe BC.ByteString
-getCreator _ = Nothing
-
-getTransient :: Pb.Proposal -> Maybe MapTextBytes
-getTransient proposal =
-  let eErrPayload = Suite.fromByteString (proposalPayload proposal)
-  in  case eErrPayload of
-        Left _ -> Nothing
-        Right payload ->
-          Just (mapKeys toStrict $ chaincodeProposalPayloadTransientMap payload)
-
--- -- TODO: Get ChannelHeader and SignatureHeader and implement getBinding
-getBinding :: Pb.Proposal -> Maybe MapTextBytes
-getBinding _ = Nothing
+newChaincodeStub mes recv send = do
+  input <- getChaincodeInput mes
+  let maybeSignedProposal = chaincodeMessageProposal mes
+      in  case maybeSignedProposal of
+          --  If the SignedProposal is empty, populate the stub with just the
+          -- args, txId, channelId, decorations, send and recv
+            Nothing -> Right $ DefaultChaincodeStub{
+                          args = chaincodeInputArgs input
+                          , txId = toStrict $ chaincodeMessageTxid mes
+                          , channelId = toStrict $ chaincodeMessageChannelId mes
+                          , creator = Nothing
+                          , signedProposal = Nothing 
+                          , proposal = Nothing
+                          , transient = Nothing
+                          , binding = Nothing
+                          , decorations = chaincodeInputDecorations input
+                          , recvStream = recv
+                          , sendStream = send
+                    }
+            --  If SignedProposal is not empty, get the proposal from it
+            -- and the creator, transient and binding from the proposal
+            Just signedProposal -> do
+              proposal <- getProposal signedProposal
+              header <- getHeader proposal
+              chaincodeProposalPayload <- getChaincodeProposalPayload proposal
+              channelHeader <- getChannelHeader header
+              signatureHeader <- getSignatureHeader header
+              Right $ DefaultChaincodeStub{
+                          args = chaincodeInputArgs input
+                          , txId = toStrict $ chaincodeMessageTxid mes
+                          , channelId = toStrict $ chaincodeMessageChannelId mes
+                          , creator = Just $ signatureHeaderCreator signatureHeader
+                          , signedProposal = Just signedProposal
+                          , proposal = Just proposal
+                          , transient = Just $ chaincodeProposalPayloadTransientMap chaincodeProposalPayload
+                          , binding = createBinding proposal
+                          , decorations = chaincodeInputDecorations input
+                          , recvStream = recv
+                          , sendStream = send
+                    }
+                           

src/Stub.hs

@@ -25,7 +25,8 @@ import           Data.Vector                   as Vector
 import qualified Data.ByteString.Lazy          as LBS
 import           Control.Monad.Except          (ExceptT(..), runExceptT)
 
-import qualified Peer.ChaincodeShim            as Pb
+import qualified Common.Common                    as Pb
+import qualified Peer.ChaincodeShim               as Pb
 import qualified Ledger.Queryresult.KvQueryResult as Pb
 
 import           Network.GRPC.HighLevel
@@ -37,6 +38,7 @@ import           Proto3.Wire.Decode
 import           Interfaces
 import           Messages
 import           Types
+import           Helper
 
 import           Debug.Trace
 -- NOTE: When support for concurrency transaction is added, this function will no longer be required
@@ -71,11 +73,36 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
   getArgsSlice ccs = Right $ Vector.foldr BS.append BS.empty $ getArgs ccs
 
   -- getTxId :: css -> String
-  getTxId css = txId css
+  getTxId = txId
 
   -- getChannelId :: ccs -> String
-  getChannelId ccs = channelId ccs
+  getChannelId = channelId
 
+  -- getSignedProposal :: ccs -> Maybe Pb.SignedProposal
+  getSignedProposal = signedProposal
+
+  -- getCreator :: ccs -> Maybe ByteString
+  getCreator = creator
+
+  -- getTransient :: ccs -> Maybe MapTextBytes
+  getTransient = transient
+
+  -- getDecorations :: ccs -> MapTextBytes
+  getDecorations = decorations
+
+  -- getBinding :: ccs -> Maybe MapTextBytes
+  getBinding = binding
+
+  -- getTxTimestamp :: ccs -> Either Error Pb.Timestamp
+  getTxTimestamp ccs = case (proposal ccs) of
+    Just prop -> do
+      header <- getHeader $ prop
+      channelHeader <- getChannelHeader header
+      case (Pb.channelHeaderTimestamp channelHeader) of
+        Nothing -> Left $ Error "ChannelHeader doesn't have a timestamp"
+        Just timestamp -> Right timestamp
+    Nothing -> Left $ Error "Chaincode stub doesn't has a proposal to get the timestamp from"
+  
   -- invokeChaincode :: ccs -> String -> [ByteString] -> String -> Pb.Response
   -- invokeChaincode ccs cc params = Pb.Response{ responseStatus = 500, responseMessage = message(notImplemented), responsePayload = Nothing }
   --
@@ -167,12 +194,14 @@ instance StateQueryIteratorInterface StateQueryIterator where
     eeQueryResultBytes <- nextResult sqi 
     case eeQueryResultBytes of
       Left _ -> pure $ Left $ Error "Error getting next queryResultBytes"
+      -- TODO: use Suite.fromByteString
       Right queryResultBytes -> pure $ first DecodeError (parse (decodeMessage (FieldNumber 1)) (Pb.queryResultBytesResultBytes queryResultBytes) :: Either ParseError Pb.KV)
 
 
 -- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
 bsToSqi :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO StateQueryIterator
 bsToSqi ccs bs = 
+      -- TODO: use Suite.fromByteString
     let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse
     in
         case eeaQueryResponse of
@@ -194,12 +223,14 @@ bsToSqi ccs bs =
 -- ExceptT is a monad transformer that allows us to compose these by binding over IO Either
 bsToSqiAndMeta :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO (StateQueryIterator, Pb.QueryResponseMetadata)
 bsToSqiAndMeta ccs bs = 
+      -- TODO: use Suite.fromByteString
     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 -> 
+                      -- TODO: use Suite.fromByteString
                   let eeMetadata = parse (decodeMessage (FieldNumber 1)) (Pb.queryResponseMetadata queryResponse) :: Either ParseError Pb.QueryResponseMetadata
                   in
                     case eeMetadata of
@@ -248,6 +279,7 @@ fetchNextQueryResult sqi = do
     bsToQueryResponse :: ByteString -> ExceptT Error IO StateQueryIterator
     bsToQueryResponse bs =
       let eeaQueryResponse =
+      -- TODO: Suite.fromByteString
               parse (decodeMessage (FieldNumber 1)) bs :: Either
                   ParseError
                   Pb.QueryResponse
@@ -316,23 +348,5 @@ fetchNextQueryResult sqi = do
 -- -- 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

src/Types.hs

@@ -3,6 +3,7 @@ module Types where
 import           Data.ByteString
 import           Data.Map
 import qualified Data.Vector
+import qualified Data.Text.Lazy                as TL
 import           Data.Text
 import           Data.IORef
 import           System.IO.Unsafe
@@ -37,10 +38,6 @@ data ChaincodeStub = ChaincodeStub {
 data DefaultChaincodeStub = DefaultChaincodeStub {
     -- chaincode invocation arguments. serialised as arrays of bytes.
     args :: Data.Vector.Vector ByteString,
-    -- -- name of the function being invoked.
-    -- function :: Maybe Text,
-    -- -- arguments of the function idenfied by the chaincode invocation.
-    -- parameters :: Maybe [String],
     -- transaction identifier.
     txId :: Text,
     -- channel identifier
@@ -82,8 +79,5 @@ instance (Show DefaultChaincodeStub) where
         ++ show (binding ccs) ++ ", "
         ++ show (decorations ccs) ++ " }"
 
--- MapStringBytes is a synonym for the Map type whose keys are String and values
-type MapStringBytes = Map String ByteString
-
 -- MapTextBytes is a synonym for the Map type whose keys are Text and values
-type MapTextBytes = Map Text ByteString
+type MapTextBytes = Map TL.Text ByteString