├── .github └── settings.yml ├── .gitignore ├── LICENSE ├── Setup.hs ├── commit-msg ├── create-commit-msg-hook.sh ├── examples ├── fabcar │ └── Fabcar.hs ├── marbles │ └── Marbles.hs ├── readme.md └── sacc │ └── Sacc.hs ├── floskell.json ├── google-protos └── google │ └── protobuf │ └── timestamp.proto ├── hie.yaml ├── package.yaml ├── protos-hs ├── Common │ ├── Common.hs │ └── Policies.hs ├── Google │ └── Protobuf │ │ └── Timestamp.hs ├── Ledger │ └── Queryresult │ │ └── KvQueryResult.hs ├── Msp │ └── MspPrincipal.hs ├── Peer │ ├── Chaincode.hs │ ├── ChaincodeEvent.hs │ ├── ChaincodeShim.hs │ ├── Proposal.hs │ └── ProposalResponse.hs └── Token │ ├── Expectations.hs │ └── Transaction.hs ├── protos ├── common │ ├── common.proto │ └── policies.proto ├── generate.sh ├── ledger │ └── queryresult │ │ └── kv_query_result.proto ├── msp │ └── msp_principal.proto ├── peer │ ├── chaincode.proto │ ├── chaincode_event.proto │ ├── chaincode_shim.proto │ ├── proposal.proto │ └── proposal_response.proto ├── readme.md └── token │ ├── expectations.proto │ └── transaction.proto ├── readme.md ├── src ├── Helper.hs ├── Interfaces.hs ├── Messages.hs ├── Shim.hs ├── Stub.hs └── Types.hs ├── stack.yaml ├── stack.yaml.lock └── test └── Spec.hs /.github/settings.yml: -------------------------------------------------------------------------------- 1 | # 2 | # SPDX-License-Identifier: Apache-2.0 3 | # 4 | repository: 5 | name: fabric-chaincode-haskell 6 | description: Haskell support for smart contracts in Hyperledger Fabric 7 | archived: true 8 | private: false 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | fabric-chaincode-haskell.cabal 3 | *~ 4 | dist-newstyle 5 | cabal.project.local 6 | 7 | .vscode -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /commit-msg: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') 4 | grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" 5 | -------------------------------------------------------------------------------- /create-commit-msg-hook.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cp commit-msg .git/hooks 4 | -------------------------------------------------------------------------------- /examples/fabcar/Fabcar.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Fabcar where 5 | 6 | import Control.Monad.Except ( ExceptT(..), runExceptT, throwError ) 7 | 8 | import Data.Aeson ( FromJSON 9 | , ToJSON 10 | , decode 11 | , defaultOptions 12 | , encode 13 | , genericToEncoding 14 | , toEncoding 15 | ) 16 | import qualified Data.ByteString as BS 17 | import qualified Data.ByteString.Lazy as LBS 18 | import qualified Data.ByteString.UTF8 as BSU 19 | import Data.Text ( Text, append, pack ) 20 | import qualified Data.Text.Encoding as TSE 21 | import qualified Data.Text.Lazy as TL 22 | 23 | import GHC.Generics 24 | 25 | import Ledger.Queryresult.KvQueryResult as Pb 26 | 27 | import Peer.ProposalResponse as Pb 28 | 29 | import Shim ( ChaincodeStub(..) 30 | , ChaincodeStubInterface(..) 31 | , DefaultChaincodeStub 32 | , Error(..) 33 | , StateQueryIterator(..) 34 | , StateQueryIteratorInterface(..) 35 | , errorPayload 36 | , start 37 | , successPayload 38 | ) 39 | 40 | main :: IO () 41 | main = Shim.start chaincodeStub 42 | 43 | data Car = Car { make :: Text 44 | , model :: Text 45 | , colour :: Text 46 | , owner :: Text 47 | } 48 | deriving ( Generic, Show ) 49 | 50 | instance ToJSON Car where 51 | toEncoding = genericToEncoding defaultOptions 52 | 53 | instance FromJSON Car 54 | 55 | chaincodeStub :: ChaincodeStub 56 | chaincodeStub = ChaincodeStub { initFn = initFunc 57 | , invokeFn = invokeFunc 58 | } 59 | 60 | initFunc :: DefaultChaincodeStub -> IO Pb.Response 61 | initFunc _ = pure $ successPayload Nothing 62 | 63 | invokeFunc :: DefaultChaincodeStub -> IO Pb.Response 64 | invokeFunc s = 65 | let e = getFunctionAndParameters s 66 | in 67 | case e of 68 | Left _ -> pure $ errorPayload "Failed to get function" 69 | Right ("initLedger", parameters) -> initLedger s parameters 70 | Right ("createCar", parameters) -> createCar s parameters 71 | Right ("queryCar", parameters) -> queryCar s parameters 72 | Right ("queryAllCars", parameters) -> queryAllCars s parameters 73 | Right ("changeCarOwner", parameters) -> changeCarOwner s parameters 74 | Right (_, _) -> pure $ errorPayload "No matching function found" 75 | 76 | initLedger :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 77 | initLedger s _ = 78 | let cars = 79 | [ Car { make = "Toyota" 80 | , model = "Prius" 81 | , colour = "blue" 82 | , owner = "Tomoko" 83 | } 84 | , Car { make = "Ford" 85 | , model = "Mustang" 86 | , colour = "red" 87 | , owner = "Brad" 88 | } 89 | , Car { make = "Hyundai" 90 | , model = "Tucson" 91 | , colour = "green" 92 | , owner = "Jin Soo" 93 | } 94 | , Car { make = "Volkswagen" 95 | , model = "Passat" 96 | , colour = "yellow" 97 | , owner = "Max" 98 | } 99 | , Car { make = "Tesla" 100 | , model = "S" 101 | , colour = "black" 102 | , owner = "Adriana" 103 | } 104 | , Car { make = "Peugeot" 105 | , model = "205" 106 | , colour = "purple" 107 | , owner = "Michel" 108 | } 109 | , Car { make = "Chery" 110 | , model = "S22L" 111 | , colour = "white" 112 | , owner = "Aarav" 113 | } 114 | , Car { make = "Fiat" 115 | , model = "Punto" 116 | , colour = "violet" 117 | , owner = "Pari" 118 | } 119 | , Car { make = "Tata" 120 | , model = "Nano" 121 | , colour = "indigo" 122 | , owner = "Valeria" 123 | } 124 | , Car { make = "Holden" 125 | , model = "Barina" 126 | , colour = "brown" 127 | , owner = "Shotaro" 128 | } 129 | ] 130 | keys = [ "CAR0", "CAR1", "CAR2", "CAR3", "CAR4", "CAR5", "CAR6", "CAR7", "CAR8", "CAR9", "CAR10" ] 131 | in 132 | createCars s keys cars 133 | 134 | createCars :: DefaultChaincodeStub -> [Text] -> [Car] -> IO Pb.Response 135 | createCars s keys cars = 136 | if length cars == 0 137 | then pure $ successPayload Nothing 138 | else do 139 | eitherErrBS <- runExceptT (putState s (head keys) (LBS.toStrict $ encode $ head cars)) 140 | case eitherErrBS of 141 | Left e -> pure $ errorPayload $ pack $ show e 142 | Right _ -> createCars s (tail keys) (tail cars) 143 | 144 | createCar :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 145 | createCar s params = 146 | if Prelude.length params == 5 147 | then let car = Car { make = params !! 1 148 | , model = params !! 2 149 | , colour = params !! 3 150 | , owner = params !! 4 151 | } 152 | in 153 | eitherToPbResponse <$> runExceptT (putState s (head params) (LBS.toStrict $ encode car)) 154 | else pure $ errorPayload "Incorrect number of arguments. Expecting 5" 155 | 156 | queryCar :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 157 | queryCar s params = if Prelude.length params == 1 158 | then eitherToPbResponse <$> runExceptT (getState s (head params)) 159 | else pure $ errorPayload "Incorrect number of arguments. Expecting 1" 160 | 161 | queryAllCars :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 162 | queryAllCars s params = 163 | if Prelude.length params == 0 164 | then eitherToPbResponse <$> (runExceptT $ do 165 | sqi <- getStateByRange s "" "" 166 | resultBytes <- generateResultBytes sqi "" 167 | pure $ successPayload (Just resultBytes)) 168 | else pure $ errorPayload "Incorrect number of arguments. Should be no arguments" 169 | 170 | changeCarOwner :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 171 | changeCarOwner s params = 172 | if Prelude.length params == 2 173 | then eitherToPbResponse 174 | <$> (runExceptT $ do 175 | -- Check that the car already exists 176 | response <- getState s (head params) 177 | if BS.length response == 0 178 | then throwError $ Error "Car not found" 179 | else 180 | -- Unmarshal the car 181 | let maybeCar = decode (LBS.fromStrict response) :: Maybe Car 182 | newOwner = params !! 1 183 | in 184 | case maybeCar of 185 | Nothing -> throwError $ Error "Error decoding car" 186 | Just oldCar -> let newCar = carWithNewOwner oldCar newOwner 187 | carJson = LBS.toStrict $ encode newCar 188 | in 189 | putState s (head params) carJson) 190 | else pure $ errorPayload "Incorrect arguments. Need a car name and new owner" 191 | 192 | carWithNewOwner :: Car -> Text -> Car 193 | carWithNewOwner oldCar newOwner = 194 | Car { make = make oldCar 195 | , model = model oldCar 196 | , colour = colour oldCar 197 | , owner = newOwner 198 | } 199 | 200 | eitherToPbResponse :: Show a => Either Error a -> Pb.Response 201 | eitherToPbResponse (Right a) = successPayload $ Just $ BSU.fromString $ show a 202 | eitherToPbResponse (Left err) = errorPayload $ pack $ show err 203 | 204 | generateResultBytes :: StateQueryIterator -> Text -> ExceptT Error IO BSU.ByteString 205 | generateResultBytes sqi text = ExceptT $ do 206 | hasNextBool <- hasNext sqi 207 | if hasNextBool 208 | then do 209 | eeKv <- runExceptT $ next sqi 210 | case eeKv of 211 | Left e -> pure $ Left e 212 | Right kv -> let makeKVString :: Pb.KV -> Text 213 | makeKVString kv_ = pack "Key: " <> TL.toStrict (Pb.kvKey kv_) <> pack ", Value: " 214 | <> TSE.decodeUtf8 (kvValue kv_) 215 | in 216 | runExceptT $ generateResultBytes sqi (append text (makeKVString kv)) 217 | else pure $ Right $ TSE.encodeUtf8 text -------------------------------------------------------------------------------- /examples/marbles/Marbles.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Marbles where 5 | 6 | import Control.Monad.Except ( ExceptT(..), runExceptT, throwError ) 7 | 8 | import Data.Aeson ( FromJSON 9 | , ToJSON 10 | , decode 11 | , defaultOptions 12 | , encode 13 | , genericToEncoding 14 | , toEncoding 15 | ) 16 | import qualified Data.ByteString as BS 17 | import qualified Data.ByteString.Lazy as LBS 18 | import qualified Data.ByteString.UTF8 as BSU 19 | import Data.Char ( chr ) 20 | import Data.Text ( Text, append, pack, unpack ) 21 | import qualified Data.Text.Encoding as TSE 22 | import qualified Data.Text.Lazy as TL 23 | 24 | import Debug.Trace 25 | 26 | import GHC.Generics 27 | 28 | import Ledger.Queryresult.KvQueryResult as Pb 29 | 30 | import Peer.ChaincodeShim as Pb 31 | import Peer.ProposalResponse as Pb 32 | 33 | import Shim ( ChaincodeStub(..) 34 | , ChaincodeStubInterface(..) 35 | , DefaultChaincodeStub 36 | , Error(..) 37 | , StateQueryIterator(..) 38 | , StateQueryIteratorInterface(..) 39 | , errorPayload 40 | , start 41 | , successPayload 42 | ) 43 | 44 | main :: IO () 45 | main = Shim.start chaincodeStub 46 | 47 | chaincodeStub :: ChaincodeStub 48 | chaincodeStub = ChaincodeStub { initFn = initFunc 49 | , invokeFn = invokeFunc 50 | } 51 | 52 | data Marble = Marble { objectType :: Text 53 | , name :: Text 54 | , color :: Text 55 | , size :: Text 56 | , owner :: Text 57 | } 58 | deriving ( Generic, Show ) 59 | 60 | instance ToJSON Marble where 61 | toEncoding = genericToEncoding defaultOptions 62 | 63 | instance FromJSON Marble 64 | 65 | initFunc :: DefaultChaincodeStub -> IO Pb.Response 66 | initFunc s = let e = getFunctionAndParameters s 67 | in 68 | case e of 69 | Left _ -> pure $ errorPayload "" 70 | Right ("initMarble", parameters) -> initMarble s parameters 71 | Right (fn, _) -> pure $ errorPayload (pack ("Invoke did not find function: " ++ unpack fn)) 72 | 73 | invokeFunc :: DefaultChaincodeStub -> IO Pb.Response 74 | invokeFunc s = 75 | let e = getFunctionAndParameters s 76 | in 77 | case e of 78 | Left _ -> pure $ errorPayload "" 79 | Right ("initMarble", parameters) -> initMarble s parameters 80 | Right ("transferMarble", parameters) -> transferMarble s parameters 81 | -- Right ("transferMarbleBasedOnColor", parameters) -> 82 | -- transferMarbleBasedOnColor s parameters 83 | Right ("deleteMarble", parameters) -> deleteMarble s parameters 84 | Right ("readMarble", parameters) -> readMarble s parameters 85 | -- Right ("queryMarblesByOwner", parameters) -> 86 | -- queryMarblesByOwner s parameters 87 | -- Right ("queryMarbles", parameters) -> queryMarbles s parameters 88 | -- Right ("getHistoryForMarble", parameters) -> 89 | -- getHistoryForMarble s parameters 90 | Right ("getMarblesByRange", parameters) -> getMarblesByRange s parameters 91 | Right ("getMarblesByRangeWithPagination", parameters) -> getMarblesByRangeWithPagination s parameters 92 | -- Right ("queryMarblesWithPagination", parameters) -> 93 | -- queryMarblesWithPagination s parameters 94 | Right (fn, _) -> pure $ errorPayload (pack ("Invoke did not find function: " ++ unpack fn)) 95 | 96 | initMarble :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 97 | initMarble s params = 98 | if Prelude.length params == 4 99 | then eitherToPbResponse 100 | <$> (runExceptT $ do 101 | response <- getState s (head params) 102 | -- Check if marble already exists 103 | if BS.length response /= 0 104 | then throwError $ Error $ "This marble already exists: " ++ unpack (head params) 105 | else let 106 | -- marshal marble to JSON 107 | marbleJSON = LBS.toStrict $ encode (parseMarble params) 108 | indexName = "color~name" 109 | nullCharByteString = BSU.fromString [ chr 0 ] 110 | in 111 | do 112 | -- we don't care about the response of putState in the success case 113 | _ <- putState s (head params) marbleJSON 114 | colorNameIndexKey 115 | <- ExceptT $ pure $ createCompositeKey s indexName [ params !! 1, params !! 0 ] 116 | putState s colorNameIndexKey nullCharByteString) 117 | else pure $ errorPayload "Incorrect arguments. Need a marble name, color, size and owner" 118 | 119 | transferMarble :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 120 | transferMarble s params = 121 | if Prelude.length params == 2 122 | then eitherToPbResponse 123 | <$> (runExceptT $ do 124 | response <- getState s (head params) 125 | if BS.length response == 0 126 | then throwError $ Error $ "Marble not found" 127 | else 128 | -- Unmarshal the marble from JSON 129 | let maybeMarble = decode (LBS.fromStrict response) :: Maybe Marble 130 | marbleOwner = params !! 1 131 | in 132 | case maybeMarble of 133 | Nothing -> throwError $ Error "Error decoding marble" 134 | Just oldMarble -> 135 | -- Create a new marble instance with the new owner 136 | let newMarble = marbleWithNewOwner marbleOwner oldMarble 137 | -- Marshal new marble to JSON 138 | marbleJSON = LBS.toStrict $ encode newMarble 139 | in 140 | putState s (head params) marbleJSON) 141 | else pure $ errorPayload "Incorrect arguments. Need a marble name and new owner" 142 | 143 | -- -- TODO: Once indexing by color has been implemented, need to 144 | -- -- get marble and also delete marble composite key 145 | deleteMarble :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 146 | deleteMarble s params = if Prelude.length params == 1 147 | then eitherToPbResponse <$> (runExceptT $ do 148 | _ <- delState s (head params) 149 | pure $ successPayload Nothing) 150 | else pure $ errorPayload "Incorrect arguments. Need a marble name" 151 | 152 | readMarble :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 153 | readMarble s params = if Prelude.length params == 1 154 | then eitherToPbResponse <$> (runExceptT $ do 155 | response <- getState s (head params) 156 | trace (BSU.toString response) (pure $ successPayload Nothing)) 157 | else pure $ errorPayload "Incorrect arguments. Need a marble name, color, size and owner" 158 | 159 | getMarblesByRange :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 160 | getMarblesByRange s params = 161 | if Prelude.length params == 2 162 | then eitherToPbResponse <$> (runExceptT $ do 163 | sqi <- getStateByRange s (params !! 0) (params !! 1) 164 | resultBytes <- generateResultBytes sqi "" 165 | trace (show resultBytes) (pure $ successPayload Nothing)) 166 | else pure $ errorPayload "Incorrect arguments. Need a start key and an end key" 167 | 168 | -- -- TODO: include retrieval of next set of results using the returned bookmark (next TODO) 169 | getMarblesByRangeWithPagination :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 170 | getMarblesByRangeWithPagination s params = 171 | if Prelude.length params == 4 172 | then eitherToPbResponse 173 | <$> (runExceptT $ do 174 | (sqi, metadata) <- getStateByRangeWithPagination s 175 | (params !! 0) 176 | (params !! 1) 177 | (read (unpack $ params !! 2) :: Int) 178 | (params !! 3) 179 | resultBytes <- generateResultBytesForPagination (sqi, metadata) "" 180 | trace (show resultBytes) (pure $ successPayload Nothing)) 181 | else pure $ errorPayload "Incorrect arguments. Need start key, end key, pageSize and bookmark" 182 | 183 | generateResultBytes :: StateQueryIterator -> Text -> ExceptT Error IO BSU.ByteString 184 | generateResultBytes sqi text = ExceptT $ do 185 | hasNextBool <- hasNext sqi 186 | if hasNextBool 187 | then do 188 | eeKv <- runExceptT $ next sqi 189 | case eeKv of 190 | Left e -> pure $ Left e 191 | Right kv -> let makeKVString :: Pb.KV -> Text 192 | makeKVString kv_ = pack "Key: " <> TL.toStrict (Pb.kvKey kv_) <> pack ", Value: " 193 | <> TSE.decodeUtf8 (kvValue kv_) 194 | in 195 | runExceptT $ generateResultBytes sqi (append text (makeKVString kv)) 196 | else pure $ Right $ TSE.encodeUtf8 text 197 | 198 | generateResultBytesForPagination 199 | :: (StateQueryIterator, Pb.QueryResponseMetadata) -> Text -> ExceptT Error IO BSU.ByteString 200 | generateResultBytesForPagination (sqi, md) text = ExceptT $ do 201 | hasNextBool <- hasNext sqi 202 | if hasNextBool 203 | then do 204 | eeKv <- runExceptT $ next sqi 205 | case eeKv of 206 | Left e -> pure $ Left e 207 | Right kv -> let makeKVString :: Pb.KV -> Text 208 | makeKVString kv_ = pack "Key: " <> TL.toStrict (Pb.kvKey kv_) <> pack ", Value: " 209 | <> TSE.decodeUtf8 (kvValue kv_) 210 | in 211 | runExceptT $ generateResultBytesForPagination (sqi, md) (append text (makeKVString kv)) 212 | else pure $ Right $ TSE.encodeUtf8 text 213 | 214 | parseMarble :: [Text] -> Marble 215 | parseMarble params = Marble { objectType = "marble" 216 | , name = params !! 0 217 | , color = params !! 1 218 | , size = params !! 2 219 | , owner = params !! 3 220 | } 221 | 222 | marbleWithNewOwner :: Text -> Marble -> Marble 223 | marbleWithNewOwner newOwner oldMarble = 224 | Marble { objectType = "marble" 225 | , name = name oldMarble 226 | , color = color oldMarble 227 | , size = size oldMarble 228 | , owner = newOwner 229 | } 230 | 231 | eitherToPbResponse :: Show a => Either Error a -> Pb.Response 232 | eitherToPbResponse (Right a) = successPayload $ Just $ BSU.fromString $ show a 233 | eitherToPbResponse (Left err) = errorPayload $ pack $ show err 234 | -------------------------------------------------------------------------------- /examples/readme.md: -------------------------------------------------------------------------------- 1 | # Haskell Chaincode Examples 2 | 3 | ## Simple Application Chaincode (SACC) 4 | 5 | The SACC chaincode can be instantiated with: 6 | 7 | ``` 8 | peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init","a","100"]}' -C myc -o orderer:7050 9 | ``` 10 | 11 | The chaincode can then be invoked with the following examples: 12 | 13 | ``` 14 | peer chaincode invoke -n mycc -c '{"Args":["get","a"]}' -C myc 15 | peer chaincode invoke -n mycc -c '{"Args":["set","b","60"]}' -C myc 16 | ``` 17 | 18 | ## Marbles Chaincode 19 | 20 | The Marbles chaincode can be instantiated with: 21 | 22 | ``` 23 | peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc -o orderer:7050 24 | ``` 25 | 26 | The chaincode can then be invoked with the following examples: 27 | 28 | ``` 29 | peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc 30 | peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble2","blue","large","Nick"]}' -C myc 31 | peer chaincode invoke -n mycc -c '{"Args":["readMarble","marble1"]}' -C myc 32 | peer chaincode invoke -n mycc -c '{"Args":["deleteMarble","marble1"]}' -C myc 33 | peer chaincode invoke -n mycc -c '{"Args":["transferMarble","marble1", "Nick"]}' -C myc 34 | peer chaincode invoke -n mycc -c '{"Args":["getMarblesByRange","marble1", "marble3"]}' -C myc 35 | peer chaincode invoke -n mycc -c '{"Args":["getMarblesByRangeWithPagination","marble1", "marble3", "1", ""]}' -C myc 36 | ``` 37 | 38 | ## Fabcar Chaincode 39 | 40 | The Fabcar chaincode can be instantiated with: 41 | 42 | ``` 43 | peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init"]}' -C myc -o orderer:7050 44 | ``` 45 | 46 | The chaincode can then be invoked with the following examples: 47 | 48 | ``` 49 | peer chaincode invoke -n mycc -c '{"Args":["initLedger"]}' -C myc 50 | peer chaincode invoke -n mycc -c '{"Args":["createCar", "CAR10", "Ford", "Falcon", "White", "Al"]}' -C myc 51 | peer chaincode invoke -n mycc -c '{"Args":["queryCar", "CAR10"]}' -C myc 52 | peer chaincode invoke -n mycc -c '{"Args":["changeCarOwner", "CAR10", "Nick"]}' -C myc 53 | peer chaincode invoke -n mycc -c '{"Args":["queryAllCars"]}' -C myc 54 | ``` 55 | -------------------------------------------------------------------------------- /examples/sacc/Sacc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Sacc where 4 | 5 | import Control.Monad.Except ( runExceptT ) 6 | 7 | import Data.ByteString.UTF8 as BSU ( fromString ) 8 | import Data.Text ( Text, pack ) 9 | import Data.Text.Encoding ( encodeUtf8 ) 10 | 11 | import Peer.ProposalResponse as Pb 12 | 13 | import Shim ( ChaincodeStub(..) 14 | , ChaincodeStubInterface(..) 15 | , DefaultChaincodeStub 16 | , Error 17 | , errorPayload 18 | , start 19 | , successPayload 20 | ) 21 | 22 | main :: IO () 23 | main = Shim.start chaincodeStub 24 | 25 | chaincodeStub :: ChaincodeStub 26 | chaincodeStub = ChaincodeStub { initFn = initFunc 27 | , invokeFn = invokeFunc 28 | } 29 | 30 | initFunc :: DefaultChaincodeStub -> IO Pb.Response 31 | initFunc s = let initArgs = getStringArgs s 32 | in 33 | if Prelude.length initArgs == 2 34 | then eitherToPbResponse <$> (runExceptT $ putState s (head initArgs) (encodeUtf8 $ initArgs !! 1)) 35 | else pure $ errorPayload "Incorrect arguments. Expecting a key and a value" 36 | 37 | invokeFunc :: DefaultChaincodeStub -> IO Pb.Response 38 | invokeFunc s = let e = getFunctionAndParameters s 39 | in 40 | case e of 41 | Left _ -> pure $ errorPayload "" 42 | Right ("set", parameters) -> set s parameters 43 | Right (_, parameters) -> get s parameters 44 | 45 | set :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 46 | set s params = if Prelude.length params == 2 47 | then eitherToPbResponse <$> (runExceptT $ putState s (head params) (encodeUtf8 $ params !! 1)) 48 | else pure $ errorPayload "Incorrect arguments. Expecting a key and a value" 49 | 50 | get :: DefaultChaincodeStub -> [Text] -> IO Pb.Response 51 | get s params = if Prelude.length params == 1 52 | then eitherToPbResponse <$> (runExceptT $ getState s (head params)) 53 | else pure $ errorPayload "Incorrect arguments. Expecting a key" 54 | 55 | eitherToPbResponse :: Show a => Either Error a -> Pb.Response 56 | eitherToPbResponse (Right a) = successPayload $ Just $ BSU.fromString $ show a 57 | eitherToPbResponse (Left err) = errorPayload $ pack $ show err -------------------------------------------------------------------------------- /floskell.json: -------------------------------------------------------------------------------- 1 | { 2 | "style": "cramer", 3 | "extensions": [], 4 | "fixities": [], 5 | "formatting": { 6 | "op": { 7 | ",": { 8 | "force-linebreak": false, 9 | "spaces": "after", 10 | "linebreaks": "before" 11 | }, 12 | "=": { 13 | "force-linebreak": false, 14 | "spaces": "both", 15 | "linebreaks": "after" 16 | }, 17 | "@": { 18 | "force-linebreak": false, 19 | "spaces": "none", 20 | "linebreaks": "none" 21 | }, 22 | "default": { 23 | "force-linebreak": false, 24 | "spaces": "both", 25 | "linebreaks": "before" 26 | }, 27 | "-> in expression": { 28 | "force-linebreak": false, 29 | "spaces": "both", 30 | "linebreaks": "after" 31 | }, 32 | ". in type": { 33 | "force-linebreak": false, 34 | "spaces": "after", 35 | "linebreaks": "after" 36 | }, 37 | "$": { 38 | "force-linebreak": false, 39 | "spaces": "both", 40 | "linebreaks": "after" 41 | }, 42 | "record in pattern": { 43 | "force-linebreak": false, 44 | "spaces": "none", 45 | "linebreaks": "none" 46 | }, 47 | "record": { 48 | "force-linebreak": false, 49 | "spaces": "after", 50 | "linebreaks": "none" 51 | } 52 | }, 53 | "group": { 54 | "$(": { 55 | "force-linebreak": false, 56 | "spaces": "none", 57 | "linebreaks": "none" 58 | }, 59 | "[ in pattern": { 60 | "force-linebreak": false, 61 | "spaces": "both", 62 | "linebreaks": "after" 63 | }, 64 | "[p|": { 65 | "force-linebreak": false, 66 | "spaces": "none", 67 | "linebreaks": "none" 68 | }, 69 | "default": { 70 | "force-linebreak": false, 71 | "spaces": "both", 72 | "linebreaks": "after" 73 | }, 74 | "( in other": { 75 | "force-linebreak": false, 76 | "spaces": "both", 77 | "linebreaks": "after" 78 | }, 79 | "[ in type": { 80 | "force-linebreak": false, 81 | "spaces": "none", 82 | "linebreaks": "none" 83 | }, 84 | "[|": { 85 | "force-linebreak": false, 86 | "spaces": "none", 87 | "linebreaks": "none" 88 | }, 89 | "* in type": { 90 | "force-linebreak": false, 91 | "spaces": "none", 92 | "linebreaks": "after" 93 | }, 94 | "* in pattern": { 95 | "force-linebreak": false, 96 | "spaces": "none", 97 | "linebreaks": "after" 98 | }, 99 | "(": { 100 | "force-linebreak": false, 101 | "spaces": "none", 102 | "linebreaks": "after" 103 | }, 104 | "[d|": { 105 | "force-linebreak": false, 106 | "spaces": "none", 107 | "linebreaks": "none" 108 | }, 109 | "[t|": { 110 | "force-linebreak": false, 111 | "spaces": "none", 112 | "linebreaks": "none" 113 | } 114 | }, 115 | "layout": { 116 | "infix-app": "flex", 117 | "if": "try-oneline", 118 | "import-spec-list": "try-oneline", 119 | "con-decls": "try-oneline", 120 | "declaration": "flex", 121 | "app": "try-oneline", 122 | "let": "try-oneline", 123 | "record": "vertical", 124 | "type": "try-oneline", 125 | "export-spec-list": "try-oneline", 126 | "list-comp": "try-oneline" 127 | }, 128 | "penalty": { 129 | "overfull": 10, 130 | "indent": 1, 131 | "overfull-once": 200, 132 | "max-line-length": 120, 133 | "linebreak": 100 134 | }, 135 | "indent": { 136 | "deriving": 4, 137 | "if": "align", 138 | "let-binds": "align", 139 | "import-spec-list": "align", 140 | "onside": 4, 141 | "where": 2, 142 | "typesig": "align", 143 | "do": "indent-by 4", 144 | "app": "align", 145 | "case": "indent-by 4", 146 | "let-in": "indent-by 4", 147 | "where-binds": "indent-by 2", 148 | "let": "align", 149 | "export-spec-list": "indent-by 4", 150 | "multi-if": "indent-by 4", 151 | "class": "indent-by 4" 152 | }, 153 | "align": { 154 | "let-binds": false, 155 | "where": false, 156 | "matches": false, 157 | "limits": [10, 25], 158 | "case": false, 159 | "import-module": true, 160 | "import-spec": true, 161 | "class": false, 162 | "record-fields": true 163 | }, 164 | "options": { 165 | "sort-pragmas": true, 166 | "flexible-oneline": false, 167 | "decl-no-blank-lines": [], 168 | "split-language-pragmas": true, 169 | "align-sum-type-decl": false, 170 | "sort-import-lists": true, 171 | "preserve-vertical-space": true, 172 | "sort-imports": true 173 | } 174 | }, 175 | "language": "Haskell2010" 176 | } 177 | -------------------------------------------------------------------------------- /google-protos/google/protobuf/timestamp.proto: -------------------------------------------------------------------------------- 1 | // Protocol Buffers - Google's data interchange format 2 | // Copyright 2008 Google Inc. All rights reserved. 3 | // https://developers.google.com/protocol-buffers/ 4 | // 5 | // Redistribution and use in source and binary forms, with or without 6 | // modification, are permitted provided that the following conditions are 7 | // met: 8 | // 9 | // * Redistributions of source code must retain the above copyright 10 | // notice, this list of conditions and the following disclaimer. 11 | // * Redistributions in binary form must reproduce the above 12 | // copyright notice, this list of conditions and the following disclaimer 13 | // in the documentation and/or other materials provided with the 14 | // distribution. 15 | // * Neither the name of Google Inc. nor the names of its 16 | // contributors may be used to endorse or promote products derived from 17 | // this software without specific prior written permission. 18 | // 19 | // THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | // "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | // LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | // A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 23 | // OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 24 | // SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 25 | // LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 26 | // DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 27 | // THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | // (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | // OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | syntax = "proto3"; 32 | 33 | package google.protobuf; 34 | 35 | option csharp_namespace = "Google.Protobuf.WellKnownTypes"; 36 | option cc_enable_arenas = true; 37 | option java_package = "com.google.protobuf"; 38 | option java_outer_classname = "TimestampProto"; 39 | option java_multiple_files = true; 40 | option java_generate_equals_and_hash = true; 41 | option objc_class_prefix = "GPB"; 42 | 43 | // A Timestamp represents a point in time independent of any time zone 44 | // or calendar, represented as seconds and fractions of seconds at 45 | // nanosecond resolution in UTC Epoch time. It is encoded using the 46 | // Proleptic Gregorian Calendar which extends the Gregorian calendar 47 | // backwards to year one. It is encoded assuming all minutes are 60 48 | // seconds long, i.e. leap seconds are "smeared" so that no leap second 49 | // table is needed for interpretation. Range is from 50 | // 0001-01-01T00:00:00Z to 9999-12-31T23:59:59.999999999Z. 51 | // By restricting to that range, we ensure that we can convert to 52 | // and from RFC 3339 date strings. 53 | // See [https://www.ietf.org/rfc/rfc3339.txt](https://www.ietf.org/rfc/rfc3339.txt). 54 | // 55 | // Example 1: Compute Timestamp from POSIX `time()`. 56 | // 57 | // Timestamp timestamp; 58 | // timestamp.set_seconds(time(NULL)); 59 | // timestamp.set_nanos(0); 60 | // 61 | // Example 2: Compute Timestamp from POSIX `gettimeofday()`. 62 | // 63 | // struct timeval tv; 64 | // gettimeofday(&tv, NULL); 65 | // 66 | // Timestamp timestamp; 67 | // timestamp.set_seconds(tv.tv_sec); 68 | // timestamp.set_nanos(tv.tv_usec * 1000); 69 | // 70 | // Example 3: Compute Timestamp from Win32 `GetSystemTimeAsFileTime()`. 71 | // 72 | // FILETIME ft; 73 | // GetSystemTimeAsFileTime(&ft); 74 | // UINT64 ticks = (((UINT64)ft.dwHighDateTime) << 32) | ft.dwLowDateTime; 75 | // 76 | // // A Windows tick is 100 nanoseconds. Windows epoch 1601-01-01T00:00:00Z 77 | // // is 11644473600 seconds before Unix epoch 1970-01-01T00:00:00Z. 78 | // Timestamp timestamp; 79 | // timestamp.set_seconds((INT64) ((ticks / 10000000) - 11644473600LL)); 80 | // timestamp.set_nanos((INT32) ((ticks % 10000000) * 100)); 81 | // 82 | // Example 4: Compute Timestamp from Java `System.currentTimeMillis()`. 83 | // 84 | // long millis = System.currentTimeMillis(); 85 | // 86 | // Timestamp timestamp = Timestamp.newBuilder().setSeconds(millis / 1000) 87 | // .setNanos((int) ((millis % 1000) * 1000000)).build(); 88 | // 89 | // 90 | // Example 5: Compute Timestamp from current time in Python. 91 | // 92 | // now = time.time() 93 | // seconds = int(now) 94 | // nanos = int((now - seconds) * 10**9) 95 | // timestamp = Timestamp(seconds=seconds, nanos=nanos) 96 | // 97 | // 98 | message Timestamp { 99 | 100 | // Represents seconds of UTC time since Unix epoch 101 | // 1970-01-01T00:00:00Z. Must be from from 0001-01-01T00:00:00Z to 102 | // 9999-12-31T23:59:59Z inclusive. 103 | int64 seconds = 1; 104 | 105 | // Non-negative fractions of a second at nanosecond resolution. Negative 106 | // second values with fractions must still have non-negative nanos values 107 | // that count forward in time. Must be from 0 to 999,999,999 108 | // inclusive. 109 | int32 nanos = 2; 110 | } -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | stack: 3 | - path: "./src" 4 | component: "fabric-chaincode-haskell:lib" 5 | 6 | - path: "./examples/fabcar/Fabcar.hs" 7 | component: "fabric-chaincode-haskell:exe:fabcar-exe" 8 | 9 | - path: "./examples/sacc/Sacc.hs" 10 | component: "fabric-chaincode-haskell:exe:sacc-exe" 11 | 12 | - path: "./examples/marbles/Marbles.hs" 13 | component: "fabric-chaincode-haskell:exe:marbles-exe" 14 | 15 | - path: "./test" 16 | component: "fabric-chaincode-haskell:test:fabric-chaincode-haskell-test" 17 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: fabric-chaincode-haskell 2 | version: 0.1.0.0 3 | github: "nwaywood/fabric-chaincode-haskell" 4 | license: Apache-2 5 | author: "Nick Waywood, Allison Irvin" 6 | maintainer: "n.waywood@gmail.com" 7 | copyright: "2020 Nick Waywood" 8 | 9 | # Metadata used when publishing your package 10 | # synopsis: Short description of your package 11 | # category: Web 12 | 13 | # To avoid duplicated efforts in documentation and dealing with the 14 | # complications of embedding Haddock markup inside cabal files, it is 15 | # common to point users to the README.md file. 16 | description: Please see the README on GitHub at 17 | 18 | dependencies: 19 | - base >= 4.7 && < 5 20 | - grpc-haskell-core 21 | - grpc-haskell 22 | - proto3-suite 23 | - proto3-wire 24 | - vector 25 | - bytestring 26 | - text 27 | - deepseq 28 | - containers 29 | - utf8-string 30 | - aeson 31 | - mtl 32 | 33 | library: 34 | source-dirs: 35 | - src 36 | - protos-hs 37 | 38 | executables: 39 | sacc-exe: 40 | main: Sacc.hs 41 | source-dirs: examples/sacc 42 | ghc-options: 43 | - -threaded 44 | - -rtsopts 45 | - -with-rtsopts=-N 46 | - -Wall 47 | - -Wincomplete-uni-patterns 48 | - -main-is Sacc 49 | dependencies: 50 | - fabric-chaincode-haskell 51 | marbles-exe: 52 | main: Marbles.hs 53 | source-dirs: examples/marbles 54 | ghc-options: 55 | - -threaded 56 | - -rtsopts 57 | - -with-rtsopts=-N 58 | - -Wall 59 | - -Wincomplete-uni-patterns 60 | - -main-is Marbles 61 | dependencies: 62 | - fabric-chaincode-haskell 63 | fabcar-exe: 64 | main: Fabcar.hs 65 | source-dirs: examples/fabcar 66 | ghc-options: 67 | - -threaded 68 | - -rtsopts 69 | - -with-rtsopts=-N 70 | - -Wall 71 | - -Wincomplete-uni-patterns 72 | - -main-is Fabcar 73 | dependencies: 74 | - fabric-chaincode-haskell 75 | 76 | tests: 77 | fabric-chaincode-haskell-test: 78 | main: Spec.hs 79 | source-dirs: test 80 | ghc-options: 81 | - -threaded 82 | - -rtsopts 83 | - -with-rtsopts=-N 84 | dependencies: 85 | - fabric-chaincode-haskell 86 | - tasty 87 | - tasty-hunit 88 | -------------------------------------------------------------------------------- /protos-hs/Google/Protobuf/Timestamp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 8 | {-# OPTIONS_GHC -fno-warn-name-shadowing #-} 9 | {-# OPTIONS_GHC -fno-warn-unused-matches #-} 10 | 11 | -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 12 | 13 | module Google.Protobuf.Timestamp where 14 | import qualified Prelude as Hs 15 | import qualified Proto3.Suite.Class as HsProtobuf 16 | import qualified Proto3.Suite.DotProto as HsProtobuf 17 | import qualified Proto3.Suite.JSONPB as HsJSONPB 18 | import Proto3.Suite.JSONPB ((.=), (.:)) 19 | import qualified Proto3.Suite.Types as HsProtobuf 20 | import qualified Proto3.Wire as HsProtobuf 21 | import qualified Control.Applicative as Hs 22 | import Control.Applicative ((<*>), (<|>), (<$>)) 23 | import qualified Control.DeepSeq as Hs 24 | import qualified Control.Monad as Hs 25 | import qualified Data.ByteString as Hs 26 | import qualified Data.Coerce as Hs 27 | import qualified Data.Int as Hs (Int16, Int32, Int64) 28 | import qualified Data.List.NonEmpty as Hs (NonEmpty(..)) 29 | import qualified Data.Map as Hs (Map, mapKeysMonotonic) 30 | import qualified Data.Proxy as Proxy 31 | import qualified Data.String as Hs (fromString) 32 | import qualified Data.Text.Lazy as Hs (Text) 33 | import qualified Data.Vector as Hs (Vector) 34 | import qualified Data.Word as Hs (Word16, Word32, Word64) 35 | import qualified GHC.Enum as Hs 36 | import qualified GHC.Generics as Hs 37 | import qualified Unsafe.Coerce as Hs 38 | 39 | data Timestamp = Timestamp{timestampSeconds :: Hs.Int64, 40 | timestampNanos :: Hs.Int32} 41 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 42 | 43 | instance HsProtobuf.Named Timestamp where 44 | nameOf _ = (Hs.fromString "Timestamp") 45 | 46 | instance HsProtobuf.HasDefault Timestamp 47 | 48 | instance HsProtobuf.Message Timestamp where 49 | encodeMessage _ 50 | Timestamp{timestampSeconds = timestampSeconds, 51 | timestampNanos = timestampNanos} 52 | = (Hs.mconcat 53 | [(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 54 | timestampSeconds), 55 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2) 56 | timestampNanos)]) 57 | decodeMessage _ 58 | = (Hs.pure Timestamp) <*> 59 | (HsProtobuf.at HsProtobuf.decodeMessageField 60 | (HsProtobuf.FieldNumber 1)) 61 | <*> 62 | (HsProtobuf.at HsProtobuf.decodeMessageField 63 | (HsProtobuf.FieldNumber 2)) 64 | dotProto _ 65 | = [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1) 66 | (HsProtobuf.Prim HsProtobuf.Int64) 67 | (HsProtobuf.Single "seconds") 68 | [] 69 | ""), 70 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2) 71 | (HsProtobuf.Prim HsProtobuf.Int32) 72 | (HsProtobuf.Single "nanos") 73 | [] 74 | "")] 75 | 76 | instance HsJSONPB.ToJSONPB Timestamp where 77 | toJSONPB (Timestamp f1 f2) 78 | = (HsJSONPB.object ["seconds" .= f1, "nanos" .= f2]) 79 | toEncodingPB (Timestamp f1 f2) 80 | = (HsJSONPB.pairs ["seconds" .= f1, "nanos" .= f2]) 81 | 82 | instance HsJSONPB.FromJSONPB Timestamp where 83 | parseJSONPB 84 | = (HsJSONPB.withObject "Timestamp" 85 | (\ obj -> 86 | (Hs.pure Timestamp) <*> obj .: "seconds" <*> obj .: "nanos")) 87 | 88 | instance HsJSONPB.ToJSON Timestamp where 89 | toJSON = HsJSONPB.toAesonValue 90 | toEncoding = HsJSONPB.toAesonEncoding 91 | 92 | instance HsJSONPB.FromJSON Timestamp where 93 | parseJSON = HsJSONPB.parseJSONPB 94 | 95 | instance HsJSONPB.ToSchema Timestamp where 96 | declareNamedSchema _ 97 | = do let declare_seconds = HsJSONPB.declareSchemaRef 98 | timestampSeconds <- declare_seconds Proxy.Proxy 99 | let declare_nanos = HsJSONPB.declareSchemaRef 100 | timestampNanos <- declare_nanos Proxy.Proxy 101 | let _ = Hs.pure Timestamp <*> HsJSONPB.asProxy declare_seconds <*> 102 | HsJSONPB.asProxy declare_nanos 103 | Hs.return 104 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 105 | Hs.Just "Timestamp", 106 | HsJSONPB._namedSchemaSchema = 107 | Hs.mempty{HsJSONPB._schemaParamSchema = 108 | Hs.mempty{HsJSONPB._paramSchemaType = 109 | Hs.Just HsJSONPB.SwaggerObject}, 110 | HsJSONPB._schemaProperties = 111 | HsJSONPB.insOrdFromList 112 | [("seconds", timestampSeconds), 113 | ("nanos", timestampNanos)]}}) -------------------------------------------------------------------------------- /protos-hs/Ledger/Queryresult/KvQueryResult.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 8 | {-# OPTIONS_GHC -fno-warn-name-shadowing #-} 9 | {-# OPTIONS_GHC -fno-warn-unused-matches #-} 10 | 11 | -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 12 | 13 | module Ledger.Queryresult.KvQueryResult where 14 | import qualified Prelude as Hs 15 | import qualified Proto3.Suite.Class as HsProtobuf 16 | import qualified Proto3.Suite.DotProto as HsProtobuf 17 | import qualified Proto3.Suite.JSONPB as HsJSONPB 18 | import Proto3.Suite.JSONPB ((.=), (.:)) 19 | import qualified Proto3.Suite.Types as HsProtobuf 20 | import qualified Proto3.Wire as HsProtobuf 21 | import qualified Control.Applicative as Hs 22 | import Control.Applicative ((<*>), (<|>), (<$>)) 23 | import qualified Control.DeepSeq as Hs 24 | import qualified Control.Monad as Hs 25 | import qualified Data.ByteString as Hs 26 | import qualified Data.Coerce as Hs 27 | import qualified Data.Int as Hs (Int16, Int32, Int64) 28 | import qualified Data.List.NonEmpty as Hs (NonEmpty(..)) 29 | import qualified Data.Map as Hs (Map, mapKeysMonotonic) 30 | import qualified Data.Proxy as Proxy 31 | import qualified Data.String as Hs (fromString) 32 | import qualified Data.Text.Lazy as Hs (Text) 33 | import qualified Data.Vector as Hs (Vector) 34 | import qualified Data.Word as Hs (Word16, Word32, Word64) 35 | import qualified GHC.Enum as Hs 36 | import qualified GHC.Generics as Hs 37 | import qualified Unsafe.Coerce as Hs 38 | import qualified Google.Protobuf.Timestamp 39 | 40 | data KV = KV{kvNamespace :: Hs.Text, kvKey :: Hs.Text, 41 | kvValue :: Hs.ByteString} 42 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 43 | 44 | instance HsProtobuf.Named KV where 45 | nameOf _ = (Hs.fromString "KV") 46 | 47 | instance HsProtobuf.HasDefault KV 48 | 49 | instance HsProtobuf.Message KV where 50 | encodeMessage _ 51 | KV{kvNamespace = kvNamespace, kvKey = kvKey, kvValue = kvValue} 52 | = (Hs.mconcat 53 | [(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 54 | kvNamespace), 55 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2) kvKey), 56 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 3) 57 | kvValue)]) 58 | decodeMessage _ 59 | = (Hs.pure KV) <*> 60 | (HsProtobuf.at HsProtobuf.decodeMessageField 61 | (HsProtobuf.FieldNumber 1)) 62 | <*> 63 | (HsProtobuf.at HsProtobuf.decodeMessageField 64 | (HsProtobuf.FieldNumber 2)) 65 | <*> 66 | (HsProtobuf.at HsProtobuf.decodeMessageField 67 | (HsProtobuf.FieldNumber 3)) 68 | dotProto _ 69 | = [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1) 70 | (HsProtobuf.Prim HsProtobuf.String) 71 | (HsProtobuf.Single "namespace") 72 | [] 73 | ""), 74 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2) 75 | (HsProtobuf.Prim HsProtobuf.String) 76 | (HsProtobuf.Single "key") 77 | [] 78 | ""), 79 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 3) 80 | (HsProtobuf.Prim HsProtobuf.Bytes) 81 | (HsProtobuf.Single "value") 82 | [] 83 | "")] 84 | 85 | instance HsJSONPB.ToJSONPB KV where 86 | toJSONPB (KV f1 f2 f3) 87 | = (HsJSONPB.object ["namespace" .= f1, "key" .= f2, "value" .= f3]) 88 | toEncodingPB (KV f1 f2 f3) 89 | = (HsJSONPB.pairs ["namespace" .= f1, "key" .= f2, "value" .= f3]) 90 | 91 | instance HsJSONPB.FromJSONPB KV where 92 | parseJSONPB 93 | = (HsJSONPB.withObject "KV" 94 | (\ obj -> 95 | (Hs.pure KV) <*> obj .: "namespace" <*> obj .: "key" <*> 96 | obj .: "value")) 97 | 98 | instance HsJSONPB.ToJSON KV where 99 | toJSON = HsJSONPB.toAesonValue 100 | toEncoding = HsJSONPB.toAesonEncoding 101 | 102 | instance HsJSONPB.FromJSON KV where 103 | parseJSON = HsJSONPB.parseJSONPB 104 | 105 | instance HsJSONPB.ToSchema KV where 106 | declareNamedSchema _ 107 | = do let declare_namespace = HsJSONPB.declareSchemaRef 108 | kvNamespace <- declare_namespace Proxy.Proxy 109 | let declare_key = HsJSONPB.declareSchemaRef 110 | kvKey <- declare_key Proxy.Proxy 111 | let declare_value = HsJSONPB.declareSchemaRef 112 | kvValue <- declare_value Proxy.Proxy 113 | let _ = Hs.pure KV <*> HsJSONPB.asProxy declare_namespace <*> 114 | HsJSONPB.asProxy declare_key 115 | <*> HsJSONPB.asProxy declare_value 116 | Hs.return 117 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = Hs.Just "KV", 118 | HsJSONPB._namedSchemaSchema = 119 | Hs.mempty{HsJSONPB._schemaParamSchema = 120 | Hs.mempty{HsJSONPB._paramSchemaType = 121 | Hs.Just HsJSONPB.SwaggerObject}, 122 | HsJSONPB._schemaProperties = 123 | HsJSONPB.insOrdFromList 124 | [("namespace", kvNamespace), ("key", kvKey), 125 | ("value", kvValue)]}}) 126 | 127 | data KeyModification = KeyModification{keyModificationTxId :: 128 | Hs.Text, 129 | keyModificationValue :: Hs.ByteString, 130 | keyModificationTimestamp :: 131 | Hs.Maybe Google.Protobuf.Timestamp.Timestamp, 132 | keyModificationIsDelete :: Hs.Bool} 133 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 134 | 135 | instance HsProtobuf.Named KeyModification where 136 | nameOf _ = (Hs.fromString "KeyModification") 137 | 138 | instance HsProtobuf.HasDefault KeyModification 139 | 140 | instance HsProtobuf.Message KeyModification where 141 | encodeMessage _ 142 | KeyModification{keyModificationTxId = keyModificationTxId, 143 | keyModificationValue = keyModificationValue, 144 | keyModificationTimestamp = keyModificationTimestamp, 145 | keyModificationIsDelete = keyModificationIsDelete} 146 | = (Hs.mconcat 147 | [(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 148 | keyModificationTxId), 149 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2) 150 | keyModificationValue), 151 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 3) 152 | (Hs.coerce @(Hs.Maybe Google.Protobuf.Timestamp.Timestamp) 153 | @(HsProtobuf.Nested Google.Protobuf.Timestamp.Timestamp) 154 | keyModificationTimestamp)), 155 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 4) 156 | keyModificationIsDelete)]) 157 | decodeMessage _ 158 | = (Hs.pure KeyModification) <*> 159 | (HsProtobuf.at HsProtobuf.decodeMessageField 160 | (HsProtobuf.FieldNumber 1)) 161 | <*> 162 | (HsProtobuf.at HsProtobuf.decodeMessageField 163 | (HsProtobuf.FieldNumber 2)) 164 | <*> 165 | (Hs.coerce 166 | @(_ (HsProtobuf.Nested Google.Protobuf.Timestamp.Timestamp)) 167 | @(_ (Hs.Maybe Google.Protobuf.Timestamp.Timestamp)) 168 | (HsProtobuf.at HsProtobuf.decodeMessageField 169 | (HsProtobuf.FieldNumber 3))) 170 | <*> 171 | (HsProtobuf.at HsProtobuf.decodeMessageField 172 | (HsProtobuf.FieldNumber 4)) 173 | dotProto _ 174 | = [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1) 175 | (HsProtobuf.Prim HsProtobuf.String) 176 | (HsProtobuf.Single "tx_id") 177 | [] 178 | ""), 179 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2) 180 | (HsProtobuf.Prim HsProtobuf.Bytes) 181 | (HsProtobuf.Single "value") 182 | [] 183 | ""), 184 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 3) 185 | (HsProtobuf.Prim 186 | (HsProtobuf.Named 187 | (HsProtobuf.Dots 188 | (HsProtobuf.Path ("google" Hs.:| ["protobuf", "Timestamp"]))))) 189 | (HsProtobuf.Single "timestamp") 190 | [] 191 | ""), 192 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 4) 193 | (HsProtobuf.Prim HsProtobuf.Bool) 194 | (HsProtobuf.Single "is_delete") 195 | [] 196 | "")] 197 | 198 | instance HsJSONPB.ToJSONPB KeyModification where 199 | toJSONPB (KeyModification f1 f2 f3 f4) 200 | = (HsJSONPB.object 201 | ["tx_id" .= f1, "value" .= f2, "timestamp" .= f3, 202 | "is_delete" .= f4]) 203 | toEncodingPB (KeyModification f1 f2 f3 f4) 204 | = (HsJSONPB.pairs 205 | ["tx_id" .= f1, "value" .= f2, "timestamp" .= f3, 206 | "is_delete" .= f4]) 207 | 208 | instance HsJSONPB.FromJSONPB KeyModification where 209 | parseJSONPB 210 | = (HsJSONPB.withObject "KeyModification" 211 | (\ obj -> 212 | (Hs.pure KeyModification) <*> obj .: "tx_id" <*> obj .: "value" <*> 213 | obj .: "timestamp" 214 | <*> obj .: "is_delete")) 215 | 216 | instance HsJSONPB.ToJSON KeyModification where 217 | toJSON = HsJSONPB.toAesonValue 218 | toEncoding = HsJSONPB.toAesonEncoding 219 | 220 | instance HsJSONPB.FromJSON KeyModification where 221 | parseJSON = HsJSONPB.parseJSONPB 222 | 223 | instance HsJSONPB.ToSchema KeyModification where 224 | declareNamedSchema _ 225 | = do let declare_tx_id = HsJSONPB.declareSchemaRef 226 | keyModificationTxId <- declare_tx_id Proxy.Proxy 227 | let declare_value = HsJSONPB.declareSchemaRef 228 | keyModificationValue <- declare_value Proxy.Proxy 229 | let declare_timestamp = HsJSONPB.declareSchemaRef 230 | keyModificationTimestamp <- declare_timestamp Proxy.Proxy 231 | let declare_is_delete = HsJSONPB.declareSchemaRef 232 | keyModificationIsDelete <- declare_is_delete Proxy.Proxy 233 | let _ = Hs.pure KeyModification <*> HsJSONPB.asProxy declare_tx_id 234 | <*> HsJSONPB.asProxy declare_value 235 | <*> HsJSONPB.asProxy declare_timestamp 236 | <*> HsJSONPB.asProxy declare_is_delete 237 | Hs.return 238 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 239 | Hs.Just "KeyModification", 240 | HsJSONPB._namedSchemaSchema = 241 | Hs.mempty{HsJSONPB._schemaParamSchema = 242 | Hs.mempty{HsJSONPB._paramSchemaType = 243 | Hs.Just HsJSONPB.SwaggerObject}, 244 | HsJSONPB._schemaProperties = 245 | HsJSONPB.insOrdFromList 246 | [("tx_id", keyModificationTxId), 247 | ("value", keyModificationValue), 248 | ("timestamp", keyModificationTimestamp), 249 | ("is_delete", keyModificationIsDelete)]}}) -------------------------------------------------------------------------------- /protos-hs/Peer/ChaincodeEvent.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 8 | {-# OPTIONS_GHC -fno-warn-name-shadowing #-} 9 | {-# OPTIONS_GHC -fno-warn-unused-matches #-} 10 | 11 | -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 12 | 13 | module Peer.ChaincodeEvent where 14 | import qualified Prelude as Hs 15 | import qualified Proto3.Suite.Class as HsProtobuf 16 | import qualified Proto3.Suite.DotProto as HsProtobuf 17 | import qualified Proto3.Suite.JSONPB as HsJSONPB 18 | import Proto3.Suite.JSONPB ((.=), (.:)) 19 | import qualified Proto3.Suite.Types as HsProtobuf 20 | import qualified Proto3.Wire as HsProtobuf 21 | import qualified Control.Applicative as Hs 22 | import Control.Applicative ((<*>), (<|>), (<$>)) 23 | import qualified Control.DeepSeq as Hs 24 | import qualified Control.Monad as Hs 25 | import qualified Data.ByteString as Hs 26 | import qualified Data.Coerce as Hs 27 | import qualified Data.Int as Hs (Int16, Int32, Int64) 28 | import qualified Data.List.NonEmpty as Hs (NonEmpty(..)) 29 | import qualified Data.Map as Hs (Map, mapKeysMonotonic) 30 | import qualified Data.Proxy as Proxy 31 | import qualified Data.String as Hs (fromString) 32 | import qualified Data.Text.Lazy as Hs (Text) 33 | import qualified Data.Vector as Hs (Vector) 34 | import qualified Data.Word as Hs (Word16, Word32, Word64) 35 | import qualified GHC.Enum as Hs 36 | import qualified GHC.Generics as Hs 37 | import qualified Unsafe.Coerce as Hs 38 | 39 | data ChaincodeEvent = ChaincodeEvent{chaincodeEventChaincodeId :: 40 | Hs.Text, 41 | chaincodeEventTxId :: Hs.Text, 42 | chaincodeEventEventName :: Hs.Text, 43 | chaincodeEventPayload :: Hs.ByteString} 44 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 45 | 46 | instance HsProtobuf.Named ChaincodeEvent where 47 | nameOf _ = (Hs.fromString "ChaincodeEvent") 48 | 49 | instance HsProtobuf.HasDefault ChaincodeEvent 50 | 51 | instance HsProtobuf.Message ChaincodeEvent where 52 | encodeMessage _ 53 | ChaincodeEvent{chaincodeEventChaincodeId = 54 | chaincodeEventChaincodeId, 55 | chaincodeEventTxId = chaincodeEventTxId, 56 | chaincodeEventEventName = chaincodeEventEventName, 57 | chaincodeEventPayload = chaincodeEventPayload} 58 | = (Hs.mconcat 59 | [(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 60 | chaincodeEventChaincodeId), 61 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2) 62 | chaincodeEventTxId), 63 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 3) 64 | chaincodeEventEventName), 65 | (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 4) 66 | chaincodeEventPayload)]) 67 | decodeMessage _ 68 | = (Hs.pure ChaincodeEvent) <*> 69 | (HsProtobuf.at HsProtobuf.decodeMessageField 70 | (HsProtobuf.FieldNumber 1)) 71 | <*> 72 | (HsProtobuf.at HsProtobuf.decodeMessageField 73 | (HsProtobuf.FieldNumber 2)) 74 | <*> 75 | (HsProtobuf.at HsProtobuf.decodeMessageField 76 | (HsProtobuf.FieldNumber 3)) 77 | <*> 78 | (HsProtobuf.at HsProtobuf.decodeMessageField 79 | (HsProtobuf.FieldNumber 4)) 80 | dotProto _ 81 | = [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1) 82 | (HsProtobuf.Prim HsProtobuf.String) 83 | (HsProtobuf.Single "chaincode_id") 84 | [] 85 | ""), 86 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2) 87 | (HsProtobuf.Prim HsProtobuf.String) 88 | (HsProtobuf.Single "tx_id") 89 | [] 90 | ""), 91 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 3) 92 | (HsProtobuf.Prim HsProtobuf.String) 93 | (HsProtobuf.Single "event_name") 94 | [] 95 | ""), 96 | (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 4) 97 | (HsProtobuf.Prim HsProtobuf.Bytes) 98 | (HsProtobuf.Single "payload") 99 | [] 100 | "")] 101 | 102 | instance HsJSONPB.ToJSONPB ChaincodeEvent where 103 | toJSONPB (ChaincodeEvent f1 f2 f3 f4) 104 | = (HsJSONPB.object 105 | ["chaincode_id" .= f1, "tx_id" .= f2, "event_name" .= f3, 106 | "payload" .= f4]) 107 | toEncodingPB (ChaincodeEvent f1 f2 f3 f4) 108 | = (HsJSONPB.pairs 109 | ["chaincode_id" .= f1, "tx_id" .= f2, "event_name" .= f3, 110 | "payload" .= f4]) 111 | 112 | instance HsJSONPB.FromJSONPB ChaincodeEvent where 113 | parseJSONPB 114 | = (HsJSONPB.withObject "ChaincodeEvent" 115 | (\ obj -> 116 | (Hs.pure ChaincodeEvent) <*> obj .: "chaincode_id" <*> 117 | obj .: "tx_id" 118 | <*> obj .: "event_name" 119 | <*> obj .: "payload")) 120 | 121 | instance HsJSONPB.ToJSON ChaincodeEvent where 122 | toJSON = HsJSONPB.toAesonValue 123 | toEncoding = HsJSONPB.toAesonEncoding 124 | 125 | instance HsJSONPB.FromJSON ChaincodeEvent where 126 | parseJSON = HsJSONPB.parseJSONPB 127 | 128 | instance HsJSONPB.ToSchema ChaincodeEvent where 129 | declareNamedSchema _ 130 | = do let declare_chaincode_id = HsJSONPB.declareSchemaRef 131 | chaincodeEventChaincodeId <- declare_chaincode_id Proxy.Proxy 132 | let declare_tx_id = HsJSONPB.declareSchemaRef 133 | chaincodeEventTxId <- declare_tx_id Proxy.Proxy 134 | let declare_event_name = HsJSONPB.declareSchemaRef 135 | chaincodeEventEventName <- declare_event_name Proxy.Proxy 136 | let declare_payload = HsJSONPB.declareSchemaRef 137 | chaincodeEventPayload <- declare_payload Proxy.Proxy 138 | let _ = Hs.pure ChaincodeEvent <*> 139 | HsJSONPB.asProxy declare_chaincode_id 140 | <*> HsJSONPB.asProxy declare_tx_id 141 | <*> HsJSONPB.asProxy declare_event_name 142 | <*> HsJSONPB.asProxy declare_payload 143 | Hs.return 144 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 145 | Hs.Just "ChaincodeEvent", 146 | HsJSONPB._namedSchemaSchema = 147 | Hs.mempty{HsJSONPB._schemaParamSchema = 148 | Hs.mempty{HsJSONPB._paramSchemaType = 149 | Hs.Just HsJSONPB.SwaggerObject}, 150 | HsJSONPB._schemaProperties = 151 | HsJSONPB.insOrdFromList 152 | [("chaincode_id", chaincodeEventChaincodeId), 153 | ("tx_id", chaincodeEventTxId), 154 | ("event_name", chaincodeEventEventName), 155 | ("payload", chaincodeEventPayload)]}}) -------------------------------------------------------------------------------- /protos-hs/Token/Expectations.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 8 | {-# OPTIONS_GHC -fno-warn-name-shadowing #-} 9 | {-# OPTIONS_GHC -fno-warn-unused-matches #-} 10 | 11 | -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 12 | 13 | module Token.Expectations where 14 | import qualified Prelude as Hs 15 | import qualified Proto3.Suite.Class as HsProtobuf 16 | import qualified Proto3.Suite.DotProto as HsProtobuf 17 | import qualified Proto3.Suite.JSONPB as HsJSONPB 18 | import Proto3.Suite.JSONPB ((.=), (.:)) 19 | import qualified Proto3.Suite.Types as HsProtobuf 20 | import qualified Proto3.Wire as HsProtobuf 21 | import qualified Control.Applicative as Hs 22 | import Control.Applicative ((<*>), (<|>), (<$>)) 23 | import qualified Control.DeepSeq as Hs 24 | import qualified Control.Monad as Hs 25 | import qualified Data.ByteString as Hs 26 | import qualified Data.Coerce as Hs 27 | import qualified Data.Int as Hs (Int16, Int32, Int64) 28 | import qualified Data.List.NonEmpty as Hs (NonEmpty(..)) 29 | import qualified Data.Map as Hs (Map, mapKeysMonotonic) 30 | import qualified Data.Proxy as Proxy 31 | import qualified Data.String as Hs (fromString) 32 | import qualified Data.Text.Lazy as Hs (Text) 33 | import qualified Data.Vector as Hs (Vector) 34 | import qualified Data.Word as Hs (Word16, Word32, Word64) 35 | import qualified GHC.Enum as Hs 36 | import qualified GHC.Generics as Hs 37 | import qualified Unsafe.Coerce as Hs 38 | import qualified Token.Transaction 39 | import qualified Google.Protobuf.Timestamp 40 | 41 | newtype TokenExpectation = TokenExpectation{tokenExpectationExpectation 42 | :: Hs.Maybe TokenExpectationExpectation} 43 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 44 | 45 | instance HsProtobuf.Named TokenExpectation where 46 | nameOf _ = (Hs.fromString "TokenExpectation") 47 | 48 | instance HsProtobuf.HasDefault TokenExpectation 49 | 50 | instance HsProtobuf.Message TokenExpectation where 51 | encodeMessage _ 52 | TokenExpectation{tokenExpectationExpectation = 53 | tokenExpectationExpectation} 54 | = (Hs.mconcat 55 | [case tokenExpectationExpectation of 56 | Hs.Nothing -> Hs.mempty 57 | Hs.Just x 58 | -> case x of 59 | TokenExpectationExpectationPlainExpectation y 60 | -> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 61 | (Hs.coerce @(Hs.Maybe Token.Expectations.PlainExpectation) 62 | @(HsProtobuf.Nested Token.Expectations.PlainExpectation) 63 | (Hs.Just y)))]) 64 | decodeMessage _ 65 | = (Hs.pure TokenExpectation) <*> 66 | (HsProtobuf.oneof Hs.Nothing 67 | [((HsProtobuf.FieldNumber 1), 68 | (Hs.pure (Hs.fmap TokenExpectationExpectationPlainExpectation)) <*> 69 | (Hs.coerce 70 | @(_ (HsProtobuf.Nested Token.Expectations.PlainExpectation)) 71 | @(_ (Hs.Maybe Token.Expectations.PlainExpectation)) 72 | HsProtobuf.decodeMessageField))]) 73 | dotProto _ = [] 74 | 75 | instance HsJSONPB.ToJSONPB TokenExpectation where 76 | toJSONPB (TokenExpectation f1) 77 | = (HsJSONPB.object 78 | [(let encodeExpectation 79 | = (case f1 of 80 | Hs.Just (TokenExpectationExpectationPlainExpectation f1) 81 | -> (HsJSONPB.pair "plain_expectation" f1) 82 | Hs.Nothing -> Hs.mempty) 83 | in 84 | \ options -> 85 | if HsJSONPB.optEmitNamedOneof options then 86 | ("Expectation" .= 87 | (HsJSONPB.objectOrNull [encodeExpectation] options)) 88 | options 89 | else encodeExpectation options)]) 90 | toEncodingPB (TokenExpectation f1) 91 | = (HsJSONPB.pairs 92 | [(let encodeExpectation 93 | = (case f1 of 94 | Hs.Just (TokenExpectationExpectationPlainExpectation f1) 95 | -> (HsJSONPB.pair "plain_expectation" f1) 96 | Hs.Nothing -> Hs.mempty) 97 | in 98 | \ options -> 99 | if HsJSONPB.optEmitNamedOneof options then 100 | ("Expectation" .= 101 | (HsJSONPB.pairsOrNull [encodeExpectation] options)) 102 | options 103 | else encodeExpectation options)]) 104 | 105 | instance HsJSONPB.FromJSONPB TokenExpectation where 106 | parseJSONPB 107 | = (HsJSONPB.withObject "TokenExpectation" 108 | (\ obj -> 109 | (Hs.pure TokenExpectation) <*> 110 | (let parseExpectation parseObj 111 | = Hs.msum 112 | [Hs.Just Hs.. TokenExpectationExpectationPlainExpectation <$> 113 | (HsJSONPB.parseField parseObj "plain_expectation"), 114 | Hs.pure Hs.Nothing] 115 | in 116 | ((obj .: "Expectation") Hs.>>= 117 | (HsJSONPB.withObject "Expectation" parseExpectation)) 118 | <|> (parseExpectation obj)))) 119 | 120 | instance HsJSONPB.ToJSON TokenExpectation where 121 | toJSON = HsJSONPB.toAesonValue 122 | toEncoding = HsJSONPB.toAesonEncoding 123 | 124 | instance HsJSONPB.FromJSON TokenExpectation where 125 | parseJSON = HsJSONPB.parseJSONPB 126 | 127 | instance HsJSONPB.ToSchema TokenExpectation where 128 | declareNamedSchema _ 129 | = do let declare_Expectation = HsJSONPB.declareSchemaRef 130 | tokenExpectationExpectation <- declare_Expectation Proxy.Proxy 131 | let _ = Hs.pure TokenExpectation <*> 132 | HsJSONPB.asProxy declare_Expectation 133 | Hs.return 134 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 135 | Hs.Just "TokenExpectation", 136 | HsJSONPB._namedSchemaSchema = 137 | Hs.mempty{HsJSONPB._schemaParamSchema = 138 | Hs.mempty{HsJSONPB._paramSchemaType = 139 | Hs.Just HsJSONPB.SwaggerObject}, 140 | HsJSONPB._schemaProperties = 141 | HsJSONPB.insOrdFromList 142 | [("Expectation", 143 | tokenExpectationExpectation)]}}) 144 | 145 | data TokenExpectationExpectation = TokenExpectationExpectationPlainExpectation Token.Expectations.PlainExpectation 146 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 147 | 148 | instance HsProtobuf.Named TokenExpectationExpectation where 149 | nameOf _ = (Hs.fromString "TokenExpectationExpectation") 150 | 151 | instance HsJSONPB.ToSchema TokenExpectationExpectation where 152 | declareNamedSchema _ 153 | = do let declare_plain_expectation = HsJSONPB.declareSchemaRef 154 | tokenExpectationExpectationPlainExpectation <- declare_plain_expectation 155 | Proxy.Proxy 156 | let _ = Hs.pure TokenExpectationExpectationPlainExpectation <*> 157 | HsJSONPB.asProxy declare_plain_expectation 158 | Hs.return 159 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 160 | Hs.Just "TokenExpectationExpectation", 161 | HsJSONPB._namedSchemaSchema = 162 | Hs.mempty{HsJSONPB._schemaParamSchema = 163 | Hs.mempty{HsJSONPB._paramSchemaType = 164 | Hs.Just HsJSONPB.SwaggerObject}, 165 | HsJSONPB._schemaProperties = 166 | HsJSONPB.insOrdFromList 167 | [("plain_expectation", 168 | tokenExpectationExpectationPlainExpectation)], 169 | HsJSONPB._schemaMinProperties = Hs.Just 1, 170 | HsJSONPB._schemaMaxProperties = Hs.Just 1}}) 171 | 172 | newtype PlainExpectation = PlainExpectation{plainExpectationPayload 173 | :: Hs.Maybe PlainExpectationPayload} 174 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 175 | 176 | instance HsProtobuf.Named PlainExpectation where 177 | nameOf _ = (Hs.fromString "PlainExpectation") 178 | 179 | instance HsProtobuf.HasDefault PlainExpectation 180 | 181 | instance HsProtobuf.Message PlainExpectation where 182 | encodeMessage _ 183 | PlainExpectation{plainExpectationPayload = plainExpectationPayload} 184 | = (Hs.mconcat 185 | [case plainExpectationPayload of 186 | Hs.Nothing -> Hs.mempty 187 | Hs.Just x 188 | -> case x of 189 | PlainExpectationPayloadImportExpectation y 190 | -> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 191 | (Hs.coerce @(Hs.Maybe Token.Expectations.PlainTokenExpectation) 192 | @(HsProtobuf.Nested Token.Expectations.PlainTokenExpectation) 193 | (Hs.Just y))) 194 | PlainExpectationPayloadTransferExpectation y 195 | -> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2) 196 | (Hs.coerce @(Hs.Maybe Token.Expectations.PlainTokenExpectation) 197 | @(HsProtobuf.Nested Token.Expectations.PlainTokenExpectation) 198 | (Hs.Just y)))]) 199 | decodeMessage _ 200 | = (Hs.pure PlainExpectation) <*> 201 | (HsProtobuf.oneof Hs.Nothing 202 | [((HsProtobuf.FieldNumber 1), 203 | (Hs.pure (Hs.fmap PlainExpectationPayloadImportExpectation)) <*> 204 | (Hs.coerce 205 | @(_ (HsProtobuf.Nested Token.Expectations.PlainTokenExpectation)) 206 | @(_ (Hs.Maybe Token.Expectations.PlainTokenExpectation)) 207 | HsProtobuf.decodeMessageField)), 208 | ((HsProtobuf.FieldNumber 2), 209 | (Hs.pure (Hs.fmap PlainExpectationPayloadTransferExpectation)) <*> 210 | (Hs.coerce 211 | @(_ (HsProtobuf.Nested Token.Expectations.PlainTokenExpectation)) 212 | @(_ (Hs.Maybe Token.Expectations.PlainTokenExpectation)) 213 | HsProtobuf.decodeMessageField))]) 214 | dotProto _ = [] 215 | 216 | instance HsJSONPB.ToJSONPB PlainExpectation where 217 | toJSONPB (PlainExpectation f1_or_f2) 218 | = (HsJSONPB.object 219 | [(let encodePayload 220 | = (case f1_or_f2 of 221 | Hs.Just (PlainExpectationPayloadImportExpectation f1) 222 | -> (HsJSONPB.pair "import_expectation" f1) 223 | Hs.Just (PlainExpectationPayloadTransferExpectation f2) 224 | -> (HsJSONPB.pair "transfer_expectation" f2) 225 | Hs.Nothing -> Hs.mempty) 226 | in 227 | \ options -> 228 | if HsJSONPB.optEmitNamedOneof options then 229 | ("payload" .= (HsJSONPB.objectOrNull [encodePayload] options)) 230 | options 231 | else encodePayload options)]) 232 | toEncodingPB (PlainExpectation f1_or_f2) 233 | = (HsJSONPB.pairs 234 | [(let encodePayload 235 | = (case f1_or_f2 of 236 | Hs.Just (PlainExpectationPayloadImportExpectation f1) 237 | -> (HsJSONPB.pair "import_expectation" f1) 238 | Hs.Just (PlainExpectationPayloadTransferExpectation f2) 239 | -> (HsJSONPB.pair "transfer_expectation" f2) 240 | Hs.Nothing -> Hs.mempty) 241 | in 242 | \ options -> 243 | if HsJSONPB.optEmitNamedOneof options then 244 | ("payload" .= (HsJSONPB.pairsOrNull [encodePayload] options)) 245 | options 246 | else encodePayload options)]) 247 | 248 | instance HsJSONPB.FromJSONPB PlainExpectation where 249 | parseJSONPB 250 | = (HsJSONPB.withObject "PlainExpectation" 251 | (\ obj -> 252 | (Hs.pure PlainExpectation) <*> 253 | (let parsePayload parseObj 254 | = Hs.msum 255 | [Hs.Just Hs.. PlainExpectationPayloadImportExpectation <$> 256 | (HsJSONPB.parseField parseObj "import_expectation"), 257 | Hs.Just Hs.. PlainExpectationPayloadTransferExpectation <$> 258 | (HsJSONPB.parseField parseObj "transfer_expectation"), 259 | Hs.pure Hs.Nothing] 260 | in 261 | ((obj .: "payload") Hs.>>= 262 | (HsJSONPB.withObject "payload" parsePayload)) 263 | <|> (parsePayload obj)))) 264 | 265 | instance HsJSONPB.ToJSON PlainExpectation where 266 | toJSON = HsJSONPB.toAesonValue 267 | toEncoding = HsJSONPB.toAesonEncoding 268 | 269 | instance HsJSONPB.FromJSON PlainExpectation where 270 | parseJSON = HsJSONPB.parseJSONPB 271 | 272 | instance HsJSONPB.ToSchema PlainExpectation where 273 | declareNamedSchema _ 274 | = do let declare_payload = HsJSONPB.declareSchemaRef 275 | plainExpectationPayload <- declare_payload Proxy.Proxy 276 | let _ = Hs.pure PlainExpectation <*> 277 | HsJSONPB.asProxy declare_payload 278 | Hs.return 279 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 280 | Hs.Just "PlainExpectation", 281 | HsJSONPB._namedSchemaSchema = 282 | Hs.mempty{HsJSONPB._schemaParamSchema = 283 | Hs.mempty{HsJSONPB._paramSchemaType = 284 | Hs.Just HsJSONPB.SwaggerObject}, 285 | HsJSONPB._schemaProperties = 286 | HsJSONPB.insOrdFromList 287 | [("payload", plainExpectationPayload)]}}) 288 | 289 | data PlainExpectationPayload = PlainExpectationPayloadImportExpectation Token.Expectations.PlainTokenExpectation 290 | | PlainExpectationPayloadTransferExpectation Token.Expectations.PlainTokenExpectation 291 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 292 | 293 | instance HsProtobuf.Named PlainExpectationPayload where 294 | nameOf _ = (Hs.fromString "PlainExpectationPayload") 295 | 296 | instance HsJSONPB.ToSchema PlainExpectationPayload where 297 | declareNamedSchema _ 298 | = do let declare_import_expectation = HsJSONPB.declareSchemaRef 299 | plainExpectationPayloadImportExpectation <- declare_import_expectation 300 | Proxy.Proxy 301 | let _ = Hs.pure PlainExpectationPayloadImportExpectation <*> 302 | HsJSONPB.asProxy declare_import_expectation 303 | let declare_transfer_expectation = HsJSONPB.declareSchemaRef 304 | plainExpectationPayloadTransferExpectation <- declare_transfer_expectation 305 | Proxy.Proxy 306 | let _ = Hs.pure PlainExpectationPayloadTransferExpectation <*> 307 | HsJSONPB.asProxy declare_transfer_expectation 308 | Hs.return 309 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 310 | Hs.Just "PlainExpectationPayload", 311 | HsJSONPB._namedSchemaSchema = 312 | Hs.mempty{HsJSONPB._schemaParamSchema = 313 | Hs.mempty{HsJSONPB._paramSchemaType = 314 | Hs.Just HsJSONPB.SwaggerObject}, 315 | HsJSONPB._schemaProperties = 316 | HsJSONPB.insOrdFromList 317 | [("import_expectation", 318 | plainExpectationPayloadImportExpectation), 319 | ("transfer_expectation", 320 | plainExpectationPayloadTransferExpectation)], 321 | HsJSONPB._schemaMinProperties = Hs.Just 1, 322 | HsJSONPB._schemaMaxProperties = Hs.Just 1}}) 323 | 324 | newtype PlainTokenExpectation = PlainTokenExpectation{plainTokenExpectationOutputs 325 | :: Hs.Vector Token.Transaction.PlainOutput} 326 | deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) 327 | 328 | instance HsProtobuf.Named PlainTokenExpectation where 329 | nameOf _ = (Hs.fromString "PlainTokenExpectation") 330 | 331 | instance HsProtobuf.HasDefault PlainTokenExpectation 332 | 333 | instance HsProtobuf.Message PlainTokenExpectation where 334 | encodeMessage _ 335 | PlainTokenExpectation{plainTokenExpectationOutputs = 336 | plainTokenExpectationOutputs} 337 | = (Hs.mconcat 338 | [(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1) 339 | (Hs.coerce @(Hs.Vector Token.Transaction.PlainOutput) 340 | @(HsProtobuf.NestedVec Token.Transaction.PlainOutput) 341 | plainTokenExpectationOutputs))]) 342 | decodeMessage _ 343 | = (Hs.pure PlainTokenExpectation) <*> 344 | (Hs.coerce 345 | @(_ (HsProtobuf.NestedVec Token.Transaction.PlainOutput)) 346 | @(_ (Hs.Vector Token.Transaction.PlainOutput)) 347 | (HsProtobuf.at HsProtobuf.decodeMessageField 348 | (HsProtobuf.FieldNumber 1))) 349 | dotProto _ 350 | = [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1) 351 | (HsProtobuf.Repeated 352 | (HsProtobuf.Named (HsProtobuf.Single "PlainOutput"))) 353 | (HsProtobuf.Single "outputs") 354 | [] 355 | "")] 356 | 357 | instance HsJSONPB.ToJSONPB PlainTokenExpectation where 358 | toJSONPB (PlainTokenExpectation f1) 359 | = (HsJSONPB.object ["outputs" .= f1]) 360 | toEncodingPB (PlainTokenExpectation f1) 361 | = (HsJSONPB.pairs ["outputs" .= f1]) 362 | 363 | instance HsJSONPB.FromJSONPB PlainTokenExpectation where 364 | parseJSONPB 365 | = (HsJSONPB.withObject "PlainTokenExpectation" 366 | (\ obj -> (Hs.pure PlainTokenExpectation) <*> obj .: "outputs")) 367 | 368 | instance HsJSONPB.ToJSON PlainTokenExpectation where 369 | toJSON = HsJSONPB.toAesonValue 370 | toEncoding = HsJSONPB.toAesonEncoding 371 | 372 | instance HsJSONPB.FromJSON PlainTokenExpectation where 373 | parseJSON = HsJSONPB.parseJSONPB 374 | 375 | instance HsJSONPB.ToSchema PlainTokenExpectation where 376 | declareNamedSchema _ 377 | = do let declare_outputs = HsJSONPB.declareSchemaRef 378 | plainTokenExpectationOutputs <- declare_outputs Proxy.Proxy 379 | let _ = Hs.pure PlainTokenExpectation <*> 380 | HsJSONPB.asProxy declare_outputs 381 | Hs.return 382 | (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = 383 | Hs.Just "PlainTokenExpectation", 384 | HsJSONPB._namedSchemaSchema = 385 | Hs.mempty{HsJSONPB._schemaParamSchema = 386 | Hs.mempty{HsJSONPB._paramSchemaType = 387 | Hs.Just HsJSONPB.SwaggerObject}, 388 | HsJSONPB._schemaProperties = 389 | HsJSONPB.insOrdFromList 390 | [("outputs", 391 | plainTokenExpectationOutputs)]}}) -------------------------------------------------------------------------------- /protos/common/common.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2016 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | syntax = "proto3"; 18 | 19 | import "google/protobuf/timestamp.proto"; 20 | 21 | option go_package = "github.com/hyperledger/fabric/protos/common"; 22 | option java_package = "org.hyperledger.fabric.protos.common"; 23 | 24 | package common; 25 | 26 | // These status codes are intended to resemble selected HTTP status codes 27 | enum Status { 28 | UNKNOWN = 0; 29 | SUCCESS = 200; 30 | BAD_REQUEST = 400; 31 | FORBIDDEN = 403; 32 | NOT_FOUND = 404; 33 | REQUEST_ENTITY_TOO_LARGE = 413; 34 | INTERNAL_SERVER_ERROR = 500; 35 | NOT_IMPLEMENTED = 501; 36 | SERVICE_UNAVAILABLE = 503; 37 | } 38 | 39 | enum HeaderType { 40 | // Prevent removed tag re-use 41 | // Uncomment after fabric-baseimage moves to 3.5.1 42 | // reserved 7; 43 | // reserved "PEER_RESOURCE_UPDATE"; 44 | 45 | MESSAGE = 0; // Used for messages which are signed but opaque 46 | CONFIG = 1; // Used for messages which express the channel config 47 | CONFIG_UPDATE = 2; // Used for transactions which update the channel config 48 | ENDORSER_TRANSACTION = 3; // Used by the SDK to submit endorser based transactions 49 | ORDERER_TRANSACTION = 4; // Used internally by the orderer for management 50 | DELIVER_SEEK_INFO = 5; // Used as the type for Envelope messages submitted to instruct the Deliver API to seek 51 | CHAINCODE_PACKAGE = 6; // Used for packaging chaincode artifacts for install 52 | PEER_ADMIN_OPERATION = 8; // Used for invoking an administrative operation on a peer 53 | TOKEN_TRANSACTION = 9; // Used to denote transactions that invoke token management operations 54 | } 55 | 56 | // This enum enlists indexes of the block metadata array 57 | enum BlockMetadataIndex { 58 | SIGNATURES = 0; // Block metadata array position for block signatures 59 | LAST_CONFIG = 1; // Block metadata array position to store last configuration block sequence number 60 | TRANSACTIONS_FILTER = 2; // Block metadata array position to store serialized bit array filter of invalid transactions 61 | ORDERER = 3; /* Block metadata array position to store operational metadata for orderers e.g. For Kafka, 62 | this is where we store the last offset written to the local ledger */ 63 | COMMIT_HASH = 4; /* Block metadata array position to store the hash of TRANSACTIONS_FILTER, State Updates, 64 | and the COMMIT_HASH of the previous block */ 65 | } 66 | 67 | // LastConfig is the encoded value for the Metadata message which is encoded in the LAST_CONFIGURATION block metadata index 68 | message LastConfig { 69 | uint64 index = 1; 70 | } 71 | 72 | // Metadata is a common structure to be used to encode block metadata 73 | message Metadata { 74 | bytes value = 1; 75 | repeated MetadataSignature signatures = 2; 76 | } 77 | 78 | message MetadataSignature { 79 | bytes signature_header = 1; // An encoded SignatureHeader 80 | bytes signature = 2; // The signature over the concatenation of the Metadata value bytes, signatureHeader, and block header 81 | } 82 | 83 | message Header { 84 | bytes channel_header = 1; 85 | bytes signature_header = 2; 86 | } 87 | 88 | // Header is a generic replay prevention and identity message to include in a signed payload 89 | message ChannelHeader { 90 | int32 type = 1; // Header types 0-10000 are reserved and defined by HeaderType 91 | 92 | // Version indicates message protocol version 93 | int32 version = 2; 94 | 95 | // Timestamp is the local time when the message was created 96 | // by the sender 97 | google.protobuf.Timestamp timestamp = 3; 98 | 99 | // Identifier of the channel this message is bound for 100 | string channel_id = 4; 101 | 102 | // An unique identifier that is used end-to-end. 103 | // - set by higher layers such as end user or SDK 104 | // - passed to the endorser (which will check for uniqueness) 105 | // - as the header is passed along unchanged, it will be 106 | // be retrieved by the committer (uniqueness check here as well) 107 | // - to be stored in the ledger 108 | string tx_id = 5; 109 | 110 | // The epoch in which this header was generated, where epoch is defined based on block height 111 | // Epoch in which the response has been generated. This field identifies a 112 | // logical window of time. A proposal response is accepted by a peer only if 113 | // two conditions hold: 114 | // 1. the epoch specified in the message is the current epoch 115 | // 2. this message has been only seen once during this epoch (i.e. it hasn't 116 | // been replayed) 117 | uint64 epoch = 6; 118 | 119 | // Extension that may be attached based on the header type 120 | bytes extension = 7; 121 | 122 | // If mutual TLS is employed, this represents 123 | // the hash of the client's TLS certificate 124 | bytes tls_cert_hash = 8; 125 | } 126 | 127 | message SignatureHeader { 128 | // Creator of the message, a marshaled msp.SerializedIdentity 129 | bytes creator = 1; 130 | 131 | // Arbitrary number that may only be used once. Can be used to detect replay attacks. 132 | bytes nonce = 2; 133 | } 134 | 135 | // Payload is the message contents (and header to allow for signing) 136 | message Payload { 137 | 138 | // Header is included to provide identity and prevent replay 139 | Header header = 1; 140 | 141 | // Data, the encoding of which is defined by the type in the header 142 | bytes data = 2; 143 | } 144 | 145 | // Envelope wraps a Payload with a signature so that the message may be authenticated 146 | message Envelope { 147 | // A marshaled Payload 148 | bytes payload = 1; 149 | 150 | // A signature by the creator specified in the Payload header 151 | bytes signature = 2; 152 | } 153 | 154 | // This is finalized block structure to be shared among the orderer and peer 155 | // Note that the BlockHeader chains to the previous BlockHeader, and the BlockData hash is embedded 156 | // in the BlockHeader. This makes it natural and obvious that the Data is included in the hash, but 157 | // the Metadata is not. 158 | message Block { 159 | BlockHeader header = 1; 160 | BlockData data = 2; 161 | BlockMetadata metadata = 3; 162 | } 163 | 164 | // BlockHeader is the element of the block which forms the block chain 165 | // The block header is hashed using the configured chain hashing algorithm 166 | // over the ASN.1 encoding of the BlockHeader 167 | message BlockHeader { 168 | uint64 number = 1; // The position in the blockchain 169 | bytes previous_hash = 2; // The hash of the previous block header 170 | bytes data_hash = 3; // The hash of the BlockData, by MerkleTree 171 | } 172 | 173 | message BlockData { 174 | repeated bytes data = 1; 175 | } 176 | 177 | message BlockMetadata { 178 | repeated bytes metadata = 1; 179 | } 180 | 181 | // OrdererBlockMetadata defines metadata that is set by the ordering service. 182 | message OrdererBlockMetadata { 183 | LastConfig last_config = 1; 184 | bytes consenter_metadata = 2; 185 | } 186 | -------------------------------------------------------------------------------- /protos/common/policies.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2017 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | syntax = "proto3"; 18 | 19 | import "msp/msp_principal.proto"; 20 | 21 | option go_package = "github.com/hyperledger/fabric/protos/common"; 22 | option java_package = "org.hyperledger.fabric.protos.common"; 23 | 24 | package common; 25 | 26 | // Policy expresses a policy which the orderer can evaluate, because there has been some desire expressed to support 27 | // multiple policy engines, this is typed as a oneof for now 28 | message Policy { 29 | enum PolicyType { 30 | UNKNOWN = 0; // Reserved to check for proper initialization 31 | SIGNATURE = 1; 32 | MSP = 2; 33 | IMPLICIT_META = 3; 34 | } 35 | int32 type = 1; // For outside implementors, consider the first 1000 types reserved, otherwise one of PolicyType 36 | bytes value = 2; 37 | } 38 | 39 | // SignaturePolicyEnvelope wraps a SignaturePolicy and includes a version for future enhancements 40 | message SignaturePolicyEnvelope { 41 | int32 version = 1; 42 | SignaturePolicy rule = 2; 43 | repeated MSPPrincipal identities = 3; 44 | } 45 | 46 | // SignaturePolicy is a recursive message structure which defines a featherweight DSL for describing 47 | // policies which are more complicated than 'exactly this signature'. The NOutOf operator is sufficent 48 | // to express AND as well as OR, as well as of course N out of the following M policies 49 | // SignedBy implies that the signature is from a valid certificate which is signed by the trusted 50 | // authority specified in the bytes. This will be the certificate itself for a self-signed certificate 51 | // and will be the CA for more traditional certificates 52 | message SignaturePolicy { 53 | message NOutOf { 54 | int32 n = 1; 55 | repeated SignaturePolicy rules = 2; 56 | } 57 | oneof Type { 58 | int32 signed_by = 1; 59 | NOutOf n_out_of = 2; 60 | } 61 | } 62 | 63 | // ImplicitMetaPolicy is a policy type which depends on the hierarchical nature of the configuration 64 | // It is implicit because the rule is generate implicitly based on the number of sub policies 65 | // It is meta because it depends only on the result of other policies 66 | // When evaluated, this policy iterates over all immediate child sub-groups, retrieves the policy 67 | // of name sub_policy, evaluates the collection and applies the rule. 68 | // For example, with 4 sub-groups, and a policy name of "foo", ImplicitMetaPolicy retrieves 69 | // each sub-group, retrieves policy "foo" for each subgroup, evaluates it, and, in the case of ANY 70 | // 1 satisfied is sufficient, ALL would require 4 signatures, and MAJORITY would require 3 signatures. 71 | message ImplicitMetaPolicy { 72 | enum Rule { 73 | ANY = 0; // Requires any of the sub-policies be satisfied, if no sub-policies exist, always returns true 74 | ALL = 1; // Requires all of the sub-policies be satisfied 75 | MAJORITY = 2; // Requires a strict majority (greater than half) of the sub-policies be satisfied 76 | } 77 | string sub_policy = 1; 78 | Rule rule = 2; 79 | } 80 | -------------------------------------------------------------------------------- /protos/generate.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | compile-proto-file --proto common/common.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 4 | compile-proto-file --proto common/policies.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 5 | compile-proto-file --proto ledger/queryresult/kv_query_result.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 6 | compile-proto-file --proto msp/msp_principal.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 7 | compile-proto-file --proto peer/chaincode.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 8 | compile-proto-file --proto peer/chaincode_event.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 9 | compile-proto-file --proto peer/chaincode_shim.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 10 | compile-proto-file --proto peer/proposal.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 11 | compile-proto-file --proto peer/proposal_response.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 12 | compile-proto-file --proto token/expectations.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 13 | compile-proto-file --proto token/transaction.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 14 | compile-proto-file --proto google/protobuf/timestamp.proto --out ../protos-hs --includeDir ../google-protos --includeDir . 15 | -------------------------------------------------------------------------------- /protos/ledger/queryresult/kv_query_result.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2017 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | syntax = "proto3"; 18 | 19 | package queryresult; 20 | 21 | option go_package = "github.com/hyperledger/fabric/protos/ledger/queryresult"; 22 | option java_package = "org.hyperledger.fabric.protos.ledger.queryresult"; 23 | 24 | import "google/protobuf/timestamp.proto"; 25 | 26 | 27 | // KV -- QueryResult for range/execute query. Holds a key and corresponding value. 28 | message KV { 29 | string namespace = 1; 30 | string key = 2; 31 | bytes value = 3; 32 | } 33 | 34 | // KeyModification -- QueryResult for history query. Holds a transaction ID, value, 35 | // timestamp, and delete marker which resulted from a history query. 36 | message KeyModification { 37 | string tx_id = 1; 38 | bytes value = 2; 39 | google.protobuf.Timestamp timestamp = 3; 40 | bool is_delete = 4; 41 | } 42 | -------------------------------------------------------------------------------- /protos/msp/msp_principal.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2016 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | 18 | syntax = "proto3"; 19 | 20 | option go_package = "github.com/hyperledger/fabric/protos/msp"; 21 | option java_package = "org.hyperledger.fabric.protos.common"; 22 | 23 | package common; 24 | 25 | 26 | // msp_principal.proto contains proto messages defining the generalized 27 | // MSP notion of identity called an MSPPrincipal. It is used as part of 28 | // the chain configuration, in particular as the identity parameters to 29 | // the configuration.proto file. This does not represent the MSP 30 | // configuration for a chain, but is understood by MSPs 31 | 32 | // MSPPrincipal aims to represent an MSP-centric set of identities. 33 | // In particular, this structure allows for definition of 34 | // - a group of identities that are member of the same MSP 35 | // - a group of identities that are member of the same organization unit 36 | // in the same MSP 37 | // - a group of identities that are administering a specific MSP 38 | // - a specific identity 39 | // Expressing these groups is done given two fields of the fields below 40 | // - Classification, that defines the type of classification of identities 41 | // in an MSP this principal would be defined on; Classification can take 42 | // three values: 43 | // (i) ByMSPRole: that represents a classification of identities within 44 | // MSP based on one of the two pre-defined MSP rules, "member" and "admin" 45 | // (ii) ByOrganizationUnit: that represents a classification of identities 46 | // within MSP based on the organization unit an identity belongs to 47 | // (iii)ByIdentity that denotes that MSPPrincipal is mapped to a single 48 | // identity/certificate; this would mean that the Principal bytes 49 | // message 50 | message MSPPrincipal { 51 | 52 | enum Classification { 53 | ROLE = 0; // Represents the one of the dedicated MSP roles, the 54 | // one of a member of MSP network, and the one of an 55 | // administrator of an MSP network 56 | ORGANIZATION_UNIT = 1; // Denotes a finer grained (affiliation-based) 57 | // groupping of entities, per MSP affiliation 58 | // E.g., this can well be represented by an MSP's 59 | // Organization unit 60 | IDENTITY = 2; // Denotes a principal that consists of a single 61 | // identity 62 | ANONYMITY = 3; // Denotes a principal that can be used to enforce 63 | // an identity to be anonymous or nominal. 64 | COMBINED = 4; // Denotes a combined principal 65 | } 66 | 67 | // Classification describes the way that one should process 68 | // Principal. An Classification value of "ByOrganizationUnit" reflects 69 | // that "Principal" contains the name of an organization this MSP 70 | // handles. A Classification value "ByIdentity" means that 71 | // "Principal" contains a specific identity. Default value 72 | // denotes that Principal contains one of the groups by 73 | // default supported by all MSPs ("admin" or "member"). 74 | Classification principal_classification = 1; 75 | 76 | // Principal completes the policy principal definition. For the default 77 | // principal types, Principal can be either "Admin" or "Member". 78 | // For the ByOrganizationUnit/ByIdentity values of Classification, 79 | // PolicyPrincipal acquires its value from an organization unit or 80 | // identity, respectively. 81 | // For the Combined Classification type, the Principal is a marshalled 82 | // CombinedPrincipal. 83 | bytes principal = 2; 84 | } 85 | 86 | 87 | // OrganizationUnit governs the organization of the Principal 88 | // field of a policy principal when a specific organization unity members 89 | // are to be defined within a policy principal. 90 | message OrganizationUnit { 91 | 92 | // MSPIdentifier represents the identifier of the MSP this organization unit 93 | // refers to 94 | string msp_identifier = 1; 95 | 96 | // OrganizationUnitIdentifier defines the organizational unit under the 97 | // MSP identified with MSPIdentifier 98 | string organizational_unit_identifier = 2; 99 | 100 | // CertifiersIdentifier is the hash of certificates chain of trust 101 | // related to this organizational unit 102 | bytes certifiers_identifier = 3; 103 | } 104 | 105 | // MSPRole governs the organization of the Principal 106 | // field of an MSPPrincipal when it aims to define one of the 107 | // two dedicated roles within an MSP: Admin and Members. 108 | message MSPRole { 109 | 110 | // MSPIdentifier represents the identifier of the MSP this principal 111 | // refers to 112 | string msp_identifier = 1; 113 | 114 | enum MSPRoleType { 115 | MEMBER = 0; // Represents an MSP Member 116 | ADMIN = 1; // Represents an MSP Admin 117 | CLIENT = 2; // Represents an MSP Client 118 | PEER = 3; // Represents an MSP Peer 119 | ORDERER = 4; // Represents an MSP Orderer 120 | } 121 | 122 | // MSPRoleType defines which of the available, pre-defined MSP-roles 123 | // an identiy should posess inside the MSP with identifier MSPidentifier 124 | MSPRoleType role = 2; 125 | 126 | } 127 | 128 | // MSPIdentityAnonymity can be used to enforce an identity to be anonymous or nominal. 129 | message MSPIdentityAnonymity { 130 | 131 | enum MSPIdentityAnonymityType { 132 | NOMINAL = 0; // Represents a nominal MSP Identity 133 | ANONYMOUS = 1; // Represents an anonymous MSP Identity 134 | } 135 | 136 | MSPIdentityAnonymityType anonymity_type = 1; 137 | 138 | } 139 | 140 | // CombinedPrincipal governs the organization of the Principal 141 | // field of a policy principal when principal_classification has 142 | // indicated that a combined form of principals is required 143 | message CombinedPrincipal { 144 | 145 | // Principals refer to combined principals 146 | repeated MSPPrincipal principals = 1; 147 | } 148 | 149 | // TODO: Bring msp.SerializedIdentity from fabric/msp/identities.proto here. Reason below. 150 | // SerializedIdentity represents an serialized version of an identity; 151 | // this consists of an MSP-identifier this identity would correspond to 152 | // and the bytes of the actual identity. A serialized form of 153 | // SerializedIdentity would govern "Principal" field of a PolicyPrincipal 154 | // of classification "ByIdentity". 155 | -------------------------------------------------------------------------------- /protos/peer/chaincode.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2017 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | syntax = "proto3"; 18 | 19 | package protos; 20 | option java_package = "org.hyperledger.fabric.protos.peer"; 21 | option go_package = "github.com/hyperledger/fabric/protos/peer"; 22 | 23 | 24 | // Confidentiality Levels 25 | enum ConfidentialityLevel { 26 | PUBLIC = 0; 27 | CONFIDENTIAL = 1; 28 | } 29 | 30 | 31 | //ChaincodeID contains the path as specified by the deploy transaction 32 | //that created it as well as the hashCode that is generated by the 33 | //system for the path. From the user level (ie, CLI, REST API and so on) 34 | //deploy transaction is expected to provide the path and other requests 35 | //are expected to provide the hashCode. The other value will be ignored. 36 | //Internally, the structure could contain both values. For instance, the 37 | //hashCode will be set when first generated using the path 38 | message ChaincodeID { 39 | //deploy transaction will use the path 40 | string path = 1; 41 | 42 | //all other requests will use the name (really a hashcode) generated by 43 | //the deploy transaction 44 | string name = 2; 45 | 46 | //user friendly version name for the chaincode 47 | string version = 3; 48 | } 49 | 50 | // Carries the chaincode function and its arguments. 51 | // UnmarshalJSON in transaction.go converts the string-based REST/JSON input to 52 | // the []byte-based current ChaincodeInput structure. 53 | message ChaincodeInput { 54 | repeated bytes args = 1; 55 | map decorations = 2; 56 | } 57 | 58 | // Carries the chaincode specification. This is the actual metadata required for 59 | // defining a chaincode. 60 | message ChaincodeSpec { 61 | 62 | enum Type { 63 | UNDEFINED = 0; 64 | GOLANG = 1; 65 | NODE = 2; 66 | CAR = 3; 67 | JAVA = 4; 68 | } 69 | 70 | Type type = 1; 71 | ChaincodeID chaincode_id = 2; 72 | ChaincodeInput input = 3; 73 | int32 timeout = 4; 74 | } 75 | 76 | // Specify the deployment of a chaincode. 77 | // TODO: Define `codePackage`. 78 | message ChaincodeDeploymentSpec { 79 | // Prevent removed tag re-use 80 | reserved 2; 81 | reserved "effective_date"; 82 | 83 | enum ExecutionEnvironment { 84 | DOCKER = 0; 85 | SYSTEM = 1; 86 | } 87 | 88 | ChaincodeSpec chaincode_spec = 1; 89 | bytes code_package = 3; 90 | ExecutionEnvironment exec_env= 4; 91 | 92 | } 93 | 94 | // Carries the chaincode function and its arguments. 95 | message ChaincodeInvocationSpec { 96 | // Prevent removed tag re-use 97 | reserved 2; 98 | reserved "id_generation_alg"; 99 | 100 | ChaincodeSpec chaincode_spec = 1; 101 | } 102 | 103 | // LifecycleEvent is used as the payload of the chaincode event emitted by LSCC 104 | message LifecycleEvent { 105 | string chaincode_name = 1; 106 | } 107 | -------------------------------------------------------------------------------- /protos/peer/chaincode_event.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2017 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | syntax = "proto3"; 17 | package protos; 18 | option java_package = "org.hyperledger.fabric.protos.peer"; 19 | option java_outer_classname = "ChaincodeEventPackage"; 20 | option go_package = "github.com/hyperledger/fabric/protos/peer"; 21 | 22 | 23 | //ChaincodeEvent is used for events and registrations that are specific to chaincode 24 | //string type - "chaincode" 25 | message ChaincodeEvent { 26 | string chaincode_id = 1; 27 | string tx_id = 2; 28 | string event_name = 3; 29 | bytes payload = 4; 30 | } 31 | -------------------------------------------------------------------------------- /protos/peer/chaincode_shim.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. All Rights Reserved. 3 | 4 | SPDX-License-Identifier: Apache-2.0 5 | */ 6 | 7 | syntax = "proto3"; 8 | 9 | package protos; 10 | option java_package = "org.hyperledger.fabric.protos.peer"; 11 | option go_package = "github.com/hyperledger/fabric/protos/peer"; 12 | import "peer/chaincode_event.proto"; 13 | import "peer/proposal.proto"; 14 | import "google/protobuf/timestamp.proto"; 15 | 16 | 17 | message ChaincodeMessage { 18 | 19 | enum Type { 20 | UNDEFINED = 0; 21 | REGISTER = 1; 22 | REGISTERED = 2; 23 | INIT = 3; 24 | READY = 4; 25 | TRANSACTION = 5; 26 | COMPLETED = 6; 27 | ERROR = 7; 28 | GET_STATE = 8; 29 | PUT_STATE = 9; 30 | DEL_STATE = 10; 31 | INVOKE_CHAINCODE = 11; 32 | RESPONSE = 13; 33 | GET_STATE_BY_RANGE = 14; 34 | GET_QUERY_RESULT = 15; 35 | QUERY_STATE_NEXT = 16; 36 | QUERY_STATE_CLOSE = 17; 37 | KEEPALIVE = 18; 38 | GET_HISTORY_FOR_KEY = 19; 39 | GET_STATE_METADATA = 20; 40 | PUT_STATE_METADATA = 21; 41 | GET_PRIVATE_DATA_HASH = 22; 42 | } 43 | 44 | Type type = 1; 45 | google.protobuf.Timestamp timestamp = 2; 46 | bytes payload = 3; 47 | string txid = 4; 48 | 49 | SignedProposal proposal = 5; 50 | 51 | //event emitted by chaincode. Used only with Init or Invoke. 52 | // This event is then stored (currently) 53 | //with Block.NonHashData.TransactionResult 54 | ChaincodeEvent chaincode_event = 6; 55 | 56 | //channel id 57 | string channel_id = 7; 58 | } 59 | 60 | // TODO: We need to finalize the design on chaincode container 61 | // compatibility upon upgrade, see FAB-5777. 62 | 63 | // GetState is the payload of a ChaincodeMessage. It contains a key which 64 | // is to be fetched from the ledger. If the collection is specified, the key 65 | // would be fetched from the collection (i.e., private state) 66 | message GetState { 67 | string key = 1; 68 | string collection = 2; 69 | } 70 | 71 | message GetStateMetadata { 72 | string key = 1; 73 | string collection = 2; 74 | } 75 | 76 | // PutState is the payload of a ChaincodeMessage. It contains a key and value 77 | // which needs to be written to the transaction's write set. If the collection is 78 | // specified, the key and value would be written to the transaction's private 79 | // write set. 80 | message PutState { 81 | string key = 1; 82 | bytes value = 2; 83 | string collection = 3; 84 | } 85 | 86 | message PutStateMetadata { 87 | string key = 1; 88 | string collection = 3; 89 | StateMetadata metadata = 4; 90 | } 91 | 92 | // DelState is the payload of a ChaincodeMessage. It contains a key which 93 | // needs to be recorded in the transaction's write set as a delete operation. 94 | // If the collection is specified, the key needs to be recorded in the 95 | // transaction's private write set as a delete operation. 96 | message DelState { 97 | string key = 1; 98 | string collection = 2; 99 | } 100 | 101 | // GetStateByRange is the payload of a ChaincodeMessage. It contains a start key and 102 | // a end key required to execute range query. If the collection is specified, 103 | // the range query needs to be executed on the private data. The metadata hold 104 | // the byte representation of QueryMetadata. 105 | message GetStateByRange { 106 | string startKey = 1; 107 | string endKey = 2; 108 | string collection = 3; 109 | bytes metadata = 4; 110 | } 111 | 112 | // GetQueryResult is the payload of a ChaincodeMessage. It contains a query 113 | // string in the form that is supported by the underlying state database. 114 | // If the collection is specified, the query needs to be executed on the 115 | // private data. The metadata hold the byte representation of QueryMetadata. 116 | message GetQueryResult { 117 | string query = 1; 118 | string collection = 2; 119 | bytes metadata = 3; 120 | } 121 | 122 | // QueryMetadata is the metadata of a GetStateByRange and GetQueryResult. 123 | // It contains a pageSize which denotes the number of records to be fetched 124 | // and a bookmark. 125 | message QueryMetadata { 126 | int32 pageSize = 1; 127 | string bookmark = 2; 128 | } 129 | 130 | // GetHistoryForKey is the payload of a ChaincodeMessage. It contains a key 131 | // for which the historical values need to be retrieved. 132 | message GetHistoryForKey { 133 | string key = 1; 134 | } 135 | 136 | message QueryStateNext { 137 | string id = 1; 138 | } 139 | 140 | message QueryStateClose { 141 | string id = 1; 142 | } 143 | 144 | // QueryResultBytes hold the byte representation of a record returned by the peer. 145 | message QueryResultBytes { 146 | bytes resultBytes = 1; 147 | } 148 | 149 | // QueryResponse is returned by the peer as a result of a GetStateByRange, 150 | // GetQueryResult, and GetHistoryForKey. It holds a bunch of records in 151 | // results field, a flag to denote whether more results need to be fetched from 152 | // the peer in has_more field, transaction id in id field, and a QueryResponseMetadata 153 | // in metadata field. 154 | message QueryResponse { 155 | repeated QueryResultBytes results = 1; 156 | bool has_more = 2; 157 | string id = 3; 158 | bytes metadata = 4; 159 | } 160 | 161 | // QueryResponseMetadata is the metadata of a QueryResponse. It contains a count 162 | // which denotes the number of records fetched from the ledger and a bookmark. 163 | message QueryResponseMetadata { 164 | int32 fetched_records_count = 1; 165 | string bookmark = 2; 166 | } 167 | 168 | message StateMetadata { 169 | string metakey = 1; 170 | bytes value = 2; 171 | } 172 | 173 | message StateMetadataResult { 174 | repeated StateMetadata entries = 1; 175 | } 176 | 177 | // Interface that provides support to chaincode execution. ChaincodeContext 178 | // provides the context necessary for the server to respond appropriately. 179 | service ChaincodeSupport { 180 | 181 | rpc Register(stream ChaincodeMessage) returns (stream ChaincodeMessage) {} 182 | 183 | 184 | } 185 | -------------------------------------------------------------------------------- /protos/peer/proposal.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2016 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | syntax = "proto3"; 18 | 19 | option go_package = "github.com/hyperledger/fabric/protos/peer"; 20 | option java_package = "org.hyperledger.fabric.protos.peer"; 21 | option java_outer_classname = "ProposalPackage"; 22 | 23 | package protos; 24 | 25 | import "peer/chaincode.proto"; 26 | import "peer/proposal_response.proto"; 27 | import "token/expectations.proto"; 28 | 29 | /* 30 | The flow to get a generic transaction approved goes as follows: 31 | 32 | 1. client sends proposal to endorser 33 | ==================================== 34 | 35 | The proposal is basically a request to do something that will result on some 36 | action with impact on the ledger; a proposal contains a header (with some 37 | metadata describing it, such as the type, the identity of the invoker, the 38 | time, the ID of the chain, a cryptographic nonce..) and an opaque payload that 39 | depends on the type specified in the header. A proposal contains the following 40 | messages: 41 | 42 | SignedProposal 43 | |\_ Signature (signature on the Proposal message by the creator specified in the header) 44 | \_ Proposal 45 | |\_ Header (the header for this proposal) 46 | \_ Payload (the payload for this proposal) 47 | 48 | 2. endorser sends proposal response back to client 49 | ================================================== 50 | 51 | The proposal response contains an endorser's response to a client's proposal. A 52 | proposal response contains a success/error code, a response payload and a 53 | signature (also referred to as endorsement) over the response payload. The 54 | response payload contains a hash of the proposal (to securely link this 55 | response to the corresponding proposal) and an opaque extension field that 56 | depends on the type specified in the header of the corresponding proposal. A 57 | proposal response contains the following messages: 58 | 59 | ProposalResponse 60 | |\_ Endorsement (the endorser's signature over the whole response payload) 61 | \_ ProposalResponsePayload (the payload of the proposal response) 62 | 63 | 3. client assembles endorsements into a transaction 64 | =================================================== 65 | 66 | A transaction message assembles one or more proposals and corresponding 67 | responses into a message to be sent to orderers. After ordering, (batches of) 68 | transactions are delivered to committing peers for validation and final 69 | delivery into the ledger. A transaction contains one or more actions. Each of 70 | them contains a header (same as that of the proposal that requested it) and an 71 | opaque payload that depends on the type specified in the header. 72 | 73 | SignedTransaction 74 | |\_ Signature (signature on the Transaction message by the creator specified in the header) 75 | \_ Transaction 76 | \_ TransactionAction (1...n) 77 | |\_ Header (1) (the header of the proposal that requested this action) 78 | \_ Payload (1) (the payload for this action) 79 | */ 80 | 81 | // This structure is necessary to sign the proposal which contains the header 82 | // and the payload. Without this structure, we would have to concatenate the 83 | // header and the payload to verify the signature, which could be expensive 84 | // with large payload 85 | // 86 | // When an endorser receives a SignedProposal message, it should verify the 87 | // signature over the proposal bytes. This verification requires the following 88 | // steps: 89 | // 1. Verification of the validity of the certificate that was used to produce 90 | // the signature. The certificate will be available once proposalBytes has 91 | // been unmarshalled to a Proposal message, and Proposal.header has been 92 | // unmarshalled to a Header message. While this unmarshalling-before-verifying 93 | // might not be ideal, it is unavoidable because i) the signature needs to also 94 | // protect the signing certificate; ii) it is desirable that Header is created 95 | // once by the client and never changed (for the sake of accountability and 96 | // non-repudiation). Note also that it is actually impossible to conclusively 97 | // verify the validity of the certificate included in a Proposal, because the 98 | // proposal needs to first be endorsed and ordered with respect to certificate 99 | // expiration transactions. Still, it is useful to pre-filter expired 100 | // certificates at this stage. 101 | // 2. Verification that the certificate is trusted (signed by a trusted CA) and 102 | // that it is allowed to transact with us (with respect to some ACLs); 103 | // 3. Verification that the signature on proposalBytes is valid; 104 | // 4. Detect replay attacks; 105 | message SignedProposal { 106 | 107 | // The bytes of Proposal 108 | bytes proposal_bytes = 1; 109 | 110 | // Signaure over proposalBytes; this signature is to be verified against 111 | // the creator identity contained in the header of the Proposal message 112 | // marshaled as proposalBytes 113 | bytes signature = 2; 114 | } 115 | 116 | // A Proposal is sent to an endorser for endorsement. The proposal contains: 117 | // 1. A header which should be unmarshaled to a Header message. Note that 118 | // Header is both the header of a Proposal and of a Transaction, in that i) 119 | // both headers should be unmarshaled to this message; and ii) it is used to 120 | // compute cryptographic hashes and signatures. The header has fields common 121 | // to all proposals/transactions. In addition it has a type field for 122 | // additional customization. An example of this is the ChaincodeHeaderExtension 123 | // message used to extend the Header for type CHAINCODE. 124 | // 2. A payload whose type depends on the header's type field. 125 | // 3. An extension whose type depends on the header's type field. 126 | // 127 | // Let us see an example. For type CHAINCODE (see the Header message), 128 | // we have the following: 129 | // 1. The header is a Header message whose extensions field is a 130 | // ChaincodeHeaderExtension message. 131 | // 2. The payload is a ChaincodeProposalPayload message. 132 | // 3. The extension is a ChaincodeAction that might be used to ask the 133 | // endorsers to endorse a specific ChaincodeAction, thus emulating the 134 | // submitting peer model. 135 | message Proposal { 136 | 137 | // The header of the proposal. It is the bytes of the Header 138 | bytes header = 1; 139 | 140 | // The payload of the proposal as defined by the type in the proposal 141 | // header. 142 | bytes payload = 2; 143 | 144 | // Optional extensions to the proposal. Its content depends on the Header's 145 | // type field. For the type CHAINCODE, it might be the bytes of a 146 | // ChaincodeAction message. 147 | bytes extension = 3; 148 | } 149 | 150 | //-------- the Chaincode Proposal ----------- 151 | 152 | /* 153 | The flow to get a CHAINCODE transaction approved goes as follows: 154 | 155 | 1. client sends proposal to endorser 156 | ==================================== 157 | 158 | The proposal is basically a request to do something on a chaincode, that will 159 | result on some action - some change in the state of a chaincode and/or some 160 | data to be committed to the ledger; a proposal in general contains a header 161 | (with some metadata describing it, such as the type, the identity of the 162 | invoker, the time, the ID of the chain, a cryptographic nonce..) and a payload 163 | (the chaincode ID, invocation arguments..). Optionally, it may contain actions 164 | that the endorser may be asked to endorse, to emulate a submitting peer. A 165 | chaincode proposal contains the following messages: 166 | 167 | SignedProposal 168 | |\_ Signature (signature on the Proposal message by the creator specified in the header) 169 | \_ Proposal 170 | |\_ Header (the header for this proposal) 171 | |\_ ChaincodeProposalPayload (the payload for this proposal) 172 | \_ ChaincodeAction (the actions for this proposal - optional for a proposal) 173 | 174 | 2. endorser sends proposal response back to client 175 | ================================================== 176 | 177 | The proposal response contains an endorser's response to a client's proposal. A 178 | proposal response contains a success/error code, a response payload and a 179 | signature (also referred to as endorsement) over the response payload. The 180 | response payload contains a hash of the proposal (to securely link this 181 | response to the corresponding proposal), a description of the action resulting 182 | from the proposal and the endorser's signature over its payload. Formally, a 183 | chaincode proposal response contains the following messages: 184 | 185 | ProposalResponse 186 | |\_ Endorsement (the endorser's signature over the whole response payload) 187 | \_ ProposalResponsePayload 188 | \_ ChaincodeAction (the actions for this proposal) 189 | 190 | 3. client assembles endorsements into a transaction 191 | =================================================== 192 | 193 | A transaction message assembles one or more proposals and corresponding 194 | responses into a message to be sent to orderers. After ordering, (batches of) 195 | transactions are delivered to committing peers for validation and final 196 | delivery into the ledger. A transaction contains one or more actions. Each of 197 | them contains a header (same as that of the proposal that requested it), a 198 | proposal payload (same as that of the proposal that requested it), a 199 | description of the resulting action and signatures from each of the endorsers 200 | that endorsed the action. 201 | 202 | SignedTransaction 203 | |\_ Signature (signature on the Transaction message by the creator specified in the header) 204 | \_ Transaction 205 | \_ TransactionAction (1...n) 206 | |\_ Header (1) (the header of the proposal that requested this action) 207 | \_ ChaincodeActionPayload (1) 208 | |\_ ChaincodeProposalPayload (1) (payload of the proposal that requested this action) 209 | \_ ChaincodeEndorsedAction (1) 210 | |\_ Endorsement (1...n) (endorsers' signatures over the whole response payload) 211 | \_ ProposalResponsePayload 212 | \_ ChaincodeAction (the actions for this proposal) 213 | */ 214 | 215 | // ChaincodeHeaderExtension is the Header's extentions message to be used when 216 | // the Header's type is CHAINCODE. This extensions is used to specify which 217 | // chaincode to invoke and what should appear on the ledger. 218 | message ChaincodeHeaderExtension { 219 | 220 | // The PayloadVisibility field controls to what extent the Proposal's payload 221 | // (recall that for the type CHAINCODE, it is ChaincodeProposalPayload 222 | // message) field will be visible in the final transaction and in the ledger. 223 | // Ideally, it would be configurable, supporting at least 3 main visibility 224 | // modes: 225 | // 1. all bytes of the payload are visible; 226 | // 2. only a hash of the payload is visible; 227 | // 3. nothing is visible. 228 | // Notice that the visibility function may be potentially part of the ESCC. 229 | // In that case it overrides PayloadVisibility field. Finally notice that 230 | // this field impacts the content of ProposalResponsePayload.proposalHash. 231 | bytes payload_visibility = 1; 232 | 233 | // The ID of the chaincode to target. 234 | ChaincodeID chaincode_id = 2; 235 | } 236 | 237 | // ChaincodeProposalPayload is the Proposal's payload message to be used when 238 | // the Header's type is CHAINCODE. It contains the arguments for this 239 | // invocation. 240 | message ChaincodeProposalPayload { 241 | 242 | // Input contains the arguments for this invocation. If this invocation 243 | // deploys a new chaincode, ESCC/VSCC are part of this field. 244 | // This is usually a marshaled ChaincodeInvocationSpec 245 | bytes input = 1; 246 | 247 | // TransientMap contains data (e.g. cryptographic material) that might be used 248 | // to implement some form of application-level confidentiality. The contents 249 | // of this field are supposed to always be omitted from the transaction and 250 | // excluded from the ledger. 251 | map TransientMap = 2; 252 | } 253 | 254 | // ChaincodeAction contains the actions the events generated by the execution 255 | // of the chaincode. 256 | message ChaincodeAction { 257 | 258 | // This field contains the read set and the write set produced by the 259 | // chaincode executing this invocation. 260 | bytes results = 1; 261 | 262 | // This field contains the events generated by the chaincode executing this 263 | // invocation. 264 | bytes events = 2; 265 | 266 | // This field contains the result of executing this invocation. 267 | Response response = 3; 268 | 269 | // This field contains the ChaincodeID of executing this invocation. Endorser 270 | // will set it with the ChaincodeID called by endorser while simulating proposal. 271 | // Committer will validate the version matching with latest chaincode version. 272 | // Adding ChaincodeID to keep version opens up the possibility of multiple 273 | // ChaincodeAction per transaction. 274 | ChaincodeID chaincode_id = 4; 275 | 276 | // This field contains the token expectation generated by the chaincode 277 | // executing this invocation 278 | TokenExpectation token_expectation = 5; 279 | } -------------------------------------------------------------------------------- /protos/peer/proposal_response.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. 2016 All Rights Reserved. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | */ 16 | 17 | syntax = "proto3"; 18 | 19 | option go_package = "github.com/hyperledger/fabric/protos/peer"; 20 | option java_package = "org.hyperledger.fabric.protos.peer"; 21 | option java_outer_classname = "ProposalResponsePackage"; 22 | 23 | package protos; 24 | 25 | import "google/protobuf/timestamp.proto"; 26 | 27 | // A ProposalResponse is returned from an endorser to the proposal submitter. 28 | // The idea is that this message contains the endorser's response to the 29 | // request of a client to perform an action over a chaincode (or more 30 | // generically on the ledger); the response might be success/error (conveyed in 31 | // the Response field) together with a description of the action and a 32 | // signature over it by that endorser. If a sufficient number of distinct 33 | // endorsers agree on the same action and produce signature to that effect, a 34 | // transaction can be generated and sent for ordering. 35 | message ProposalResponse { 36 | 37 | // Version indicates message protocol version 38 | int32 version = 1; 39 | 40 | // Timestamp is the time that the message 41 | // was created as defined by the sender 42 | google.protobuf.Timestamp timestamp = 2; 43 | 44 | // A response message indicating whether the 45 | // endorsement of the action was successful 46 | Response response = 4; 47 | 48 | // The payload of response. It is the bytes of ProposalResponsePayload 49 | bytes payload = 5; 50 | 51 | // The endorsement of the proposal, basically 52 | // the endorser's signature over the payload 53 | Endorsement endorsement = 6; 54 | } 55 | 56 | // A response with a representation similar to an HTTP response that can 57 | // be used within another message. 58 | message Response { 59 | 60 | // A status code that should follow the HTTP status codes. 61 | int32 status = 1; 62 | 63 | // A message associated with the response code. 64 | string message = 2; 65 | 66 | // A payload that can be used to include metadata with this response. 67 | bytes payload = 3; 68 | } 69 | 70 | // ProposalResponsePayload is the payload of a proposal response. This message 71 | // is the "bridge" between the client's request and the endorser's action in 72 | // response to that request. Concretely, for chaincodes, it contains a hashed 73 | // representation of the proposal (proposalHash) and a representation of the 74 | // chaincode state changes and events inside the extension field. 75 | message ProposalResponsePayload { 76 | 77 | // Hash of the proposal that triggered this response. The hash is used to 78 | // link a response with its proposal, both for bookeeping purposes on an 79 | // asynchronous system and for security reasons (accountability, 80 | // non-repudiation). The hash usually covers the entire Proposal message 81 | // (byte-by-byte). However this implies that the hash can only be verified 82 | // if the entire proposal message is available when ProposalResponsePayload is 83 | // included in a transaction or stored in the ledger. For confidentiality 84 | // reasons, with chaincodes it might be undesirable to store the proposal 85 | // payload in the ledger. If the type is CHAINCODE, this is handled by 86 | // separating the proposal's header and 87 | // the payload: the header is always hashed in its entirety whereas the 88 | // payload can either be hashed fully, or only its hash may be hashed, or 89 | // nothing from the payload can be hashed. The PayloadVisibility field in the 90 | // Header's extension controls to which extent the proposal payload is 91 | // "visible" in the sense that was just explained. 92 | bytes proposal_hash = 1; 93 | 94 | // Extension should be unmarshaled to a type-specific message. The type of 95 | // the extension in any proposal response depends on the type of the proposal 96 | // that the client selected when the proposal was initially sent out. In 97 | // particular, this information is stored in the type field of a Header. For 98 | // chaincode, it's a ChaincodeAction message 99 | bytes extension = 2; 100 | } 101 | 102 | // An endorsement is a signature of an endorser over a proposal response. By 103 | // producing an endorsement message, an endorser implicitly "approves" that 104 | // proposal response and the actions contained therein. When enough 105 | // endorsements have been collected, a transaction can be generated out of a 106 | // set of proposal responses. Note that this message only contains an identity 107 | // and a signature but no signed payload. This is intentional because 108 | // endorsements are supposed to be collected in a transaction, and they are all 109 | // expected to endorse a single proposal response/action (many endorsements 110 | // over a single proposal response) 111 | message Endorsement { 112 | 113 | // Identity of the endorser (e.g. its certificate) 114 | bytes endorser = 1; 115 | 116 | // Signature of the payload included in ProposalResponse concatenated with 117 | // the endorser's certificate; ie, sign(ProposalResponse.payload + endorser) 118 | bytes signature = 2; 119 | } 120 | -------------------------------------------------------------------------------- /protos/readme.md: -------------------------------------------------------------------------------- 1 | # Generate script 2 | 3 | A subset of proto files from [Hyperledger Fabric](https://github.com/awakesecurity/proto3-suite/issues/119#issuecomment-684391154) (commit 9848841) are used to create Haskell source files. 4 | 5 | Note: Due to [an issue](https://github.com/awakesecurity/proto3-suite/issues/119) with the latest `compile-proto-file` binary (v0.4.0.2, commit 185517b), it generates code that doesn't type check. Add to `Chaincode.hs`: 6 | ``` 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# OPTIONS_GHC -Wno-missing-export-lists #-} 9 | {-# OPTIONS_GHC -fno-warn-orphans #-} 10 | 11 | instance {-# OVERLAPPING #-} HsJSONPB.ToSchema (HsJSONPB.OverrideToSchema (Hs.Map a Hs.ByteString)) where 12 | declareNamedSchema _ = Hs.return (HsJSONPB.NamedSchema Hs.Nothing Hs.mempty) 13 | ``` 14 | 15 | The `generate.sh` script is used to generate the Haskell source files from the `.proto` files. 16 | 17 | The script requires the `compile-proto-file` binary, which can be installed from here https://github.com/awakesecurity/proto3-suite 18 | -------------------------------------------------------------------------------- /protos/token/expectations.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. All Rights Reserved. 3 | 4 | SPDX-License-Identifier: Apache-2.0 5 | */ 6 | 7 | syntax = "proto3"; 8 | 9 | option go_package = "github.com/hyperledger/fabric/protos/token"; 10 | option java_package = "org.hyperledger.fabric.protos.token"; 11 | 12 | package protos; 13 | 14 | import "google/protobuf/timestamp.proto"; 15 | import "token/transaction.proto"; 16 | 17 | // TokenExpectation represent the belief that someone should achieve in terms of a token action 18 | message TokenExpectation { 19 | oneof Expectation { 20 | // PlainExpectation describes a plain token expectation 21 | PlainExpectation plain_expectation = 1; 22 | } 23 | } 24 | 25 | // PlainExpectation represent the plain expectation where no confidentiality is provided. 26 | message PlainExpectation { 27 | oneof payload { 28 | // ImportExpectation describes an token import expectation 29 | PlainTokenExpectation import_expectation = 1; 30 | // TransferExpectation describes a token transfer expectation 31 | PlainTokenExpectation transfer_expectation = 2; 32 | } 33 | } 34 | 35 | // PlainTokenExpectation represents the expecation that 36 | // certain outputs will be matched 37 | message PlainTokenExpectation { 38 | // Outputs contains the expected outputs 39 | repeated PlainOutput outputs = 1; 40 | } 41 | -------------------------------------------------------------------------------- /protos/token/transaction.proto: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright IBM Corp. All Rights Reserved. 3 | 4 | SPDX-License-Identifier: Apache-2.0 5 | */ 6 | 7 | syntax = "proto3"; 8 | 9 | option go_package = "github.com/hyperledger/fabric/protos/token"; 10 | option java_package = "org.hyperledger.fabric.protos.token"; 11 | 12 | package protos; 13 | 14 | // ================ Existing Fabric Transaction structure =============== 15 | // 16 | //In Summary, Fabric supports the following transaction structure: 17 | // 18 | // Envelope 19 | // |\_ Signature (signature on the common.Payload message 20 | // | including the transaction by the creator 21 | // | specified in the Payload.header) 22 | // \_ Payload 23 | // |\_ Header (1) (the header of the proposal that requested this 24 | // | action; containing channel header, and 25 | // | signature header) 26 | // \_ Data (1) (serialised Transaction message) 27 | // \_ Transaction 28 | // \_ TransactionAction (1...n) 29 | // |\_ Header (1) (the header of the proposal that 30 | // | requested this action) 31 | // \_ ChaincodeActionPayload (1) 32 | // 33 | // 34 | // 35 | // 36 | // =============== Changes to Existing Fabric Transaction structure =============== 37 | // For envelopes that carry FabToken transaction we still maintain the same structure 38 | // such that the orderers functionality is not disturbed: 39 | // 40 | // Envelope 41 | // |\_ Signature (signature on the Payload message including 42 | // | the transaction by the creator 43 | // | specified in the Payload.header) 44 | // \_ Payload 45 | // |\_ Header (1) (the header of the proposal that requested 46 | // | this action; containing 47 | // | channel header, and signature header) 48 | // \_ Data (1) (serialised Transaction message) 49 | // \_ TokenTransaction (1) 50 | // \_ action (1) (a oneof for the different types of transactions) 51 | 52 | 53 | 54 | // TokenTransaction governs the structure of Payload.data, when 55 | // the transaction's envelope header indicates a transaction of type 56 | // "Token" 57 | message TokenTransaction { 58 | // action carries the content of this transaction. 59 | oneof action { 60 | PlainTokenAction plain_action = 1; 61 | } 62 | } 63 | 64 | // PlainTokenAction governs the structure of a token action that is 65 | // subjected to no privacy restrictions 66 | message PlainTokenAction { 67 | oneof data { 68 | // A plaintext token import transaction 69 | PlainImport plain_import = 1; 70 | // A plaintext token transfer transaction 71 | PlainTransfer plain_transfer = 2; 72 | // A plaintext token redeem transaction 73 | PlainTransfer plain_redeem = 3; 74 | // A plaintext token approve transaction 75 | PlainApprove plain_approve = 4; 76 | // A plaintext token transfer from transaction 77 | PlainTransferFrom plain_transfer_From = 5; 78 | } 79 | } 80 | 81 | // PlainImport specifies an import of one or more tokens in plaintext format 82 | message PlainImport { 83 | 84 | // An import transaction may contain one or more outputs 85 | repeated PlainOutput outputs = 1; 86 | } 87 | 88 | // PlainTransfer specifies a transfer of one or more plaintext tokens to one or more outputs 89 | message PlainTransfer { 90 | 91 | // The inputs to the transfer transaction are specified by their ID 92 | repeated InputId inputs = 1; 93 | 94 | // A transfer transaction may contain one or more outputs 95 | repeated PlainOutput outputs = 2; 96 | } 97 | 98 | // PlainApprove specifies an approve of one or more tokens in plaintext format 99 | message PlainApprove { 100 | // The inputs to the transfer transaction are specified by their ID 101 | repeated InputId inputs = 1; 102 | 103 | // An approve transaction contains one or more plain delegated outputs 104 | repeated PlainDelegatedOutput delegated_outputs = 2; 105 | 106 | // An approve transaction contains one plain output 107 | PlainOutput output = 3; 108 | } 109 | 110 | // PlainTransferFrom specifies a transfer of one or more plaintext delegated tokens to one or more outputs 111 | // an to a delegated output 112 | message PlainTransferFrom { 113 | // The inputs to the transfer transaction are specified by their ID 114 | repeated InputId inputs = 1; 115 | 116 | // A transferFrom transaction contains multiple outputs 117 | repeated PlainOutput outputs = 2; 118 | 119 | // A transferFrom transaction may contain one delegatable output 120 | PlainDelegatedOutput delegated_output = 3; 121 | } 122 | 123 | // A PlainOutput is the result of import and transfer transactions using plaintext tokens 124 | message PlainOutput { 125 | 126 | // The owner is the serialization of a SerializedIdentity struct 127 | bytes owner = 1; 128 | 129 | // The token type 130 | string type = 2; 131 | 132 | // The quantity of tokens 133 | uint64 quantity = 3; 134 | } 135 | 136 | // An InputId specifies an output using the transaction ID and the index of the output in the transaction 137 | message InputId { 138 | 139 | // The transaction ID 140 | string tx_id = 1; 141 | 142 | // The index of the output in the transaction 143 | uint32 index = 2; 144 | } 145 | 146 | // A PlainDelegatedOutput is the result of approve transactions using plaintext tokens 147 | message PlainDelegatedOutput { 148 | // The owner is the serialization of a SerializedIdentity struct 149 | bytes owner = 1; 150 | 151 | // The delegatees is an arrary of the serialized identities that can spend the output on behalf 152 | // the owner 153 | repeated bytes delegatees = 2; 154 | 155 | // The token type 156 | string type = 3; 157 | 158 | // The quantity of tokens 159 | uint64 quantity = 4; 160 | } -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # fabric-chaincode-haskell 2 | 3 | NOTE: This project is currently a PRE-ALPHA and is NOT suitable for production 4 | use. 5 | 6 | `fabric-chaincode-haskell` is a Haskell shim for Hyperledger Fabric to allow the 7 | authoring of smart contracts in Haskell. 8 | 9 | The project has three main parts: 10 | 11 | - `protos` and `google-protos/google/protobuf` - The source protobuf files that 12 | define the communication between the shim and the peer. The corresponding 13 | Haskell files are generated in `protos-hs` 14 | - `src` - Contains the Shim 15 | - `examples` - Contains the main executable which is an example usage of the 16 | shim 17 | 18 | ## Installation 19 | 20 | To build the project, run the following from the root directory: 21 | 22 | ``` 23 | stack build 24 | ``` 25 | 26 | Note : It is possible that you might get a build error with `grpc-haskell-core`, 27 | like the following: 28 | 29 | ``` 30 | Missing dependencies on foreign libraries: 31 | - Missing (or bad) header file: include/grpc_haskell.h 32 | - Missing (or bad) C libraries: grpc, gpr 33 | ``` 34 | 35 | This is because the underlying C binaries are either not installed or are not 36 | installed correctly. To fix this, try reinstalling the grpc binary with `brew install grpc`/`brew reinstall grpc`. 37 | 38 | ## Usage 39 | 40 | Note: Since running chaincode in production mode depends on a language specific 41 | flag (e.g. `-l golang`, `-l java` or `-l node`), it is currently only possible 42 | to run Haskell chaincode in dev mode. Supporting Haskell chaincode in production 43 | mode will require some minor changes to be made to the peer source code. 44 | 45 | ### Running the Haskell chaincode 46 | 47 | There are three example chaincodes that have been implemented. Please see the 48 | readme in the `examples` directory for information on how to run each of them. 49 | 50 | The instructions for running for the `sacc` example are described below. 51 | 52 | Start the Haskell chaincode process with: 53 | 54 | ``` 55 | stack run sacc-exe 56 | ``` 57 | 58 | When the Fabric peer is running (see below), the Haskell process that is started 59 | does a number of things 60 | 61 | 1. It connects to the Fabric peer through gRPC 62 | 2. It sends a REGISTER message to the peer and receives a REGISTERED response 63 | 3. It receives a READY message from the peer 64 | 4. It listens for an INIT message from the peer 65 | 5. It listens for TRANSACTION messages from the peer 66 | 67 | ### Connecting to the Fabric peer 68 | 69 | The Haskell shim can be used with any Fabric network with a peer running in 70 | development mode. However, we have provided a very simple [Fabric 71 | network](https://github.com/airvin/fabric-network) for testing purposes. If you 72 | would like to use this network, start the Fabric network with the peer in 73 | development mode and without a chaincode container. This can be done with the 74 | `./start-no-cc.sh` script. The peer needs to be told about the chaincode process 75 | running with the `install` and `instantiate` commands. 76 | 77 | Open a second terminal tab for the fabric network. In the first tab, run `docker logs peer -f` to keep tabs on the logs for the peer container. In the second 78 | tab, run the following: 79 | 80 | ``` 81 | docker exec -it cli bash 82 | peer chaincode install -n mycc -v v0 -l golang -p chaincodedev/chaincode/chaincode_example02/go 83 | peer chaincode list --installed 84 | peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init","a","100"]}' -C myc -o orderer:7050 85 | ``` 86 | 87 | The chaincode can then be invoked with the following examples: 88 | 89 | ``` 90 | peer chaincode invoke -n mycc -c '{"Args":["get","a"]}' -C myc 91 | peer chaincode invoke -n mycc -c '{"Args":["put","b","60"]}' -C myc 92 | peer chaincode invoke -n mycc -c '{"Args":["set","b","60"]}' -C myc 93 | peer chaincode invoke -n mycc -c '{"Args":["del","a"]}' -C myc 94 | ``` 95 | 96 | ## Development notes 97 | 98 | The formatter used in this project is 99 | [floskell](https://github.com/ennocramer/floskell). Ensure your Haskell 100 | formatter is set to floskell and it will use the `floskell.json` configuration 101 | at the root of the project. We have found the best LSP to use is 102 | [haskell-language-server](https://github.com/haskell/haskell-language-server). 103 | 104 | ## TODO 105 | 106 | - [x] Finish implementing shim functions and clean up shim module exports 107 | - [x] Add examples directory 108 | - [ ] Add support for concurrent transactions 109 | - [ ] Finish implementing all stub functions 110 | - [ ] Publish to Hackage 111 | - [ ] Improve logging 112 | -------------------------------------------------------------------------------- /src/Helper.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Helper where 4 | 5 | import Common.Common as Pb 6 | 7 | import Data.Bifunctor ( first ) 8 | 9 | import Peer.Chaincode as Pb 10 | import Peer.ChaincodeShim as Pb 11 | import Peer.Proposal as Pb 12 | import Peer.ProposalResponse as Pb 13 | 14 | import Proto3.Suite as Suite 15 | 16 | import Types ( ChaincodeStub(..), Error(..), MapTextBytes ) 17 | 18 | -- These are some helper functions to process the unmarshalling of different types 19 | -- from the chaincode message in order to populate the stub 20 | getChaincodeInput :: ChaincodeMessage -> Either Error Pb.ChaincodeInput 21 | getChaincodeInput mes = first DecodeError $ Suite.fromByteString (chaincodeMessagePayload mes) 22 | 23 | getProposal :: Pb.SignedProposal -> Either Error Pb.Proposal 24 | getProposal signedProposal = first DecodeError $ Suite.fromByteString (signedProposalProposalBytes signedProposal) 25 | 26 | getHeader :: Pb.Proposal -> Either Error Pb.Header 27 | getHeader proposal = first DecodeError $ Suite.fromByteString (proposalHeader proposal) 28 | 29 | getChannelHeader :: Pb.Header -> Either Error Pb.ChannelHeader 30 | getChannelHeader header = first DecodeError $ Suite.fromByteString (headerChannelHeader header) 31 | 32 | getChaincodeProposalPayload :: Pb.Proposal -> Either Error Pb.ChaincodeProposalPayload 33 | getChaincodeProposalPayload proposal = first DecodeError $ Suite.fromByteString (proposalPayload proposal) 34 | 35 | getSignatureHeader :: Pb.Header -> Either Error Pb.SignatureHeader 36 | getSignatureHeader header = first DecodeError $ Suite.fromByteString (headerSignatureHeader header) 37 | 38 | -- -- TODO: Use ChannelHeader and SignatureHeader to implement getBinding 39 | createBinding :: Pb.Proposal -> Maybe MapTextBytes 40 | createBinding _ = Nothing 41 | -------------------------------------------------------------------------------- /src/Messages.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Messages where 4 | 5 | import Data.ByteString as BS 6 | import qualified Data.ByteString.Lazy as LBS 7 | import qualified Data.ByteString.UTF8 as BSU 8 | import Data.Text 9 | import Data.Text.Encoding as TSE 10 | import Data.Text.Lazy ( fromStrict ) 11 | 12 | import Network.GRPC.HighLevel.Generated 13 | import qualified Network.GRPC.LowLevel.Client as Client 14 | 15 | import Peer.Chaincode as Pb 16 | import Peer.ChaincodeShim as Pb 17 | import Peer.ProposalResponse as Pb 18 | 19 | import Proto3.Suite as Suite 20 | import Proto3.Wire 21 | import Proto3.Wire.Decode as Wire 22 | import Proto3.Wire.Encode as Wire 23 | 24 | data CCMessageType = GET_STATE | PUT_STATE | DEL_STATE | REGISTER | COMPLETED | GET_STATE_BY_RANGE | QUERY_STATE_NEXT 25 | 26 | regMessage :: ChaincodeMessage 27 | regMessage = buildChaincodeMessage REGISTER regPayload "" "" 28 | 29 | regPayload :: Pb.ChaincodeID 30 | regPayload = Pb.ChaincodeID { chaincodeIDName = "mycc:v0" -- Go shim only sends this 31 | , chaincodeIDPath = "" 32 | , chaincodeIDVersion = "" 33 | } 34 | 35 | successPayload :: Maybe ByteString -> Pb.Response 36 | successPayload Nothing = Pb.Response { responseStatus = 200 37 | , responseMessage = "" 38 | , responsePayload = TSE.encodeUtf8 "" 39 | } 40 | successPayload (Just payload) = 41 | Pb.Response { responseStatus = 200 42 | , responseMessage = "" 43 | , responsePayload = payload 44 | } 45 | 46 | errorPayload :: Text -> Pb.Response 47 | errorPayload message = Pb.Response { responseStatus = 400 48 | , responseMessage = fromStrict message 49 | , responsePayload = TSE.encodeUtf8 "" 50 | } 51 | 52 | getStatePayload :: Text -> Pb.GetState 53 | getStatePayload key = Pb.GetState { getStateKey = fromStrict key 54 | , getStateCollection = "" 55 | } 56 | 57 | putStatePayload :: Text -> BS.ByteString -> Pb.PutState 58 | putStatePayload key value = Pb.PutState { putStateKey = fromStrict key 59 | , putStateValue = value 60 | , putStateCollection = "" 61 | } 62 | 63 | delStatePayload :: Text -> Pb.DelState 64 | delStatePayload key = Pb.DelState { delStateKey = fromStrict key 65 | , delStateCollection = "" 66 | } 67 | 68 | getStateByRangePayload :: Text -> Text -> Maybe Pb.QueryMetadata -> Pb.GetStateByRange 69 | getStateByRangePayload startKey endKey metaData = 70 | Pb.GetStateByRange { getStateByRangeStartKey = fromStrict startKey 71 | , getStateByRangeEndKey = fromStrict endKey 72 | , getStateByRangeCollection = "" 73 | , getStateByRangeMetadata = case metaData of 74 | -- This is an example of how to encode a Pb type into a bytestring 75 | -- https://hackage.haskell.org/package/proto3-wire-1.2.0/docs/Proto3-Wire-Tutorial.html 76 | -- TODO: Use Suite.toLazyByteString 77 | Just metaData -> LBS.toStrict $ Wire.toLazyByteString $ 78 | encodeMessage (FieldNumber 1) metaData 79 | Nothing -> BSU.fromString "" 80 | } 81 | 82 | queryNextStatePayload :: Text -> Pb.QueryStateNext 83 | queryNextStatePayload id = Pb.QueryStateNext { queryStateNextId = fromStrict id 84 | } 85 | 86 | -- buildChaincodeMessage 87 | -- :: Enumerated Pb.ChaincodeMessage_Type 88 | -- -> a 89 | -- -> Text 90 | -- -> Text 91 | -- -> ChaincodeMessage 92 | buildChaincodeMessage mesType payload txid chanID = 93 | ChaincodeMessage { chaincodeMessageType = getCCMessageType mesType 94 | , chaincodeMessageTimestamp = Nothing 95 | -- TODO: Use Suite.toLazyByteString 96 | , chaincodeMessagePayload = LBS.toStrict $ Wire.toLazyByteString $ 97 | encodeMessage (FieldNumber 1) payload 98 | , chaincodeMessageTxid = fromStrict txid 99 | , chaincodeMessageProposal = Nothing 100 | , chaincodeMessageChaincodeEvent = Nothing 101 | , chaincodeMessageChannelId = fromStrict chanID 102 | } 103 | 104 | getCCMessageType :: CCMessageType -> Enumerated Pb.ChaincodeMessage_Type 105 | getCCMessageType ccMessageType = case ccMessageType of 106 | GET_STATE -> Enumerated $ Right ChaincodeMessage_TypeGET_STATE 107 | PUT_STATE -> Enumerated $ Right ChaincodeMessage_TypePUT_STATE 108 | DEL_STATE -> Enumerated $ Right ChaincodeMessage_TypeDEL_STATE 109 | REGISTER -> Enumerated $ Right ChaincodeMessage_TypeREGISTER 110 | COMPLETED -> Enumerated $ Right ChaincodeMessage_TypeCOMPLETED 111 | GET_STATE_BY_RANGE -> Enumerated $ Right ChaincodeMessage_TypeGET_STATE_BY_RANGE 112 | QUERY_STATE_NEXT -> Enumerated $ Right ChaincodeMessage_TypeQUERY_STATE_NEXT 113 | -------------------------------------------------------------------------------- /src/Shim.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLists #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | module Shim 6 | ( start 7 | , DefaultChaincodeStub(..) 8 | , ChaincodeStub(..) 9 | , Error(..) 10 | , errorPayload 11 | , successPayload 12 | , ChaincodeStubInterface(..) 13 | , StateQueryIterator(..) 14 | , StateQueryIteratorInterface(..) 15 | ) where 16 | 17 | import Common.Common as Pb 18 | 19 | import Data.Bifunctor ( first ) 20 | import qualified Data.ByteString.Char8 as BC 21 | import qualified Data.ByteString.Lazy as LBS 22 | import Data.Map ( mapKeys ) 23 | import Data.Text 24 | import Data.Text.Encoding as TSE 25 | import Data.Text.Lazy ( toStrict ) 26 | 27 | import Debug.Trace 28 | 29 | import Helper 30 | 31 | import Interfaces ( ChaincodeStubInterface(..), StateQueryIteratorInterface(..) ) 32 | 33 | import Messages 34 | 35 | import Network.GRPC.HighLevel 36 | -- import Crypto.Hash.SHA256 37 | import Network.GRPC.HighLevel.Generated 38 | import qualified Network.GRPC.LowLevel.Client as Client 39 | 40 | import Peer.Chaincode as Pb 41 | import Peer.ChaincodeShim as Pb 42 | import Peer.Proposal as Pb 43 | import Peer.ProposalResponse as Pb 44 | 45 | import Proto3.Suite as Suite 46 | 47 | import Stub 48 | 49 | import Types ( ChaincodeStub(..) 50 | , DefaultChaincodeStub(..) 51 | , Error(..) 52 | , MapTextBytes 53 | , StateQueryIterator(..) 54 | ) 55 | 56 | clientConfig :: ClientConfig 57 | clientConfig = ClientConfig { clientServerHost = "localhost" 58 | , clientServerPort = 7052 59 | , clientArgs = [] 60 | , clientSSLConfig = Nothing 61 | , clientAuthority = Nothing 62 | } 63 | 64 | -- TODO: start :: ChaincodeStub a => (a -> Pb.Response) -> IO () 65 | start :: ChaincodeStub -> IO () 66 | start chaincodeStub = withGRPCClient clientConfig $ grpcRunner chaincodeStub 67 | 68 | -- initialise the GRPC communication with the peer 69 | grpcRunner :: ChaincodeStub -> Client.Client -> IO () 70 | grpcRunner chaincodeStub client = do 71 | -- contains chaincodeSupportRegister function 72 | Pb.ChaincodeSupport{..} <- chaincodeSupportClient client 73 | 74 | -- NOTE: This 2000 seconds is a hack till this gets resolved https://github.com/awakesecurity/gRPC-haskell/issues/100 75 | _ <- chaincodeSupportRegister $ ClientBiDiRequest 2000 [] $ biDiRequestFn chaincodeStub 76 | 77 | putStrLn "Could not connect to peer" 78 | 79 | -- biDiRequestFn :: ClientCall -> MetadataMap -> StreamRecv ChaincodeMessage -> 80 | -- StreamSend ChaincodeMessage -> WritesDone -> IO () 81 | biDiRequestFn chaincodeStub _call _mmap recv send _done = do 82 | e <- send regMessage :: IO (Either GRPCIOError ()) 83 | case e of 84 | Left err -> error ("Error registering with peer: " ++ show err) 85 | Right _ -> trace "Registering with peer" pure () 86 | chatWithPeer recv send chaincodeStub 87 | 88 | -- main loop listening for messages from the peer 89 | chatWithPeer 90 | :: IO (Either GRPCIOError (Maybe ChaincodeMessage)) -> StreamSend ChaincodeMessage -> ChaincodeStub -> IO b 91 | chatWithPeer recv send chaincodeStub = do 92 | res <- recv 93 | case res of 94 | Left err -> error ("Error during communication with peer: " ++ show err) 95 | Right (Just message) -> handler message recv send chaincodeStub 96 | Right Nothing -> putStrLn "Empty message received from peer" 97 | chatWithPeer recv send chaincodeStub 98 | 99 | -- function to process the different chainccode message types 100 | handler :: ChaincodeMessage -> StreamRecv ChaincodeMessage -> StreamSend ChaincodeMessage -> ChaincodeStub -> IO () 101 | handler message recv send chaincodeStub = case message of 102 | ChaincodeMessage{chaincodeMessageType = Enumerated (Right ChaincodeMessage_TypeREGISTERED)} -> 103 | putStrLn "REGISTERED message received from the peer" 104 | ChaincodeMessage{chaincodeMessageType = Enumerated (Right ChaincodeMessage_TypeREADY)} -> 105 | putStrLn "READY message received from the peer" 106 | ChaincodeMessage{chaincodeMessageType = Enumerated (Right ChaincodeMessage_TypeINIT)} -> 107 | trace "INIT message received from the peer" $ handleInit message recv send (initFn chaincodeStub) 108 | ChaincodeMessage{chaincodeMessageType = Enumerated (Right ChaincodeMessage_TypeTRANSACTION)} -> 109 | trace "TRANSACTION message received from the peer" $ handleInvoke message recv send (invokeFn chaincodeStub) 110 | s -> putStrLn ("Unknown message received from peer:" ++ show s) 111 | 112 | handleInit :: ChaincodeMessage 113 | -> StreamRecv ChaincodeMessage 114 | -> StreamSend ChaincodeMessage 115 | -> (DefaultChaincodeStub -> IO Pb.Response) 116 | -> IO () 117 | handleInit mes recv send initFn = 118 | let eStub = newChaincodeStub mes recv send 119 | in 120 | case eStub of 121 | Left err -> error ("Error while creating stub: " ++ show err) 122 | Right stub -> do 123 | response <- initFn stub 124 | e <- send (buildChaincodeMessage COMPLETED response (getTxId stub) (getChannelId stub)) 125 | :: IO (Either GRPCIOError ()) 126 | case e of 127 | Left err -> error ("Error while streaming: " ++ show err) 128 | Right _ -> pure () 129 | 130 | handleInvoke :: ChaincodeMessage 131 | -> StreamRecv ChaincodeMessage 132 | -> StreamSend ChaincodeMessage 133 | -> (DefaultChaincodeStub -> IO Pb.Response) 134 | -> IO () 135 | handleInvoke mes recv send invokeFn = 136 | let eStub = newChaincodeStub mes recv send 137 | in 138 | case eStub of 139 | Left err -> error ("Error while creating stub: " ++ show err) 140 | Right stub -> do 141 | response <- invokeFn stub 142 | e <- send (buildChaincodeMessage COMPLETED response (getTxId stub) (getChannelId stub)) 143 | :: IO (Either GRPCIOError ()) 144 | case e of 145 | Left err -> error ("Error while streaming: " ++ show err) 146 | Right _ -> pure () 147 | 148 | newChaincodeStub :: ChaincodeMessage 149 | -> StreamRecv ChaincodeMessage 150 | -> StreamSend ChaincodeMessage 151 | -> Either Error DefaultChaincodeStub 152 | newChaincodeStub mes recv send = do 153 | input <- getChaincodeInput mes 154 | let maybeSignedProposal = chaincodeMessageProposal mes 155 | in 156 | case maybeSignedProposal of 157 | -- If the SignedProposal is empty, populate the stub with just the 158 | -- args, txId, channelId, decorations, send and recv 159 | Nothing -> Right $ 160 | DefaultChaincodeStub { args = chaincodeInputArgs input 161 | , txId = toStrict $ chaincodeMessageTxid mes 162 | , channelId = toStrict $ chaincodeMessageChannelId mes 163 | , creator = Nothing 164 | , signedProposal = Nothing 165 | , proposal = Nothing 166 | , transient = Nothing 167 | , binding = Nothing 168 | , decorations = chaincodeInputDecorations input 169 | , recvStream = recv 170 | , sendStream = send 171 | } 172 | -- If SignedProposal is not empty, get the proposal from it 173 | -- and the creator, transient and binding from the proposal 174 | Just signedProposal -> do 175 | proposal <- getProposal signedProposal 176 | header <- getHeader proposal 177 | chaincodeProposalPayload <- getChaincodeProposalPayload proposal 178 | channelHeader <- getChannelHeader header 179 | signatureHeader <- getSignatureHeader header 180 | Right $ DefaultChaincodeStub { args = chaincodeInputArgs input 181 | , txId = toStrict $ chaincodeMessageTxid mes 182 | , channelId = toStrict $ chaincodeMessageChannelId mes 183 | , creator = Just $ signatureHeaderCreator signatureHeader 184 | , signedProposal = Just signedProposal 185 | , proposal = Just proposal 186 | , transient = Just $ 187 | chaincodeProposalPayloadTransientMap chaincodeProposalPayload 188 | , binding = createBinding proposal 189 | , decorations = chaincodeInputDecorations input 190 | , recvStream = recv 191 | , sendStream = send 192 | } 193 | -------------------------------------------------------------------------------- /src/Stub.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-orphans #-} 4 | 5 | module Stub where 6 | 7 | import qualified Common.Common as Pb 8 | 9 | import Control.Monad.Except ( ExceptT(..), runExceptT, throwError ) 10 | 11 | import Data.Bifunctor 12 | import Data.ByteString as BS 13 | import qualified Data.ByteString.Lazy as LBS 14 | import Data.Char ( chr ) 15 | import Data.IORef ( modifyIORef, newIORef, readIORef, writeIORef ) 16 | import Data.Text as TS 17 | import Data.Text.Encoding 18 | import Data.Text.Lazy as TL 19 | import Data.Vector as Vector ( (!), Vector, empty, foldr, length, toList ) 20 | 21 | import Debug.Trace 22 | 23 | import Google.Protobuf.Timestamp as Pb 24 | 25 | import Helper 26 | 27 | import Interfaces 28 | 29 | import qualified Ledger.Queryresult.KvQueryResult as Pb 30 | 31 | import Messages 32 | 33 | import Network.GRPC.HighLevel 34 | 35 | import qualified Peer.ChaincodeShim as Pb 36 | import Peer.Proposal as Pb 37 | 38 | import Proto3.Suite 39 | import Proto3.Wire.Decode 40 | 41 | import Types 42 | 43 | -- NOTE: When support for concurrency transaction is added, this function will no longer be required 44 | -- as the stub function will block and listen for responses over a channel when the code is concurrent 45 | listenForResponse :: StreamRecv Pb.ChaincodeMessage -> IO (Either Error ByteString) 46 | listenForResponse recv = do 47 | res <- recv 48 | case res of 49 | Left err -> pure $ Left $ GRPCError err 50 | Right (Just Pb.ChaincodeMessage{ Pb.chaincodeMessageType = Enumerated (Right Pb.ChaincodeMessage_TypeRESPONSE) 51 | , Pb.chaincodeMessagePayload = payload 52 | }) -> pure $ Right payload 53 | Right (Just Pb.ChaincodeMessage{ Pb.chaincodeMessageType = Enumerated (Right Pb.ChaincodeMessage_TypeERROR) 54 | , Pb.chaincodeMessagePayload = payload 55 | }) -> pure $ Left $ Error "Peer failed to complete stub invocation request" 56 | Right (Just _) -> listenForResponse recv 57 | Right Nothing -> pure $ Left $ Error "Empty message received from peer" 58 | 59 | instance ChaincodeStubInterface DefaultChaincodeStub where 60 | -- getArgs :: ccs -> Vector ByteString 61 | getArgs ccs = args ccs 62 | 63 | -- getStringArgs :: ccs -> [Text] 64 | getStringArgs ccs = let args = getArgs ccs in toList $ decodeUtf8 <$> args 65 | 66 | -- getFunctionAndParameters :: ccs -> Either Error (Text, [Text]) 67 | getFunctionAndParameters ccs = 68 | let args = getStringArgs ccs 69 | in 70 | if not (Prelude.null args) then Right (Prelude.head args, Prelude.tail args) else Left InvalidArgs 71 | 72 | -- getArgsSlice :: ccs -> Either Error ByteString 73 | getArgsSlice ccs = Right $ Vector.foldr BS.append BS.empty $ getArgs ccs 74 | 75 | -- getTxId :: css -> String 76 | getTxId = txId 77 | 78 | -- getChannelId :: ccs -> String 79 | getChannelId = channelId 80 | 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 | 106 | -- getState :: ccs -> Text -> ExceptT Error IO ByteString 107 | getState ccs key = 108 | let payload = getStatePayload key 109 | message = buildChaincodeMessage GET_STATE payload (txId ccs) (channelId ccs) 110 | in 111 | ExceptT $ do 112 | e <- (sendStream ccs) message 113 | case e of 114 | Left err -> pure $ Left $ Error $ "Error while streaming: " ++ show err 115 | Right _ -> listenForResponse (recvStream ccs) 116 | 117 | -- putState :: ccs -> Text -> ByteString -> ExceptT Error IO ByteString 118 | putState ccs key value = 119 | let payload = putStatePayload key value 120 | message = buildChaincodeMessage PUT_STATE payload (txId ccs) (channelId ccs) 121 | in 122 | ExceptT $ do 123 | e <- (sendStream ccs) message 124 | case e of 125 | Left err -> pure $ Left $ Error $ "Error while streaming: " ++ show err 126 | Right _ -> listenForResponse (recvStream ccs) 127 | 128 | -- delState :: ccs -> Text -> IO (Maybe Error) 129 | delState ccs key = 130 | let payload = delStatePayload key 131 | message = buildChaincodeMessage DEL_STATE payload (txId ccs) (channelId ccs) 132 | in 133 | ExceptT $ do 134 | e <- (sendStream ccs) message 135 | case e of 136 | Left err -> error ("Error while streaming: " ++ show err) 137 | Right _ -> pure () 138 | listenForResponse (recvStream ccs) 139 | 140 | -- TODO: Implement better error handling/checks etc 141 | -- getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator) 142 | getStateByRange ccs startKey endKey = 143 | let payload = getStateByRangePayload startKey endKey Nothing 144 | message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs) 145 | in 146 | ExceptT $ do 147 | e <- (sendStream ccs) message 148 | case e of 149 | Left err -> error ("Error while streaming: " ++ show err) 150 | Right _ -> pure () 151 | runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= (bsToSqi ccs) 152 | 153 | -- TODO: We need to implement this so we can test the fetchNextQueryResult functionality 154 | -- getStateByRangeWithPagination :: ccs -> Text -> Text -> Int -> Text -> IO (Either Error (StateQueryIterator, Pb.QueryResponseMetadata)) 155 | getStateByRangeWithPagination ccs startKey endKey pageSize bookmark = 156 | let metadata = Pb.QueryMetadata { Pb.queryMetadataPageSize = fromIntegral pageSize 157 | , Pb.queryMetadataBookmark = TL.fromStrict bookmark 158 | } 159 | payload = getStateByRangePayload startKey endKey $ Just metadata 160 | message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs) 161 | in 162 | ExceptT $ do 163 | e <- (sendStream ccs) message 164 | case e of 165 | Left err -> error ("Error while streaming: " ++ show err) 166 | Right _ -> pure () 167 | runExceptT $ ExceptT (listenForResponse (recvStream ccs)) >>= (bsToSqiAndMeta ccs) 168 | 169 | -- TODO: This is the next TODO! Implement these 7 function because they are needed in marbles.hs 170 | -- getStateByPartialCompositeKey :: ccs -> Text -> [Text] -> Either Error StateQueryIterator 171 | getStateByPartialCompositeKey ccs objectType keys = throwError $ Error "not implemented" 172 | 173 | --getStateByPartialCompositeKeyWithPagination :: ccs -> Text -> [Text] -> Int32 -> Text -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata) 174 | getStateByPartialCompositeKeyWithPagination ccs objectType keys pageSize bookmark = 175 | throwError $ Error "not implemented" 176 | 177 | --createCompositeKey :: ccs -> Text -> [Text] -> Either Error Text 178 | createCompositeKey ccs objectType keys = 179 | let keysString = Prelude.foldr (\key acc -> acc ++ TS.unpack key ++ nullCodepoint) "" keys 180 | nullCodepoint = [ chr 0 ] 181 | in 182 | -- TODO: Check that objectTypes and keys are all valid utf8 strings 183 | Right $ TS.pack $ "\x00" ++ TS.unpack objectType ++ nullCodepoint ++ keysString 184 | 185 | --splitCompositeKey :: ccs -> Text -> Either Error (Text, [Text]) 186 | splitCompositeKey ccs key = 187 | -- key has the form \x00objectTypeU+0000keyU+0000key etc so we use `tail key` to ignore the \x00 char 188 | -- and then split on the unicode codepoint U+0000 to extract the objectType and keys 189 | let keys = TS.splitOn (TS.singleton $ chr 0) (TS.tail key) in Right (Prelude.head keys, Prelude.tail keys) 190 | 191 | --getQueryResult :: ccs -> Text -> Either Error StateQueryIterator 192 | getQueryResult ccs query = throwError $ Error "not implemented" 193 | 194 | --getQueryResultWithPagination :: ccs -> Text -> Int32 -> Text -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata) 195 | getQueryResultWithPagination ccs key pageSize bookmark = throwError $ Error "not implemented" 196 | 197 | --getHistoryForKey :: ccs -> Text -> Either Error HistoryQueryIterator 198 | getHistoryForKey ccs key = throwError $ Error "not implemented" 199 | 200 | instance StateQueryIteratorInterface StateQueryIterator where 201 | -- TODO: remove the IO from this function (possibly with the State monad) 202 | -- hasNext :: sqi -> IO Bool 203 | hasNext sqi = do 204 | queryResponse <- readIORef $ sqiResponse sqi 205 | -- (trace $ "Query response: " ++ show queryResponse) 206 | currentLoc <- readIORef $ sqiCurrentLoc sqi 207 | pure $ (currentLoc < Prelude.length (Pb.queryResponseResults queryResponse)) 208 | || (Pb.queryResponseHasMore queryResponse) 209 | 210 | -- TODO : implement close function (need to do anything here in haskell?) 211 | -- close :: sqi -> IO (Maybe Error) 212 | close _ = pure Nothing 213 | 214 | -- next :: sqi -> IO (Either Error Pb.KV) 215 | next sqi = ExceptT $ do 216 | eeQueryResultBytes <- nextResult sqi 217 | case eeQueryResultBytes of 218 | Left _ -> pure $ Left $ Error "Error getting next queryResultBytes" 219 | -- TODO: use Suite.fromByteString 220 | Right queryResultBytes -> pure $ 221 | first DecodeError 222 | (parse (decodeMessage (FieldNumber 1)) (Pb.queryResultBytesResultBytes queryResultBytes) 223 | :: Either ParseError Pb.KV) 224 | 225 | -- ExceptT is a monad transformer that allows us to compose these by binding over IO Either 226 | bsToSqi :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO StateQueryIterator 227 | bsToSqi ccs bs = 228 | -- TODO: use Suite.fromByteString 229 | let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse 230 | in 231 | case eeaQueryResponse of 232 | -- TODO: refactor out pattern matching, e.g. using >>= or <*> 233 | Left err -> ExceptT $ pure $ Left $ DecodeError err 234 | Right queryResponse -> ExceptT $ do 235 | -- queryResponse and currentLoc are IORefs as they need to be mutated 236 | -- as a part of the next() function 237 | queryResponseIORef <- newIORef queryResponse 238 | currentLocIORef <- newIORef 0 239 | pure $ Right StateQueryIterator { sqiChaincodeStub = ccs 240 | , sqiChannelId = getChannelId ccs 241 | , sqiTxId = getTxId ccs 242 | , sqiResponse = queryResponseIORef 243 | , sqiCurrentLoc = currentLocIORef 244 | } 245 | 246 | -- ExceptT is a monad transformer that allows us to compose these by binding over IO Either 247 | bsToSqiAndMeta :: DefaultChaincodeStub -> ByteString -> ExceptT Error IO (StateQueryIterator, Pb.QueryResponseMetadata) 248 | bsToSqiAndMeta ccs bs = 249 | -- TODO: use Suite.fromByteString 250 | let eeaQueryResponse = parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse 251 | in 252 | case eeaQueryResponse of 253 | -- TODO: refactor out pattern matching, e.g. using >>= or <*> 254 | Left err -> ExceptT $ pure $ Left $ DecodeError err 255 | Right queryResponse -> 256 | -- TODO: use Suite.fromByteString 257 | let eeMetadata = parse (decodeMessage (FieldNumber 1)) (Pb.queryResponseMetadata queryResponse) 258 | :: Either ParseError Pb.QueryResponseMetadata 259 | in 260 | case eeMetadata of 261 | Left err -> ExceptT $ pure $ Left $ DecodeError err 262 | Right metadata -> ExceptT $ do 263 | -- queryResponse and currentLoc are IORefs as they need to be mutated 264 | -- as a part of the next() function 265 | queryResponseIORef <- newIORef queryResponse 266 | currentLocIORef <- newIORef 0 267 | pure $ Right ( StateQueryIterator { sqiChaincodeStub = ccs 268 | , sqiChannelId = getChannelId ccs 269 | , sqiTxId = getTxId ccs 270 | , sqiResponse = queryResponseIORef 271 | , sqiCurrentLoc = currentLocIORef 272 | } 273 | , metadata 274 | ) 275 | 276 | nextResult :: StateQueryIterator -> IO (Either Error Pb.QueryResultBytes) 277 | nextResult sqi = do 278 | currentLoc <- readIORef $ sqiCurrentLoc sqi 279 | queryResponse <- readIORef $ sqiResponse sqi 280 | -- Checking if there are more local results 281 | if (currentLoc < Prelude.length (Pb.queryResponseResults $ queryResponse)) 282 | then let queryResult = pure $ Right $ (Pb.queryResponseResults $ queryResponse) ! currentLoc 283 | in 284 | do 285 | modifyIORef (sqiCurrentLoc sqi) (+ 1) 286 | if ((currentLoc + 1) == Prelude.length (Pb.queryResponseResults $ queryResponse)) 287 | then do 288 | fetchNextQueryResult sqi 289 | queryResult 290 | else queryResult 291 | else pure $ Left $ Error "Invalid iterator state" 292 | 293 | -- This function is only called when the local result list has been 294 | -- iterated through and there are more results to get from the peer 295 | -- It makes a call to get the next QueryResponse back from the peer 296 | -- and mutates the sqi with the new QueryResponse and sets currentLoc back to 0 297 | fetchNextQueryResult :: StateQueryIterator -> IO (Either Error StateQueryIterator) 298 | fetchNextQueryResult sqi = do 299 | queryResponse <- readIORef $ sqiResponse sqi 300 | let payload = queryNextStatePayload $ TL.toStrict $ Pb.queryResponseId queryResponse 301 | message = buildChaincodeMessage QUERY_STATE_NEXT payload (sqiTxId sqi) (sqiChannelId sqi) 302 | bsToQueryResponse :: ByteString -> ExceptT Error IO StateQueryIterator 303 | bsToQueryResponse bs = 304 | let eeaQueryResponse = 305 | -- TODO: Suite.fromByteString 306 | parse (decodeMessage (FieldNumber 1)) bs :: Either ParseError Pb.QueryResponse 307 | in 308 | case eeaQueryResponse of 309 | -- TODO: refactor out pattern matching, e.g. using >>= or <*> 310 | Left err -> ExceptT $ pure $ Left $ DecodeError err 311 | Right queryResponse -> ExceptT $ do 312 | -- Need to put the new queryResponse in the sqi queryResponse 313 | writeIORef (sqiCurrentLoc sqi) 0 314 | writeIORef (sqiResponse sqi) queryResponse 315 | pure $ Right sqi 316 | in 317 | do 318 | e <- (sendStream $ sqiChaincodeStub sqi) message 319 | case e of 320 | Left err -> error ("Error while streaming: " ++ show err) 321 | Right _ -> pure () 322 | runExceptT $ ExceptT (listenForResponse (recvStream $ sqiChaincodeStub sqi)) >>= bsToQueryResponse 323 | -- --getPrivateData :: ccs -> String -> String -> Either Error ByteString 324 | -- getPrivateData ccs collection key = Left notImplemented 325 | -- 326 | -- --getPrivateDataHash :: ccs -> String -> String -> Either Error ByteString 327 | -- getPrivateDataHash ccs collection key = Left notImplemented 328 | -- 329 | -- --putPrivateData :: ccs -> String -> String -> ByteString -> Maybe Error 330 | -- putPrivateData ccs collection string value = Right notImplemented 331 | -- 332 | -- --delPrivateData :: ccs -> String -> String -> Maybe Error 333 | -- delPrivateData ccs collection key = Right notImplemented 334 | -- 335 | -- --setPrivateDataValidationParameter :: ccs -> String -> String -> ByteArray -> Maybe Error 336 | -- setPrivateDataValidationParameter ccs collection key params = Right notImplemented 337 | -- 338 | -- --getPrivateDataValidationParameter :: ccs -> String -> String -> Either Error ByteString 339 | -- getPrivateDataValidationParameter ccs collection key = Left notImplemented 340 | -- 341 | -- --getPrivateDataByRange :: ccs -> String -> String -> String -> Either Error StateQueryIterator 342 | -- getPrivateDataByRange ccs collection startKey endKey = Left notImplemented 343 | -- 344 | -- --getPrivateDataByPartialCompositeKey :: ccs -> String -> String -> [String] -> Either Error StateQueryIterator 345 | -- getPrivateDataByPartialCompositeKey ccs collection objectType keys = Left notImplemented 346 | -- 347 | -- -- getPrivateDataQueryResult :: ccs -> String -> String -> Either Error StateQueryIterator 348 | -- getPrivateDataQueryResult ccs collection query = Left notImplemented 349 | -- 350 | -- -- setEvent :: ccs -> String -> ByteArray -> Maybe Error 351 | -- setEvent ccs = Right notImplemented 352 | -------------------------------------------------------------------------------- /src/Types.hs: -------------------------------------------------------------------------------- 1 | module Types where 2 | 3 | import Data.ByteString 4 | import Data.IORef 5 | import Data.Map 6 | import Data.Text 7 | import qualified Data.Text.Lazy as TL 8 | import qualified Data.Vector 9 | 10 | import Google.Protobuf.Timestamp as Pb 11 | 12 | import Network.GRPC.HighLevel 13 | import Network.GRPC.HighLevel.Generated 14 | 15 | import Peer.ChaincodeShim as Pb 16 | import Peer.Proposal as Pb 17 | import Peer.ProposalResponse as Pb ( Response ) 18 | 19 | import Proto3.Suite 20 | import Proto3.Wire.Decode 21 | 22 | import System.IO.Unsafe 23 | 24 | data Error = GRPCError GRPCIOError | InvalidArgs | Error String | DecodeError ParseError 25 | deriving ( Eq, Show ) 26 | 27 | data ChaincodeStub = ChaincodeStub { initFn :: DefaultChaincodeStub -> IO Pb.Response 28 | , invokeFn :: DefaultChaincodeStub -> IO Pb.Response 29 | } 30 | 31 | -- Algebraic Type represeting the DefaultChaincodeStub. This is the 32 | -- one used to enable the chaincode to interact with ledger and chaincode 33 | -- execution services of the peer. A istance of this type is created for 34 | -- each of the chaincode invocations that are performed. 35 | -- TODO: remove all these maybes when the stub is being created properly 36 | data DefaultChaincodeStub = DefaultChaincodeStub -- chaincode invocation arguments. serialised as arrays of bytes. 37 | { args :: Data.Vector.Vector ByteString 38 | -- transaction identifier. 39 | , txId :: Text 40 | -- channel identifier 41 | , channelId :: Text 42 | -- timestamp of the transaction invocation 43 | -- txTimestamp :: Maybe Pb.Timestamp, 44 | -- bytes of the X.509 identity of the originator of the transaction. 45 | , creator :: Maybe ByteString 46 | -- information about the signed proposal 47 | , signedProposal :: Maybe Pb.SignedProposal 48 | , proposal :: Maybe Pb.Proposal 49 | , transient :: Maybe MapTextBytes 50 | , binding :: Maybe MapTextBytes 51 | , decorations :: MapTextBytes 52 | , recvStream :: StreamRecv ChaincodeMessage 53 | , sendStream :: StreamSend ChaincodeMessage 54 | } 55 | 56 | data StateQueryIterator = 57 | StateQueryIterator { sqiChaincodeStub :: DefaultChaincodeStub 58 | , sqiChannelId :: Text 59 | , sqiTxId :: Text 60 | , sqiResponse :: IORef Pb.QueryResponse 61 | , sqiCurrentLoc :: IORef Int 62 | } 63 | deriving ( Show ) 64 | 65 | instance (Show a) => Show (IORef a) where 66 | show a = show (unsafePerformIO (readIORef a)) 67 | 68 | instance (Show DefaultChaincodeStub) where 69 | show ccs = "Chaincode stub { " ++ show (args ccs) ++ ", " ++ show (txId ccs) ++ ", " ++ show (channelId ccs) ++ ", " 70 | ++ show (creator ccs) ++ ", " ++ show (signedProposal ccs) ++ ", " ++ show (proposal ccs) ++ ", " 71 | ++ show (transient ccs) ++ ", " ++ show (binding ccs) ++ ", " ++ show (decorations ccs) ++ " }" 72 | 73 | -- MapTextBytes is a synonym for the Map type whose keys are Text and values 74 | type MapTextBytes = Map TL.Text ByteString -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-14.22 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | extra-deps: 38 | - grpc-haskell-core-0.0.0.0@sha256:4bacd90915321750db570042cd05ada01b9b83c79f6bf6b6ccdef1889b383efa,3306 39 | - grpc-haskell-0.0.1.0@sha256:453f89f3a3a846b31596b0f8f41ed3d71c747d59b208a043d75afd37a9f17308,6012 40 | - proto3-suite-0.4.0.0@sha256:51545a2592f22d1bf612a2f55ca3af8b0083fb5c620c8996bc6d48f742d1faa1,5720 41 | - proto3-wire-1.1.0@sha256:a8fe11ec7c8d01ded2224a1ca43c53cdc09adefd197a3b21ab14b543923840f3,1993 42 | # - acme-missiles-0.3 43 | # - git: https://github.com/commercialhaskell/stack.git 44 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 45 | # 46 | # extra-deps: [] 47 | 48 | # Override default flag values for local packages and extra-deps 49 | # flags: {} 50 | 51 | # Extra package databases containing global packages 52 | # extra-package-dbs: [] 53 | 54 | # Control whether we use the GHC we find on the path 55 | # system-ghc: true 56 | # 57 | # Require a specific version of stack, using version ranges 58 | # require-stack-version: -any # Default 59 | # require-stack-version: ">=2.1" 60 | # 61 | # Override the architecture used by stack, especially useful on Windows 62 | # arch: i386 63 | # arch: x86_64 64 | # 65 | # Extra directories used by stack for building 66 | # extra-include-dirs: [/path/to/dir] 67 | # extra-lib-dirs: [/path/to/dir] 68 | # 69 | # Allow a newer minor version of GHC than the snapshot specifies 70 | # compiler-check: newer-minor 71 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: grpc-haskell-core-0.0.0.0@sha256:4bacd90915321750db570042cd05ada01b9b83c79f6bf6b6ccdef1889b383efa,3306 9 | pantry-tree: 10 | size: 2330 11 | sha256: 2b6324b0b2e9a3ca3ba98864945fb7c6bedad5fbe94ddfc1a1dbec1069d63bde 12 | original: 13 | hackage: grpc-haskell-core-0.0.0.0@sha256:4bacd90915321750db570042cd05ada01b9b83c79f6bf6b6ccdef1889b383efa,3306 14 | - completed: 15 | hackage: grpc-haskell-0.0.1.0@sha256:453f89f3a3a846b31596b0f8f41ed3d71c747d59b208a043d75afd37a9f17308,6012 16 | pantry-tree: 17 | size: 1933 18 | sha256: 4f0fe14943b118a4f26919ccf2e15ac9ff9640c8dd923cac63e9ce3338e4c39d 19 | original: 20 | hackage: grpc-haskell-0.0.1.0@sha256:453f89f3a3a846b31596b0f8f41ed3d71c747d59b208a043d75afd37a9f17308,6012 21 | - completed: 22 | hackage: proto3-suite-0.4.0.0@sha256:51545a2592f22d1bf612a2f55ca3af8b0083fb5c620c8996bc6d48f742d1faa1,5720 23 | pantry-tree: 24 | size: 2972 25 | sha256: f67473f90bac87cd65765571639149ddf3c88e52755c64d9e602a585a7c52571 26 | original: 27 | hackage: proto3-suite-0.4.0.0@sha256:51545a2592f22d1bf612a2f55ca3af8b0083fb5c620c8996bc6d48f742d1faa1,5720 28 | - completed: 29 | hackage: proto3-wire-1.1.0@sha256:a8fe11ec7c8d01ded2224a1ca43c53cdc09adefd197a3b21ab14b543923840f3,1993 30 | pantry-tree: 31 | size: 666 32 | sha256: c6b85d517d924449b19898c96ddc72added6272cbd9593472496e8c305b04fbd 33 | original: 34 | hackage: proto3-wire-1.1.0@sha256:a8fe11ec7c8d01ded2224a1ca43c53cdc09adefd197a3b21ab14b543923840f3,1993 35 | snapshots: 36 | - completed: 37 | size: 524164 38 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/22.yaml 39 | sha256: 7ad8f33179b32d204165a3a662c6269464a47a7e65a30abc38d01b5a38ec42c0 40 | original: lts-14.22 41 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | import Test.Tasty 2 | import Test.Tasty.HUnit 3 | 4 | import Stub 5 | 6 | main :: IO () 7 | main = defaultMain tests 8 | 9 | tests :: TestTree 10 | tests = testGroup "Tests" [stubUnitTests] 11 | 12 | stubUnitTests :: TestTree 13 | stubUnitTests = testGroup "Stub Unit Tests" [getState] 14 | 15 | getState :: TestTree 16 | getState = testCase "getState" $ [1, 2, 3] `compare` [1, 2] @?= GT 17 | --------------------------------------------------------------------------------