{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Class of errors used in the Api.
module Cardano.Api.Serialise.DeserialiseAnyOf
  ( InputFormat (..)
  , InputDecodeError (..)
  , deserialiseInput
  , deserialiseInputAnyOf
  , readFormattedFile
  , readFormattedFileTextEnvelope
  , readFormattedFileAnyOf
  , renderInputDecodeError
  )
where

import Cardano.Api.Error
import Cardano.Api.HasTypeProxy
import Cardano.Api.IO
import Cardano.Api.Serialise.Bech32
import Cardano.Api.Serialise.Raw
import Cardano.Api.Serialise.TextEnvelope.Internal

-- import Cardano.Api.Internal.Utils

import Control.Monad.Except (runExceptT)
import Data.Aeson qualified as Aeson
import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BSC
import Data.Char (toLower)
import Data.Data
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import GHC.Exts (IsList (..))
import Prettyprinter

------------------------------------------------------------------------------
-- Formatted/encoded input deserialisation
------------------------------------------------------------------------------

-- | Input format/encoding.
data InputFormat a where
  -- | Bech32 encoding.
  InputFormatBech32 :: SerialiseAsBech32 a => InputFormat a
  -- | Hex/Base16 encoding.
  InputFormatHex :: SerialiseAsRawBytes a => InputFormat a
  -- TODO: Specify TextEnvelope CBOR hex

  -- | Text envelope format.
  InputFormatTextEnvelope :: HasTextEnvelope a => InputFormat a

-- TODO: Add constructor for TextEnvelope Bech32

-- | Input decoding error.
data InputDecodeError
  = -- | The provided data seems to be a valid text envelope, but some error
    -- occurred in deserialising it.
    InputTextEnvelopeError !TextEnvelopeError
  | -- | The provided data is valid Bech32, but some error occurred in
    -- deserialising it.
    InputBech32DecodeError !Bech32DecodeError
  | -- | The provided data does not represent a valid value of the provided
    -- type.
    InputInvalidError
  deriving (InputDecodeError -> InputDecodeError -> Bool
(InputDecodeError -> InputDecodeError -> Bool)
-> (InputDecodeError -> InputDecodeError -> Bool)
-> Eq InputDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputDecodeError -> InputDecodeError -> Bool
== :: InputDecodeError -> InputDecodeError -> Bool
$c/= :: InputDecodeError -> InputDecodeError -> Bool
/= :: InputDecodeError -> InputDecodeError -> Bool
Eq, Int -> InputDecodeError -> ShowS
[InputDecodeError] -> ShowS
InputDecodeError -> String
(Int -> InputDecodeError -> ShowS)
-> (InputDecodeError -> String)
-> ([InputDecodeError] -> ShowS)
-> Show InputDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputDecodeError -> ShowS
showsPrec :: Int -> InputDecodeError -> ShowS
$cshow :: InputDecodeError -> String
show :: InputDecodeError -> String
$cshowList :: [InputDecodeError] -> ShowS
showList :: [InputDecodeError] -> ShowS
Show, Typeable InputDecodeError
Typeable InputDecodeError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> InputDecodeError -> c InputDecodeError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InputDecodeError)
-> (InputDecodeError -> Constr)
-> (InputDecodeError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InputDecodeError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InputDecodeError))
-> ((forall b. Data b => b -> b)
    -> InputDecodeError -> InputDecodeError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InputDecodeError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InputDecodeError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InputDecodeError -> m InputDecodeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InputDecodeError -> m InputDecodeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InputDecodeError -> m InputDecodeError)
