From 5414111ef8d2565c7c34d1bd4c99f58df31d6cdf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 6 Nov 2024 11:42:51 +0100 Subject: [PATCH 1/3] ValueParser: rename publicly exposed function names to indicate they are parsers --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 2 +- cardano-api/internal/Cardano/Api/Tx/Body.hs | 6 ++--- .../internal/Cardano/Api/ValueParser.hs | 22 +++++++++---------- cardano-api/src/Cardano/Api.hs | 4 ++-- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 0af3991dc..aa4c05787 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -392,7 +392,7 @@ genLedgerValue w genAId genQuant = genValueDefault :: MaryEraOnwards era -> Gen (L.Value (ShelleyLedgerEra era)) genValueDefault w = genLedgerValue w genAssetId genSignedNonZeroQuantity -genValueForRole :: MaryEraOnwards era -> ValueRole -> Gen Value +genValueForRole :: MaryEraOnwards era -> ParserValueRole -> Gen Value genValueForRole w = \case RoleMint -> diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 36671f265..18a2e3da3 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -997,10 +997,10 @@ instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where decodeAssets :: Aeson.Object -> Aeson.Parser [(AssetName, Quantity)] decodeAssets assetNameHm = let l = toList assetNameHm - in mapM (\(aName, q) -> (,) <$> parseAssetName aName <*> decodeQuantity q) l + in mapM (\(aName, q) -> (,) <$> parseKeyAsAssetName aName <*> decodeQuantity q) l - parseAssetName :: Aeson.Key -> Aeson.Parser AssetName - parseAssetName aName = runParsecParser assetName (Aeson.toText aName) + parseKeyAsAssetName :: Aeson.Key -> Aeson.Parser AssetName + parseKeyAsAssetName aName = runParsecParser parseAssetName (Aeson.toText aName) decodeQuantity :: Aeson.Value -> Aeson.Parser Quantity decodeQuantity (Aeson.Number sci) = diff --git a/cardano-api/internal/Cardano/Api/ValueParser.hs b/cardano-api/internal/Cardano/Api/ValueParser.hs index 340c4d1d9..6d497dc88 100644 --- a/cardano-api/internal/Cardano/Api/ValueParser.hs +++ b/cardano-api/internal/Cardano/Api/ValueParser.hs @@ -5,9 +5,9 @@ module Cardano.Api.ValueParser , parseTxOutMultiAssetValue , parseMintingMultiAssetValue , parseUTxOValue - , assetName - , policyId - , ValueRole (..) + , parseAssetName + , parsePolicyId + , ParserValueRole (..) ) where @@ -32,7 +32,7 @@ import Text.Parsec.String (Parser) import Text.ParserCombinators.Parsec.Combinator (many1) -- | The role for which a 'Value' is being parsed. -data ValueRole +data ParserValueRole = -- | The value is used as a UTxO or transaction output. RoleUTxO | -- | The value is used as a minting policy. @@ -45,7 +45,7 @@ data ValueRole -- Because we can't rule out the negation operator -- for transaction outputs: some users have negative values in additions, with the addition's total -- summing up to a positive value. So forbidding negations altogether is too restrictive. -parseValue :: ValueRole -> Parser Value +parseValue :: ParserValueRole -> Parser Value parseValue role = do valueExpr <- parseValueExpr let value = evalValueExpr valueExpr @@ -154,8 +154,8 @@ decimal = do return $! List.foldl' (\x d -> 10 * x + toInteger (Char.digitToInt d)) 0 digits -- | Asset name parser. -assetName :: Parser AssetName -assetName = do +parseAssetName :: Parser AssetName +parseAssetName = do hexText <- many hexDigit failEitherWith (\e -> "AssetName deserisalisation failed: " ++ displayError e) @@ -163,8 +163,8 @@ assetName = do $ BSC.pack hexText -- | Policy ID parser. -policyId :: Parser PolicyId -policyId = do +parsePolicyId :: Parser PolicyId +parsePolicyId = do hexText <- many1 hexDigit failEitherWith ( \e -> @@ -196,7 +196,7 @@ assetId = -- Parse a multi-asset ID. nonAdaAssetId :: Parser AssetId nonAdaAssetId = do - polId <- policyId + polId <- parsePolicyId fullAssetId polId <|> assetIdNoAssetName polId -- Parse a fully specified multi-asset ID with both a policy ID and asset @@ -204,7 +204,7 @@ assetId = fullAssetId :: PolicyId -> Parser AssetId fullAssetId polId = do _ <- period - aName <- assetName "hexadecimal asset name" + aName <- parseAssetName "hexadecimal asset name" pure (AssetId polId aName) -- Parse a multi-asset ID that specifies a policy ID, but no asset name. diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index be93e8ac9..263b02d91 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -232,9 +232,9 @@ module Cardano.Api , AssetName (..) , AssetId (..) , Value - , ValueRole (..) + , ParserValueRole (..) , parseValue - , policyId + , parsePolicyId , selectAsset , valueFromList , valueToList From f2eabc7bf09ed3e89cb23036462e255760514b8c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 6 Nov 2024 13:38:20 +0100 Subject: [PATCH 2/3] Add missing exports of function parsing multiassets --- cardano-api/src/Cardano/Api.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 263b02d91..f8a0238c4 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -235,6 +235,10 @@ module Cardano.Api , ParserValueRole (..) , parseValue , parsePolicyId + , parseAssetName + , parseTxOutMultiAssetValue + , parseMintingMultiAssetValue + , parseUTxOValue , selectAsset , valueFromList , valueToList From 7bb45d9d1e06088b104a5dc21e521320d1dcc463 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 6 Nov 2024 13:44:30 +0100 Subject: [PATCH 3/3] ValueParser: prefix internal functions that return a Parser with 'parse' --- .../internal/Cardano/Api/ValueParser.hs | 76 +++++++++---------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/ValueParser.hs b/cardano-api/internal/Cardano/Api/ValueParser.hs index 6d497dc88..f5b13c1ea 100644 --- a/cardano-api/internal/Cardano/Api/ValueParser.hs +++ b/cardano-api/internal/Cardano/Api/ValueParser.hs @@ -94,19 +94,19 @@ data ValueExpr parseValueExpr :: Parser ValueExpr parseValueExpr = - buildExpressionParser operatorTable valueExprTerm + buildExpressionParser operatorTable parseValueExprTerm "multi-asset value expression" where operatorTable = - [ [Prefix negateOp] - , [Infix plusOp AssocLeft] + [ [Prefix parseNegateOp] + , [Infix parsePlusOp AssocLeft] ] -- | Parse either a 'ValueExprLovelace' or 'ValueExprMultiAsset'. -valueExprTerm :: Parser ValueExpr -valueExprTerm = do - q <- try quantity "quantity (word64)" - aId <- try assetIdUnspecified <|> assetIdSpecified "asset id" +parseValueExprTerm :: Parser ValueExpr +parseValueExprTerm = do + q <- try parseQuantity "quantity (word64)" + aId <- try parseAssetIdUnspecified <|> parseAssetIdSpecified "asset id" _ <- spaces pure $ case aId of AdaAssetId -> ValueExprLovelace q @@ -114,12 +114,12 @@ valueExprTerm = do where -- Parse an asset ID which must be lead by one or more whitespace -- characters and may be trailed by whitespace characters. - assetIdSpecified :: Parser AssetId - assetIdSpecified = some space *> assetId + parseAssetIdSpecified :: Parser AssetId + parseAssetIdSpecified = some space *> parseAssetId -- Default for if an asset ID is not specified. - assetIdUnspecified :: Parser AssetId - assetIdUnspecified = + parseAssetIdUnspecified :: Parser AssetId + parseAssetIdUnspecified = spaces *> notFollowedBy alphaNum $> AdaAssetId @@ -128,28 +128,28 @@ valueExprTerm = do -- Primitive parsers ------------------------------------------------------------------------------ -plusOp :: Parser (ValueExpr -> ValueExpr -> ValueExpr) -plusOp = (char '+' *> spaces) $> ValueExprAdd +parsePlusOp :: Parser (ValueExpr -> ValueExpr -> ValueExpr) +parsePlusOp = (char '+' *> spaces) $> ValueExprAdd -negateOp :: Parser (ValueExpr -> ValueExpr) -negateOp = (char '-' *> spaces) $> ValueExprNegate +parseNegateOp :: Parser (ValueExpr -> ValueExpr) +parseNegateOp = (char '-' *> spaces) $> ValueExprNegate -- | Period (\".\") parser. -period :: Parser () -period = void $ char '.' +parsePeriod :: Parser () +parsePeriod = void $ char '.' -- | Word64 parser. -word64 :: Parser Integer -word64 = do - i <- decimal +parseWord64 :: Parser Integer +parseWord64 = do + i <- parseDecimal if i > fromIntegral (maxBound :: Word64) then fail $ "expecting word64, but the number exceeds the max bound: " <> show i else return i -decimal :: Parser Integer -decimal = do +parseDecimal :: Parser Integer +parseDecimal = do digits <- many1 digit return $! List.foldl' (\x d -> 10 * x + toInteger (Char.digitToInt d)) 0 digits @@ -183,34 +183,34 @@ parsePolicyId = do . Text.pack -- | Asset ID parser. -assetId :: Parser AssetId -assetId = - try adaAssetId - <|> nonAdaAssetId +parseAssetId :: Parser AssetId +parseAssetId = + try parseAdaAssetId + <|> parseNonAdaAssetId "asset ID" where -- Parse the ADA asset ID. - adaAssetId :: Parser AssetId - adaAssetId = string "lovelace" $> AdaAssetId + parseAdaAssetId :: Parser AssetId + parseAdaAssetId = string "lovelace" $> AdaAssetId -- Parse a multi-asset ID. - nonAdaAssetId :: Parser AssetId - nonAdaAssetId = do + parseNonAdaAssetId :: Parser AssetId + parseNonAdaAssetId = do polId <- parsePolicyId - fullAssetId polId <|> assetIdNoAssetName polId + parseFullAssetId polId <|> parseAssetIdNoAssetName polId -- Parse a fully specified multi-asset ID with both a policy ID and asset -- name. - fullAssetId :: PolicyId -> Parser AssetId - fullAssetId polId = do - _ <- period + parseFullAssetId :: PolicyId -> Parser AssetId + parseFullAssetId polId = do + _ <- parsePeriod aName <- parseAssetName "hexadecimal asset name" pure (AssetId polId aName) -- Parse a multi-asset ID that specifies a policy ID, but no asset name. - assetIdNoAssetName :: PolicyId -> Parser AssetId - assetIdNoAssetName polId = pure (AssetId polId "") + parseAssetIdNoAssetName :: PolicyId -> Parser AssetId + parseAssetIdNoAssetName polId = pure (AssetId polId "") -- | Quantity (word64) parser. Only accepts positive quantities. -quantity :: Parser Quantity -quantity = fmap Quantity word64 +parseQuantity :: Parser Quantity +parseQuantity = fmap Quantity parseWord64