Merge #3211

3211: Serialize AssetName to JSON as hex string r=cblp a=cblp

Fix (second attempt) of incorrect UTF-8 decoding of non-textual (non-UTF-8) asset names.

I also changed tx-view to test JSON repr.

BEFORE:
```js
{
  "51f056b530aba5969bf996d1be51c7aa3581f6e0d7b9e0911a5c0c1d": {
    "TheDrifter13": 1,
    "GOLDtest": 5,
    "��\"3DUfw��������": 42 // UTF-8 fail, actually
  }
}
```

AFTER:
```js
{
  "51f056b530aba5969bf996d1be51c7aa3581f6e0d7b9e0911a5c0c1d": {
    "546865447269667465723133": 1,
    "474f4c4474657374": 5,
    "00112233445566778899AABBCCDDEEFF": 42
  }
}
```

This is how it already looks like in UI (Cardano Explorer):
> asset1...
> Ticker:
> Name:
> Description:
> Policy ID: 51f056b530aba5969bf996d1be51c7aa3581f6e0d7b9e0911a5c0c1d
> Asset Name: 474f4c4474657374

Future Daedalus:
> Name: GoodCoin
> Asset name: 676f6f64636f696e (ASCII: goodcoin)

Co-authored-by: Yuriy Syrovetskiy <yuriy.syrovetskiy@iohk.io>

cardano-api/gen/Gen/Cardano/Api/Typed.hs

@@ -30,6 +30,7 @@ module Gen.Cardano.Api.Typed
   , genScriptHash
   , genScriptData
 
+  , genAssetName
   , genOperationalCertificate
   , genOperationalCertificateIssueCounter
   , genShelleyWitness
@@ -227,8 +228,8 @@ genAssetName =
   Gen.frequency
     -- mostly from a small number of choices, so we get plenty of repetition
     [ (9, Gen.element ["", "a", "b", "c"])
-    , (1, AssetName <$> Gen.utf8 (Range.singleton  32) Gen.alphaNum)
-    , (1, AssetName <$> Gen.utf8 (Range.constant 1 31) Gen.alphaNum)
+    , (1, AssetName <$> Gen.bytes (Range.singleton  32))
+    , (1, AssetName <$> Gen.bytes (Range.constant 1 31))
     ]
 
 genPolicyId :: Gen PolicyId

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',

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

cardano-api/src/Cardano/Api/Value.hs

@@ -56,9 +56,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,15 +74,16 @@ 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
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseRaw
 import           Cardano.Api.SerialiseUsing
+import           Cardano.Api.Utils (note)
 
 
 -- ----------------------------------------------------------------------------
@@ -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,13 @@ 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
+
 
 -- ----------------------------------------------------------------------------
 -- Printing and pretty-printing
@@ -406,6 +399,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

cardano-api/src/Cardano/Api/ValueParser.hs

@@ -5,22 +5,22 @@ module Cardano.Api.ValueParser
 
 import           Prelude
 
+import           Control.Applicative (many, some, (<|>))
+import qualified Data.ByteString.Char8 as BSC
 import qualified Data.Char as Char
 import           Data.Functor (void, ($>))
 import           Data.List (foldl')
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Word (Word64)
-
-import           Control.Applicative (many, some, (<|>))
-
 import           Text.Parsec as Parsec (notFollowedBy, try, (<?>))
 import           Text.Parsec.Char (alphaNum, char, digit, hexDigit, space, spaces, string)
 import           Text.Parsec.Expr (Assoc (..), Operator (..), buildExpressionParser)
 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 +113,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

cardano-api/test/Test/Cardano/Api/Typed/Value.hs

@@ -6,16 +6,18 @@ module Test.Cardano.Api.Typed.Value
 
 import           Prelude
 
-import           Data.Aeson
+import           Data.Aeson (eitherDecode, encode)
 import           Data.List (groupBy, sort)
 import qualified Data.Map.Strict as Map
 import           Hedgehog (Property, forAll, property, tripping, (===))
 import           Test.Tasty (TestTree)
 import           Test.Tasty.Hedgehog (testProperty)
 import           Test.Tasty.TH (testGroupGenerator)
 
-import           Cardano.Api.Shelley
-import           Gen.Cardano.Api.Typed
+import           Cardano.Api (ValueNestedBundle (ValueNestedBundle, ValueNestedBundleAda),
+                   ValueNestedRep (..), valueFromNestedRep, valueToNestedRep)
+
+import           Gen.Cardano.Api.Typed (genAssetName, genValueDefault, genValueNestedRep)
 
 prop_roundtrip_Value_JSON :: Property
 prop_roundtrip_Value_JSON =
@@ -67,6 +69,20 @@ canonicalise =
     isZeroOrEmpty (ValueNestedBundleAda q) = q == 0
     isZeroOrEmpty (ValueNestedBundle _ as) = Map.null as
 
+
+prop_roundtrip_AssetName_JSON :: Property
+prop_roundtrip_AssetName_JSON =
+  property $ do
+    v <- forAll genAssetName
+    tripping v encode eitherDecode
+
+prop_roundtrip_AssetName_JSONKey :: Property
+prop_roundtrip_AssetName_JSONKey =
+  property $ do
+    v <- forAll genAssetName
+    tripping (Map.singleton v ()) encode eitherDecode
+
+
 -- -----------------------------------------------------------------------------
 
 tests :: TestTree

cardano-cli/cardano-cli.cabal

@@ -208,6 +208,7 @@ test-suite cardano-cli-golden
   type:                 exitcode-stdio-1.0
 
   build-depends:        aeson             >= 1.5.6.0
+                      , base16-bytestring
                       , bytestring
                       , cardano-api
                       , cardano-cli

cardano-cli/src/Cardano/CLI/Run/Friendly.hs

@@ -15,10 +15,13 @@ import           Cardano.Prelude
 import           Data.Aeson (Value (..), object, toJSON, (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.ByteString.Char8 as BSC
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
 import           Data.Yaml (array)
 import           Data.Yaml.Pretty (defConfig, encodePretty, setConfCompare)
 
-import           Cardano.Api
+import           Cardano.Api as Api
 import           Cardano.Api.Shelley (Address (ShelleyAddress), StakeAddress (..))
 import           Cardano.Ledger.Crypto (Crypto)
 import qualified Cardano.Ledger.Shelley.API as Shelley
@@ -165,27 +168,40 @@ friendlyLovelace (Lovelace value) = String $ textShow value <> " Lovelace"
 friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value
 friendlyMintValue = \case
   TxMintNone -> Null
-  TxMintValue _ v _ ->
-    object
-      [ friendlyAssetId assetId .= quantity
-      | (assetId, quantity) <- valueToList v
-      ]
-
-friendlyAssetId :: AssetId -> Text
-friendlyAssetId = \case
-  AdaAssetId -> "ADA"
-  AssetId policyId (AssetName assetName) ->
-    decodeUtf8 $ serialiseToRawBytesHex policyId <> suffix
-    where
-      suffix =
-        case assetName of
-          "" -> ""
-          _ -> "." <> assetName
+  TxMintValue _ v _ -> friendlyValue v
 
 friendlyTxOutValue :: TxOutValue era -> Aeson.Value
 friendlyTxOutValue = \case
   TxOutAdaOnly _ lovelace -> friendlyLovelace lovelace
-  TxOutValue _ multiasset -> toJSON multiasset
+  TxOutValue _ v -> friendlyValue v
+
+friendlyValue :: Api.Value -> Aeson.Value
+friendlyValue v =
+  object
+    [ case bundle of
+        ValueNestedBundleAda q -> "lovelace" .= q
+        ValueNestedBundle policy assets ->
+          friendlyPolicyId policy .= friendlyAssets assets
+    | bundle <- bundles
+    ]
+  where
+
+    ValueNestedRep bundles = valueToNestedRep v
+
+    friendlyPolicyId = ("policy " <>) . serialiseToRawBytesHexText
+
+    friendlyAssets = Map.mapKeys friendlyAssetName
+
+    friendlyAssetName = \case
+      "" -> "default asset"
+      name@(AssetName nameBS) ->
+        "asset " <> serialiseToRawBytesHexText name <> nameAsciiSuffix
+        where
+          nameAsciiSuffix
+            | nameIsAscii = " (" <> nameAscii <> ")"
+            | otherwise = ""
+          nameIsAscii = BSC.all (\c -> isAscii c && isAlphaNum c) nameBS
+          nameAscii = Text.pack $ BSC.unpack nameBS
 
 friendlyMetadata :: TxMetadataInEra era -> Aeson.Value
 friendlyMetadata = \case