-> Data InputDecodeError
InputDecodeError -> Constr
InputDecodeError -> DataType
(forall b. Data b => b -> b)
-> InputDecodeError -> InputDecodeError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InputDecodeError -> u
forall u. (forall d. Data d => d -> u) -> InputDecodeError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputDecodeError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputDecodeError -> c InputDecodeError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputDecodeError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputDecodeError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputDecodeError -> c InputDecodeError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputDecodeError -> c InputDecodeError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputDecodeError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputDecodeError
$ctoConstr :: InputDecodeError -> Constr
toConstr :: InputDecodeError -> Constr
$cdataTypeOf :: InputDecodeError -> DataType
dataTypeOf :: InputDecodeError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputDecodeError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputDecodeError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputDecodeError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputDecodeError)
$cgmapT :: (forall b. Data b => b -> b)
-> InputDecodeError -> InputDecodeError
gmapT :: (forall b. Data b => b -> b)
-> InputDecodeError -> InputDecodeError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputDecodeError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InputDecodeError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> InputDecodeError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InputDecodeError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InputDecodeError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InputDecodeError -> m InputDecodeError
Data)

instance Error InputDecodeError where
  prettyError :: forall ann. InputDecodeError -> Doc ann
prettyError = InputDecodeError -> Doc ann
forall ann. InputDecodeError -> Doc ann
renderInputDecodeError

-- | Render an error message for a 'InputDecodeError'.
renderInputDecodeError :: InputDecodeError -> Doc ann
renderInputDecodeError :: forall ann. InputDecodeError -> Doc ann
renderInputDecodeError = \case
  InputTextEnvelopeError TextEnvelopeError
textEnvErr ->
    TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TextEnvelopeError -> Doc ann
prettyError TextEnvelopeError
textEnvErr
  InputBech32DecodeError Bech32DecodeError
decodeErr ->
    Bech32DecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError Bech32DecodeError
decodeErr
  InputDecodeError
InputInvalidError ->
    Doc ann
"Invalid key."

-- | The result of a deserialisation function.
--
-- Note that this type isn't intended to be exported, but only used as a
-- helper within the 'deserialiseInput' function.
data DeserialiseInputResult a
  = -- | Input successfully deserialised.
    DeserialiseInputSuccess !a
  | -- | The provided data is of the expected format/encoding, but an error
    -- occurred in deserialising it.
    DeserialiseInputError !InputDecodeError
  | -- | The provided data's formatting/encoding does not match that which was
    -- expected. This error is an indication that one could attempt to
    -- deserialise the input again, but instead expecting a different format.
    DeserialiseInputErrorFormatMismatch

-- | Deserialise an input of some type that is formatted in some way.
deserialiseInput
  :: forall a
   . NonEmpty (InputFormat a)
  -> ByteString
  -> Either InputDecodeError a
deserialiseInput :: forall a.
NonEmpty (InputFormat a) -> ByteString -> Either InputDecodeError a
deserialiseInput NonEmpty (InputFormat a)
acceptedFormats ByteString
inputBs =
  [InputFormat a] -> Either InputDecodeError a
go (NonEmpty (InputFormat a) -> [Item (NonEmpty (InputFormat a))]
forall l. IsList l => l -> [Item l]
toList NonEmpty (InputFormat a)
acceptedFormats)
 where
  inputText :: Text
  inputText :: Text
inputText = ByteString -> Text
Text.decodeUtf8 ByteString
inputBs

  go :: [InputFormat a] -> Either InputDecodeError a
  go :: [InputFormat a] -> Either InputDecodeError a
go [] = InputDecodeError -> Either InputDecodeError a
forall a b. a -> Either a b
Left InputDecodeError
InputInvalidError
  go (InputFormat a
kf : [InputFormat a]
kfs) =
    let res :: DeserialiseInputResult a
res =
          case InputFormat a
kf of
            InputFormat a
InputFormatBech32 -> DeserialiseInputResult a
SerialiseAsBech32 a => DeserialiseInputResult a
deserialiseBech32
            InputFormat a
InputFormatHex -> DeserialiseInputResult a
SerialiseAsRawBytes a => DeserialiseInputResult a
deserialiseHex
            InputFormat a
InputFormatTextEnvelope -> DeserialiseInputResult a
HasTextEnvelope a => DeserialiseInputResult a
deserialiseTextEnvelope
     in case DeserialiseInputResult a
