{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | Ledger CDDL Serialisation
module Cardano.Api.SerialiseLedgerCddl
  ( TextEnvelopeCddlError (..)
  , FromSomeTypeCDDL (..)
  , cddlTypeToEra

    -- * Reading one of several transaction or

  -- key witness types
  , readFileTextEnvelopeCddlAnyOf
  , deserialiseFromTextEnvelopeCddlAnyOf
  , writeTxFileTextEnvelopeCddl
  , writeTxWitnessFileTextEnvelopeCddl
  -- Exported for testing
  , serialiseTxLedgerCddl
  , deserialiseTxLedgerCddl
  , deserialiseByronTxCddl
  , serialiseWitnessLedgerCddl
  , deserialiseWitnessLedgerCddl

    -- * Byron tx serialization
  , serializeByronTx
  , writeByronTxFileTextEnvelopeCddl
  )
where

import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.IO
import           Cardano.Api.Pretty
import           Cardano.Api.SerialiseTextEnvelope (TextEnvelope (..),
                   TextEnvelopeDescr (TextEnvelopeDescr), TextEnvelopeError (..),
                   TextEnvelopeType (TextEnvelopeType), deserialiseFromTextEnvelope,
                   legacyComparison, serialiseToTextEnvelope)
import           Cardano.Api.Tx.Sign
import           Cardano.Api.Utils

import qualified Cardano.Chain.UTxO as Byron
import           Cardano.Ledger.Binary (DecoderError)
import qualified Cardano.Ledger.Binary as CBOR

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither,
                   newExceptT, runExceptT)
import qualified Data.Aeson as Aeson
import           Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder)
import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import           Data.Data (Data)
import           Data.Either.Combinators (mapLeft)
import qualified Data.List as List
import           Data.Text (Text)
import qualified Data.Text as T

-- Why have we gone this route? The serialization format of `TxBody era`
-- differs from the CDDL. We serialize to an intermediate type in order to simplify
-- the specification of Plutus scripts and to avoid users having to think about
-- and construct redeemer pointers. However it turns out we can still serialize to
-- the ledger's CDDL format and maintain the convenient script witness specification
-- that the cli commands build and build-raw expose.
--
-- The long term plan is to have all relevant outputs from the cli to adhere to
-- the ledger's CDDL spec. Modifying the existing TextEnvelope machinery to encompass
-- this would result in a lot of unnecessary changes where the serialization
-- already defaults to the CDDL spec. In order to reduce the number of changes, and to
-- ease removal of the non-CDDL spec serialization, we have opted to create a separate
-- data type to encompass this in the interim.

data TextEnvelopeCddlError
  = TextEnvelopeCddlErrCBORDecodingError DecoderError
  | TextEnvelopeCddlAesonDecodeError FilePath String
  | TextEnvelopeCddlUnknownKeyWitness
  | TextEnvelopeCddlTypeError
      [Text]
      -- ^ Expected types
      Text
      -- ^ Actual types
  | TextEnvelopeCddlErrUnknownType Text
  | TextEnvelopeCddlErrByronKeyWitnessUnsupported
  deriving (Int -> TextEnvelopeCddlError -> ShowS
[TextEnvelopeCddlError] -> ShowS
TextEnvelopeCddlError -> String
(Int -> TextEnvelopeCddlError -> ShowS)
-> (TextEnvelopeCddlError -> String)
-> ([TextEnvelopeCddlError] -> ShowS)
-> Show TextEnvelopeCddlError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEnvelopeCddlError -> ShowS
showsPrec :: Int -> TextEnvelopeCddlError -> ShowS
$cshow :: TextEnvelopeCddlError -> String
show :: TextEnvelopeCddlError -> String
$cshowList :: [TextEnvelopeCddlError] -> ShowS
showList :: [TextEnvelopeCddlError] -> ShowS
Show, TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
(TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool)
-> (TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool)
-> Eq TextEnvelopeCddlError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
== :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
$c/= :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
/= :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
Eq, Typeable TextEnvelopeCddlError
Typeable TextEnvelopeCddlError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> TextEnvelopeCddlError
 -> c TextEnvelopeCddlError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TextEnvelopeCddlError)
-> (TextEnvelopeCddlError -> Constr)
-> (TextEnvelopeCddlError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TextEnvelopeCddlError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TextEnvelopeCddlError))
-> ((forall b. Data b => b -> b)
    -> TextEnvelopeCddlError -> TextEnvelopeCddlError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> TextEnvelopeCddlError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> TextEnvelopeCddlError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TextEnvelopeCddlError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TextEnvelopeCddlError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TextEnvelopeCddlError -> m TextEnvelopeCddlError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TextEnvelopeCddlError -> m TextEnvelopeCddlError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TextEnvelopeCddlError -> m TextEnvelopeCddlError)
