{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.CLI.Compatible.Transaction.TxOut
  ( mkTxOut
  , toTxOutInAnyEra
  )
where

import Cardano.Api
import Cardano.Api.Experimental.Tx qualified as Exp
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Script.Read.Common
import Cardano.CLI.Orphan ()
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.Ledger.Api.Tx qualified as L
import Cardano.Ledger.Hashes (DataHash)

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Lens.Micro

toTxOutInAnyEra
  :: ShelleyBasedEra era
  -> TxOutAnyEra
  -> CIO e (Exp.TxOut (ShelleyLedgerEra era), Map DataHash (L.Data (ShelleyLedgerEra era)))
toTxOutInAnyEra :: forall era e.
ShelleyBasedEra era
-> TxOutAnyEra
-> CIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
toTxOutInAnyEra ShelleyBasedEra era
era (TxOutAnyEra AddressAny
addr' Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp) = do
  let addr :: AddressInEra era
addr = ShelleyBasedEra era -> AddressAny -> AddressInEra era
forall era. ShelleyBasedEra era -> AddressAny -> AddressInEra era
anyAddressInShelleyBasedEra ShelleyBasedEra era
era AddressAny
addr'
  ShelleyBasedEra era
-> AddressInEra era
-> Value
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> CIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
forall era e.
ShelleyBasedEra era
-> AddressInEra era
-> Value
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> CIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
mkTxOut ShelleyBasedEra era
era AddressInEra era
addr Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp

mkTxOut
  :: ShelleyBasedEra era
  -> AddressInEra era
  -> Value
  -> TxOutDatumAnyEra
  -> ReferenceScriptAnyEra
  -> CIO e (Exp.TxOut (ShelleyLedgerEra era), Map DataHash (L.Data (ShelleyLedgerEra era)))
mkTxOut :: forall era e.
ShelleyBasedEra era
-> AddressInEra era
-> Value
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> CIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
mkTxOut ShelleyBasedEra era
sbe AddressInEra era
addr Value
val' TxOutDatumAnyEra
mDatumAnyEra ReferenceScriptAnyEra
refScriptFp = do
  txVal <- ShelleyBasedEra era -> Value -> CIO e (TxOutValue era)
forall era e.
ShelleyBasedEra era -> Value -> CIO e (TxOutValue era)
toTxOutValueInShelleyBasedEra ShelleyBasedEra era
sbe Value
val'
  let ledgerAddr = AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
addr
  shelleyBasedEraConstraints sbe $
    case txVal of
      TxOutValueShelleyBased ShelleyBasedEra era
_ Value (ShelleyLedgerEra era)
ledgerVal ->
        case ShelleyBasedEra era
sbe of
          ShelleyBasedEra era
ShelleyBasedEraShelley -> (TxOut (ShelleyLedgerEra era),
 Map DataHash (Data (ShelleyLedgerEra era)))
-> RIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut ShelleyEra -> TxOut ShelleyEra
forall era. EraTxOut era => TxOut era -> TxOut era
Exp.TxOut (Addr -> Value ShelleyEra -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut Addr
ledgerAddr Value (ShelleyLedgerEra era)
Value ShelleyEra
ledgerVal), Map DataHash (Data ShelleyEra)
forall a. Monoid a => a
mempty)
          ShelleyBasedEra era
ShelleyBasedEraAllegra -> (TxOut (ShelleyLedgerEra era),
 Map DataHash (Data (ShelleyLedgerEra era)))
-> RIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut AllegraEra -> TxOut AllegraEra
forall era. EraTxOut era => TxOut era -> TxOut era
Exp.TxOut (Addr -> Value AllegraEra -> TxOut AllegraEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut Addr
ledgerAddr Value (ShelleyLedgerEra era)
Value AllegraEra
ledgerVal), Map DataHash (Data AllegraEra)
forall a. Monoid a => a
mempty)
          ShelleyBasedEra era
ShelleyBasedEraMary -> (TxOut (ShelleyLedgerEra era),
 Map DataHash (Data (ShelleyLedgerEra era)))
-> RIO
     e
     (TxOut (ShelleyLedgerEra era),
      Map DataHash (Data (ShelleyLedgerEra era)))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut MaryEra -> TxOut MaryEra
forall era. EraTxOut era => TxOut era -> TxOut era
Exp.TxOut (Addr -> Value MaryEra -> TxOut MaryEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut Addr
ledgerAddr Value (ShelleyLedgerEra era)
Value MaryEra
ledgerVal), Map DataHash (Data MaryEra)
forall a. Monoid a => a
mempty)
          ShelleyBasedEra era
ShelleyBasedEraAlonzo -> do
            (mDH, suppl) <- TxOutDatumAnyEra
-> CIO e (StrictMaybe DataHash, Map DataHash (Data AlonzoEra))
forall ledgerera e.
Era ledgerera =>
TxOutDatumAnyEra
-> CIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera))
alonzoDatumFields TxOutDatumAnyEra
mDatumAnyEra
            pure
              ( Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal & L.dataHashTxOutL .~ mDH)
              , suppl
              )
          ShelleyBasedEra era
ShelleyBasedEraBabbage -> do
            (dat, suppl) <- TxOutDatumAnyEra
-> CIO e (Datum BabbageEra, Map DataHash (Data BabbageEra))
forall ledgerera e.
Era ledgerera =>
TxOutDatumAnyEra
-> CIO e (Datum ledgerera, Map DataHash (Data ledgerera))
babbageDatumFields TxOutDatumAnyEra
mDatumAnyEra
            refScript <- readRefScript sbe refScriptFp
            pure
              ( Exp.TxOut
                  ( L.mkBasicTxOut ledgerAddr ledgerVal
                      & L.datumTxOutL .~ dat
                      & L.referenceScriptTxOutL .~ refScript
                  )
              , suppl
              )
          ShelleyBasedEra era
ShelleyBasedEraConway -> do
            (dat, suppl) <- TxOutDatumAnyEra
-> CIO e (Datum ConwayEra, Map DataHash (Data ConwayEra))
forall ledgerera e.
Era ledgerera =>
TxOutDatumAnyEra
-> CIO e (Datum ledgerera, Map DataHash (Data ledgerera))
babbageDatumFields TxOutDatumAnyEra
mDatumAnyEra
            refScript <- readRefScript sbe refScriptFp
            pure
              ( Exp.TxOut
                  ( L.mkBasicTxOut ledgerAddr ledgerVal
                      & L.datumTxOutL .~ dat
                      & L.referenceScriptTxOutL .~ refScript
                  )
              , suppl
              )

alonzoDatumFields
  :: L.Era ledgerera
  => TxOutDatumAnyEra
  -> CIO e (L.StrictMaybe DataHash, Map DataHash (L.Data ledgerera))
alonzoDatumFields :: forall ledgerera e.
Era ledgerera =>
TxOutDatumAnyEra
-> CIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera))
alonzoDatumFields = \case
  TxOutDatumAnyEra
TxOutDatumByNone ->
    (StrictMaybe DataHash, Map DataHash (Data ledgerera))
-> RIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe DataHash
forall a. StrictMaybe a
L.SNothing, Map DataHash (Data ledgerera)
forall a. Monoid a => a
mempty)
  TxOutDatumByHashOnly Hash ScriptData
h ->
    (StrictMaybe DataHash, Map DataHash (Data ledgerera))
-> RIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
L.SJust (Hash ScriptData -> DataHash
unScriptDataHash Hash ScriptData
h), Map DataHash (Data ledgerera)
forall a. Monoid a => a
mempty)
  TxOutDatumByHashOf ScriptDataOrFile
sDataOrFile -> do
    sData <- ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData
 -> RIO e HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
    pure (L.SJust (unScriptDataHash (hashScriptDataBytes sData)), mempty)
  TxOutDatumByValue ScriptDataOrFile
sDataOrFile -> do
    sData <- ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData
 -> RIO e HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
    let ld = HashableScriptData -> Data ledgerera
forall ledgerera.
Era ledgerera =>
HashableScriptData -> Data ledgerera
toAlonzoData HashableScriptData
sData
        dh = Data ledgerera -> DataHash
forall era. Data era -> DataHash
L.hashData Data ledgerera
ld
    pure (L.SJust dh, Map.singleton dh ld)
  TxOutInlineDatumByValue ScriptDataOrFile
_ ->
    TxCmdTxFeatureMismatch
-> RIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera))
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (TxCmdTxFeatureMismatch
 -> RIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera)))
-> TxCmdTxFeatureMismatch
-> RIO e (StrictMaybe DataHash, Map DataHash (Data ledgerera))
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxFeature -> TxCmdTxFeatureMismatch
TxCmdTxFeatureMismatch (CardanoEra AlonzoEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra) TxFeature
TxFeatureInlineDatums