res of
          DeserialiseInputSuccess a
a -> a -> Either InputDecodeError a
forall a b. b -> Either a b
Right a
a
          DeserialiseInputError InputDecodeError
err -> InputDecodeError -> Either InputDecodeError a
forall a b. a -> Either a b
Left InputDecodeError
err
          DeserialiseInputResult a
DeserialiseInputErrorFormatMismatch -> [InputFormat a] -> Either InputDecodeError a
go [InputFormat a]
kfs

  deserialiseTextEnvelope :: HasTextEnvelope a => DeserialiseInputResult a
  deserialiseTextEnvelope :: HasTextEnvelope a => DeserialiseInputResult a
deserialiseTextEnvelope = do
    let textEnvRes :: Either TextEnvelopeError a
        textEnvRes :: Either TextEnvelopeError a
textEnvRes =
          TextEnvelope -> Either TextEnvelopeError a
forall a.
HasTextEnvelope a =>
TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope
            (TextEnvelope -> Either TextEnvelopeError a)
-> Either TextEnvelopeError TextEnvelope
-> Either TextEnvelopeError a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> TextEnvelopeError)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TextEnvelopeError
TextEnvelopeAesonDecodeError (ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
inputBs)
    case Either TextEnvelopeError a
textEnvRes of
      Right a
res -> a -> DeserialiseInputResult a
forall a. a -> DeserialiseInputResult a
DeserialiseInputSuccess a
res
      -- The input was valid a text envelope, but there was a type mismatch
      -- error.
      Left err :: TextEnvelopeError
err@TextEnvelopeTypeError{} ->
        InputDecodeError -> DeserialiseInputResult a
forall a. InputDecodeError -> DeserialiseInputResult a
DeserialiseInputError (TextEnvelopeError -> InputDecodeError
InputTextEnvelopeError TextEnvelopeError
err)
      -- The input was not valid a text envelope.
      Left TextEnvelopeError
_ -> DeserialiseInputResult a
forall a. DeserialiseInputResult a
DeserialiseInputErrorFormatMismatch

  deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
  deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
deserialiseBech32 =
    case Text -> Either Bech32DecodeError a
forall a. SerialiseAsBech32 a => Text -> Either Bech32DecodeError a
deserialiseFromBech32 Text
inputText of
      Right a
res -> a -> DeserialiseInputResult a
forall a. a -> DeserialiseInputResult a
DeserialiseInputSuccess a
res
      -- The input was not valid Bech32.
      Left (Bech32DecodingError DecodingError
_) -> DeserialiseInputResult a
forall a. DeserialiseInputResult a
DeserialiseInputErrorFormatMismatch
      -- The input was valid Bech32, but some other error occurred.
      Left Bech32DecodeError
err -> InputDecodeError -> DeserialiseInputResult a
forall a. InputDecodeError -> DeserialiseInputResult a
DeserialiseInputError (InputDecodeError -> DeserialiseInputResult a)
-> InputDecodeError -> DeserialiseInputResult a
forall a b. (a -> b) -> a -> b
$ Bech32DecodeError -> InputDecodeError
InputBech32DecodeError Bech32DecodeError
err

  deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
  deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
deserialiseHex
    | ByteString -> Bool
isValidHex ByteString
inputBs =
        case ByteString -> Either RawBytesHexError a
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex ByteString
inputBs of
          Left RawBytesHexError
_ -> InputDecodeError -> DeserialiseInputResult a
forall a. InputDecodeError -> DeserialiseInputResult a
DeserialiseInputError InputDecodeError
InputInvalidError
          Right a
x -> a -> DeserialiseInputResult a
forall a. a -> DeserialiseInputResult a
DeserialiseInputSuccess a
x
    | Bool
otherwise = DeserialiseInputResult a
forall a. DeserialiseInputResult a
DeserialiseInputErrorFormatMismatch

  isValidHex :: ByteString -> Bool
  isValidHex :: ByteString -> Bool