-> Data TextEnvelopeCddlError
TextEnvelopeCddlError -> Constr
TextEnvelopeCddlError -> DataType
(forall b. Data b => b -> b)
-> TextEnvelopeCddlError -> TextEnvelopeCddlError
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) -> TextEnvelopeCddlError -> u
forall u.
(forall d. Data d => d -> u) -> TextEnvelopeCddlError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TextEnvelopeCddlError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TextEnvelopeCddlError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TextEnvelopeCddlError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TextEnvelopeCddlError
-> c TextEnvelopeCddlError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TextEnvelopeCddlError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TextEnvelopeCddlError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TextEnvelopeCddlError
-> c TextEnvelopeCddlError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TextEnvelopeCddlError
-> c TextEnvelopeCddlError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TextEnvelopeCddlError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TextEnvelopeCddlError
$ctoConstr :: TextEnvelopeCddlError -> Constr
toConstr :: TextEnvelopeCddlError -> Constr
$cdataTypeOf :: TextEnvelopeCddlError -> DataType
dataTypeOf :: TextEnvelopeCddlError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TextEnvelopeCddlError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TextEnvelopeCddlError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TextEnvelopeCddlError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TextEnvelopeCddlError)
$cgmapT :: (forall b. Data b => b -> b)
-> TextEnvelopeCddlError -> TextEnvelopeCddlError
gmapT :: (forall b. Data b => b -> b)
-> TextEnvelopeCddlError -> TextEnvelopeCddlError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TextEnvelopeCddlError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TextEnvelopeCddlError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TextEnvelopeCddlError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TextEnvelopeCddlError -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> TextEnvelopeCddlError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> TextEnvelopeCddlError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TextEnvelopeCddlError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TextEnvelopeCddlError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TextEnvelopeCddlError -> m TextEnvelopeCddlError
Data)

textEnvelopeErrorToTextEnvelopeCddlError :: TextEnvelopeError -> TextEnvelopeCddlError
textEnvelopeErrorToTextEnvelopeCddlError :: TextEnvelopeError -> TextEnvelopeCddlError
textEnvelopeErrorToTextEnvelopeCddlError = \case
  TextEnvelopeTypeError [TextEnvelopeType]
expectedTypes TextEnvelopeType
actualType ->
    [Text] -> Text -> TextEnvelopeCddlError
TextEnvelopeCddlTypeError
      ((TextEnvelopeType -> Text) -> [TextEnvelopeType] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text)
-> (TextEnvelopeType -> String) -> TextEnvelopeType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelopeType -> String
forall a. Show a => a -> String
show) [TextEnvelopeType]
expectedTypes)
      (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TextEnvelopeType -> String
forall a. Show a => a -> String
show TextEnvelopeType
actualType)
  TextEnvelopeDecodeError DecoderError
decoderError -> DecoderError -> TextEnvelopeCddlError
TextEnvelopeCddlErrCBORDecodingError DecoderError
decoderError
  TextEnvelopeAesonDecodeError String
errorString -> String -> String -> TextEnvelopeCddlError
TextEnvelopeCddlAesonDecodeError String
"" String
errorString

instance Error TextEnvelopeCddlError where
  prettyError :: forall ann. TextEnvelopeCddlError -> Doc ann
prettyError = \case
    TextEnvelopeCddlErrCBORDecodingError DecoderError
decoderError ->
      Doc ann
"TextEnvelopeCDDL CBOR decoding error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow DecoderError
decoderError
    TextEnvelopeCddlAesonDecodeError String
fp String
aesonErr ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Could not JSON decode TextEnvelopeCddl file at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp
        , Doc ann
" Error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
aesonErr
        ]
    TextEnvelopeCddlError
TextEnvelopeCddlUnknownKeyWitness ->
      Doc ann
"Unknown key witness specified"
    TextEnvelopeCddlTypeError [Text]
expTypes Text
actType ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"TextEnvelopeCddl type error: "
        , Doc ann
" Expected one of: "
        , [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
List.intersperse Doc ann
", " ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Text]
expTypes)
        , Doc ann
" Actual: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
actType
        ]
    TextEnvelopeCddlErrUnknownType Text
unknownType ->
      Doc ann
"Unknown TextEnvelopeCddl type: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
unknownType
    TextEnvelopeCddlError
