Skip to content

Commit 89d8aa3

Browse files
paolinopaolino
committed
[cli] Inline validation in token get command
1 parent 5361254 commit 89d8aa3

File tree

5 files changed

+98
-21
lines changed

5 files changed

+98
-21
lines changed

‎cli/src/Lib/JSON/Canonical/Extra.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE ConstraintKinds #-}
22
{-# LANGUAGE DeriveFunctor #-}
33
{-# OPTIONS_GHC -Wno-orphans #-}
4+
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
45

56
module Lib.JSON.Canonical.Extra
67
( getField
@@ -236,3 +237,9 @@ instance Applicative m => ToJSON m () where
236237
instance (ReportSchemaErrors m) => FromJSON m () where
237238
fromJSON JSNull = pure ()
238239
fromJSON v = expectedButGotValue "()" v
240+
241+
instance (Monad m, ToJSON m a) => ToJSON m (Identity a) where
242+
toJSON (Identity a) = toJSON a
243+
244+
instance (ReportSchemaErrors m, FromJSON m a) => FromJSON m (Identity a) where
245+
fromJSON v = Identity <$> fromJSON v

‎cli/src/Oracle/Token/Cli.hs‎

Lines changed: 43 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ import Core.Types.Basic (RequestRefId, TokenId)
1919
import Core.Types.Tx (TxHash, WithTxHash (WithTxHash))
2020
import Core.Types.Wallet (Wallet (..))
2121
import Data.Functor ((<&>))
22+
import Data.Functor.Identity (Identity (..))
2223
import Data.List (find)
2324
import Lib.JSON.Canonical.Extra (object, (.=))
2425
import MPFS.API
@@ -30,6 +31,7 @@ import Oracle.Types
3031
, RequestZoo
3132
, Token (..)
3233
, TokenState (..)
34+
, fmapMToken
3335
, requestZooRefId
3436
)
3537
import Oracle.Validate.Request
@@ -38,6 +40,7 @@ import Oracle.Validate.Request
3840
import Oracle.Validate.Types
3941
( AValidationResult (..)
4042
, Validate
43+
, ValidationResult
4144
, liftMaybe
4245
, mapFailure
4346
, notValidated
@@ -47,7 +50,6 @@ import Oracle.Validate.Types
4750
import Submitting (Submission (..))
4851
import Text.JSON.Canonical
4952
( FromJSON (fromJSON)
50-
, JSValue (..)
5153
, ToJSON (..)
5254
)
5355

@@ -101,8 +103,18 @@ instance Monad m => ToJSON m TokenUpdateFailure where
101103
TokenUpdateNotRequestedFromTokenOwner ->
102104
toJSON ("Token update not requested from token owner" :: String)
103105

106+
newtype TokenInfoFailure = TokenInfoTokenNotParsable TokenId
107+
deriving (Show, Eq)
108+
109+
instance Monad m => ToJSON m TokenInfoFailure where
110+
toJSON (TokenInfoTokenNotParsable tk) =
111+
object ["tokenNotParsable" .= tk]
112+
104113
data TokenCommand a where
105-
GetToken :: TokenId -> TokenCommand JSValue
114+
GetToken
115+
:: TokenId
116+
-> TokenCommand
117+
(AValidationResult TokenInfoFailure (Token WithValidation))
106118
BootToken :: Wallet -> TokenCommand (WithTxHash TokenId)
107119
UpdateToken
108120
:: TokenId
@@ -130,14 +142,40 @@ promoteFailure req =
130142
. TokenUpdateRequestValidationFailure
131143
)
132144

145+
data WithValidation x = WithValidation
146+
{ validation :: ValidationResult RequestValidationFailure
147+
, request :: x
148+
}
149+
deriving (Show, Eq)
150+
151+
instance (Monad m, ToJSON m x) => ToJSON m (WithValidation x) where
152+
toJSON (WithValidation mvalidation request) =
153+
object
154+
[ "validation" .= mvalidation
155+
, "request" .= request
156+
]
157+
133158
tokenCmdCore
134159
:: (MonadIO m, MonadMask m)
135160
=> TokenCommand a
136161
-> WithContext m a
137162
tokenCmdCore command = do
138163
mpfs <- askMpfs
139164
case command of
140-
GetToken tk -> lift $ mpfsGetToken mpfs tk
165+
GetToken tk -> do
166+
validation <- askValidation $ Just tk
167+
mconfig <- askConfig tk
168+
lift $ runValidate $ do
169+
mpendings <- lift $ fromJSON <$> mpfsGetToken mpfs tk
170+
token <- liftMaybe (TokenInfoTokenNotParsable tk) mpendings
171+
let oracle = tokenOwner $ tokenState token
172+
f (Identity req) = do
173+
r <-
174+
runValidate
175+
$ validateRequest oracle mconfig validation req
176+
pure $ WithValidation r req
177+
lift $ fmapMToken f token
178+
-- validateRequest oracle mconfig validation
141179
UpdateToken tk wallet wanted -> do
142180
Submission submit <- ($ wallet) <$> askSubmit
143181
validation <- askValidation $ Just tk
@@ -156,10 +194,10 @@ tokenCmdCore command = do
156194
$ sequenceValidate
157195
$ wanted
158196
<&> \req -> do
159-
tokenRequest <-
197+
Identity tokenRequest <-
160198
liftMaybe
161199
(TokenUpdateRequestValidation req TokenUpdateRequestNotFound)
162-
$ find ((== req) . requestZooRefId) requests
200+
$ find ((== req) . requestZooRefId . runIdentity) requests
163201
promoteFailure tokenRequest
164202
$ validateRequest oracle mconfig validation tokenRequest
165203
WithTxHash txHash _ <- lift

‎cli/src/Oracle/Types.hs‎

Lines changed: 29 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE StrictData #-}
2+
{-# LANGUAGE UndecidableInstances #-}
23

34
module Oracle.Types
45
( Request (..)
@@ -7,13 +8,16 @@ module Oracle.Types
78
, RequestZoo (..)
89
, requestZooRefId
910
, RequestValidationFailure (..)
11+
, fmapToken
12+
, fmapMToken
1013
) where
1114

1215
import Control.Applicative (Alternative, (<|>))
1316
import Core.Types.Basic (Owner, RequestRefId)
1417
import Core.Types.Change (Change (..))
1518
import Core.Types.Operation (Op (..), Operation (..))
1619
import Core.Types.Tx (Root)
20+
import Data.Functor.Identity (Identity)
1721
import Lib.JSON.Canonical.Extra (object, withObject, (.:), (.=))
1822
import Oracle.Config.Types (Config, ConfigKey)
1923
import Oracle.Validate.Requests.Config (ConfigFailure)
@@ -189,13 +193,34 @@ instance Monad m => ToJSON m RequestZoo where
189193
toJSON (UnknownDeleteRequest req) = toJSON req
190194
toJSON (UnknownUpdateRequest req) = toJSON req
191195

192-
data Token = Token
196+
data Token r = Token
193197
{ tokenRefId :: RequestRefId
194198
, tokenState :: TokenState
195-
, tokenRequests :: [RequestZoo]
199+
, tokenRequests :: [r RequestZoo]
196200
}
197201

198-
instance Monad m => ToJSON m Token where
202+
fmapToken :: (r RequestZoo -> r' RequestZoo) -> Token r -> Token r'
203+
fmapToken f (Token refId state requests) =
204+
Token
205+
{ tokenRefId = refId
206+
, tokenState = state
207+
, tokenRequests = f <$> requests
208+
}
209+
210+
fmapMToken
211+
:: (Monad m)
212+
=> (r RequestZoo -> m (r' RequestZoo))
213+
-> Token r
214+
-> m (Token r')
215+
fmapMToken f (Token refId state requests) = do
216+
requests' <- mapM f requests
217+
pure
218+
$ Token
219+
{ tokenRefId = refId
220+
, tokenState = state
221+
, tokenRequests = requests'
222+
}
223+
instance (Monad m, ToJSON m (r RequestZoo)) => ToJSON m (Token r) where
199224
toJSON (Token refId state requests) =
200225
object
201226
[ "outputRefId" .= refId
@@ -205,7 +230,7 @@ instance Monad m => ToJSON m Token where
205230

206231
instance
207232
(Alternative m, ReportSchemaErrors m)
208-
=> FromJSON m Token
233+
=> FromJSON m (Token Identity)
209234
where
210235
fromJSON = withObject "Token" $ \v -> do
211236
refId <- v .: "outputRefId"

‎cli/src/Oracle/Validate/Cli.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import Core.Context
1818
, askValidation
1919
)
2020
import Core.Types.Basic (RequestRefId, TokenId)
21+
import Data.Functor.Identity (Identity (..))
2122
import Lib.JSON.Canonical.Extra
2223
( object
2324
, (.=)
@@ -27,6 +28,7 @@ import MPFS.API
2728
)
2829
import Oracle.Types
2930
( RequestValidationFailure
31+
, RequestZoo
3032
, Token (..)
3133
, TokenState (..)
3234
, requestZooRefId
@@ -80,7 +82,7 @@ validateCmd tk command = case command of
8082
lift $ runValidate $ case command of
8183
ValidateRequests -> do
8284
canonicalJSON <- lift $ mpfsGetToken mpfs tk
83-
(oracle, requests) <- do
85+
(oracle, requests :: [Identity RequestZoo]) <- do
8486
let mtoken = fromJSON canonicalJSON
8587
case mtoken of
8688
Nothing ->
@@ -91,7 +93,7 @@ validateCmd tk command = case command of
9193
( tokenOwner $ tokenState jsValue
9294
, tokenRequests jsValue
9395
)
94-
forM requests $ \request -> lift $ do
96+
forM requests $ \(Identity request) -> lift $ do
9597
RequestValidation (requestZooRefId request)
9698
<$> runValidate
9799
(validateRequest oracle mconfig validation request)

‎cli/test-E2E/scenarios/validateUserRegAddRole.sh‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -146,21 +146,26 @@ expectedGet1=$(
146146
cat <<EOF
147147
[
148148
{
149-
"change": {
150-
"key": "{\"platform\":\"github\",\"repository\":{\"organization\":\"cardano-foundation\",\"project\":\"hal-fixture-sin\"},\"type\":\"register-role\",\"user\":\"cfhal\"}",
151-
"type": "insert",
152-
"value": "null"
153-
},
154-
"outputRefId": "$outputRoleRef1",
155-
"owner": $owner
149+
"request": {
150+
"change": {
151+
"key": "{\"platform\":\"github\",\"repository\":{\"organization\":\"cardano-foundation\",\"project\":\"hal-fixture-sin\"},\"type\":\"register-role\",\"user\":\"cfhal\"}",
152+
"operation": {
153+
"type": "insert",
154+
"value": "null"
155+
}
156+
},
157+
"outputRefId": "1a56ff76fe4b87a98f89d7f8ac1f50e058ff3375a2d06d0b1026cf2082a863e6-0",
158+
"owner": "8da87507ba0a8a3c67eaeb8ec768dee132ad8ecac6f526ac526f0c9f"
159+
},
160+
"validation": "validated"
156161
}
157162
]
158163
EOF
159164
)
160165

161166
resultGet1=$(anti oracle token get | jq '.result.requests')
162167

163-
if [[ "$(echo "$resultGet1" | jq -S 'sort_by(.outputRefId)')" != "$(echo "$expectedGet1" | jq -S 'sort_by(.outputRefId)')" ]]; then
168+
if [[ "$(echo "$resultGet1" | jq -S 'sort_by(.request.outputRefId)')" != "$(echo "$expectedGet1" | jq -S 'sort_by(.request.outputRefId)')" ]]; then
164169
emitMismatch 4 "get token requests" "$resultGet1" "$expectedGet1"
165170
fi
166171

@@ -194,7 +199,7 @@ EOF
194199

195200
resultGet2=$(anti oracle token get | jq '.result.requests')
196201

197-
if [[ "$(echo "$resultGet2" | jq -S 'sort_by(.outputRefId)')" != "$(echo "$expectedGet2" | jq -S 'sort_by(.outputRefId)')" ]]; then
202+
if [[ "$(echo "$resultGet2" | jq -S 'sort_by(.request.outputRefId)')" != "$(echo "$expectedGet2" | jq -S 'sort_by(.request.outputRefId)')" ]]; then
198203
emitMismatch 6 "get token requests" "$resultGet2" "$expectedGet2"
199204
fi
200205

@@ -313,6 +318,6 @@ EOF
313318

314319
resultGet3=$(anti oracle token get | jq '.result.requests')
315320

316-
if [[ "$(echo "$resultGet3" | jq -S 'sort_by(.outputRefId)')" != "$(echo "$expectedGet3" | jq -S 'sort_by(.outputRefId)')" ]]; then
321+
if [[ "$(echo "$resultGet3" | jq -S 'sort_by(.request.outputRefId)')" != "$(echo "$expectedGet3" | jq -S 'sort_by(.request.outputRefId)')" ]]; then
317322
emitMismatch 11 "get token requests" "$resultGet3" "$expectedGet3"
318323
fi

0 commit comments

Comments
 (0)