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

Commit 22f78c3

Browse files
airvinairvin
authored
Merge pull request #16 from hyperledger-labs/iterator-methods
Iterator methods
2 parents e9b5a25 + f5745bd commit 22f78c3

File tree

11 files changed

+341
-139
lines changed

11 files changed

+341
-139
lines changed

‎.gitignore‎

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

‎examples/Fabcar.hs‎

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,6 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# LANGUAGE DeriveGeneric #-}
33

4-
-- peer chaincode invoke -n mycc -c '{"Args":["initLedger"]}' -C myc
5-
-- peer chaincode invoke -n mycc -c '{"Args":["createCar", "CAR10", "Ford", "Falcon", "White", "Al"]}' -C myc
6-
-- peer chaincode invoke -n mycc -c '{"Args":["queryCar", "CAR10"]}' -C myc
7-
-- peer chaincode invoke -n mycc -c '{"Args":["changeCarOwner", "CAR10", "Nick"]}' -C myc
8-
94
module Fabcar where
105

116
import GHC.Generics

‎examples/Marbles.hs‎

Lines changed: 48 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,6 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# LANGUAGE DeriveGeneric #-}
33

4-
-- Example invocations:
5-
-- peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc
6-
-- peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble2","blue","large","Nick"]}' -C myc
7-
-- peer chaincode invoke -n mycc -c '{"Args":["readMarble","marble1"]}' -C myc
8-
-- peer chaincode invoke -n mycc -c '{"Args":["deleteMarble","marble1"]}' -C myc
9-
-- peer chaincode invoke -n mycc -c '{"Args":["transferMarble","marble1", "Nick"]}' -C myc
10-
-- peer chaincode invoke -n mycc -c '{"Args":["getMarblesByRange","marble1", "marble3"]}' -C myc
11-
124
module Marbles where
135

146
import GHC.Generics
@@ -18,17 +10,24 @@ import Shim ( start
1810
, ChaincodeStub(..)
1911
, ChaincodeStubInterface(..)
2012
, DefaultChaincodeStub
13+
, StateQueryIterator(..)
14+
, StateQueryIteratorInterface(..)
15+
, Error(..)
2116
)
2217

2318
import Peer.ProposalResponse as Pb
19+
import Ledger.Queryresult.KvQueryResult as Pb
2420

2521
import Data.Text ( Text
2622
, unpack
2723
, pack
24+
, append
2825
)
26+
import qualified Data.Text.Encoding as TSE
2927
import qualified Data.ByteString as BS
3028
import qualified Data.ByteString.UTF8 as BSU
3129
import qualified Data.ByteString.Lazy as LBS
30+
import qualified Data.Text.Lazy as TL
3231

3332
import Data.Aeson ( ToJSON
3433
, FromJSON
@@ -38,6 +37,7 @@ import Data.Aeson ( ToJSON
3837
, encode
3938
, decode
4039
)
40+
4141
import Debug.Trace
4242

4343
main :: IO ()
@@ -60,8 +60,14 @@ instance ToJSON Marble where
6060
instance FromJSON Marble
6161

6262
initFunc :: DefaultChaincodeStub -> IO Pb.Response
63-
initFunc _ = pure $ successPayload Nothing
64-
63+
initFunc s =
64+
let e = getFunctionAndParameters s
65+
in
66+
case e of
67+
Left _ -> pure $ errorPayload ""
68+
Right ("initMarble" , parameters) -> initMarble s parameters
69+
Right (fn , _ ) -> pure
70+
$ errorPayload (pack ("Invoke did not find function: " ++ unpack fn))
6571

6672
invokeFunc :: DefaultChaincodeStub -> IO Pb.Response
6773
invokeFunc s =
@@ -81,8 +87,8 @@ invokeFunc s =
8187
-- Right ("getHistoryForMarble", parameters) ->
8288
-- getHistoryForMarble s parameters
8389
Right ("getMarblesByRange", parameters) -> getMarblesByRange s parameters
84-
-- Right ("getMarblesByRangeWithPagination", parameters) ->
85-
-- getMarblesByRangeWithPagination s parameters
90+
Right ("getMarblesByRangeWithPagination", parameters) ->
91+
getMarblesByRangeWithPagination s parameters
8692
-- Right ("queryMarblesWithPagination", parameters) ->
8793
-- queryMarblesWithPagination s parameters
8894
Right (fn , _ ) -> pure
@@ -166,9 +172,36 @@ getMarblesByRange s params = if Prelude.length params == 2
166172
e <- getStateByRange s (params !! 0) (params !! 1)
167173
case e of
168174
Left _ -> pure $ errorPayload "Failed to get marbles"
169-
Right a -> trace (show a) (pure $ successPayload Nothing)
170-
else pure $ errorPayload
171-
"Incorrect arguments. Need a start key and an end key"
175+
Right sqi -> do
176+
resultBytes <- generateResultBytes sqi ""
177+
trace (show resultBytes) (pure $ successPayload Nothing)
178+
else pure $ errorPayload "Incorrect arguments. Need a start key and an end key"
179+
180+
getMarblesByRangeWithPagination :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
181+
getMarblesByRangeWithPagination s params = if Prelude.length params == 4
182+
then do
183+
e <- getStateByRangeWithPagination s (params !! 0) (params !! 1) (read (unpack $ params !! 2) :: Int) (params !! 3)
184+
case e of
185+
Left _ -> pure $ errorPayload "Failed to get marbles"
186+
Right _ -> pure $ successPayload $ Just "The payload"
187+
else pure $ errorPayload "Incorrect arguments. Need start key, end key, pageSize and bookmark"
188+
189+
generateResultBytes :: StateQueryIterator -> Text -> IO (Either Error BSU.ByteString)
190+
generateResultBytes sqi text = do
191+
hasNextBool <- hasNext sqi
192+
if hasNextBool then do
193+
eeKV <- next sqi
194+
-- TODO: We need to check that the Either Error KV returned from next
195+
-- is correct and append the showable version of KVs instead of "abc".
196+
case eeKV of
197+
Left e -> pure $ Left e
198+
Right kv ->
199+
let
200+
makeKVString :: Pb.KV -> Text
201+
makeKVString kv_ = pack "Key: " <> TL.toStrict (Pb.kvKey kv_) <> pack ", Value: " <> TSE.decodeUtf8 (kvValue kv_)
202+
in
203+
generateResultBytes sqi (append text (makeKVString kv))
204+
else pure $ Right $ TSE.encodeUtf8 text
172205

173206
parseMarble :: [Text] -> Marble
174207
parseMarble params = Marble { objectType = "marble"

‎examples/readme.md‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
# Haskell Chaincode Examples
2+
3+
## Simple Application Chaincode (SACC)
4+
5+
The SACC chaincode can be instantiated with:
6+
```
7+
peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init","a","100"]}' -C myc -o orderer:7050
8+
```
9+
10+
The chaincode can then be invoked with the following examples:
11+
12+
```
13+
peer chaincode invoke -n mycc -c '{"Args":["get","a"]}' -C myc
14+
peer chaincode invoke -n mycc -c '{"Args":["put","b","60"]}' -C myc
15+
peer chaincode invoke -n mycc -c '{"Args":["set","b","60"]}' -C myc
16+
peer chaincode invoke -n mycc -c '{"Args":["del","a"]}' -C myc
17+
```
18+
19+
20+
## Marbles Chaincode
21+
22+
The Marbles chaincode can be instantiated with:
23+
```
24+
peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc -o orderer:7050
25+
```
26+
27+
The chaincode can then be invoked with the following examples:
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+
```
36+
37+
## Fabcar Chaincode
38+
39+
The Fabcar chaincode can be instantiated with:
40+
```
41+
peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init"]}' -C myc -o orderer:7050
42+
```
43+
44+
The chaincode can then be invoked with the following examples:
45+
```
46+
peer chaincode invoke -n mycc -c '{"Args":["initLedger"]}' -C myc
47+
peer chaincode invoke -n mycc -c '{"Args":["createCar", "CAR10", "Ford", "Falcon", "White", "Al"]}' -C myc
48+
peer chaincode invoke -n mycc -c '{"Args":["queryCar", "CAR10"]}' -C myc
49+
peer chaincode invoke -n mycc -c '{"Args":["changeCarOwner", "CAR10", "Nick"]}' -C myc
50+
```

‎package.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ dependencies:
2828
- containers
2929
- utf8-string
3030
- aeson
31+
- mtl
3132

3233
library:
3334
source-dirs:

‎readme.md‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -35,14 +35,17 @@ Note: Since running chaincode in production mode depends on a language specific
3535

3636
### Running the Haskell chaincode
3737

38-
The Haskell chaincode process can be started with:
38+
There are three example chaincodes that have been implemented. Please see the
39+
readme in the `examples` directory for information on how to run each of them.
40+
41+
The instructions for running for the `sacc` example are described below.
42+
43+
Start the Haskell chaincode process with:
3944

4045
```
4146
stack run sacc-exe
4247
```
4348

44-
To run the `sacc` example. Look at `package.yaml` to see available executables.
45-
4649
When the Fabric peer is running (see below), the Haskell process that is started does a number of things
4750

4851
1. It connects to the Fabric peer through gRPC
@@ -71,7 +74,6 @@ peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init","a","100"
7174
```
7275

7376
The chaincode can then be invoked with the following examples:
74-
7577
```
7678
peer chaincode invoke -n mycc -c '{"Args":["get","a"]}' -C myc
7779
peer chaincode invoke -n mycc -c '{"Args":["put","b","60"]}' -C myc
@@ -83,7 +85,7 @@ peer chaincode invoke -n mycc -c '{"Args":["del","a"]}' -C myc
8385

8486
- [x] Finish implementing shim functions and clean up shim module exports
8587
- [x] Add examples directory
86-
- [ ] Write unit tests for stub functions
8788
- [ ] Add support for concurrent transactions
8889
- [ ] Finish implementing all stub functions
8990
- [ ] Publish to Hackage
91+
- [ ] Add traces throughout the chaincode examples

‎src/Interfaces.hs‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import qualified Google.Protobuf.Timestamp as GooglePb
1414
import qualified Peer.Proposal as Pb
1515
import qualified Peer.ProposalResponse as Pb
1616
import qualified Peer.Chaincode as Pb
17+
import qualified Peer.ChaincodeShim as Pb
1718

1819

1920
import Types
@@ -37,7 +38,8 @@ class ChaincodeStubInterface ccs where
3738
-- setStateValidationParameter :: ccs -> String -> [ByteString] -> Maybe Error
3839
-- getStateValiationParameter :: ccs -> String -> Either Error [ByteString]
3940
getStateByRange :: ccs -> Text -> Text -> IO (Either Error StateQueryIterator)
40-
-- getStateByRangeWithPagination :: ccs -> String -> String -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
41+
getStateByRangeWithPagination :: ccs -> Text -> Text -> Int -> Text -> IO (Either Error (StateQueryIterator, Pb.QueryResponseMetadata))
42+
4143
-- getStateByPartialCompositeKey :: ccs -> String -> [String] -> Either Error StateQueryIterator
4244
-- getStateByPartialCompositeKeyWithPagination :: ccs -> String -> [String] -> Int32 -> String -> Either Error (StateQueryIterator, Pb.QueryResponseMetadata)
4345
-- createCompositeKey :: ccs -> String -> [String] -> Either Error String
@@ -68,11 +70,13 @@ class ChaincodeStubInterface ccs where
6870
class StateQueryIteratorInterface sqi where
6971
-- -- hasNext provides information on current status of the iterator and whether there are
7072
-- -- more elements in the collection key-value pairs returned by the result.
71-
hasNext :: sqi -> Bool
73+
hasNext :: sqi -> IO Bool
7274
-- -- close terminantes the iteration.
73-
close :: sqi -> Maybe Error
75+
close :: sqi -> IO (Maybe Error)
7476
-- -- Provides the next key-value pair pointed by the iterator
75-
next :: sqi -> Either Error Pb.KV
77+
-- TODO: Change this to an ExceptT type to make handling the next function
78+
-- easier on the user chaincode side
79+
next :: sqi -> IO (Either Error Pb.KV)
7680

7781
-- The type class HistoryQueryIterator defines the behaviour of the types that expose functionalities
7882
-- for iteratogin over a set of key modifications that are associated to the history of a key.

‎src/Messages.hs‎

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

2222

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

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

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

‎src/Shim.hs‎

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

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

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

4752
import Debug.Trace

0 commit comments

Comments
 (0)