{-# 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 Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, (.=))
import qualified Data.Aeson as Aeson
import Data.String (IsString)
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,
HashableScriptData, 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
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
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
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
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
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
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) = forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON CurrentKesPeriod where
parseJSON :: Value -> Parser CurrentKesPeriod
parseJSON Value
v = Word64 -> CurrentKesPeriod
CurrentKesPeriod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype GenesisFile = GenesisFile
{ GenesisFile -> String
unGenesisFile :: FilePath }
deriving stock (GenesisFile -> GenesisFile -> Bool
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
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
Ord)
deriving newtype (String -> GenesisFile
forall a. (String -> a) -> IsString a
fromString :: String -> GenesisFile
$cfromString :: String -> GenesisFile
IsString, Int -> GenesisFile -> ShowS
[GenesisFile] -> ShowS
GenesisFile -> String
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
= OpCertOnDiskCounterEqualToNodeState
OpCertOnDiskCounter
OpCertNodeStateCounter
| OpCertOnDiskCounterAheadOfNodeState
OpCertOnDiskCounter
OpCertNodeStateCounter
| OpCertOnDiskCounterTooFarAheadOfNodeState
OpCertOnDiskCounter
OpCertNodeStateCounter
| OpCertOnDiskCounterBehindNodeState
OpCertOnDiskCounter
OpCertNodeStateCounter
| OpCertNoBlocksMintedYet
OpCertOnDiskCounter
deriving (OpCertNodeAndOnDiskCounterInformation
-> OpCertNodeAndOnDiskCounterInformation -> Bool
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
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
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
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) = forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertOnDiskCounter where
parseJSON :: Value -> Parser OpCertOnDiskCounter
parseJSON Value
v = Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype OpCertNodeStateCounter = OpCertNodeStateCounter { OpCertNodeStateCounter -> Word64
unOpCertNodeStateCounter :: Word64 }
deriving (OpCertNodeStateCounter -> OpCertNodeStateCounter -> Bool
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
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) = forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertNodeStateCounter where
parseJSON :: Value -> Parser OpCertNodeStateCounter
parseJSON Value
v = Word64 -> OpCertNodeStateCounter
OpCertNodeStateCounter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype OpCertStartingKesPeriod = OpCertStartingKesPeriod { OpCertStartingKesPeriod -> Word64
unOpCertStartingKesPeriod :: Word64 }
deriving (OpCertStartingKesPeriod -> OpCertStartingKesPeriod -> Bool
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
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) = forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertStartingKesPeriod where
parseJSON :: Value -> Parser OpCertStartingKesPeriod
parseJSON Value
v = Word64 -> OpCertStartingKesPeriod
OpCertStartingKesPeriod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
newtype OpCertEndingKesPeriod = OpCertEndingKesPeriod { OpCertEndingKesPeriod -> Word64
unOpCertEndingKesPeriod :: Word64 }
deriving (OpCertEndingKesPeriod -> OpCertEndingKesPeriod -> Bool
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
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) = forall a. ToJSON a => a -> Value
toJSON Word64
k
instance FromJSON OpCertEndingKesPeriod where
parseJSON :: Value -> Parser OpCertEndingKesPeriod
parseJSON Value
v = Word64 -> OpCertEndingKesPeriod
OpCertEndingKesPeriod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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
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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenesisFile
GenesisFile forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
genFp
parseJSON Value
invalid = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Parsing of GenesisFile failed due to type mismatch. "
forall a. Semigroup a => a -> a -> a
<> String
"Encountered: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Value
invalid
data OutputFormat
= OutputFormatHex
| OutputFormatBech32
deriving (OutputFormat -> OutputFormat -> Bool
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
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
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
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
{ forall crypto. Params crypto -> Maybe (PoolParams crypto)
poolParameters :: Maybe (PoolParams crypto)
, forall crypto. Params crypto -> Maybe (PoolParams crypto)
futurePoolParameters :: Maybe (PoolParams crypto)
, forall crypto. Params crypto -> Maybe EpochNo
retiringEpoch :: Maybe EpochNo
} deriving Int -> Params crypto -> ShowS
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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
p
, Key
"futurePoolParams" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
fp
, Key
"retiring" 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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Key
"poolParams" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
p
, Key
"futurePoolParams" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (PoolParams crypto)
fp
, Key
"retiring" 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
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
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
Ord)
deriving newtype (String -> SigningKeyFile
forall a. (String -> a) -> IsString a
fromString :: String -> SigningKeyFile
$cfromString :: String -> SigningKeyFile
IsString, Int -> SigningKeyFile -> ShowS
[SigningKeyFile] -> ShowS
SigningKeyFile -> String
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
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
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
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
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
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
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 HashableScriptData
deriving (ScriptDataOrFile -> ScriptDataOrFile -> Bool
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
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
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
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) = forall a. ToJSON a => a -> Value
toJSON SlotNo
k
instance FromJSON SlotsTillKesKeyExpiry where
parseJSON :: Value -> Parser SlotsTillKesKeyExpiry
parseJSON Value
v = SlotNo -> SlotsTillKesKeyExpiry
SlotsTillKesKeyExpiry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
data TransferDirection = TransferToReserves | TransferToTreasury
deriving Int -> TransferDirection -> ShowS
[TransferDirection] -> ShowS
TransferDirection -> String
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
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
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
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
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
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
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
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
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
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
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
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
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
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