TextEnvelopeCddlErrByronKeyWitnessUnsupported ->
      Doc ann
"TextEnvelopeCddl error: Byron key witnesses are currently unsupported."

{-# DEPRECATED
  serialiseTxLedgerCddl
  "Use 'serialiseToTextEnvelope' from 'Cardano.Api.SerialiseTextEnvelope' instead."
  #-}
serialiseTxLedgerCddl :: ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxLedgerCddl :: forall era. ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxLedgerCddl ShelleyBasedEra era
era Tx era
tx =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era ((ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope)
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall a b. (a -> b) -> a -> b
$
    (Maybe TextEnvelopeDescr -> Tx era -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (String -> TextEnvelopeDescr
TextEnvelopeDescr String
"Ledger Cddl Format")) Tx era
tx)
      { teType = TextEnvelopeType $ T.unpack $ genType tx
      }
 where
  genType :: Tx era -> Text
  genType :: forall era. Tx era -> Text
genType Tx era
tx' = case Tx era -> [KeyWitness era]
forall era. Tx era -> [KeyWitness era]
getTxWitnesses Tx era
tx' of
    [] -> Text
"Unwitnessed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
genTxType
    [KeyWitness era]
_ -> Text
"Witnessed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
genTxType
  genTxType :: Text
  genTxType :: Text
genTxType =
    case ShelleyBasedEra era
era of
      ShelleyBasedEra era
ShelleyBasedEraShelley -> Text
"Tx ShelleyEra"
      ShelleyBasedEra era
ShelleyBasedEraAllegra -> Text
"Tx AllegraEra"
      ShelleyBasedEra era
ShelleyBasedEraMary -> Text
"Tx MaryEra"
      ShelleyBasedEra era
ShelleyBasedEraAlonzo -> Text
"Tx AlonzoEra"
      ShelleyBasedEra era
ShelleyBasedEraBabbage -> Text
"Tx BabbageEra"
      ShelleyBasedEra era
ShelleyBasedEraConway -> Text
"Tx ConwayEra"

{-# DEPRECATED
  deserialiseTxLedgerCddl
  "Use 'deserialiseFromTextEnvelope' from 'Cardano.Api.SerialiseTextEnvelope' instead."
  #-}
deserialiseTxLedgerCddl
  :: forall era
   . ShelleyBasedEra era
  -> TextEnvelope
  -> Either TextEnvelopeError (Tx era)
deserialiseTxLedgerCddl :: forall era.
ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeError (Tx era)
deserialiseTxLedgerCddl ShelleyBasedEra era
era =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    TextEnvelope -> Either TextEnvelopeError (Tx era))
-> TextEnvelope
-> Either TextEnvelopeError (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era ((ShelleyBasedEraConstraints era =>
  TextEnvelope -> Either TextEnvelopeError (Tx era))
 -> TextEnvelope -> Either TextEnvelopeError (Tx era))
-> (ShelleyBasedEraConstraints era =>
    TextEnvelope -> Either TextEnvelopeError (Tx era))
-> TextEnvelope
-> Either TextEnvelopeError (Tx era)
forall a b. (a -> b) -> a -> b
$ AsType (Tx era)
-> TextEnvelope -> Either TextEnvelopeError (Tx era)
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope AsType (Tx era)
asType
 where
  asType :: AsType (Tx era)
  asType :: AsType (Tx era)
asType = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => AsType (Tx era))
-> AsType (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era ((ShelleyBasedEraConstraints era => AsType (Tx era))
 -> AsType (Tx era))
-> (ShelleyBasedEraConstraints era => AsType (Tx era))
-> AsType (Tx era)
forall a b. (a -> b) -> a -> b
$ Proxy (Tx era) -> AsType (Tx era)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy (Tx era)
forall {k} (t :: k). Proxy t
Proxy

writeByronTxFileTextEnvelopeCddl
  :: File content Out
  -> Byron.ATxAux ByteString
  -> IO (Either (FileError ()) ())
writeByronTxFileTextEnvelopeCddl :: forall content.
File content 'Out
-> ATxAux ByteString -> IO (Either (FileError ()) ())
writeByronTxFileTextEnvelopeCddl File content 'Out
path ATxAux ByteString
w =
  ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ()))
-> ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ do
    (IOException -> FileError ())
-> IO () -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError (File content 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'Out
path)) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile (File content 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'Out
path) ByteString
txJson
 where
  txJson :: ByteString
