{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

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

  -- * Reading one of several transaction or
  -- key witness types
  , readFileTextEnvelopeCddlAnyOf

  , writeTxFileTextEnvelopeCddl
  , writeTxWitnessFileTextEnvelopeCddl

  -- Exported for testing
  , serialiseTxLedgerCddl
  , deserialiseTxLedgerCddl
  , serialiseWitnessLedgerCddl
  , deserialiseWitnessLedgerCddl
  )
  where

import           Prelude

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither,
                   newExceptT, runExceptT)
import           Data.Aeson
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 as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as List
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import           Cardano.Binary (DecoderError)
import qualified Cardano.Binary as CBOR

import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.Tx


-- 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 TextEnvelopeCddl = TextEnvelopeCddl
  { TextEnvelopeCddl -> Text
teCddlType :: !Text
  , TextEnvelopeCddl -> Text
teCddlDescription :: !Text
  , TextEnvelopeCddl -> ByteString
teCddlRawCBOR :: !ByteString
  } deriving (TextEnvelopeCddl -> TextEnvelopeCddl -> Bool
(TextEnvelopeCddl -> TextEnvelopeCddl -> Bool)
-> (TextEnvelopeCddl -> TextEnvelopeCddl -> Bool)
-> Eq TextEnvelopeCddl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextEnvelopeCddl -> TextEnvelopeCddl -> Bool
$c/= :: TextEnvelopeCddl -> TextEnvelopeCddl -> Bool
== :: TextEnvelopeCddl -> TextEnvelopeCddl -> Bool
$c== :: TextEnvelopeCddl -> TextEnvelopeCddl -> Bool
Eq, Int -> TextEnvelopeCddl -> ShowS
[TextEnvelopeCddl] -> ShowS
TextEnvelopeCddl -> String
(Int -> TextEnvelopeCddl -> ShowS)
-> (TextEnvelopeCddl -> String)
-> ([TextEnvelopeCddl] -> ShowS)
-> Show TextEnvelopeCddl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextEnvelopeCddl] -> ShowS
$cshowList :: [TextEnvelopeCddl] -> ShowS
show :: TextEnvelopeCddl -> String
$cshow :: TextEnvelopeCddl -> String
showsPrec :: Int -> TextEnvelopeCddl -> ShowS
$cshowsPrec :: Int -> TextEnvelopeCddl -> ShowS
Show)

instance ToJSON TextEnvelopeCddl where
  toJSON :: TextEnvelopeCddl -> Value
toJSON TextEnvelopeCddl {Text
teCddlType :: Text
teCddlType :: TextEnvelopeCddl -> Text
teCddlType, Text
teCddlDescription :: Text
teCddlDescription :: TextEnvelopeCddl -> Text
teCddlDescription, ByteString
teCddlRawCBOR :: ByteString
teCddlRawCBOR :: TextEnvelopeCddl -> ByteString
teCddlRawCBOR} =
    [Pair] -> Value
object [ Key
"type"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
teCddlType
           , Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
teCddlDescription
           , Key
"cborHex"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
Base16.encode ByteString
teCddlRawCBOR)
           ]

instance FromJSON TextEnvelopeCddl where
  parseJSON :: Value -> Parser TextEnvelopeCddl
parseJSON = String
-> (Object -> Parser TextEnvelopeCddl)
-> Value
-> Parser TextEnvelopeCddl
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TextEnvelopeCddl" ((Object -> Parser TextEnvelopeCddl)
 -> Value -> Parser TextEnvelopeCddl)
