From d2f3850700e60456a293c45b1b26df4322685830 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Fri, 17 Sep 2021 16:05:33 +0300 Subject: [PATCH] cardano-api: Serialize AssetName to JSON as hex string with latin-1 helper --- cardano-api/src/Cardano/Api/SerialiseUsing.hs | 56 ++++++++++--------- cardano-api/src/Cardano/Api/Utils.hs | 8 +++ cardano-api/src/Cardano/Api/Value.hs | 48 ++++++++-------- cardano-api/src/Cardano/Api/ValueParser.hs | 9 +-- 4 files changed, 67 insertions(+), 54 deletions(-) diff --git a/cardano-api/src/Cardano/Api/SerialiseUsing.hs b/cardano-api/src/Cardano/Api/SerialiseUsing.hs index 662cab79e66..9855b36fd77 100644 --- a/cardano-api/src/Cardano/Api/SerialiseUsing.hs +++ b/cardano-api/src/Cardano/Api/SerialiseUsing.hs @@ -10,14 +10,14 @@ module Cardano.Api.SerialiseUsing import Prelude +import qualified Data.Aeson.Types as Aeson +import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BSC import Data.String (IsString (..)) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Typeable - -import qualified Data.Aeson.Types as Aeson +import Data.Typeable (Typeable, tyConName, typeRep, typeRepTyCon) import Cardano.Api.Error import Cardano.Api.HasTypeProxy @@ -63,33 +63,39 @@ instance SerialiseAsRawBytes a => Show (UsingRawBytesHex a) where show (UsingRawBytesHex x) = show (serialiseToRawBytesHex x) instance SerialiseAsRawBytes a => IsString (UsingRawBytesHex a) where - fromString str = - case Base16.decode (BSC.pack str) of - Right raw -> case deserialiseFromRawBytes ttoken raw of - Just x -> UsingRawBytesHex x - Nothing -> error ("fromString: cannot deserialise " ++ show str) - Left msg -> error ("fromString: invalid hex " ++ show str ++ ", " ++ msg) - where - ttoken :: AsType a - ttoken = proxyToAsType Proxy + fromString = either error id . deserialiseFromRawBytesBase16 . BSC.pack instance SerialiseAsRawBytes a => ToJSON (UsingRawBytesHex a) where toJSON (UsingRawBytesHex x) = toJSON (serialiseToRawBytesHexText x) instance (SerialiseAsRawBytes a, Typeable a) => FromJSON (UsingRawBytesHex a) where - parseJSON = - Aeson.withText tname $ \str -> - case Base16.decode (Text.encodeUtf8 str) of - Right raw -> case deserialiseFromRawBytes ttoken raw of - Just x -> return (UsingRawBytesHex x) - Nothing -> fail ("cannot deserialise " ++ show str) - Left msg -> fail ("invalid hex " ++ show str ++ ", " ++ msg) - where - ttoken = proxyToAsType (Proxy :: Proxy a) - tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) - -instance SerialiseAsRawBytes a => ToJSONKey (UsingRawBytesHex a) -instance (SerialiseAsRawBytes a, Typeable a) => FromJSONKey (UsingRawBytesHex a) + parseJSON = + Aeson.withText tname $ + either fail pure . deserialiseFromRawBytesBase16 . Text.encodeUtf8 + where + tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) + +instance SerialiseAsRawBytes a => ToJSONKey (UsingRawBytesHex a) where + toJSONKey = + Aeson.toJSONKeyText $ \(UsingRawBytesHex x) -> serialiseToRawBytesHexText x + +instance + (SerialiseAsRawBytes a, Typeable a) => FromJSONKey (UsingRawBytesHex a) where + + fromJSONKey = + Aeson.FromJSONKeyTextParser $ + either fail pure . deserialiseFromRawBytesBase16 . Text.encodeUtf8 + +deserialiseFromRawBytesBase16 :: + SerialiseAsRawBytes a => ByteString -> Either String (UsingRawBytesHex a) +deserialiseFromRawBytesBase16 str = + case Base16.decode str of + Right raw -> case deserialiseFromRawBytes ttoken raw of + Just x -> Right (UsingRawBytesHex x) + Nothing -> Left ("cannot deserialise " ++ show str) + Left msg -> Left ("invalid hex " ++ show str ++ ", " ++ msg) + where + ttoken = proxyToAsType (Proxy :: Proxy a) -- | For use with @deriving via@, to provide instances for any\/all of 'Show', diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index 59eb3f36a01..71fe2fa3e90 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + -- | Internal utils for the other Api modules -- module Cardano.Api.Utils @@ -6,6 +8,7 @@ module Cardano.Api.Utils , formatParsecError , noInlineMaybeToStrictMaybe , runParsecParser + , note ) where import Prelude @@ -42,3 +45,8 @@ runParsecParser parser input = case Parsec.parse (parser <* Parsec.eof) "" (Text.unpack input) of Right txin -> pure txin Left parseError -> fail $ formatParsecError parseError + +note :: MonadFail m => String -> Maybe a -> m a +note msg = \case + Nothing -> fail msg + Just a -> pure a diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 012fa73f928..3701b5983fc 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -56,9 +57,9 @@ module Cardano.Api.Value import Prelude -import Data.Aeson hiding (Value) +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject) import qualified Data.Aeson as Aeson -import Data.Aeson.Types (Parser, toJSONKeyText) +import Data.Aeson.Types (Parser, ToJSONKey) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC @@ -74,9 +75,9 @@ import qualified Data.Text.Encoding as Text import qualified Cardano.Chain.Common as Byron import qualified Cardano.Ledger.Coin as Shelley +import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Mary.Value as Mary import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as Shelley -import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Api.HasTypeProxy import Cardano.Api.Script @@ -158,8 +159,10 @@ scriptPolicyId = PolicyId . hashScript newtype AssetName = AssetName ByteString - deriving stock (Eq, Ord) - deriving newtype (Show) + deriving stock (Eq, Ord) + deriving newtype (Show) + deriving (ToJSON, FromJSON, ToJSONKey, FromJSONKey) + via UsingRawBytesHex AssetName instance IsString AssetName where fromString s @@ -177,18 +180,6 @@ instance SerialiseAsRawBytes AssetName where | BS.length bs <= 32 = Just (AssetName bs) | otherwise = Nothing -instance ToJSON AssetName where - toJSON (AssetName an) = Aeson.String $ Text.decodeUtf8 an - -instance FromJSON AssetName where - parseJSON = withText "AssetName" (return . AssetName . Text.encodeUtf8) - -instance ToJSONKey AssetName where - toJSONKey = toJSONKeyText (\(AssetName asset) -> Text.decodeUtf8 asset) - -instance FromJSONKey AssetName where - fromJSONKey = FromJSONKeyText (AssetName . Text.encodeUtf8) - data AssetId = AdaAssetId | AssetId !PolicyId !AssetName @@ -366,11 +357,18 @@ instance FromJSON ValueNestedRep where where parsePid :: (Text, Aeson.Value) -> Parser ValueNestedBundle parsePid ("lovelace", q) = ValueNestedBundleAda <$> parseJSON q - parsePid (pid, q) = - case deserialiseFromRawBytesHex AsScriptHash (Text.encodeUtf8 pid) of - Just sHash -> ValueNestedBundle (PolicyId sHash) <$> parseJSON q - Nothing -> fail $ "Failure when deserialising PolicyId: " - <> Text.unpack pid + parsePid (pid, quantityBundleJson) = do + sHash <- + note ("Expected hex encoded PolicyId but got: " <> Text.unpack pid) $ + deserialiseFromRawBytesHex AsScriptHash $ Text.encodeUtf8 pid + quantityBundle <- parseJSON quantityBundleJson + pure $ ValueNestedBundle (PolicyId sHash) quantityBundle + +note :: MonadFail m => String -> Maybe a -> m a +note msg = \case + Nothing -> fail msg + Just a -> pure a + -- ---------------------------------------------------------------------------- -- Printing and pretty-printing @@ -406,6 +404,6 @@ renderPolicyId (PolicyId scriptHash) = serialiseToRawBytesHexText scriptHash renderAssetId :: AssetId -> Text renderAssetId AdaAssetId = "lovelace" -renderAssetId (AssetId polId (AssetName assetName)) - | BS.null assetName = renderPolicyId polId - | otherwise = renderPolicyId polId <> "." <> Text.decodeUtf8 assetName +renderAssetId (AssetId polId (AssetName "")) = renderPolicyId polId +renderAssetId (AssetId polId assetName) = + renderPolicyId polId <> "." <> serialiseToRawBytesHexText assetName diff --git a/cardano-api/src/Cardano/Api/ValueParser.hs b/cardano-api/src/Cardano/Api/ValueParser.hs index 3723dd72e69..9a6e639a693 100644 --- a/cardano-api/src/Cardano/Api/ValueParser.hs +++ b/cardano-api/src/Cardano/Api/ValueParser.hs @@ -21,6 +21,7 @@ import Text.Parsec.String (Parser) import Text.ParserCombinators.Parsec.Combinator (many1) import Cardano.Api.SerialiseRaw +import Cardano.Api.Utils (note) import Cardano.Api.Value -- | Parse a 'Value' from its string representation. @@ -113,10 +114,10 @@ decimal = do -- | Asset name parser. assetName :: Parser AssetName -assetName = - toAssetName <$> many alphaNum - where - toAssetName = AssetName . Text.encodeUtf8 . Text.pack +assetName = do + hexText <- many hexDigit + note "AssetName deserisalisation failed" $ + deserialiseFromRawBytesHex AsAssetName $ BSC.pack hexText -- | Policy ID parser. policyId :: Parser PolicyId