txJson = Config -> TextEnvelope -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
textEnvelopeCddlJSONConfig (ATxAux ByteString -> TextEnvelope
serializeByronTx ATxAux ByteString
w) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"

serializeByronTx :: Byron.ATxAux ByteString -> TextEnvelope
serializeByronTx :: ATxAux ByteString -> TextEnvelope
serializeByronTx ATxAux ByteString
tx =
  TextEnvelope
    { teType :: TextEnvelopeType
teType = TextEnvelopeType
"Tx ByronEra"
    , teDescription :: TextEnvelopeDescr
teDescription = TextEnvelopeDescr
"Ledger Cddl Format"
    , teRawCBOR :: ByteString
teRawCBOR = ATxAux ByteString -> ByteString
forall t. Decoded t => t -> ByteString
CBOR.recoverBytes ATxAux ByteString
tx
    }

deserialiseByronTxCddl :: TextEnvelope -> Either TextEnvelopeCddlError (Byron.ATxAux ByteString)
deserialiseByronTxCddl :: TextEnvelope -> Either TextEnvelopeCddlError (ATxAux ByteString)
deserialiseByronTxCddl TextEnvelope
tec =
  (DecoderError -> TextEnvelopeCddlError)
-> Either DecoderError (ATxAux ByteString)
-> Either TextEnvelopeCddlError (ATxAux ByteString)
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 DecoderError -> TextEnvelopeCddlError
TextEnvelopeCddlErrCBORDecodingError (Either DecoderError (ATxAux ByteString)
 -> Either TextEnvelopeCddlError (ATxAux ByteString))
-> Either DecoderError (ATxAux ByteString)
-> Either TextEnvelopeCddlError (ATxAux ByteString)
forall a b. (a -> b) -> a -> b
$
    Version
-> Text
-> (forall s. Decoder s (ATxAux ByteSpan))
-> ByteString
-> Either DecoderError (ATxAux ByteString)
forall (f :: * -> *).
Functor f =>
Version
-> Text
-> (forall s. Decoder s (f ByteSpan))
-> ByteString
-> Either DecoderError (f ByteString)
CBOR.decodeFullAnnotatedBytes
      Version
CBOR.byronProtVer
      Text
"Byron Tx"
      Decoder s (ATxAux ByteSpan)
forall s. Decoder s (ATxAux ByteSpan)
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
      (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TextEnvelope -> ByteString
teRawCBOR TextEnvelope
tec)

serialiseWitnessLedgerCddl :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
serialiseWitnessLedgerCddl :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
serialiseWitnessLedgerCddl ShelleyBasedEra era
sbe KeyWitness era
kw =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope)
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall a b. (a -> b) -> a -> b
$
    Maybe TextEnvelopeDescr -> KeyWitness era -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (String -> TextEnvelopeDescr
TextEnvelopeDescr (String -> TextEnvelopeDescr) -> String -> TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ KeyWitness era -> Text
genDesc KeyWitness era
kw)) KeyWitness era
kw
 where
  genDesc :: KeyWitness era -> Text
  genDesc :: KeyWitness era -> Text
genDesc ByronKeyWitness{} = case ShelleyBasedEra era
sbe of {}
  genDesc ShelleyBootstrapWitness{} = Text
"Key BootstrapWitness ShelleyEra"
  genDesc ShelleyKeyWitness{} = Text
"Key Witness ShelleyEra"

deserialiseWitnessLedgerCddl
  :: forall era
   . ShelleyBasedEra era
  -> TextEnvelope
  -> Either TextEnvelopeCddlError (KeyWitness era)
deserialiseWitnessLedgerCddl :: forall era.
ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeCddlError (KeyWitness era)
deserialiseWitnessLedgerCddl ShelleyBasedEra era
sbe TextEnvelope
te =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either TextEnvelopeCddlError (KeyWitness era))
-> Either TextEnvelopeCddlError (KeyWitness era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either TextEnvelopeCddlError (KeyWitness era))
 -> Either TextEnvelopeCddlError (KeyWitness era))
-> (ShelleyBasedEraConstraints era =>
    Either TextEnvelopeCddlError (KeyWitness era))
-> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
    TextEnvelope
-> Either TextEnvelopeCddlError (KeyWitness era)
-> Either TextEnvelopeCddlError (KeyWitness era)
legacyDecoding TextEnvelope
te (Either TextEnvelopeCddlError (KeyWitness era)
 -> Either TextEnvelopeCddlError (KeyWitness era))
-> Either TextEnvelopeCddlError (KeyWitness era)
-> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
      (TextEnvelopeError -> TextEnvelopeCddlError)
-> Either TextEnvelopeError (KeyWitness era)
-> Either TextEnvelopeCddlError (KeyWitness era)
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft TextEnvelopeError -> TextEnvelopeCddlError
textEnvelopeErrorToTextEnvelopeCddlError (Either TextEnvelopeError (KeyWitness era)
 -> Either TextEnvelopeCddlError (KeyWitness era))
-> Either TextEnvelopeError (KeyWitness era)
-> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
        AsType (KeyWitness era)
-> TextEnvelope -> Either TextEnvelopeError (KeyWitness era)
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope AsType (KeyWitness era)
asType TextEnvelope
te
 where
  asType :: AsType (KeyWitness era)
  asType :: AsType (KeyWitness era)
asType = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => AsType (KeyWitness era))
-> AsType (KeyWitness era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => AsType (KeyWitness era))
 -> AsType (KeyWitness era))
-> (ShelleyBasedEraConstraints era => AsType (KeyWitness era))
-> AsType (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ Proxy (KeyWitness era) -> AsType (KeyWitness era)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy (KeyWitness era)
forall {k} (t :: k). Proxy t
Proxy

  -- \| This wrapper ensures that we can still decode the key witness
  -- that were serialized before we migrated to using 'serialiseToTextEnvelope'
  legacyDecoding
    :: TextEnvelope
    -> Either TextEnvelopeCddlError (KeyWitness era)
    -> Either TextEnvelopeCddlError (KeyWitness era)
  legacyDecoding :: TextEnvelope
-> Either TextEnvelopeCddlError (KeyWitness era)
-> Either TextEnvelopeCddlError (KeyWitness era)
legacyDecoding TextEnvelope{TextEnvelopeDescr
teDescription :: TextEnvelope -> TextEnvelopeDescr
teDescription :: TextEnvelopeDescr
teDescription, ByteString
teRawCBOR :: TextEnvelope -> ByteString
teRawCBOR :: ByteString
teRawCBOR} (Left (TextEnvelopeCddlErrCBORDecodingError DecoderError
_)) =
    case TextEnvelopeDescr
teDescription of
      TextEnvelopeDescr
"Key BootstrapWitness ShelleyEra" -> do
        BootstrapWitness StandardCrypto
w <-
          (DecoderError -> TextEnvelopeCddlError)
-> Either DecoderError (BootstrapWitness StandardCrypto)
-> Either TextEnvelopeCddlError (BootstrapWitness StandardCrypto)
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 DecoderError -> TextEnvelopeCddlError
TextEnvelopeCddlErrCBORDecodingError (Either DecoderError (BootstrapWitness StandardCrypto)
 -> Either TextEnvelopeCddlError (BootstrapWitness StandardCrypto))
-> Either DecoderError (BootstrapWitness StandardCrypto)
-> Either TextEnvelopeCddlError (BootstrapWitness StandardCrypto)
forall a b. (a -> b) -> a -> b
$
            Version
-> Text
-> (forall s.
    Decoder s (Annotator (BootstrapWitness StandardCrypto)))
-> ByteString
-> Either DecoderError (BootstrapWitness StandardCrypto)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
              (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerLow ShelleyBasedEra era
sbe)
              Text
"Shelley Witness"
              Decoder s (Annotator (BootstrapWitness StandardCrypto))
forall s. Decoder s (Annotator (BootstrapWitness StandardCrypto))
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
              (ByteString -> ByteString
LBS.fromStrict ByteString
teRawCBOR)
        KeyWitness era -> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era -> Either TextEnvelopeCddlError (KeyWitness era))
-> KeyWitness era -> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> BootstrapWitness StandardCrypto -> KeyWitness era
forall era.
ShelleyBasedEra era
-> BootstrapWitness StandardCrypto -> KeyWitness era
ShelleyBootstrapWitness ShelleyBasedEra era
sbe BootstrapWitness StandardCrypto
w
      TextEnvelopeDescr
"Key Witness ShelleyEra" -> do
        WitVKey 'Witness StandardCrypto
w <-
          (DecoderError -> TextEnvelopeCddlError)