isValidHex ByteString
x =
    (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
hexAlpha) (Char -> Bool) -> (Char -> Char) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower) (ByteString -> String
BSC.unpack ByteString
x)
      Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even (ByteString -> Int
BSC.length ByteString
x)
   where
    hexAlpha :: [Char]
    hexAlpha :: String
hexAlpha = String
"0123456789abcdef"

-- | Deserialise an input of some type that is formatted in some way.
--
-- The provided 'ByteString' can either be Bech32-encoded or in the text
-- envelope format.
deserialiseInputAnyOf
  :: forall b
   . [FromSomeType SerialiseAsBech32 b]
  -> [FromSomeType HasTextEnvelope b]
  -> ByteString
  -> Either InputDecodeError b
deserialiseInputAnyOf :: forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> ByteString
-> Either InputDecodeError b
deserialiseInputAnyOf [FromSomeType SerialiseAsBech32 b]
bech32Types [FromSomeType HasTextEnvelope b]
textEnvTypes ByteString
inputBs =
  case DeserialiseInputResult b
deserialiseBech32 DeserialiseInputResult b
-> DeserialiseInputResult b -> DeserialiseInputResult b
`orTry` DeserialiseInputResult b
deserialiseTextEnvelope of
    DeserialiseInputSuccess b
res -> b -> Either InputDecodeError b
forall a b. b -> Either a b
Right b
res
    DeserialiseInputError InputDecodeError
err -> InputDecodeError -> Either InputDecodeError b
forall a b. a -> Either a b
Left InputDecodeError
err
    DeserialiseInputResult b
DeserialiseInputErrorFormatMismatch -> InputDecodeError -> Either InputDecodeError b
forall a b. a -> Either a b
Left InputDecodeError
InputInvalidError
 where
  inputText :: Text
  inputText :: Text
inputText = ByteString -> Text
Text.decodeUtf8 ByteString
inputBs

  orTry
    :: DeserialiseInputResult b
    -> DeserialiseInputResult b
    -> DeserialiseInputResult b
  orTry :: DeserialiseInputResult b
-> DeserialiseInputResult b -> DeserialiseInputResult b
orTry DeserialiseInputResult b
x DeserialiseInputResult b
y =
    case DeserialiseInputResult b
x of
      DeserialiseInputSuccess b
_ -> DeserialiseInputResult b
x
      DeserialiseInputError InputDecodeError
_ -> DeserialiseInputResult b
x
      DeserialiseInputResult b
DeserialiseInputErrorFormatMismatch -> DeserialiseInputResult b
y

  deserialiseTextEnvelope :: DeserialiseInputResult b
  deserialiseTextEnvelope :: DeserialiseInputResult b
deserialiseTextEnvelope = do
    let textEnvRes :: Either TextEnvelopeError b
        textEnvRes :: Either TextEnvelopeError b
textEnvRes =
          [FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
textEnvTypes
            (TextEnvelope -> Either TextEnvelopeError b)
-> Either TextEnvelopeError TextEnvelope
-> Either TextEnvelopeError b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> TextEnvelopeError)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TextEnvelopeError
TextEnvelopeAesonDecodeError (ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
inputBs)
    case Either TextEnvelopeError b
textEnvRes of
      Right b
res -> b -> DeserialiseInputResult b
forall a. a -> DeserialiseInputResult a
DeserialiseInputSuccess b
res
      -- The input was valid a text envelope, but there was a type mismatch
      -- error.
      Left err :: TextEnvelopeError
err@TextEnvelopeTypeError{} ->
        InputDecodeError -> DeserialiseInputResult b
forall a. InputDecodeError -> DeserialiseInputResult a
DeserialiseInputError (TextEnvelopeError -> InputDecodeError
InputTextEnvelopeError TextEnvelopeError
err)
      -- The input was not valid a text envelope.
      Left TextEnvelopeError
_ -> DeserialiseInputResult b
forall a. DeserialiseInputResult a
DeserialiseInputErrorFormatMismatch

  deserialiseBech32 :: DeserialiseInputResult b
  deserialiseBech32 :: DeserialiseInputResult b
deserialiseBech32 =
    case [FromSomeType SerialiseAsBech32 b]
-> Text -> Either Bech32DecodeError b
forall b.
[FromSomeType SerialiseAsBech32 b]
-> Text -> Either Bech32DecodeError b
deserialiseAnyOfFromBech32 [FromSomeType SerialiseAsBech32 b]
bech32Types Text
inputText of
      Right b
res -> b -> DeserialiseInputResult b
forall a. a -> DeserialiseInputResult a
DeserialiseInputSuccess b
res
      -- The input was not valid Bech32.
      Left (Bech32DecodingError DecodingError
_) -> DeserialiseInputResult b
forall a. DeserialiseInputResult a
DeserialiseInputErrorFormatMismatch
      -- The input was valid Bech32, but some other error occurred.
      Left Bech32DecodeError
err -> InputDecodeError -> DeserialiseInputResult b
forall a. InputDecodeError -> DeserialiseInputResult a
DeserialiseInputError (InputDecodeError -> DeserialiseInputResult b)
-> InputDecodeError -> DeserialiseInputResult b
forall a b. (a -> b) -> a -> b
$ Bech32DecodeError -> InputDecodeError
InputBech32DecodeError Bech32DecodeError
err

-- | Read formatted file
readFormattedFile
  :: NonEmpty (InputFormat a)
  -- ^ one of expected input formats
  -> FilePath
  -> IO (Either (FileError InputDecodeError) a)
readFormattedFile :: forall a.
NonEmpty (InputFormat a)
-> String -> IO (Either (FileError InputDecodeError) a)
readFormattedFile NonEmpty (InputFormat a)
acceptedFormats String
path = do
  Either (FileError InputDecodeError) ByteString
eContent <- ExceptT (FileError InputDecodeError) IO ByteString
-> IO (Either (FileError InputDecodeError) ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError InputDecodeError) IO ByteString
 -> IO (Either (FileError InputDecodeError) ByteString))
-> ExceptT (FileError InputDecodeError) IO ByteString
-> IO (Either (FileError InputDecodeError) ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> IO ByteString)
-> ExceptT (FileError InputDecodeError) IO ByteString
forall (m :: * -> *) s e.
MonadIO m =>
String -> (String -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT String
path String -> IO ByteString
readFileBlocking
  case Either (FileError InputDecodeError) ByteString
eContent of
    Left FileError InputDecodeError
e -> Either (FileError InputDecodeError) a
-> IO (Either (FileError InputDecodeError) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError InputDecodeError) a
 -> IO (Either (FileError InputDecodeError) a))
-> Either (FileError InputDecodeError) a
-> IO (Either (FileError InputDecodeError) a)
forall a b. (a -> b) -> a -> b
$ FileError InputDecodeError -> Either (FileError InputDecodeError) a
forall a b. a -> Either a b
Left FileError InputDecodeError
e
    Right ByteString
content ->
      Either (FileError InputDecodeError) a
-> IO (Either (FileError InputDecodeError) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError InputDecodeError) a
 -> IO (Either (FileError InputDecodeError) a))
-> (Either InputDecodeError a
    -> Either (FileError InputDecodeError) a)
-> Either InputDecodeError a
-> IO (Either (FileError InputDecodeError) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InputDecodeError -> FileError InputDecodeError)
-> Either InputDecodeError a
-> Either (FileError InputDecodeError) a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> InputDecodeError -> FileError InputDecodeError
forall e. String -> e -> FileError e
FileError String
path) (Either InputDecodeError a
 -> IO (Either (FileError InputDecodeError) a))
