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..f5b13c1ea 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 @@ -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,34 +128,34 @@ 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 -- | 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 -> @@ -183,34 +183,34 @@ policyId = 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 - polId <- policyId - fullAssetId polId <|> assetIdNoAssetName polId + parseNonAdaAssetId :: Parser AssetId + parseNonAdaAssetId = do + polId <- parsePolicyId + 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 - aName <- assetName "hexadecimal asset name" + 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 diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index be93e8ac9..f8a0238c4 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -232,9 +232,13 @@ module Cardano.Api , AssetName (..) , AssetId (..) , Value - , ValueRole (..) + , ParserValueRole (..) , parseValue - , policyId + , parsePolicyId + , parseAssetName + , parseTxOutMultiAssetValue + , parseMintingMultiAssetValue + , parseUTxOValue , selectAsset , valueFromList , valueToList