-> Either DecoderError (WitVKey 'Witness StandardCrypto)
-> Either TextEnvelopeCddlError (WitVKey 'Witness StandardCrypto)
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 DecoderError -> TextEnvelopeCddlError
TextEnvelopeCddlErrCBORDecodingError (Either DecoderError (WitVKey 'Witness StandardCrypto)
 -> Either TextEnvelopeCddlError (WitVKey 'Witness StandardCrypto))
-> Either DecoderError (WitVKey 'Witness StandardCrypto)
-> Either TextEnvelopeCddlError (WitVKey 'Witness StandardCrypto)
forall a b. (a -> b) -> a -> b
$
            Version
-> Text
-> (forall s.
    Decoder s (Annotator (WitVKey 'Witness StandardCrypto)))
-> ByteString
-> Either DecoderError (WitVKey 'Witness StandardCrypto)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
              (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerLow ShelleyBasedEra era
sbe)
              Text
"Shelley Witness"
              Decoder s (Annotator (WitVKey 'Witness StandardCrypto))
forall s. Decoder s (Annotator (WitVKey 'Witness StandardCrypto))
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
              (ByteString -> ByteString
LBS.fromStrict ByteString
teRawCBOR)
        KeyWitness era -> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era -> Either TextEnvelopeCddlError (KeyWitness era))
-> KeyWitness era -> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
ShelleyKeyWitness ShelleyBasedEra era
sbe WitVKey 'Witness StandardCrypto
w
      TextEnvelopeDescr
_ -> TextEnvelopeCddlError
-> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. a -> Either a b
Left TextEnvelopeCddlError
TextEnvelopeCddlUnknownKeyWitness
  legacyDecoding TextEnvelope
_ Either TextEnvelopeCddlError (KeyWitness era)
v = Either TextEnvelopeCddlError (KeyWitness era)
v

writeTxFileTextEnvelopeCddl
  :: ()
  => ShelleyBasedEra era
  -> File content Out
  -> Tx era
  -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl :: forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl ShelleyBasedEra era
era File content 'Out
path Tx era
tx =
  ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ()))
-> ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ do
    (IOException -> FileError ())
-> IO () -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError (File content 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'Out
path)) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile (File content 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'Out
path) ByteString
txJson
 where
  txJson :: ByteString
txJson = Config -> TextEnvelope -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
textEnvelopeCddlJSONConfig (ShelleyBasedEra era -> Tx era -> TextEnvelope
forall era. ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxLedgerCddl ShelleyBasedEra era
era Tx era
tx) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"

writeTxWitnessFileTextEnvelopeCddl
  :: ShelleyBasedEra era
  -> File () Out
  -> KeyWitness era
  -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelopeCddl :: forall era.
ShelleyBasedEra era
-> File () 'Out -> KeyWitness era -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelopeCddl ShelleyBasedEra era
sbe File () 'Out
path KeyWitness era
w =
  ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ()))
-> ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ do
    (IOException -> FileError ())
-> IO () -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError (File () 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'Out
path)) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile (File () 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'Out
path) ByteString
txJson
 where
  txJson :: ByteString
txJson = Config -> TextEnvelope -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
textEnvelopeCddlJSONConfig (ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
serialiseWitnessLedgerCddl ShelleyBasedEra era
sbe KeyWitness era
w) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"

textEnvelopeCddlJSONConfig :: Config
textEnvelopeCddlJSONConfig :: Config
textEnvelopeCddlJSONConfig =
  Config
defConfig{confCompare = textEnvelopeCddlJSONKeyOrder}

textEnvelopeCddlJSONKeyOrder :: Text -> Text -> Ordering
textEnvelopeCddlJSONKeyOrder :: Text -> Text -> Ordering
textEnvelopeCddlJSONKeyOrder = [Text] -> Text -> Text -> Ordering
keyOrder [Text
"type", Text
"description", Text
"cborHex"]

-- | This GADT allows us to deserialise a tx or key witness without
-- having to provide the era.
data FromSomeTypeCDDL c b where
  FromCDDLTx
    :: Text
    -- ^ CDDL type that we want
    -> (InAnyShelleyBasedEra Tx -> b)
    -> FromSomeTypeCDDL TextEnvelope b
  FromCDDLWitness
    :: Text
    -- ^ CDDL type that we want
    -> (InAnyShelleyBasedEra KeyWitness -> b)
    -> FromSomeTypeCDDL TextEnvelope b

deserialiseFromTextEnvelopeCddlAnyOf
  :: [FromSomeTypeCDDL TextEnvelope b]
  -> TextEnvelope
  -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf :: forall b.
[FromSomeTypeCDDL TextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelope b]
types TextEnvelope
teCddl =
  case (FromSomeTypeCDDL TextEnvelope b -> Bool)
-> [FromSomeTypeCDDL TextEnvelope b]
-> Maybe (FromSomeTypeCDDL TextEnvelope b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find FromSomeTypeCDDL TextEnvelope b -> Bool
forall b. FromSomeTypeCDDL TextEnvelope b -> Bool
matching [FromSomeTypeCDDL TextEnvelope b]
types of
    Maybe (FromSomeTypeCDDL TextEnvelope b)
Nothing ->
      TextEnvelopeCddlError -> Either TextEnvelopeCddlError b
forall a b. a -> Either a b
Left ([Text] -> Text -> TextEnvelopeCddlError
TextEnvelopeCddlTypeError [Text]
expectedTypes Text
actualType)
    Just (FromCDDLTx Text
ttoken InAnyShelleyBasedEra Tx -> b
f) -> do
      AnyShelleyBasedEra ShelleyBasedEra era
era <- Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra
cddlTypeToEra Text
ttoken
      InAnyShelleyBasedEra Tx -> b
f (InAnyShelleyBasedEra Tx -> b)
-> (Tx era -> InAnyShelleyBasedEra Tx) -> Tx era -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> Tx era -> InAnyShelleyBasedEra Tx
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra era
era
        (Tx era -> b)
-> Either TextEnvelopeCddlError (Tx era)
-> Either TextEnvelopeCddlError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TextEnvelopeError -> TextEnvelopeCddlError)
-> Either TextEnvelopeError (Tx era)
-> Either TextEnvelopeCddlError (Tx era)
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft TextEnvelopeError -> TextEnvelopeCddlError
textEnvelopeErrorToTextEnvelopeCddlError (ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeError (Tx era)
forall era.
ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeError (Tx era)
deserialiseTxLedgerCddl ShelleyBasedEra era
era TextEnvelope
teCddl)
    Just (FromCDDLWitness Text
ttoken InAnyShelleyBasedEra KeyWitness -> b
f) -> do
      AnyShelleyBasedEra ShelleyBasedEra era
era <- Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra
cddlTypeToEra Text
ttoken
      InAnyShelleyBasedEra KeyWitness -> b
f (InAnyShelleyBasedEra KeyWitness -> b)
-> (KeyWitness era -> InAnyShelleyBasedEra KeyWitness)
-> KeyWitness era
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> KeyWitness era -> InAnyShelleyBasedEra KeyWitness
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra era
era (KeyWitness era -> b)
-> Either TextEnvelopeCddlError (KeyWitness era)
-> Either TextEnvelopeCddlError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeCddlError (KeyWitness era)
forall era.
ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeCddlError (KeyWitness era)
deserialiseWitnessLedgerCddl ShelleyBasedEra era
era TextEnvelope
teCddl
 where
  actualType :: Text
  actualType :: Text
actualType = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TextEnvelopeType -> String
forall a. Show a => a -> String
show (TextEnvelopeType -> String) -> TextEnvelopeType -> String
forall a b. (a -> b) -> a -> b
$ TextEnvelope -> TextEnvelopeType
teType TextEnvelope
teCddl

  expectedTypes :: [Text]
  expectedTypes :: [Text]
expectedTypes = [Text
typ | FromCDDLTx Text
typ InAnyShelleyBasedEra Tx -> b
_f <- [FromSomeTypeCDDL TextEnvelope b]
types]

  matching :: FromSomeTypeCDDL TextEnvelope b -> Bool
  matching :: forall b. FromSomeTypeCDDL TextEnvelope b -> Bool
matching (FromCDDLTx Text
ttoken InAnyShelleyBasedEra Tx -> b
_f) = String -> TextEnvelopeType
TextEnvelopeType (Text -> String
T.unpack Text
ttoken) TextEnvelopeType -> TextEnvelopeType -> Bool
`legacyComparison` TextEnvelope -> TextEnvelopeType
teType TextEnvelope
teCddl
  matching (FromCDDLWitness Text
ttoken InAnyShelleyBasedEra KeyWitness -> b
_f) = String -> TextEnvelopeType
TextEnvelopeType (Text -> String
T.unpack Text
ttoken) TextEnvelopeType -> TextEnvelopeType -> Bool
`legacyComparison` TextEnvelope -> TextEnvelopeType
teType TextEnvelope
teCddl

-- Parse the text into types because this will increase code readability and
-- will make it easier to keep track of the different Cddl descriptions via
-- a single sum data type.
cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra
cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra
cddlTypeToEra =
  \case
    Text
"TxSignedShelley" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    Text
"Tx AllegraEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    Text
"Tx MaryEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    Text
"Tx AlonzoEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    Text
"Tx BabbageEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    Text
"Tx ConwayEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    Text
"Witnessed Tx ShelleyEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    Text
"Witnessed Tx AllegraEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    Text
"Witnessed Tx MaryEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    Text
"Witnessed Tx AlonzoEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    Text
"Witnessed Tx BabbageEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    Text
"Witnessed Tx ConwayEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    Text
"Unwitnessed Tx ShelleyEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    Text
"Unwitnessed Tx AllegraEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    Text
"Unwitnessed Tx MaryEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    Text
"Unwitnessed Tx AlonzoEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    Text
"Unwitnessed Tx BabbageEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    Text
"Unwitnessed Tx ConwayEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    Text
"TxWitness ShelleyEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    Text
"TxWitness AllegraEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    Text
"TxWitness MaryEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    Text
"TxWitness AlonzoEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    Text
"TxWitness BabbageEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    Text
"TxWitness ConwayEra" -> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a. a -> Either TextEnvelopeCddlError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyShelleyBasedEra
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> AnyShelleyBasedEra
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    Text
unknownCddlType -> TextEnvelopeCddlError
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. a -> Either a b
Left (TextEnvelopeCddlError
 -> Either TextEnvelopeCddlError AnyShelleyBasedEra)
-> TextEnvelopeCddlError
-> Either TextEnvelopeCddlError AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ Text -> TextEnvelopeCddlError
TextEnvelopeCddlErrUnknownType Text
unknownCddlType

readFileTextEnvelopeCddlAnyOf
  :: [FromSomeTypeCDDL TextEnvelope b]
  -> FilePath
  -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf :: forall b.
[FromSomeTypeCDDL TextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelope b]
types String
path =
  ExceptT (FileError TextEnvelopeCddlError) IO b
-> IO (Either (FileError TextEnvelopeCddlError) b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeCddlError) IO b
 -> IO (Either (FileError TextEnvelopeCddlError) b))
-> ExceptT (FileError TextEnvelopeCddlError) IO b
-> IO (Either (FileError TextEnvelopeCddlError) b)
forall a b. (a -> b) -> a -> b
$ do
    TextEnvelope
te <- IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
 -> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope)
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
forall a b. (a -> b) -> a -> b
$ String
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
readTextEnvelopeCddlFromFile String
path
    (TextEnvelopeCddlError -> FileError TextEnvelopeCddlError)
-> ExceptT TextEnvelopeCddlError IO b
-> ExceptT (FileError TextEnvelopeCddlError) IO b
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeCddlError -> FileError TextEnvelopeCddlError
forall e. String -> e -> FileError e
FileError String
path) (ExceptT TextEnvelopeCddlError IO b
 -> ExceptT (FileError TextEnvelopeCddlError) IO b)
-> ExceptT TextEnvelopeCddlError IO b
-> ExceptT (FileError TextEnvelopeCddlError) IO b
forall a b. (a -> b) -> a -> b
$ Either TextEnvelopeCddlError b
-> ExceptT TextEnvelopeCddlError IO b
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TextEnvelopeCddlError b
 -> ExceptT TextEnvelopeCddlError IO b)
-> Either TextEnvelopeCddlError b
-> ExceptT TextEnvelopeCddlError IO b
forall a b. (a -> b) -> a -> b
$ do
      [FromSomeTypeCDDL TextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeCddlError b
forall b.
[FromSomeTypeCDDL TextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelope b]
types TextEnvelope
te

readTextEnvelopeCddlFromFile
  :: FilePath
  -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
readTextEnvelopeCddlFromFile :: String
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
readTextEnvelopeCddlFromFile String
path =
  ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
 -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope))
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelope)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- String
-> (String -> IO ByteString)
-> ExceptT (FileError TextEnvelopeCddlError) IO ByteString
forall (m :: * -> *) s e.
MonadIO m =>
String -> (String -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT String
path String -> IO ByteString
readFileBlocking
    (String -> FileError TextEnvelopeCddlError)
-> ExceptT String IO TextEnvelope
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeCddlError -> FileError TextEnvelopeCddlError
forall e. String -> e -> FileError e
FileError String
path (TextEnvelopeCddlError -> FileError TextEnvelopeCddlError)
-> (String -> TextEnvelopeCddlError)
-> String
-> FileError TextEnvelopeCddlError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> TextEnvelopeCddlError
TextEnvelopeCddlAesonDecodeError String
path)
      (ExceptT String IO TextEnvelope
 -> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope)
-> (Either String TextEnvelope -> ExceptT String IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String TextEnvelope -> ExceptT String IO TextEnvelope
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
      (Either String TextEnvelope
 -> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelope
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs