{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
module Cardano.CLI.Types
( BalanceTxExecUnits (..)
, CBORObject (..)
, CertificateFile (..)
, CurrentKesPeriod (..)
, EpochLeadershipSchedule (..)
, GenesisFile (..)
, OpCertEndingKesPeriod (..)
, OpCertIntervalInformation (..)
, OpCertOnDiskCounter (..)
, OpCertNodeAndOnDiskCounterInformation (..)
, OpCertNodeStateCounter (..)
, OpCertStartingKesPeriod (..)
, OutputFormat (..)
, TxBuildOutputOptions(..)
, ReferenceScriptAnyEra (..)
, SigningKeyFile (..)
, ScriptFile (..)
, ScriptDataOrFile (..)
, ScriptRedeemerOrFile
, ScriptWitnessFiles (..)
, ScriptDatumOrFile (..)
, SlotsTillKesKeyExpiry (..)
, TransferDirection(..)
, TxBodyFile (..)
, TxOutAnyEra (..)
, TxOutChangeAddress (..)
, TxOutDatumAnyEra (..)
, TxFile (..)
, TxMempoolQuery (..)
, UpdateProposalFile (..)
, VerificationKeyFile (..)
, Params (..)
, RequiredSigner (..)
, AllOrOnly(..)
) where
import Cardano.Prelude hiding (Word64)
import Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import Data.Word (Word64)
import qualified Cardano.Chain.Slotting as Byron
import Cardano.Api (AddressAny, AnyScriptLanguage, EpochNo, ExecutionUnits, Hash,
PaymentKey, PolicyId, ScriptData, SlotNo (SlotNo), TxId, TxIn, Value, WitCtxMint,
WitCtxStake, WitCtxTxIn)
import qualified Cardano.Ledger.Crypto as Crypto
import Cardano.Ledger.Shelley.TxBody (PoolParams (..))
data TxBuildOutputOptions = OutputScriptCostOnly FilePath
| OutputTxBodyOnly TxBodyFile
deriving Int -> TxBuildOutputOptions -> ShowS
[TxBuildOutputOptions] -> ShowS
TxBuildOutputOptions -> String
(Int -> TxBuildOutputOptions -> ShowS)
-> (TxBuildOutputOptions -> String)
-> ([TxBuildOutputOptions] -> ShowS)
-> Show TxBuildOutputOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxBuildOutputOptions] -> ShowS
$cshowList :: [TxBuildOutputOptions] -> ShowS
show :: TxBuildOutputOptions -> String
$cshow :: TxBuildOutputOptions -> String
showsPrec :: Int -> TxBuildOutputOptions -> ShowS
$cshowsPrec :: Int -> TxBuildOutputOptions -> ShowS
Show
data CBORObject = CBORBlockByron Byron.EpochSlots
| CBORDelegationCertificateByron
| CBORTxByron
| CBORUpdateProposalByron
| CBORVoteByron
deriving Int -> CBORObject -> ShowS
[CBORObject] -> ShowS
CBORObject -> String
(Int -> CBORObject -> ShowS)
-> (CBORObject -> String)
-> ([CBORObject] -> ShowS)
-> Show CBORObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBORObject] -> ShowS
$cshowList :: [CBORObject] -> ShowS
show :: CBORObject -> String
$cshow :: CBORObject -> String
showsPrec :: Int -> CBORObject -> ShowS
$cshowsPrec :: Int -> CBORObject -> ShowS
Show
newtype CertificateFile = CertificateFile { CertificateFile -> String
unCertificateFile :: FilePath }
deriving newtype (CertificateFile -> CertificateFile -> Bool
(CertificateFile -> CertificateFile -> Bool)
-> (CertificateFile -> CertificateFile -> Bool)
-> Eq CertificateFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateFile -> CertificateFile -> Bool
$c/= :: CertificateFile -> CertificateFile -> Bool
== :: CertificateFile -> CertificateFile -> Bool
$c== :: CertificateFile -> CertificateFile -> Bool
Eq, Int -> CertificateFile -> ShowS
[CertificateFile] -> ShowS
CertificateFile -> String
(Int -> CertificateFile -> ShowS)
-> (CertificateFile -> String)
-> ([CertificateFile] -> ShowS)
-> Show CertificateFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateFile] -> ShowS
$cshowList :: [CertificateFile] -> ShowS
show :: CertificateFile -> String
$cshow :: CertificateFile -> String
showsPrec :: Int -> CertificateFile -> ShowS
$cshowsPrec :: Int -> CertificateFile -> ShowS
Show)
newtype CurrentKesPeriod = CurrentKesPeriod { CurrentKesPeriod -> Word64
unCurrentKesPeriod :: Word64 } deriving (CurrentKesPeriod -> CurrentKesPeriod -> Bool
(CurrentKesPeriod -> CurrentKesPeriod -> Bool)
-> (CurrentKesPeriod -> CurrentKesPeriod -> Bool)
-> Eq CurrentKesPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentKesPeriod -> CurrentKesPeriod -> Bool
$c/= :: CurrentKesPeriod -> CurrentKesPeriod -> Bool
== :: CurrentKesPeriod -> CurrentKesPeriod -> Bool
$c== :: CurrentKesPeriod -> CurrentKesPeriod -> Bool
Eq, Int -> CurrentKesPeriod -> ShowS
[CurrentKesPeriod] -> ShowS
CurrentKesPeriod -> String
(Int -> CurrentKesPeriod -> ShowS)
-> (CurrentKesPeriod -> String)
-> ([CurrentKesPeriod] -> ShowS)
-> Show CurrentKesPeriod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentKesPeriod] -> ShowS
$cshowList :: [CurrentKesPeriod] -> ShowS
show :: CurrentKesPeriod -> String
$cshow :: CurrentKesPeriod -> String
showsPrec :: Int -> CurrentKesPeriod -> ShowS
$cshowsPrec :: Int -> CurrentKesPeriod -> ShowS
Show)
instance ToJSON CurrentKesPeriod where
toJSON :: CurrentKesPeriod -> Value
toJSON (CurrentKesPeriod Word64
k) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON CurrentKesPeriod where
parseJSON :: Value -> Parser CurrentKesPeriod
parseJSON Value
v = Word64 -> CurrentKesPeriod
CurrentKesPeriod (Word64 -> CurrentKesPeriod)
-> Parser Word64 -> Parser CurrentKesPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype GenesisFile = GenesisFile
{ GenesisFile -> String
unGenesisFile :: FilePath }
deriving stock (GenesisFile -> GenesisFile -> Bool
(GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool) -> Eq GenesisFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisFile -> GenesisFile -> Bool
$c/= :: GenesisFile -> GenesisFile -> Bool
== :: GenesisFile -> GenesisFile -> Bool
$c== :: GenesisFile -> GenesisFile -> Bool
Eq, Eq GenesisFile
Eq GenesisFile
-> (GenesisFile -> GenesisFile -> Ordering)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> GenesisFile)
-> (GenesisFile -> GenesisFile -> GenesisFile)
-> Ord GenesisFile
GenesisFile -> GenesisFile -> Bool
GenesisFile -> GenesisFile -> Ordering
GenesisFile -> GenesisFile -> GenesisFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GenesisFile -> GenesisFile -> GenesisFile
$cmin :: GenesisFile -> GenesisFile -> GenesisFile
max :: GenesisFile -> GenesisFile -> GenesisFile
$cmax :: GenesisFile -> GenesisFile -> GenesisFile
>= :: GenesisFile -> GenesisFile -> Bool
$c>= :: GenesisFile -> GenesisFile -> Bool
> :: GenesisFile -> GenesisFile -> Bool
$c> :: GenesisFile -> GenesisFile -> Bool
<= :: GenesisFile -> GenesisFile -> Bool
$c<= :: GenesisFile -> GenesisFile -> Bool
< :: GenesisFile -> GenesisFile -> Bool
$c< :: GenesisFile -> GenesisFile -> Bool
compare :: GenesisFile -> GenesisFile -> Ordering
$ccompare :: GenesisFile -> GenesisFile -> Ordering
$cp1Ord :: Eq GenesisFile
Ord)
deriving newtype (String -> GenesisFile
(String -> GenesisFile) -> IsString GenesisFile
forall a. (String -> a) -> IsString a
fromString :: String -> GenesisFile
$cfromString :: String -> GenesisFile
IsString, Int -> GenesisFile -> ShowS
[GenesisFile] -> ShowS
GenesisFile -> String
(Int -> GenesisFile -> ShowS)
-> (GenesisFile -> String)
-> ([GenesisFile] -> ShowS)
-> Show GenesisFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisFile] -> ShowS
$cshowList :: [GenesisFile] -> ShowS
show :: GenesisFile -> String
$cshow :: GenesisFile -> String
showsPrec :: Int -> GenesisFile -> ShowS
$cshowsPrec :: Int -> GenesisFile -> ShowS
Show)
data OpCertNodeAndOnDiskCounterInformation
= OpCertOnDiskCounterMoreThanOrEqualToNodeState
OpCertOnDiskCounter
OpCertNodeStateCounter
| OpCertOnDiskCounterBehindNodeState
OpCertOnDiskCounter
OpCertNodeStateCounter
| OpCertNoBlocksMintedYet
OpCertOnDiskCounter
deriving (OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool
(OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool)
-> (OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool)
-> Eq OpCertNodeAndOnDiskCounterInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool
$c/= :: OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool
== :: OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool
$c== :: OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool
Eq, Int -> OpCertNodeAndOnDiskCounterInformation -> ShowS
[OpCertNodeAndOnDiskCounterInformation] -> ShowS
OpCertNodeAndOnDiskCounterInformation -> String
(Int -> OpCertNodeAndOnDiskCounterInformation -> ShowS)
-> (OpCertNodeAndOnDiskCounterInformation -> String)
-> ([OpCertNodeAndOnDiskCounterInformation] -> ShowS)
-> Show OpCertNodeAndOnDiskCounterInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertNodeAndOnDiskCounterInformation] -> ShowS
$cshowList :: [OpCertNodeAndOnDiskCounterInformation] -> ShowS
show :: OpCertNodeAndOnDiskCounterInformation -> String
$cshow :: OpCertNodeAndOnDiskCounterInformation -> String
showsPrec :: Int -> OpCertNodeAndOnDiskCounterInformation -> ShowS
$cshowsPrec :: Int -> OpCertNodeAndOnDiskCounterInformation -> ShowS
Show)
newtype OpCertOnDiskCounter = OpCertOnDiskCounter { OpCertOnDiskCounter -> Word64
unOpCertOnDiskCounter :: Word64 }
deriving (OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool
(OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool)
-> (OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool)
-> Eq OpCertOnDiskCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool
$c/= :: OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool
== :: OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool
$c== :: OpCertOnDiskCounter -> OpCertOnDiskCounter -> Bool
Eq, Int -> OpCertOnDiskCounter -> ShowS
[OpCertOnDiskCounter] -> ShowS
OpCertOnDiskCounter -> String
(Int -> OpCertOnDiskCounter -> ShowS)
-> (OpCertOnDiskCounter -> String)
-> ([OpCertOnDiskCounter] -> ShowS)
-> Show OpCertOnDiskCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertOnDiskCounter] -> ShowS
$cshowList :: [OpCertOnDiskCounter] -> ShowS
show :: OpCertOnDiskCounter -> String
$cshow :: OpCertOnDiskCounter -> String
showsPrec :: Int -> OpCertOnDiskCounter -> ShowS
$cshowsPrec :: Int -> OpCertOnDiskCounter -> ShowS
Show)
instance ToJSON OpCertOnDiskCounter where
toJSON :: OpCertOnDiskCounter -> Value
toJSON (OpCertOnDiskCounter Word64
k) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertOnDiskCounter where
parseJSON :: Value -> Parser OpCertOnDiskCounter
parseJSON Value
v = Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter (Word64 -> OpCertOnDiskCounter)
-> Parser Word64 -> Parser OpCertOnDiskCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype OpCertNodeStateCounter = OpCertNodeStateCounter { OpCertNodeStateCounter -> Word64
unOpCertNodeStateCounter :: Word64 }
deriving (OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool
(OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool)
-> (OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool)
-> Eq OpCertNodeStateCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool
$c/= :: OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool
== :: OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool
$c== :: OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool
Eq, Int -> OpCertNodeStateCounter -> ShowS
[OpCertNodeStateCounter] -> ShowS
OpCertNodeStateCounter -> String
(Int -> OpCertNodeStateCounter -> ShowS)
-> (OpCertNodeStateCounter -> String)
-> ([OpCertNodeStateCounter] -> ShowS)
-> Show OpCertNodeStateCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertNodeStateCounter] -> ShowS
$cshowList :: [OpCertNodeStateCounter] -> ShowS
show :: OpCertNodeStateCounter -> String
$cshow :: OpCertNodeStateCounter -> String
showsPrec :: Int -> OpCertNodeStateCounter -> ShowS
$cshowsPrec :: Int -> OpCertNodeStateCounter -> ShowS
Show)
instance ToJSON OpCertNodeStateCounter where
toJSON :: OpCertNodeStateCounter -> Value
toJSON (OpCertNodeStateCounter Word64
k) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertNodeStateCounter where
parseJSON :: Value -> Parser OpCertNodeStateCounter
parseJSON Value
v = Word64 -> OpCertNodeStateCounter
OpCertNodeStateCounter (Word64 -> OpCertNodeStateCounter)
-> Parser Word64 -> Parser OpCertNodeStateCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype OpCertStartingKesPeriod = OpCertStartingKesPeriod { OpCertStartingKesPeriod -> Word64
unOpCertStartingKesPeriod :: Word64 }
deriving (OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool
(OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool)
-> (OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool)
-> Eq OpCertStartingKesPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool
$c/= :: OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool
== :: OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool
$c== :: OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool
Eq, Int -> OpCertStartingKesPeriod -> ShowS
[OpCertStartingKesPeriod] -> ShowS
OpCertStartingKesPeriod -> String
(Int -> OpCertStartingKesPeriod -> ShowS)
-> (OpCertStartingKesPeriod -> String)
-> ([OpCertStartingKesPeriod] -> ShowS)
-> Show OpCertStartingKesPeriod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertStartingKesPeriod] -> ShowS
$cshowList :: [OpCertStartingKesPeriod] -> ShowS
show :: OpCertStartingKesPeriod -> String
$cshow :: OpCertStartingKesPeriod -> String
showsPrec :: Int -> OpCertStartingKesPeriod -> ShowS
$cshowsPrec :: Int -> OpCertStartingKesPeriod -> ShowS
Show)
instance ToJSON OpCertStartingKesPeriod where
toJSON :: OpCertStartingKesPeriod -> Value
toJSON (OpCertStartingKesPeriod Word64
k) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertStartingKesPeriod where
parseJSON :: Value -> Parser OpCertStartingKesPeriod
parseJSON Value
v = Word64 -> OpCertStartingKesPeriod
OpCertStartingKesPeriod (Word64 -> OpCertStartingKesPeriod)
-> Parser Word64 -> Parser OpCertStartingKesPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype OpCertEndingKesPeriod = OpCertEndingKesPeriod { OpCertEndingKesPeriod -> Word64
unOpCertEndingKesPeriod :: Word64 }
deriving (OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool
(OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool)
-> (OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool)
-> Eq OpCertEndingKesPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool
$c/= :: OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool
== :: OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool
$c== :: OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool
Eq, Int -> OpCertEndingKesPeriod -> ShowS
[OpCertEndingKesPeriod] -> ShowS
OpCertEndingKesPeriod -> String
(Int -> OpCertEndingKesPeriod -> ShowS)
-> (OpCertEndingKesPeriod -> String)
-> ([OpCertEndingKesPeriod] -> ShowS)
-> Show OpCertEndingKesPeriod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertEndingKesPeriod] -> ShowS
$cshowList :: [OpCertEndingKesPeriod] -> ShowS
show :: OpCertEndingKesPeriod -> String
$cshow :: OpCertEndingKesPeriod -> String
showsPrec :: Int -> OpCertEndingKesPeriod -> ShowS
$cshowsPrec :: Int -> OpCertEndingKesPeriod -> ShowS
Show)
instance ToJSON OpCertEndingKesPeriod where
toJSON :: OpCertEndingKesPeriod -> Value
toJSON (OpCertEndingKesPeriod Word64
k) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertEndingKesPeriod where
parseJSON :: Value -> Parser OpCertEndingKesPeriod
parseJSON Value
v = Word64 -> OpCertEndingKesPeriod
OpCertEndingKesPeriod (Word64 -> OpCertEndingKesPeriod)
-> Parser Word64 -> Parser OpCertEndingKesPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
data OpCertIntervalInformation
= OpCertWithinInterval
OpCertStartingKesPeriod
OpCertEndingKesPeriod
CurrentKesPeriod
SlotsTillKesKeyExpiry
| OpCertStartingKesPeriodIsInTheFuture
OpCertStartingKesPeriod
OpCertEndingKesPeriod
CurrentKesPeriod
| OpCertExpired
OpCertStartingKesPeriod
OpCertEndingKesPeriod
CurrentKesPeriod
| OpCertSomeOtherError
OpCertStartingKesPeriod
OpCertEndingKesPeriod
CurrentKesPeriod
deriving (OpCertIntervalInformation -> OpCertIntervalInformation -> Bool
(OpCertIntervalInformation -> OpCertIntervalInformation -> Bool)
-> (OpCertIntervalInformation -> OpCertIntervalInformation -> Bool)
-> Eq OpCertIntervalInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpCertIntervalInformation -> OpCertIntervalInformation -> Bool
$c/= :: OpCertIntervalInformation -> OpCertIntervalInformation -> Bool
== :: OpCertIntervalInformation -> OpCertIntervalInformation -> Bool
$c== :: OpCertIntervalInformation -> OpCertIntervalInformation -> Bool
Eq, Int -> OpCertIntervalInformation -> ShowS
[OpCertIntervalInformation] -> ShowS
OpCertIntervalInformation -> String
(Int -> OpCertIntervalInformation -> ShowS)
-> (OpCertIntervalInformation -> String)
-> ([OpCertIntervalInformation] -> ShowS)
-> Show OpCertIntervalInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertIntervalInformation] -> ShowS
$cshowList :: [OpCertIntervalInformation] -> ShowS
show :: OpCertIntervalInformation -> String
$cshow :: OpCertIntervalInformation -> String
showsPrec :: Int -> OpCertIntervalInformation -> ShowS
$cshowsPrec :: Int -> OpCertIntervalInformation -> ShowS
Show)
instance FromJSON GenesisFile where
parseJSON :: Value -> Parser GenesisFile
parseJSON (Aeson.String Text
genFp) = GenesisFile -> Parser GenesisFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisFile -> Parser GenesisFile)
-> (String -> GenesisFile) -> String -> Parser GenesisFile
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> GenesisFile
GenesisFile (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
genFp
parseJSON Value
invalid = Text -> Parser GenesisFile
forall a. HasCallStack => Text -> a
panic (Text -> Parser GenesisFile) -> Text -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ Text
"Parsing of GenesisFile failed due to type mismatch. "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Encountered: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Value -> String
forall a b. (Show a, StringConv String b) => a -> b
show Value
invalid)
data OutputFormat
= OutputFormatHex
| OutputFormatBech32
deriving (OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c== :: OutputFormat -> OutputFormat -> Bool
Eq, Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputFormat] -> ShowS
$cshowList :: [OutputFormat] -> ShowS
show :: OutputFormat -> String
$cshow :: OutputFormat -> String
showsPrec :: Int -> OutputFormat -> ShowS
$cshowsPrec :: Int -> OutputFormat -> ShowS
Show)
data AllOrOnly a = All | Only a deriving (AllOrOnly a -> AllOrOnly a -> Bool
(AllOrOnly a -> AllOrOnly a -> Bool)
-> (AllOrOnly a -> AllOrOnly a -> Bool) -> Eq (AllOrOnly a)
forall a. Eq a => AllOrOnly a -> AllOrOnly a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllOrOnly a -> AllOrOnly a -> Bool
$c/= :: forall a. Eq a => AllOrOnly a -> AllOrOnly a -> Bool
== :: AllOrOnly a -> AllOrOnly a -> Bool
$c== :: forall a. Eq a => AllOrOnly a -> AllOrOnly a -> Bool
Eq, Int -> AllOrOnly a -> ShowS
[AllOrOnly a] -> ShowS
AllOrOnly a -> String
(Int -> AllOrOnly a -> ShowS)
-> (AllOrOnly a -> String)
-> ([AllOrOnly a] -> ShowS)
-> Show (AllOrOnly a)
forall a. Show a => Int -> AllOrOnly a -> ShowS
forall a. Show a => [AllOrOnly a] -> ShowS
forall a. Show a => AllOrOnly a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllOrOnly a] -> ShowS
$cshowList :: forall a. Show a => [AllOrOnly a] -> ShowS
show :: AllOrOnly a -> String
$cshow :: forall a. Show a => AllOrOnly a -> String
showsPrec :: Int -> AllOrOnly a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AllOrOnly a -> ShowS
Show)
data Params crypto = Params
{ Params crypto -> Maybe (PoolParams crypto)
poolParameters :: Maybe (PoolParams crypto)
, Params crypto -> Maybe (PoolParams crypto)
futurePoolParameters :: Maybe (PoolParams crypto)
, Params crypto -> Maybe EpochNo
retiringEpoch :: Maybe EpochNo
} deriving Int -> Params crypto -> ShowS
[Params crypto] -> ShowS
Params crypto -> String
(Int -> Params crypto -> ShowS)
-> (Params crypto -> String)
-> ([Params crypto] -> ShowS)
-> Show (Params crypto)
forall crypto. Int -> Params crypto -> ShowS
forall crypto. [Params crypto] -> ShowS
forall crypto. Params crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Params crypto] -> ShowS
$cshowList :: forall crypto. [Params crypto] -> ShowS
show :: Params crypto -> String
$cshow :: forall crypto. Params crypto -> String
showsPrec :: Int -> Params crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> Params crypto -> ShowS
Show
instance Crypto.Crypto crypto => ToJSON (Params crypto) where
toJSON :: Params crypto -> Value
toJSON (Params Maybe (PoolParams crypto)
p Maybe (PoolParams crypto)
fp Maybe EpochNo
r) = [Pair] -> Value
object
[ Key
"poolParams" Key -> Maybe (PoolParams crypto) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
p
, Key
"futurePoolParams" Key -> Maybe (PoolParams crypto) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
fp
, Key
"retiring" Key -> Maybe EpochNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe EpochNo
r
]
toEncoding :: Params crypto -> Encoding
toEncoding (Params Maybe (PoolParams crypto)
p Maybe (PoolParams crypto)
fp Maybe EpochNo
r) = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
[ Key
"poolParams" Key -> Maybe (PoolParams crypto) -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
p
, Key
"futurePoolParams" Key -> Maybe (PoolParams crypto) -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
fp
, Key
"retiring" Key -> Maybe EpochNo -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe EpochNo
r
]
newtype SigningKeyFile = SigningKeyFile
{ SigningKeyFile -> String
unSigningKeyFile :: FilePath }
deriving stock (SigningKeyFile -> SigningKeyFile -> Bool
(SigningKeyFile -> SigningKeyFile -> Bool)
-> (SigningKeyFile -> SigningKeyFile -> Bool) -> Eq SigningKeyFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigningKeyFile -> SigningKeyFile -> Bool
$c/= :: SigningKeyFile -> SigningKeyFile -> Bool
== :: SigningKeyFile -> SigningKeyFile -> Bool
$c== :: SigningKeyFile -> SigningKeyFile -> Bool
Eq, Eq SigningKeyFile
Eq SigningKeyFile
-> (SigningKeyFile -> SigningKeyFile -> Ordering)
-> (SigningKeyFile -> SigningKeyFile -> Bool)
-> (SigningKeyFile -> SigningKeyFile -> Bool)
-> (SigningKeyFile -> SigningKeyFile -> Bool)
-> (SigningKeyFile -> SigningKeyFile -> Bool)
-> (SigningKeyFile -> SigningKeyFile -> SigningKeyFile)
-> (SigningKeyFile -> SigningKeyFile -> SigningKeyFile)
-> Ord SigningKeyFile
SigningKeyFile -> SigningKeyFile -> Bool
SigningKeyFile -> SigningKeyFile -> Ordering
SigningKeyFile -> SigningKeyFile -> SigningKeyFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SigningKeyFile -> SigningKeyFile -> SigningKeyFile
$cmin :: SigningKeyFile -> SigningKeyFile -> SigningKeyFile
max :: SigningKeyFile -> SigningKeyFile -> SigningKeyFile
$cmax :: SigningKeyFile -> SigningKeyFile -> SigningKeyFile
>= :: SigningKeyFile -> SigningKeyFile -> Bool
$c>= :: SigningKeyFile -> SigningKeyFile -> Bool
> :: SigningKeyFile -> SigningKeyFile -> Bool
$c> :: SigningKeyFile -> SigningKeyFile -> Bool
<= :: SigningKeyFile -> SigningKeyFile -> Bool
$c<= :: SigningKeyFile -> SigningKeyFile -> Bool
< :: SigningKeyFile -> SigningKeyFile -> Bool
$c< :: SigningKeyFile -> SigningKeyFile -> Bool
compare :: SigningKeyFile -> SigningKeyFile -> Ordering
$ccompare :: SigningKeyFile -> SigningKeyFile -> Ordering
$cp1Ord :: Eq SigningKeyFile
Ord)
deriving newtype (String -> SigningKeyFile
(String -> SigningKeyFile) -> IsString SigningKeyFile
forall a. (String -> a) -> IsString a
fromString :: String -> SigningKeyFile
$cfromString :: String -> SigningKeyFile
IsString, Int -> SigningKeyFile -> ShowS
[SigningKeyFile] -> ShowS
SigningKeyFile -> String
(Int -> SigningKeyFile -> ShowS)
-> (SigningKeyFile -> String)
-> ([SigningKeyFile] -> ShowS)
-> Show SigningKeyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigningKeyFile] -> ShowS
$cshowList :: [SigningKeyFile] -> ShowS
show :: SigningKeyFile -> String
$cshow :: SigningKeyFile -> String
showsPrec :: Int -> SigningKeyFile -> ShowS
$cshowsPrec :: Int -> SigningKeyFile -> ShowS
Show)
newtype UpdateProposalFile = UpdateProposalFile { UpdateProposalFile -> String
unUpdateProposalFile :: FilePath }
deriving newtype (UpdateProposalFile -> UpdateProposalFile -> Bool
(UpdateProposalFile -> UpdateProposalFile -> Bool)
-> (UpdateProposalFile -> UpdateProposalFile -> Bool)
-> Eq UpdateProposalFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProposalFile -> UpdateProposalFile -> Bool
$c/= :: UpdateProposalFile -> UpdateProposalFile -> Bool
== :: UpdateProposalFile -> UpdateProposalFile -> Bool
$c== :: UpdateProposalFile -> UpdateProposalFile -> Bool
Eq, Int -> UpdateProposalFile -> ShowS
[UpdateProposalFile] -> ShowS
UpdateProposalFile -> String
(Int -> UpdateProposalFile -> ShowS)
-> (UpdateProposalFile -> String)
-> ([UpdateProposalFile] -> ShowS)
-> Show UpdateProposalFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProposalFile] -> ShowS
$cshowList :: [UpdateProposalFile] -> ShowS
show :: UpdateProposalFile -> String
$cshow :: UpdateProposalFile -> String
showsPrec :: Int -> UpdateProposalFile -> ShowS
$cshowsPrec :: Int -> UpdateProposalFile -> ShowS
Show)
newtype VerificationKeyFile
= VerificationKeyFile { VerificationKeyFile -> String
unVerificationKeyFile :: FilePath }
deriving (VerificationKeyFile -> VerificationKeyFile -> Bool
(VerificationKeyFile -> VerificationKeyFile -> Bool)
-> (VerificationKeyFile -> VerificationKeyFile -> Bool)
-> Eq VerificationKeyFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationKeyFile -> VerificationKeyFile -> Bool
$c/= :: VerificationKeyFile -> VerificationKeyFile -> Bool
== :: VerificationKeyFile -> VerificationKeyFile -> Bool
$c== :: VerificationKeyFile -> VerificationKeyFile -> Bool
Eq, Int -> VerificationKeyFile -> ShowS
[VerificationKeyFile] -> ShowS
VerificationKeyFile -> String
(Int -> VerificationKeyFile -> ShowS)
-> (VerificationKeyFile -> String)
-> ([VerificationKeyFile] -> ShowS)
-> Show VerificationKeyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationKeyFile] -> ShowS
$cshowList :: [VerificationKeyFile] -> ShowS
show :: VerificationKeyFile -> String
$cshow :: VerificationKeyFile -> String
showsPrec :: Int -> VerificationKeyFile -> ShowS
$cshowsPrec :: Int -> VerificationKeyFile -> ShowS
Show)
newtype ScriptFile = ScriptFile { ScriptFile -> String
unScriptFile :: FilePath }
deriving (ScriptFile -> ScriptFile -> Bool
(ScriptFile -> ScriptFile -> Bool)
-> (ScriptFile -> ScriptFile -> Bool) -> Eq ScriptFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptFile -> ScriptFile -> Bool
$c/= :: ScriptFile -> ScriptFile -> Bool
== :: ScriptFile -> ScriptFile -> Bool
$c== :: ScriptFile -> ScriptFile -> Bool
Eq, Int -> ScriptFile -> ShowS
[ScriptFile] -> ShowS
ScriptFile -> String
(Int -> ScriptFile -> ShowS)
-> (ScriptFile -> String)
-> ([ScriptFile] -> ShowS)
-> Show ScriptFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptFile] -> ShowS
$cshowList :: [ScriptFile] -> ShowS
show :: ScriptFile -> String
$cshow :: ScriptFile -> String
showsPrec :: Int -> ScriptFile -> ShowS
$cshowsPrec :: Int -> ScriptFile -> ShowS
Show)
data ScriptDataOrFile = ScriptDataCborFile FilePath
| ScriptDataJsonFile FilePath
| ScriptDataValue ScriptData
deriving (ScriptDataOrFile -> ScriptDataOrFile -> Bool
(ScriptDataOrFile -> ScriptDataOrFile -> Bool)
-> (ScriptDataOrFile -> ScriptDataOrFile -> Bool)
-> Eq ScriptDataOrFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptDataOrFile -> ScriptDataOrFile -> Bool
$c/= :: ScriptDataOrFile -> ScriptDataOrFile -> Bool
== :: ScriptDataOrFile -> ScriptDataOrFile -> Bool
$c== :: ScriptDataOrFile -> ScriptDataOrFile -> Bool
Eq, Int -> ScriptDataOrFile -> ShowS
[ScriptDataOrFile] -> ShowS
ScriptDataOrFile -> String
(Int -> ScriptDataOrFile -> ShowS)
-> (ScriptDataOrFile -> String)
-> ([ScriptDataOrFile] -> ShowS)
-> Show ScriptDataOrFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDataOrFile] -> ShowS
$cshowList :: [ScriptDataOrFile] -> ShowS
show :: ScriptDataOrFile -> String
$cshow :: ScriptDataOrFile -> String
showsPrec :: Int -> ScriptDataOrFile -> ShowS
$cshowsPrec :: Int -> ScriptDataOrFile -> ShowS
Show)
type ScriptRedeemerOrFile = ScriptDataOrFile
data ScriptWitnessFiles witctx where
SimpleScriptWitnessFile :: ScriptFile
-> ScriptWitnessFiles witctx
PlutusScriptWitnessFiles :: ScriptFile
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles witctx
PlutusReferenceScriptWitnessFiles
:: TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles witctx
SimpleReferenceScriptWitnessFiles
:: TxIn
-> AnyScriptLanguage
-> Maybe PolicyId
-> ScriptWitnessFiles witctx
deriving instance Show (ScriptWitnessFiles witctx)
data ScriptDatumOrFile witctx where
ScriptDatumOrFileForTxIn :: ScriptDataOrFile
-> ScriptDatumOrFile WitCtxTxIn
InlineDatumPresentAtTxIn :: ScriptDatumOrFile WitCtxTxIn
NoScriptDatumOrFileForMint :: ScriptDatumOrFile WitCtxMint
NoScriptDatumOrFileForStake :: ScriptDatumOrFile WitCtxStake
deriving instance Show (ScriptDatumOrFile witctx)
newtype SlotsTillKesKeyExpiry = SlotsTillKesKeyExpiry { SlotsTillKesKeyExpiry -> SlotNo
unSlotsTillKesKeyExpiry :: SlotNo }
deriving (SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool
(SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool)
-> (SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool)
-> Eq SlotsTillKesKeyExpiry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool
$c/= :: SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool
== :: SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool
$c== :: SlotsTillKesKeyExpiry -> SlotsTillKesKeyExpiry -> Bool
Eq, Int -> SlotsTillKesKeyExpiry -> ShowS
[SlotsTillKesKeyExpiry] -> ShowS
SlotsTillKesKeyExpiry -> String
(Int -> SlotsTillKesKeyExpiry -> ShowS)
-> (SlotsTillKesKeyExpiry -> String)
-> ([SlotsTillKesKeyExpiry] -> ShowS)
-> Show SlotsTillKesKeyExpiry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlotsTillKesKeyExpiry] -> ShowS
$cshowList :: [SlotsTillKesKeyExpiry] -> ShowS
show :: SlotsTillKesKeyExpiry -> String
$cshow :: SlotsTillKesKeyExpiry -> String
showsPrec :: Int -> SlotsTillKesKeyExpiry -> ShowS
$cshowsPrec :: Int -> SlotsTillKesKeyExpiry -> ShowS
Show)
instance ToJSON SlotsTillKesKeyExpiry where
toJSON :: SlotsTillKesKeyExpiry -> Value
toJSON (SlotsTillKesKeyExpiry SlotNo
k) = SlotNo -> Value
forall a. ToJSON a => a -> Value
toJSON SlotNo
k
instance FromJSON SlotsTillKesKeyExpiry where
parseJSON :: Value -> Parser SlotsTillKesKeyExpiry
parseJSON Value
v = SlotNo -> SlotsTillKesKeyExpiry
SlotsTillKesKeyExpiry (SlotNo -> SlotsTillKesKeyExpiry)
-> Parser SlotNo -> Parser SlotsTillKesKeyExpiry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SlotNo
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
data TransferDirection = TransferToReserves | TransferToTreasury
deriving Int -> TransferDirection -> ShowS
[TransferDirection] -> ShowS
TransferDirection -> String
(Int -> TransferDirection -> ShowS)
-> (TransferDirection -> String)
-> ([TransferDirection] -> ShowS)
-> Show TransferDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferDirection] -> ShowS
$cshowList :: [TransferDirection] -> ShowS
show :: TransferDirection -> String
$cshow :: TransferDirection -> String
showsPrec :: Int -> TransferDirection -> ShowS
$cshowsPrec :: Int -> TransferDirection -> ShowS
Show
data TxOutAnyEra = TxOutAnyEra
AddressAny
Value
TxOutDatumAnyEra
ReferenceScriptAnyEra
deriving (TxOutAnyEra -> TxOutAnyEra -> Bool
(TxOutAnyEra -> TxOutAnyEra -> Bool)
-> (TxOutAnyEra -> TxOutAnyEra -> Bool) -> Eq TxOutAnyEra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutAnyEra -> TxOutAnyEra -> Bool
$c/= :: TxOutAnyEra -> TxOutAnyEra -> Bool
== :: TxOutAnyEra -> TxOutAnyEra -> Bool
$c== :: TxOutAnyEra -> TxOutAnyEra -> Bool
Eq, Int -> TxOutAnyEra -> ShowS
[TxOutAnyEra] -> ShowS
TxOutAnyEra -> String
(Int -> TxOutAnyEra -> ShowS)
-> (TxOutAnyEra -> String)
-> ([TxOutAnyEra] -> ShowS)
-> Show TxOutAnyEra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutAnyEra] -> ShowS
$cshowList :: [TxOutAnyEra] -> ShowS
show :: TxOutAnyEra -> String
$cshow :: TxOutAnyEra -> String
showsPrec :: Int -> TxOutAnyEra -> ShowS
$cshowsPrec :: Int -> TxOutAnyEra -> ShowS
Show)
data TxOutDatumAnyEra = TxOutDatumByHashOnly (Hash ScriptData)
| TxOutDatumByHashOf ScriptDataOrFile
| TxOutDatumByValue ScriptDataOrFile
| TxOutInlineDatumByValue ScriptDataOrFile
| TxOutDatumByNone
deriving (TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool
(TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool)
-> (TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool)
-> Eq TxOutDatumAnyEra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool
$c/= :: TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool
== :: TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool
$c== :: TxOutDatumAnyEra -> TxOutDatumAnyEra -> Bool
Eq, Int -> TxOutDatumAnyEra -> ShowS
[TxOutDatumAnyEra] -> ShowS
TxOutDatumAnyEra -> String
(Int -> TxOutDatumAnyEra -> ShowS)
-> (TxOutDatumAnyEra -> String)
-> ([TxOutDatumAnyEra] -> ShowS)
-> Show TxOutDatumAnyEra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutDatumAnyEra] -> ShowS
$cshowList :: [TxOutDatumAnyEra] -> ShowS
show :: TxOutDatumAnyEra -> String
$cshow :: TxOutDatumAnyEra -> String
showsPrec :: Int -> TxOutDatumAnyEra -> ShowS
$cshowsPrec :: Int -> TxOutDatumAnyEra -> ShowS
Show)
data ReferenceScriptAnyEra
= ReferenceScriptAnyEraNone
| ReferenceScriptAnyEra FilePath
deriving (ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool
(ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool)
-> (ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool)
-> Eq ReferenceScriptAnyEra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool
$c/= :: ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool
== :: ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool
$c== :: ReferenceScriptAnyEra -> ReferenceScriptAnyEra -> Bool
Eq, Int -> ReferenceScriptAnyEra -> ShowS
[ReferenceScriptAnyEra] -> ShowS
ReferenceScriptAnyEra -> String
(Int -> ReferenceScriptAnyEra -> ShowS)
-> (ReferenceScriptAnyEra -> String)
-> ([ReferenceScriptAnyEra] -> ShowS)
-> Show ReferenceScriptAnyEra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceScriptAnyEra] -> ShowS
$cshowList :: [ReferenceScriptAnyEra] -> ShowS
show :: ReferenceScriptAnyEra -> String
$cshow :: ReferenceScriptAnyEra -> String
showsPrec :: Int -> ReferenceScriptAnyEra -> ShowS
$cshowsPrec :: Int -> ReferenceScriptAnyEra -> ShowS
Show)
newtype TxOutChangeAddress = TxOutChangeAddress AddressAny
deriving (TxOutChangeAddress -> TxOutChangeAddress -> Bool
(TxOutChangeAddress -> TxOutChangeAddress -> Bool)
-> (TxOutChangeAddress -> TxOutChangeAddress -> Bool)
-> Eq TxOutChangeAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutChangeAddress -> TxOutChangeAddress -> Bool
$c/= :: TxOutChangeAddress -> TxOutChangeAddress -> Bool
== :: TxOutChangeAddress -> TxOutChangeAddress -> Bool
$c== :: TxOutChangeAddress -> TxOutChangeAddress -> Bool
Eq, Int -> TxOutChangeAddress -> ShowS
[TxOutChangeAddress] -> ShowS
TxOutChangeAddress -> String
(Int -> TxOutChangeAddress -> ShowS)
-> (TxOutChangeAddress -> String)
-> ([TxOutChangeAddress] -> ShowS)
-> Show TxOutChangeAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutChangeAddress] -> ShowS
$cshowList :: [TxOutChangeAddress] -> ShowS
show :: TxOutChangeAddress -> String
$cshow :: TxOutChangeAddress -> String
showsPrec :: Int -> TxOutChangeAddress -> ShowS
$cshowsPrec :: Int -> TxOutChangeAddress -> ShowS
Show)
data BalanceTxExecUnits = AutoBalance | ManualBalance
data RequiredSigner
= RequiredSignerSkeyFile SigningKeyFile
| RequiredSignerHash (Hash PaymentKey)
deriving Int -> RequiredSigner -> ShowS
[RequiredSigner] -> ShowS
RequiredSigner -> String
(Int -> RequiredSigner -> ShowS)
-> (RequiredSigner -> String)
-> ([RequiredSigner] -> ShowS)
-> Show RequiredSigner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequiredSigner] -> ShowS
$cshowList :: [RequiredSigner] -> ShowS
show :: RequiredSigner -> String
$cshow :: RequiredSigner -> String
showsPrec :: Int -> RequiredSigner -> ShowS
$cshowsPrec :: Int -> RequiredSigner -> ShowS
Show
data EpochLeadershipSchedule
= CurrentEpoch
| NextEpoch
deriving Int -> EpochLeadershipSchedule -> ShowS
[EpochLeadershipSchedule] -> ShowS
EpochLeadershipSchedule -> String
(Int -> EpochLeadershipSchedule -> ShowS)
-> (EpochLeadershipSchedule -> String)
-> ([EpochLeadershipSchedule] -> ShowS)
-> Show EpochLeadershipSchedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpochLeadershipSchedule] -> ShowS
$cshowList :: [EpochLeadershipSchedule] -> ShowS
show :: EpochLeadershipSchedule -> String
$cshow :: EpochLeadershipSchedule -> String
showsPrec :: Int -> EpochLeadershipSchedule -> ShowS
$cshowsPrec :: Int -> EpochLeadershipSchedule -> ShowS
Show
newtype TxBodyFile
= TxBodyFile FilePath
deriving Int -> TxBodyFile -> ShowS
[TxBodyFile] -> ShowS
TxBodyFile -> String
(Int -> TxBodyFile -> ShowS)
-> (TxBodyFile -> String)
-> ([TxBodyFile] -> ShowS)
-> Show TxBodyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxBodyFile] -> ShowS
$cshowList :: [TxBodyFile] -> ShowS
show :: TxBodyFile -> String
$cshow :: TxBodyFile -> String
showsPrec :: Int -> TxBodyFile -> ShowS
$cshowsPrec :: Int -> TxBodyFile -> ShowS
Show
newtype TxFile
= TxFile FilePath
deriving Int -> TxFile -> ShowS
[TxFile] -> ShowS
TxFile -> String
(Int -> TxFile -> ShowS)
-> (TxFile -> String) -> ([TxFile] -> ShowS) -> Show TxFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFile] -> ShowS
$cshowList :: [TxFile] -> ShowS
show :: TxFile -> String
$cshow :: TxFile -> String
showsPrec :: Int -> TxFile -> ShowS
$cshowsPrec :: Int -> TxFile -> ShowS
Show
data TxMempoolQuery =
TxMempoolQueryTxExists TxId
| TxMempoolQueryNextTx
| TxMempoolQueryInfo
deriving Int -> TxMempoolQuery -> ShowS
[TxMempoolQuery] -> ShowS
TxMempoolQuery -> String
(Int -> TxMempoolQuery -> ShowS)
-> (TxMempoolQuery -> String)
-> ([TxMempoolQuery] -> ShowS)
-> Show TxMempoolQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxMempoolQuery] -> ShowS
$cshowList :: [TxMempoolQuery] -> ShowS
show :: TxMempoolQuery -> String
$cshow :: TxMempoolQuery -> String
showsPrec :: Int -> TxMempoolQuery -> ShowS
$cshowsPrec :: Int -> TxMempoolQuery -> ShowS
Show