babbageDatumFields
  :: L.Era ledgerera
  => TxOutDatumAnyEra
  -> CIO e (L.Datum ledgerera, Map DataHash (L.Data ledgerera))
babbageDatumFields :: forall ledgerera e.
Era ledgerera =>
TxOutDatumAnyEra
-> CIO e (Datum ledgerera, Map DataHash (Data ledgerera))
babbageDatumFields = \case
  TxOutDatumAnyEra
TxOutDatumByNone ->
    (Datum ledgerera, Map DataHash (Data ledgerera))
-> RIO e (Datum ledgerera, Map DataHash (Data ledgerera))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Datum ledgerera
forall era. Datum era
L.NoDatum, Map DataHash (Data ledgerera)
forall a. Monoid a => a
mempty)
  TxOutDatumByHashOnly Hash ScriptData
h ->
    (Datum ledgerera, Map DataHash (Data ledgerera))
-> RIO e (Datum ledgerera, Map DataHash (Data ledgerera))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataHash -> Datum ledgerera
forall era. DataHash -> Datum era
L.DatumHash (Hash ScriptData -> DataHash
unScriptDataHash Hash ScriptData
h), Map DataHash (Data ledgerera)
forall a. Monoid a => a
mempty)
  TxOutDatumByHashOf ScriptDataOrFile
sDataOrFile -> do
    sData <- ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData
 -> RIO e HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
    pure (L.DatumHash (unScriptDataHash (hashScriptDataBytes sData)), mempty)
  TxOutDatumByValue ScriptDataOrFile
sDataOrFile -> do
    sData <- ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData
 -> RIO e HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
    let ld = HashableScriptData -> Data ledgerera
forall ledgerera.
Era ledgerera =>
HashableScriptData -> Data ledgerera
toAlonzoData HashableScriptData
sData
        dh = Data ledgerera -> DataHash
forall era. Data era -> DataHash
L.hashData Data ledgerera
ld
    pure (L.DatumHash dh, Map.singleton dh ld)
  TxOutInlineDatumByValue ScriptDataOrFile
sDataOrFile -> do
    sData <- ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData
 -> RIO e HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
    pure (scriptDataToInlineDatum sData, mempty)

readRefScript
  :: ShelleyBasedEra era
  -> ReferenceScriptAnyEra
  -> CIO e (L.StrictMaybe (L.Script (ShelleyLedgerEra era)))
readRefScript :: forall era e.
ShelleyBasedEra era
-> ReferenceScriptAnyEra
-> CIO e (StrictMaybe (Script (ShelleyLedgerEra era)))
readRefScript ShelleyBasedEra era
sbe = \case
  ReferenceScriptAnyEra
ReferenceScriptAnyEraNone -> StrictMaybe (Script (ShelleyLedgerEra era))
-> RIO e (StrictMaybe (Script (ShelleyLedgerEra era)))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (Script (ShelleyLedgerEra era))
forall a. StrictMaybe a
L.SNothing
  ReferenceScriptAnyEra FilePath
fp -> do
    script <- FilePath -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => FilePath -> m ScriptInAnyLang
readFileScriptInAnyLang FilePath
fp
    pure $ maybe L.SNothing (L.SJust . toShelleyScript) (toScriptInEra sbe script)

toTxOutValueInShelleyBasedEra
  :: ShelleyBasedEra era
  -> Value
  -> CIO e (TxOutValue era)
toTxOutValueInShelleyBasedEra :: forall era e.
ShelleyBasedEra era -> Value -> CIO e (TxOutValue era)
toTxOutValueInShelleyBasedEra ShelleyBasedEra era
sbe Value
val =
  CardanoEra era