-> Either InputDecodeError a
-> IO (Either (FileError InputDecodeError) a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (InputFormat a) -> ByteString -> Either InputDecodeError a
forall a.
NonEmpty (InputFormat a) -> ByteString -> Either InputDecodeError a
deserialiseInput NonEmpty (InputFormat a)
acceptedFormats ByteString
content

-- | Read text envelope file
readFormattedFileTextEnvelope
  :: HasTextEnvelope a
  => File content In
  -> IO (Either (FileError InputDecodeError) a)
readFormattedFileTextEnvelope :: forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError InputDecodeError) a)
readFormattedFileTextEnvelope File content 'In
fp =
  (FileError TextEnvelopeError -> FileError InputDecodeError)
-> Either (FileError TextEnvelopeError) a
-> Either (FileError InputDecodeError) a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TextEnvelopeError -> InputDecodeError)
-> FileError TextEnvelopeError -> FileError InputDecodeError
forall a b. (a -> b) -> FileError a -> FileError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEnvelopeError -> InputDecodeError
InputTextEnvelopeError) (Either (FileError TextEnvelopeError) a
 -> Either (FileError InputDecodeError) a)
-> IO (Either (FileError TextEnvelopeError) a)
-> IO (Either (FileError InputDecodeError) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope File content 'In
fp

-- | Read in in any of the format in the text envelope
readFormattedFileAnyOf
  :: forall content b
   . [FromSomeType SerialiseAsBech32 b]
  -> [FromSomeType HasTextEnvelope b]
  -> File content In
  -> IO (Either (FileError InputDecodeError) b)
readFormattedFileAnyOf :: forall content b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> File content 'In
-> IO (Either (FileError InputDecodeError) b)
readFormattedFileAnyOf [FromSomeType SerialiseAsBech32 b]
bech32Types [FromSomeType HasTextEnvelope b]
textEnvTypes File content 'In
path = do
  Either (FileError InputDecodeError) ByteString
eContent <- ExceptT (FileError InputDecodeError) IO ByteString
-> IO (Either (FileError InputDecodeError) ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError InputDecodeError) IO ByteString
 -> IO (Either (FileError InputDecodeError) ByteString))
-> ExceptT (FileError InputDecodeError) IO ByteString
-> IO (Either (FileError InputDecodeError) ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> IO ByteString)
-> ExceptT (FileError InputDecodeError) IO ByteString
forall (m :: * -> *) s e.
MonadIO m =>
String -> (String -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT (File content 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'In
path) String -> IO ByteString
readFileBlocking
  case Either (FileError InputDecodeError) ByteString
eContent of
    Left FileError InputDecodeError
e -> Either (FileError InputDecodeError) b
-> IO (Either (FileError InputDecodeError) b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError InputDecodeError) b
 -> IO (Either (FileError InputDecodeError) b))
-> Either (FileError InputDecodeError) b
-> IO (Either (FileError InputDecodeError) b)
forall a b. (a -> b) -> a -> b
$ FileError InputDecodeError -> Either (FileError InputDecodeError) b
forall a b. a -> Either a b
Left FileError InputDecodeError
e
    Right ByteString
content ->
      Either (FileError InputDecodeError) b
-> IO (Either (FileError InputDecodeError) b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError InputDecodeError) b
 -> IO (Either (FileError InputDecodeError) b))
-> (Either InputDecodeError b
    -> Either (FileError InputDecodeError) b)
-> Either InputDecodeError b
-> IO (Either (FileError InputDecodeError) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InputDecodeError -> FileError InputDecodeError)
-> Either InputDecodeError b
-> Either (FileError InputDecodeError) b
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> InputDecodeError -> FileError InputDecodeError
forall e. String -> e -> FileError e
FileError (File content 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'In
path)) (Either InputDecodeError b
 -> IO (Either (FileError InputDecodeError) b))
-> Either InputDecodeError b
-> IO (Either (FileError InputDecodeError) b)
forall a b. (a -> b) -> a -> b
$ [FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> ByteString
-> Either InputDecodeError b
forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> ByteString
-> Either InputDecodeError b
deserialiseInputAnyOf [FromSomeType SerialiseAsBech32 b]
bech32Types [FromSomeType HasTextEnvelope b]
textEnvTypes ByteString
content