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

Commit 5504e7a

Browse files
author
Nick Waywood
committed
Updated sacc and fabcar examples to work with new getState and putState signatures
Signed-off-by: Nick Waywood <nwaywood@au1.ibm.com>
1 parent f2692b0 commit 5504e7a

File tree

5 files changed

+108
-118
lines changed

5 files changed

+108
-118
lines changed

‎examples/Fabcar.hs

Lines changed: 83 additions & 81 deletions
Original file line numberDiff line numberDiff line change
@@ -3,32 +3,39 @@
33

44
module Fabcar where
55

6-
import Data.Aeson ( FromJSON
7-
, ToJSON
8-
, decode
9-
, defaultOptions
10-
, encode
11-
, genericToEncoding
12-
, toEncoding
13-
)
14-
import qualified Data.ByteString as BS
15-
import qualified Data.ByteString.Lazy as LBS
16-
import qualified Data.ByteString.UTF8 as BSU
17-
import Data.Text ( Text )
18-
19-
import Debug.Trace
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
2022

2123
import GHC.Generics
2224

23-
import Peer.ProposalResponse as Pb
25+
import Ledger.Queryresult.KvQueryResult as Pb
2426

25-
import Shim ( ChaincodeStub(..)
26-
, ChaincodeStubInterface(..)
27-
, DefaultChaincodeStub
28-
, errorPayload
29-
, start
30-
, successPayload
31-
)
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+
)
3239

3340
main :: IO ()
3441
main = Shim.start chaincodeStub
@@ -128,13 +135,11 @@ createCars :: DefaultChaincodeStub -> [Text] -> [Car] -> IO Pb.Response
128135
createCars s keys cars =
129136
if length cars == 0
130137
then pure $ successPayload Nothing
131-
else let response = putState s (head keys) (LBS.toStrict $ encode $ head cars)
132-
in
133-
do
134-
e <- response
135-
case e of
136-
Left _ -> pure $ errorPayload "Failed to set asset"
137-
Right _ -> createCars s (tail keys) (tail cars)
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)
138143

139144
createCar :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
140145
createCar s params =
@@ -144,66 +149,44 @@ createCar s params =
144149
, colour = params !! 3
145150
, owner = params !! 4
146151
}
147-
response = putState s (head params) (LBS.toStrict $ encode car)
148152
in
149-
do
150-
e <- response
151-
case e of
152-
Left _ -> pure $ errorPayload "Failed to set asset"
153-
Right _ -> pure $ successPayload Nothing
153+
eitherToPbResponse <$> runExceptT (putState s (head params) (LBS.toStrict $ encode car))
154154
else pure $ errorPayload "Incorrect number of arguments. Expecting 5"
155155

156156
queryCar :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
157-
queryCar s params =
158-
if Prelude.length params == 1
159-
then let response = getState s (head params)
160-
in
161-
do
162-
e <- response
163-
case e of
164-
Left _ -> pure $ errorPayload "Failed to get asset"
165-
Right carBytes -> trace (BSU.toString carBytes) (pure $ successPayload $ Just carBytes)
166-
else pure $ errorPayload "Incorrect number of arguments. Expecting 1"
167-
168-
-- TODO: requires the getStateByRange stub function
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+
169161
queryAllCars :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
170-
queryAllCars _ _ = pure $ errorPayload "Not yet implemented"
171-
172-
-- let
173-
-- startKey = "CAR0"
174-
-- endKey = "CAR999"
175-
-- response = getStateByRange s startKey endKey
176-
-- in do
177-
-- e <- response
178-
-- case e of
179-
-- Left _ -> pure $ errorPayload "Failed to get assets"
180-
-- Right carsBytes -> trace (BSU.toString carsBytes) (pure $ successPayload $ Just carsBytes)
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+
181170
changeCarOwner :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
182171
changeCarOwner s params =
183172
if Prelude.length params == 2
184-
then do
185-
-- Check that the car already exists
186-
e <- getState s (head params)
187-
case e of
188-
Left _ -> pure $ errorPayload "Failed to get car"
189-
Right response ->
190-
if BS.length response == 0
191-
then pure $ errorPayload "Car not found"
192-
else
193-
-- Unmarshal the car
194-
let maybeCar = decode (LBS.fromStrict response) :: Maybe Car
195-
newOwner = params !! 1
196-
in
197-
case maybeCar of
198-
Nothing -> pure $ errorPayload "Error decoding car"
199-
Just oldCar -> let newCar = carWithNewOwner oldCar newOwner
200-
carJson = LBS.toStrict $ encode newCar
201-
in
202-
do
203-
ee <- putState s (head params) carJson
204-
case ee of
205-
Left _ -> pure $ errorPayload "Failed to create car"
206-
Right _ -> pure $ successPayload Nothing
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)
207190
else pure $ errorPayload "Incorrect arguments. Need a car name and new owner"
208191

209192
carWithNewOwner :: Car -> Text -> Car
@@ -213,3 +196,22 @@ carWithNewOwner oldCar newOwner =
213196
, colour = colour oldCar
214197
, owner = newOwner
215198
}
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.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ import Data.Aeson ( FromJSON
1616
import qualified Data.ByteString as BS
1717
import qualified Data.ByteString.Lazy as LBS
1818
import qualified Data.ByteString.UTF8 as BSU
19-
import Data.Functor.Classes
2019
import Data.Text ( Text, append, pack, unpack )
2120
import qualified Data.Text.Encoding as TSE
2221
import qualified Data.Text.Lazy as TL

‎examples/Sacc.hs

Lines changed: 11 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,11 @@
22

33
module Sacc where
44

5-
import Data.ByteString.UTF8 as BSU ( ByteString, toString )
6-
import Data.Text ( Text )
7-
import Data.Text.Encoding ( encodeUtf8 )
5+
import Control.Monad.Except ( runExceptT )
86

9-
import Debug.Trace
7+
import Data.ByteString.UTF8 as BSU ( fromString )
8+
import Data.Text ( Text, pack )
9+
import Data.Text.Encoding ( encodeUtf8 )
1010

1111
import Peer.ProposalResponse as Pb
1212

@@ -31,13 +31,7 @@ initFunc :: DefaultChaincodeStub -> IO Pb.Response
3131
initFunc s = let initArgs = getStringArgs s
3232
in
3333
if Prelude.length initArgs == 2
34-
then let response = putState s (head initArgs) (encodeUtf8 $ initArgs !! 1)
35-
in
36-
do
37-
e <- response :: IO (Either Error ByteString)
38-
case e of
39-
Left _ -> pure $ errorPayload "Failed to create asset"
40-
Right _ -> pure $ successPayload Nothing
34+
then eitherToPbResponse <$> (runExceptT $ putState s (head initArgs) (encodeUtf8 $ initArgs !! 1))
4135
else pure $ errorPayload "Incorrect arguments. Expecting a key and a value"
4236

4337
invokeFunc :: DefaultChaincodeStub -> IO Pb.Response
@@ -50,22 +44,14 @@ invokeFunc s = let e = getFunctionAndParameters s
5044

5145
set :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
5246
set s params = if Prelude.length params == 2
53-
then let response = putState s (head params) (encodeUtf8 $ params !! 1)
54-
in
55-
do
56-
e <- response :: IO (Either Error ByteString)
57-
case e of
58-
Left _ -> pure $ errorPayload "Failed to set asset"
59-
Right _ -> pure $ successPayload Nothing
47+
then eitherToPbResponse <$> (runExceptT $ putState s (head params) (encodeUtf8 $ params !! 1))
6048
else pure $ errorPayload "Incorrect arguments. Expecting a key and a value"
6149

6250
get :: DefaultChaincodeStub -> [Text] -> IO Pb.Response
6351
get s params = if Prelude.length params == 1
64-
then let response = getState s (head params)
65-
in
66-
do
67-
e <- response
68-
case e of
69-
Left _ -> pure $ errorPayload "Failed to get asset"
70-
Right a -> trace (BSU.toString a) (pure $ successPayload Nothing)
52+
then eitherToPbResponse <$> (runExceptT $ getState s (head params))
7153
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

‎examples/readme.md

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
## Simple Application Chaincode (SACC)
44

55
The SACC chaincode can be instantiated with:
6+
67
```
78
peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init","a","100"]}' -C myc -o orderer:7050
89
```
@@ -11,20 +12,19 @@ The chaincode can then be invoked with the following examples:
1112

1213
```
1314
peer chaincode invoke -n mycc -c '{"Args":["get","a"]}' -C myc
14-
peer chaincode invoke -n mycc -c '{"Args":["put","b","60"]}' -C myc
1515
peer chaincode invoke -n mycc -c '{"Args":["set","b","60"]}' -C myc
16-
peer chaincode invoke -n mycc -c '{"Args":["del","a"]}' -C myc
1716
```
1817

19-
20-
## Marbles Chaincode
18+
## Marbles Chaincode
2119

2220
The Marbles chaincode can be instantiated with:
21+
2322
```
2423
peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc -o orderer:7050
2524
```
2625

2726
The chaincode can then be invoked with the following examples:
27+
2828
```
2929
peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble1","red","large","Al"]}' -C myc
3030
peer chaincode invoke -n mycc -c '{"Args":["initMarble","marble2","blue","large","Nick"]}' -C myc
@@ -38,14 +38,17 @@ peer chaincode invoke -n mycc -c '{"Args":["getMarblesByRangeWithPagination","ma
3838
## Fabcar Chaincode
3939

4040
The Fabcar chaincode can be instantiated with:
41+
4142
```
4243
peer chaincode instantiate -n mycc -v v0 -l golang -c '{"Args":["init"]}' -C myc -o orderer:7050
4344
```
4445

4546
The chaincode can then be invoked with the following examples:
47+
4648
```
4749
peer chaincode invoke -n mycc -c '{"Args":["initLedger"]}' -C myc
4850
peer chaincode invoke -n mycc -c '{"Args":["createCar", "CAR10", "Ford", "Falcon", "White", "Al"]}' -C myc
4951
peer chaincode invoke -n mycc -c '{"Args":["queryCar", "CAR10"]}' -C myc
5052
peer chaincode invoke -n mycc -c '{"Args":["changeCarOwner", "CAR10", "Nick"]}' -C myc
51-
```
53+
peer chaincode invoke -n mycc -c '{"Args":["queryAllCars"]}' -C myc
54+
```

‎src/Stub.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -163,8 +163,7 @@ instance ChaincodeStubInterface DefaultChaincodeStub where
163163
let metadata = Pb.QueryMetadata { Pb.queryMetadataPageSize = fromIntegral pageSize
164164
, Pb.queryMetadataBookmark = TL.fromStrict bookmark
165165
}
166-
payload = (trace "Building getStateByRangeWithPagination payload") getStateByRangePayload startKey endKey $
167-
Just metadata
166+
payload = getStateByRangePayload startKey endKey $ Just metadata
168167
message = buildChaincodeMessage GET_STATE_BY_RANGE payload (txId ccs) (channelId ccs)
169168
in
170169
ExceptT $ do
@@ -180,7 +179,8 @@ instance StateQueryIteratorInterface StateQueryIterator where
180179
-- hasNext :: sqi -> IO Bool
181180
hasNext sqi = do
182181
queryResponse <- readIORef $ sqiResponse sqi
183-
currentLoc <- (trace $ "Query response: " ++ show queryResponse) readIORef $ sqiCurrentLoc sqi
182+
-- (trace $ "Query response: " ++ show queryResponse)
183+
currentLoc <- readIORef $ sqiCurrentLoc sqi
184184
pure $ (currentLoc < Prelude.length (Pb.queryResponseResults queryResponse))
185185
|| (Pb.queryResponseHasMore queryResponse)
186186

@@ -235,7 +235,7 @@ bsToSqiAndMeta ccs bs =
235235
in
236236
case eeMetadata of
237237
Left err -> ExceptT $ pure $ Left $ DecodeError err
238-
Right metadata -> (trace $ "Metadata from bsToSqiAndMeta: " ++ show metadata) ExceptT $ do
238+
Right metadata -> ExceptT $ do
239239
-- queryResponse and currentLoc are IORefs as they need to be mutated
240240
-- as a part of the next() function
241241
queryResponseIORef <- newIORef queryResponse
@@ -261,9 +261,9 @@ nextResult sqi = do
261261
modifyIORef (sqiCurrentLoc sqi) (+ 1)
262262
if ((currentLoc + 1) == Prelude.length (Pb.queryResponseResults $ queryResponse))
263263
then do
264-
(trace "Fetching next query result from the peer") fetchNextQueryResult sqi
264+
fetchNextQueryResult sqi
265265
queryResult
266-
else (trace "Returning local query result") queryResult
266+
else queryResult
267267
else pure $ Left $ Error "Invalid iterator state"
268268

269269
-- This function is only called when the local result list has been

0 commit comments

Comments
 (0)