-> RIO e (TxOutValue era)
-> (MaryEraOnwards era -> RIO e (TxOutValue era))
-> RIO e (TxOutValue era)
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon
    (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyBasedEra era
sbe)
    ( case Value -> Maybe Lovelace
valueToLovelace Value
val of
        Just Lovelace
l -> TxOutValue era -> RIO e (TxOutValue era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyBasedEra era -> Lovelace -> TxOutValue era
forall era. ShelleyBasedEra era -> Lovelace -> TxOutValue era
lovelaceToTxOutValue ShelleyBasedEra era
sbe Lovelace
l)
        Maybe Lovelace
Nothing -> ShelleyBasedEra era -> TxFeature -> CIO e (TxOutValue era)
forall (eon :: * -> *) era e a.
ToCardanoEra eon =>
eon era -> TxFeature -> CIO e a
txFeatureMismatch ShelleyBasedEra era
sbe TxFeature
TxFeatureMultiAssetOutputs
    )
    (\MaryEraOnwards era
w -> MaryEraOnwards era
-> (MaryEraOnwardsConstraints era => RIO e (TxOutValue era))
-> RIO e (TxOutValue era)
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w ((MaryEraOnwardsConstraints era => RIO e (TxOutValue era))
 -> RIO e (TxOutValue era))
-> (MaryEraOnwardsConstraints era => RIO e (TxOutValue era))
-> RIO e (TxOutValue era)
forall a b. (a -> b) -> a -> b
$ TxOutValue era -> RIO e (TxOutValue era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe (MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
forall era.
MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
toLedgerValue MaryEraOnwards era
w Value
val)))

-- | An enumeration of era-dependent features where we have to check that it
-- is permissible to use this feature in this era.
data TxFeature
  = TxFeatureMultiAssetOutputs
  | TxFeatureInlineDatums
  deriving Int -> TxFeature -> ShowS
[TxFeature] -> ShowS
TxFeature -> FilePath
(Int -> TxFeature -> ShowS)
-> (TxFeature -> FilePath)
-> ([TxFeature] -> ShowS)
-> Show TxFeature
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxFeature -> ShowS
showsPrec :: Int -> TxFeature -> ShowS
$cshow :: TxFeature -> FilePath
show :: TxFeature -> FilePath
$cshowList :: [TxFeature] -> ShowS
showList :: [TxFeature] -> ShowS
Show

renderFeature :: TxFeature -> Text
renderFeature :: TxFeature -> Text
renderFeature = \case
  TxFeature
TxFeatureMultiAssetOutputs -> Text
"Multi-Asset outputs"
  TxFeature
TxFeatureInlineDatums -> Text
"Inline datums"

data TxCmdTxFeatureMismatch = TxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature deriving Int -> TxCmdTxFeatureMismatch -> ShowS
[TxCmdTxFeatureMismatch] -> ShowS
TxCmdTxFeatureMismatch -> FilePath
(Int -> TxCmdTxFeatureMismatch -> ShowS)
-> (TxCmdTxFeatureMismatch -> FilePath)
-> ([TxCmdTxFeatureMismatch] -> ShowS)
-> Show TxCmdTxFeatureMismatch
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxCmdTxFeatureMismatch -> ShowS
showsPrec :: Int -> TxCmdTxFeatureMismatch -> ShowS
$cshow :: TxCmdTxFeatureMismatch -> FilePath
show :: TxCmdTxFeatureMismatch -> FilePath
$cshowList :: [TxCmdTxFeatureMismatch] -> ShowS
showList :: [TxCmdTxFeatureMismatch] -> ShowS
Show

instance Error TxCmdTxFeatureMismatch where
  prettyError :: forall ann. TxCmdTxFeatureMismatch -> Doc ann
prettyError (TxCmdTxFeatureMismatch (AnyCardanoEra CardanoEra era
era) TxFeature
feature) =
    Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ TxFeature -> Text
renderFeature TxFeature
feature
        , Text
" cannot be used for "
        , CardanoEra era -> Text
forall a. CardanoEra a -> Text
eraToStringKey CardanoEra era
era
        , Text
" era transactions."
        ]

txFeatureMismatch
  :: ()
  => ToCardanoEra eon
  => eon era
  -> TxFeature
  -> CIO e a
txFeatureMismatch :: forall (eon :: * -> *) era e a.
ToCardanoEra eon =>
eon era -> TxFeature -> CIO e a
txFeatureMismatch eon era
eon TxFeature
feature =
  TxCmdTxFeatureMismatch -> RIO e a
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (TxCmdTxFeatureMismatch -> RIO e a)
-> TxCmdTxFeatureMismatch -> RIO e a
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxFeature -> TxCmdTxFeatureMismatch
TxCmdTxFeatureMismatch (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra (CardanoEra era -> AnyCardanoEra)
-> CardanoEra era -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ eon era -> CardanoEra era
forall era. eon era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra eon era
eon) TxFeature
feature

eraToStringKey :: CardanoEra a -> Text
eraToStringKey :: forall a. CardanoEra a -> Text
eraToStringKey = Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text)
-> (CardanoEra a -> Doc AnsiStyle) -> CardanoEra a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoEra a -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra a -> Doc ann
pretty