cardano-api: Serialize AssetName to JSON as hex string with latin-1 h…

…elper

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

@@ -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

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