-> (Object -> Parser TextEnvelopeCddl)
-> Value
-> Parser TextEnvelopeCddl
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                Text -> Text -> ByteString -> TextEnvelopeCddl
TextEnvelopeCddl (Text -> Text -> ByteString -> TextEnvelopeCddl)
-> Parser Text -> Parser (Text -> ByteString -> TextEnvelopeCddl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type")
                                 Parser (Text -> ByteString -> TextEnvelopeCddl)
-> Parser Text -> Parser (ByteString -> TextEnvelopeCddl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description")
                                 Parser (ByteString -> TextEnvelopeCddl)
-> Parser ByteString -> Parser TextEnvelopeCddl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser ByteString
parseJSONBase16 (Value -> Parser ByteString) -> Parser Value -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cborHex")
    where
      parseJSONBase16 :: Value -> Parser ByteString
parseJSONBase16 Value
v =
        (String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ByteString -> Parser ByteString)
-> (Text -> Either String ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v


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
showList :: [TextEnvelopeCddlError] -> ShowS
$cshowList :: [TextEnvelopeCddlError] -> ShowS
show :: TextEnvelopeCddlError -> String
$cshow :: TextEnvelopeCddlError -> String
showsPrec :: Int -> TextEnvelopeCddlError -> ShowS
$cshowsPrec :: Int -> TextEnvelopeCddlError -> ShowS
Show, TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
(TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool)
-> (TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool)
-> Eq TextEnvelopeCddlError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
$c/= :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
== :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
$c== :: TextEnvelopeCddlError -> TextEnvelopeCddlError -> Bool
Eq)

instance Error TextEnvelopeCddlError where
  displayError :: TextEnvelopeCddlError -> String
displayError (TextEnvelopeCddlErrCBORDecodingError DecoderError
decoderError) =
    String
"TextEnvelopeCDDL CBOR decoding error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
decoderError
  displayError (TextEnvelopeCddlAesonDecodeError String
fp String
aesonErr) =
    String
"Could not JSON decode TextEnvelopeCddl file at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
aesonErr
  displayError TextEnvelopeCddlError
TextEnvelopeCddlUnknownKeyWitness =
    String
"Unknown key witness specified"
  displayError (TextEnvelopeCddlTypeError [Text]
expTypes Text
actType) =
    String
"TextEnvelopeCddl type error: "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Expected one of: "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Text.unpack [Text]
expTypes)
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Actual: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
actType
  displayError (TextEnvelopeCddlErrUnknownType Text
unknownType) =
    String
"Unknown TextEnvelopeCddl type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
unknownType
  displayError TextEnvelopeCddlError
TextEnvelopeCddlErrByronKeyWitnessUnsupported =
    String
"TextEnvelopeCddl error: Byron key witnesses are currently unsupported."

serialiseTxLedgerCddl :: forall era. IsCardanoEra era => Tx era -> TextEnvelopeCddl
serialiseTxLedgerCddl :: Tx era -> TextEnvelopeCddl
serialiseTxLedgerCddl Tx era
tx =
  TextEnvelopeCddl :: Text -> Text -> ByteString -> TextEnvelopeCddl
TextEnvelopeCddl
    { teCddlType :: Text
teCddlType = Tx era -> Text
genType Tx era
tx
    , teCddlDescription :: Text
teCddlDescription = Text
"Ledger Cddl Format"
    , teCddlRawCBOR :: ByteString
teCddlRawCBOR = Tx era -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Tx era
tx
    -- The SerialiseAsCBOR (Tx era) instance serializes to the Cddl format
    }
 where
  genType :: Tx era -> Text
  genType :: 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 CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra :: CardanoEra era of
      CardanoEra era
ByronEra -> Text
"Tx ByronEra"
      CardanoEra era
ShelleyEra -> Text
"Tx ShelleyEra"
      CardanoEra era
AllegraEra -> Text
"Tx AllegraEra"
      CardanoEra era
MaryEra -> Text
"Tx MaryEra"
      CardanoEra era
AlonzoEra -> Text
"Tx AlonzoEra"
      CardanoEra era
BabbageEra -> Text
"Tx BabbageEra"

deserialiseTxLedgerCddl
  :: IsCardanoEra era
  => CardanoEra era
  -> TextEnvelopeCddl
  -> Either TextEnvelopeCddlError (Tx era)
deserialiseTxLedgerCddl :: CardanoEra era
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError (Tx era)
deserialiseTxLedgerCddl CardanoEra era
era TextEnvelopeCddl
tec =
  (DecoderError -> TextEnvelopeCddlError)
-> Either DecoderError (Tx era)
-> Either TextEnvelopeCddlError (Tx era)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TextEnvelopeCddlError
TextEnvelopeCddlErrCBORDecodingError (Either DecoderError (Tx era)
 -> Either TextEnvelopeCddlError (Tx era))
-> (ByteString -> Either DecoderError (Tx era))
-> ByteString
-> Either TextEnvelopeCddlError (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoEra era -> ByteString -> Either DecoderError (Tx era)
forall era.
IsCardanoEra era =>
CardanoEra era -> ByteString -> Either DecoderError (Tx era)
deserialiseTx CardanoEra era
era (ByteString -> Either TextEnvelopeCddlError (Tx era))
-> ByteString -> Either TextEnvelopeCddlError (Tx era)
forall a b. (a -> b) -> a -> b
$ TextEnvelopeCddl -> ByteString
teCddlRawCBOR TextEnvelopeCddl
tec

deserialiseTx
  :: forall era. IsCardanoEra era
  => CardanoEra era
  -> ByteString
  -> Either DecoderError (Tx era)
deserialiseTx :: CardanoEra era -> ByteString -> Either DecoderError (Tx era)
deserialiseTx CardanoEra era
era ByteString
bs =
  case CardanoEra era
era of
    CardanoEra era
ByronEra -> ATxAux ByteString -> Tx ByronEra
ByronTx (ATxAux ByteString -> Tx ByronEra)
-> Either DecoderError (ATxAux ByteString)
-> Either DecoderError (Tx ByronEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (forall s. Decoder s (ATxAux ByteSpan))
-> LByteString
-> Either DecoderError (ATxAux ByteString)
forall (f :: * -> *).
Functor f =>
Text
-> (forall s. Decoder s (f ByteSpan))
-> LByteString
-> Either DecoderError (f ByteString)
CBOR.decodeFullAnnotatedBytes
                              Text
"Byron Tx" forall s. Decoder s (ATxAux ByteSpan)
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> LByteString
LBS.fromStrict ByteString
bs)
    CardanoEra era
_ -> AsType (Tx era) -> ByteString -> Either DecoderError (Tx era)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (AsType era -> AsType (Tx era)
forall era. AsType era -> AsType (Tx era)
AsTx AsType era
ttoken) ByteString
bs
 where
  ttoken :: AsType era
  ttoken :: AsType era
ttoken = Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy era
forall k (t :: k). Proxy t
Proxy

serialiseWitnessLedgerCddl :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelopeCddl
serialiseWitnessLedgerCddl :: ShelleyBasedEra era -> KeyWitness era -> TextEnvelopeCddl
serialiseWitnessLedgerCddl ShelleyBasedEra era
sbe KeyWitness era
kw =
  TextEnvelopeCddl :: Text -> Text -> ByteString -> TextEnvelopeCddl
TextEnvelopeCddl
    { teCddlType :: Text
teCddlType = ShelleyBasedEra era -> Text
witEra ShelleyBasedEra era
sbe
    , teCddlDescription :: Text
teCddlDescription = KeyWitness era -> Text
genDesc KeyWitness era
kw
    , teCddlRawCBOR :: ByteString
teCddlRawCBOR = KeyWitness era -> ByteString
cddlSerialiseWitness KeyWitness era
kw
    }
 where
  cddlSerialiseWitness :: KeyWitness era -> ByteString
  cddlSerialiseWitness :: KeyWitness era -> ByteString
cddlSerialiseWitness (ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness StandardCrypto
wit) = BootstrapWitness StandardCrypto -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' BootstrapWitness StandardCrypto
wit
  cddlSerialiseWitness (ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey 'Witness StandardCrypto
wit) = WitVKey 'Witness StandardCrypto -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' WitVKey 'Witness StandardCrypto
wit
  cddlSerialiseWitness ByronKeyWitness{} = case ShelleyBasedEra era
sbe of {}

  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"

  witEra :: ShelleyBasedEra era -> Text
  witEra :: ShelleyBasedEra era -> Text
witEra ShelleyBasedEra era
ShelleyBasedEraShelley = Text
"TxWitness ShelleyEra"
  witEra ShelleyBasedEra era
ShelleyBasedEraAllegra = Text
"TxWitness AllegraEra"
  witEra ShelleyBasedEra era
ShelleyBasedEraMary = Text
"TxWitness MaryEra"
  witEra ShelleyBasedEra era
ShelleyBasedEraAlonzo = Text
"TxWitness AlonzoEra"
  witEra ShelleyBasedEra era
ShelleyBasedEraBabbage = Text
"TxWitness BabbageEra"

deserialiseWitnessLedgerCddl
  :: ShelleyBasedEra era
  -> TextEnvelopeCddl
  -> Either TextEnvelopeCddlError (KeyWitness era)
deserialiseWitnessLedgerCddl :: ShelleyBasedEra era
-> TextEnvelopeCddl
-> Either TextEnvelopeCddlError (KeyWitness era)
deserialiseWitnessLedgerCddl ShelleyBasedEra era
era TextEnvelopeCddl{ByteString
teCddlRawCBOR :: ByteString
teCddlRawCBOR :: TextEnvelopeCddl -> ByteString
teCddlRawCBOR,Text
teCddlDescription :: Text
teCddlDescription :: TextEnvelopeCddl -> Text
teCddlDescription} =
  --TODO: Parse these 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.
  case Text
teCddlDescription of
    Text
"Key BootstrapWitness ShelleyEra" -> do
      BootstrapWitness StandardCrypto
w <- (DecoderError -> TextEnvelopeCddlError)
-> Either DecoderError (BootstrapWitness StandardCrypto)
-> Either TextEnvelopeCddlError (BootstrapWitness StandardCrypto)
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
$ Text
-> (forall s.
    Decoder s (Annotator (BootstrapWitness StandardCrypto)))
-> LByteString
-> Either DecoderError (BootstrapWitness StandardCrypto)
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
CBOR.decodeAnnotator Text
"Shelley Witness" forall s. Decoder s (Annotator (BootstrapWitness StandardCrypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> LByteString
LBS.fromStrict ByteString
teCddlRawCBOR)
      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
era BootstrapWitness StandardCrypto
w
    Text
"Key Witness ShelleyEra" -> do
      WitVKey 'Witness StandardCrypto
w <- (DecoderError -> TextEnvelopeCddlError)
-> Either DecoderError (WitVKey 'Witness StandardCrypto)
-> Either TextEnvelopeCddlError (WitVKey 'Witness StandardCrypto)
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
$ Text
-> (forall s.
    Decoder s (Annotator (WitVKey 'Witness StandardCrypto)))
-> LByteString
-> Either DecoderError (WitVKey 'Witness StandardCrypto)
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
CBOR.decodeAnnotatorText
"Shelley Witness" forall s. Decoder s (Annotator (WitVKey 'Witness StandardCrypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> LByteString
LBS.fromStrict ByteString
teCddlRawCBOR)
      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
era WitVKey 'Witness StandardCrypto
w
    Text
_ -> TextEnvelopeCddlError
-> Either TextEnvelopeCddlError (KeyWitness era)
forall a b. a -> Either a b
Left TextEnvelopeCddlError
TextEnvelopeCddlUnknownKeyWitness

writeTxFileTextEnvelopeCddl
  :: IsCardanoEra era
  => FilePath
  -> Tx era
  -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl :: String -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl String
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 String
path) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ String -> LByteString -> IO ()
LBS.writeFile String
path LByteString
txJson
 where
  txJson :: LByteString
txJson = Config -> TextEnvelopeCddl -> LByteString
forall a. ToJSON a => Config -> a -> LByteString
encodePretty' Config
textEnvelopeCddlJSONConfig (Tx era -> TextEnvelopeCddl
forall era. IsCardanoEra era => Tx era -> TextEnvelopeCddl
serialiseTxLedgerCddl Tx era
tx) LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> LByteString
"\n"

writeTxWitnessFileTextEnvelopeCddl
  :: ShelleyBasedEra era
  -> FilePath
  -> KeyWitness era
  -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelopeCddl :: ShelleyBasedEra era
-> String -> KeyWitness era -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelopeCddl ShelleyBasedEra era
sbe String
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 String
path) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ String -> LByteString -> IO ()
LBS.writeFile String
path LByteString
txJson
 where
  txJson :: LByteString
txJson = Config -> TextEnvelopeCddl -> LByteString
forall a. ToJSON a => Config -> a -> LByteString
encodePretty' Config
textEnvelopeCddlJSONConfig (ShelleyBasedEra era -> KeyWitness era -> TextEnvelopeCddl
forall era.
ShelleyBasedEra era -> KeyWitness era -> TextEnvelopeCddl
serialiseWitnessLedgerCddl ShelleyBasedEra era
sbe KeyWitness era
w) LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> LByteString
"\n"

textEnvelopeCddlJSONConfig :: Config
textEnvelopeCddlJSONConfig :: Config
textEnvelopeCddlJSONConfig =
  Config
defConfig { confCompare :: Text -> Text -> Ordering
confCompare = Text -> Text -> Ordering
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
    -> (InAnyCardanoEra Tx -> b)
    -> FromSomeTypeCDDL TextEnvelopeCddl b

  FromCDDLWitness
    :: Text -- ^ CDDL type that we want
    -> (InAnyCardanoEra KeyWitness -> b)
    -> FromSomeTypeCDDL TextEnvelopeCddl b

deserialiseFromTextEnvelopeCddlAnyOf
  :: [FromSomeTypeCDDL TextEnvelopeCddl b]
  -> TextEnvelopeCddl
  -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf :: [FromSomeTypeCDDL TextEnvelopeCddl b]
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl b]
types TextEnvelopeCddl
teCddl =
    case (FromSomeTypeCDDL TextEnvelopeCddl b -> Bool)
-> [FromSomeTypeCDDL TextEnvelopeCddl b]
-> Maybe (FromSomeTypeCDDL TextEnvelopeCddl b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find FromSomeTypeCDDL TextEnvelopeCddl b -> Bool
forall b. FromSomeTypeCDDL TextEnvelopeCddl b -> Bool
matching [FromSomeTypeCDDL TextEnvelopeCddl b]
types of
      Maybe (FromSomeTypeCDDL TextEnvelopeCddl 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 InAnyCardanoEra Tx -> b
f) -> do
        AnyCardanoEra CardanoEra era
era <- Text -> Either TextEnvelopeCddlError AnyCardanoEra
cddlTypeToEra Text
ttoken
        InAnyCardanoEra Tx -> b
f (InAnyCardanoEra Tx -> b)
-> (Tx era -> InAnyCardanoEra Tx) -> Tx era -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoEra era -> Tx era -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (Tx era -> b)
-> Either TextEnvelopeCddlError (Tx era)
-> Either TextEnvelopeCddlError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoEra era
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError (Tx era)
forall era.
IsCardanoEra era =>
CardanoEra era
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError (Tx era)
deserialiseTxLedgerCddl CardanoEra era
era TextEnvelopeCddl
teCddl

      Just (FromCDDLWitness Text
ttoken InAnyCardanoEra KeyWitness -> b
f) -> do
         AnyCardanoEra CardanoEra era
era <- Text -> Either TextEnvelopeCddlError AnyCardanoEra
cddlTypeToEra Text
ttoken
         case CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era of
           CardanoEraStyle era
LegacyByronEra -> TextEnvelopeCddlError -> Either TextEnvelopeCddlError b
forall a b. a -> Either a b
Left TextEnvelopeCddlError
TextEnvelopeCddlErrByronKeyWitnessUnsupported
           ShelleyBasedEra ShelleyBasedEra era
sbe ->
             InAnyCardanoEra KeyWitness -> b
f (InAnyCardanoEra KeyWitness -> b)
-> (KeyWitness era -> InAnyCardanoEra KeyWitness)
-> KeyWitness era
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoEra era -> KeyWitness era -> InAnyCardanoEra KeyWitness
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra 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
-> TextEnvelopeCddl
-> Either TextEnvelopeCddlError (KeyWitness era)
forall era.
ShelleyBasedEra era
-> TextEnvelopeCddl
-> Either TextEnvelopeCddlError (KeyWitness era)
deserialiseWitnessLedgerCddl ShelleyBasedEra era
sbe TextEnvelopeCddl
teCddl
  where
   actualType :: Text
   actualType :: Text
actualType = TextEnvelopeCddl -> Text
teCddlType TextEnvelopeCddl
teCddl

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

   matching :: FromSomeTypeCDDL TextEnvelopeCddl b -> Bool
   matching :: FromSomeTypeCDDL TextEnvelopeCddl b -> Bool
matching (FromCDDLTx Text
ttoken InAnyCardanoEra Tx -> b
_f) = Text
actualType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ttoken
   matching (FromCDDLWitness Text
ttoken InAnyCardanoEra KeyWitness -> b
_f)  = Text
actualType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ttoken

-- 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 AnyCardanoEra
cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyCardanoEra
cddlTypeToEra Text
"Witnessed Tx ByronEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
cddlTypeToEra Text
"Witnessed Tx ShelleyEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
cddlTypeToEra Text
"Witnessed Tx AllegraEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
cddlTypeToEra Text
"Witnessed Tx MaryEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
cddlTypeToEra Text
"Witnessed Tx AlonzoEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
cddlTypeToEra Text
"Witnessed Tx BabbageEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra BabbageEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra BabbageEra
BabbageEra
cddlTypeToEra Text
"Unwitnessed Tx ByronEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
cddlTypeToEra Text
"Unwitnessed Tx ShelleyEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
cddlTypeToEra Text
"Unwitnessed Tx AllegraEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
cddlTypeToEra Text
"Unwitnessed Tx MaryEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
cddlTypeToEra Text
"Unwitnessed Tx AlonzoEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
cddlTypeToEra Text
"Unwitnessed Tx BabbageEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra BabbageEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra BabbageEra
BabbageEra
cddlTypeToEra Text
"TxWitness ShelleyEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
cddlTypeToEra Text
"TxWitness AllegraEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
cddlTypeToEra Text
"TxWitness MaryEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
cddlTypeToEra Text
"TxWitness AlonzoEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
cddlTypeToEra Text
"TxWitness BabbageEra" = AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra)
-> AnyCardanoEra -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra BabbageEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra BabbageEra
BabbageEra
cddlTypeToEra Text
unknownCddlType = TextEnvelopeCddlError -> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. a -> Either a b
Left (TextEnvelopeCddlError
 -> Either TextEnvelopeCddlError AnyCardanoEra)
-> TextEnvelopeCddlError
-> Either TextEnvelopeCddlError AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ Text -> TextEnvelopeCddlError
TextEnvelopeCddlErrUnknownType Text
unknownCddlType

readFileTextEnvelopeCddlAnyOf
  :: [FromSomeTypeCDDL TextEnvelopeCddl b]
  -> FilePath
  -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf :: [FromSomeTypeCDDL TextEnvelopeCddl b]
-> String -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl 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
    TextEnvelopeCddl
te <- IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
 -> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl)
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
forall a b. (a -> b) -> a -> b
$ String
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
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 TextEnvelopeCddl b]
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError b
forall b.
[FromSomeTypeCDDL TextEnvelopeCddl b]
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl b]
types TextEnvelopeCddl
te

readTextEnvelopeCddlFromFile
  :: FilePath
  -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
readTextEnvelopeCddlFromFile :: String
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
readTextEnvelopeCddlFromFile String
path =
  ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
 -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl))
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- (IOException -> FileError TextEnvelopeCddlError)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeCddlError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError TextEnvelopeCddlError
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO ByteString
 -> ExceptT (FileError TextEnvelopeCddlError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeCddlError) IO ByteString
forall a b. (a -> b) -> a -> b
$
            String -> IO ByteString
BS.readFile String
path
    (String -> FileError TextEnvelopeCddlError)
-> ExceptT String IO TextEnvelopeCddl
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
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 TextEnvelopeCddl
 -> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl)
-> (Either String TextEnvelopeCddl
    -> ExceptT String IO TextEnvelopeCddl)
-> Either String TextEnvelopeCddl
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String TextEnvelopeCddl
-> ExceptT String IO TextEnvelopeCddl
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String TextEnvelopeCddl
 -> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl)
-> Either String TextEnvelopeCddl
-> ExceptT (FileError TextEnvelopeCddlError) IO TextEnvelopeCddl
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String TextEnvelopeCddl
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs