Merge #3304

3304: Extend deserialiseFromRawBytesHex to produce error description r=cblp a=cblp



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

bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs

@@ -65,10 +65,10 @@ readScript fp = do
       error "Wrong script version."
 
 toScriptHash :: String -> Hash ScriptData
-toScriptHash str
-  = case deserialiseFromRawBytesHex (AsHash AsScriptData) (BSC.pack str) of
-    Just x -> x
-    Nothing  -> error $ "Invalid datum hash: " ++ show str
+toScriptHash str =
+  case deserialiseFromRawBytesHex (AsHash AsScriptData) (BSC.pack str) of
+    Right x -> x
+    Left e -> error $ "Invalid datum hash: " ++ displayError e
 
 preExecuteScript ::
      ProtocolParameters

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

@@ -159,6 +159,7 @@ import           Cardano.Api.SerialiseJSON
 import           Cardano.Api.SerialiseRaw
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.SerialiseUsing
+import           Cardano.Api.Utils (failEitherWith)
 
 {- HLINT ignore "Use section" -}
 
@@ -1364,10 +1365,11 @@ parseScriptAfter lang =
         _       -> fail "\"after\" script value not found"
 
 parsePaymentKeyHash :: Text -> Aeson.Parser (Hash PaymentKey)
-parsePaymentKeyHash txt =
-    case deserialiseFromRawBytesHex (AsHash AsPaymentKey) (Text.encodeUtf8 txt) of
-      Just payKeyHash -> return payKeyHash
-      Nothing -> fail $ "Error deserialising payment key hash: " <> Text.unpack txt
+parsePaymentKeyHash =
+  failEitherWith
+    (\e -> "Error deserialising payment key hash: " ++ displayError e)
+  . deserialiseFromRawBytesHex (AsHash AsPaymentKey)
+  . Text.encodeUtf8
 
 
 -- ----------------------------------------------------------------------------

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Raw binary serialisation
@@ -9,13 +10,13 @@ module Cardano.Api.SerialiseRaw
   , serialiseToRawBytesHexText
   ) where
 
-import           Prelude
+import           Cardano.Prelude
+import           Prelude (String)
 
-import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as Base16
-import           Data.Text (Text)
 import qualified Data.Text.Encoding as Text
 
+import           Cardano.Api.Error (Error, displayError)
 import           Cardano.Api.HasTypeProxy
 
 
@@ -31,9 +32,28 @@ serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes
 serialiseToRawBytesHexText :: SerialiseAsRawBytes a => a -> Text
 serialiseToRawBytesHexText = Text.decodeUtf8 . serialiseToRawBytesHex
 
-deserialiseFromRawBytesHex :: SerialiseAsRawBytes a
-                           => AsType a -> ByteString -> Maybe a
-deserialiseFromRawBytesHex proxy hex =
-    case Base16.decode hex of
-      Right raw -> deserialiseFromRawBytes proxy raw
-      Left _msg -> Nothing
+data RawBytesHexError
+  = RawBytesHexErrorBase16DecodeFail
+      ByteString -- ^ original input
+      String -- ^ error message
+  | RawBytesHexErrorRawBytesDecodeFail
+      ByteString -- ^ original input
+      -- TODO(2022-01-26, cblp) TypeRep -- ^ output type proxy
+  deriving (Show)
+
+instance Error RawBytesHexError where
+  displayError = \case
+    RawBytesHexErrorBase16DecodeFail input message ->
+      "Expected Base16-encoded bytestring, but got " ++ show input ++ "; "
+      ++ message
+    RawBytesHexErrorRawBytesDecodeFail input ->
+      "Failed to deserialise " ++ show input
+      -- TODO(2022-01-26, cblp) show expected output type
+
+deserialiseFromRawBytesHex
+  :: SerialiseAsRawBytes a
+  => AsType a -> ByteString -> Either RawBytesHexError a
+deserialiseFromRawBytesHex proxy hex = do
+  raw <- first (RawBytesHexErrorBase16DecodeFail hex) $ Base16.decode hex
+  maybe (Left $ RawBytesHexErrorRawBytesDecodeFail hex) Right $
+    deserialiseFromRawBytes proxy raw

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

@@ -152,6 +152,7 @@ module Cardano.Api.TxBody (
 
 import           Prelude
 
+import           Control.Applicative (some)
 import           Control.Monad (guard)
 import           Data.Aeson (object, withObject, withText, (.:), (.:?), (.=))
 import qualified Data.Aeson as Aeson
@@ -182,6 +183,7 @@ import           Data.Word (Word16, Word32, Word64)
 import           GHC.Generics
 import           GHC.Records (HasField (..))
 import qualified Text.Parsec as Parsec
+import           Text.Parsec ((<?>))
 import qualified Text.Parsec.Language as Parsec
 import qualified Text.Parsec.String as Parsec
 import qualified Text.Parsec.Token as Parsec
@@ -240,8 +242,8 @@ import           Cardano.Api.Address
 import           Cardano.Api.Certificate
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
-import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Hash
+import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.KeysByron
 import           Cardano.Api.KeysShelley
 import           Cardano.Api.NetworkId
@@ -430,10 +432,10 @@ instance FromJSONKey TxIn where
 
 parseTxId :: Parsec.Parser TxId
 parseTxId = do
-  str <- Parsec.many1 Parsec.hexDigit Parsec.<?> "transaction id (hexadecimal)"
-  case deserialiseFromRawBytesHex AsTxId (BSC.pack str) of
-    Just addr -> return addr
-    Nothing -> fail $ "Incorrect transaction id format:: " ++ show str
+  str <- some Parsec.hexDigit <?> "transaction id (hexadecimal)"
+  failEitherWith
+    (\e -> "Incorrect transaction id format: " ++ displayError e) $
+    deserialiseFromRawBytesHex AsTxId $ BSC.pack str
 
 parseTxIn :: Parsec.Parser TxIn
 parseTxIn = TxIn <$> parseTxId <*> (Parsec.char '#' *> parseTxIx)
@@ -1486,10 +1488,9 @@ pattern TxOutDatumInTx s d <- TxOutDatumInTx' s _ d
 
 parseHash :: SerialiseAsRawBytes (Hash a) => AsType (Hash a) -> Parsec.Parser (Hash a)
 parseHash asType = do
-  str <- Parsec.many1 Parsec.hexDigit Parsec.<?> "hash"
-  case deserialiseFromRawBytesHex asType (BSC.pack str) of
-    Just sdh -> return sdh
-    Nothing  -> fail $ "Failed to parse hash: " ++ show str
+  str <- some Parsec.hexDigit <?> "hash"
+  failEitherWith (\e -> "Failed to parse hash: " ++ displayError e) $
+    deserialiseFromRawBytesHex asType (BSC.pack str)
 
 -- ----------------------------------------------------------------------------
 -- Transaction fees

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

@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-
 -- | Internal utils for the other Api modules
 --
 module Cardano.Api.Utils
@@ -8,7 +6,8 @@ module Cardano.Api.Utils
   , formatParsecError
   , noInlineMaybeToStrictMaybe
   , runParsecParser
-  , note
+  , failEither
+  , failEitherWith
   ) where
 
 import           Prelude
@@ -46,7 +45,8 @@ runParsecParser parser input =
     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
+failEither :: MonadFail m => Either String a -> m a
+failEither = either fail pure
+
+failEitherWith :: MonadFail m => (e -> String) -> Either e a -> m a
+failEitherWith f = either (fail . f) pure

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

@@ -74,18 +74,18 @@ import qualified Data.Text as Text
 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.Api.Error (displayError)
 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)
+import           Cardano.Api.Utils (failEitherWith)
 
 
 -- ----------------------------------------------------------------------------
@@ -361,11 +361,10 @@ instance FromJSON ValueNestedRep where
       parsePid ("lovelace", q) = ValueNestedBundleAda <$> parseJSON q
       parsePid (Aeson.toText -> pid, quantityBundleJson) = do
         sHash <-
-          note ("Expected hex encoded PolicyId but got: " <> Text.unpack pid) $
+          failEitherWith
+            (\e -> "Failure when deserialising PolicyId: " ++ displayError e) $
           deserialiseFromRawBytesHex AsScriptHash $ Text.encodeUtf8 pid
-        quantityBundle <- parseJSON quantityBundleJson
-        pure $ ValueNestedBundle (PolicyId sHash) quantityBundle
-
+        ValueNestedBundle (PolicyId sHash) <$> parseJSON quantityBundleJson
 
 -- ----------------------------------------------------------------------------
 -- Printing and pretty-printing

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

@@ -19,8 +19,9 @@ import           Text.Parsec.Expr (Assoc (..), Operator (..), buildExpressionPar
 import           Text.Parsec.String (Parser)
 import           Text.ParserCombinators.Parsec.Combinator (many1)
 
+import           Cardano.Api.Error (displayError)
 import           Cardano.Api.SerialiseRaw
-import           Cardano.Api.Utils (note)
+import           Cardano.Api.Utils (failEitherWith)
 import           Cardano.Api.Value
 
 -- | Parse a 'Value' from its string representation.
@@ -115,18 +116,21 @@ decimal = do
 assetName :: Parser AssetName
 assetName = do
   hexText <- many hexDigit
-  note "AssetName deserisalisation failed" $
+  failEitherWith
+    (\e -> "AssetName deserisalisation failed: " ++ displayError e) $
     deserialiseFromRawBytesHex AsAssetName $ BSC.pack hexText
 
 -- | Policy ID parser.
 policyId :: Parser PolicyId
 policyId = do
   hexText <- many1 hexDigit
-  case textToPolicyId hexText of
-    Just p -> pure p
-    Nothing ->
-      fail $ "expecting a 56 hex-encoded policy ID, but found only "
-          ++ show (length hexText) ++ " hex digits"
+  failEitherWith
+    ( \e ->
+        fail $
+          "expecting a 56-hex-digit policy ID, but found "
+            ++ show (length hexText) ++ " hex digits; " ++ displayError e
+    )
+    (textToPolicyId hexText)
   where
     textToPolicyId =
         fmap PolicyId

cardano-cli/src/Cardano/CLI/Byron/Parsers.hs

@@ -279,8 +279,8 @@ parseTxIdAtto :: Atto.Parser TxId
 parseTxIdAtto = (<?> "Transaction ID (hexadecimal)") $ do
   bstr <- Atto.takeWhile1 Char.isHexDigit
   case deserialiseFromRawBytesHex AsTxId bstr of
-    Just addr -> return addr
-    Nothing -> fail $ "Incorrect transaction id format:: " ++ show bstr
+    Right addr -> return addr
+    Left e -> fail $ "Incorrect transaction id format: " ++ displayError e
 
 parseTxIxAtto :: Atto.Parser TxIx
 parseTxIxAtto = toEnum <$> Atto.decimal

cardano-cli/src/Cardano/CLI/Shelley/Key.hs

@@ -163,10 +163,9 @@ deserialiseInput asType acceptedFormats inputBs =
     deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
     deserialiseHex
       | isValidHex inputBs =
-          maybe
-            (DeserialiseInputError InputInvalidError)
-            DeserialiseInputSuccess
-            (deserialiseFromRawBytesHex asType inputBs)
+          case deserialiseFromRawBytesHex asType inputBs of
+            Left _ -> DeserialiseInputError InputInvalidError
+            Right x -> DeserialiseInputSuccess x
       | otherwise = DeserialiseInputErrorFormatMismatch
 
     isValidHex :: ByteString -> Bool