{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- An extra interface for operation on transactions (e.g. creating witnesses,
-- estimating size...). This makes it possible to decouple those operations from
-- our wallet layer, keeping the implementation flexible to various backends.
--
module Cardano.Wallet.Transaction
    (
    -- * Interface
      TransactionLayer (..)
    , DelegationAction (..)
    , TransactionCtx (..)
    , defaultTransactionCtx
    , Withdrawal (..)
    , withdrawalToCoin
    , TxUpdate (..)
    , TxFeeUpdate(..)
    , TokenMapWithScripts (..)
    , emptyTokenMapWithScripts
    , AnyScript (..)
    , PlutusScriptInfo (..)
    , PlutusVersion (..)
    , TxFeeAndChange (..)
    , mapTxFeeAndChange
    , ValidityIntervalExplicit (..)

    -- * Errors
    , ErrSignTx (..)
    , ErrMkTransaction (..)
    , ErrCannotJoin (..)
    , ErrCannotQuit (..)
    , ErrUpdateSealedTx (..)
    , ErrAssignRedeemers(..)
    , ErrMoreSurplusNeeded (..)
    ) where

import Prelude

import Cardano.Address.Derivation
    ( XPrv, XPub )
import Cardano.Address.Script
    ( KeyHash, Script )
import Cardano.Api
    ( AnyCardanoEra )
import Cardano.Ledger.Alonzo.TxInfo
    ( TranslationError )
import Cardano.Ledger.Crypto
    ( StandardCrypto )
import Cardano.Wallet.CoinSelection
    ( SelectionCollateralRequirement (..)
    , SelectionLimit
    , SelectionOf (..)
    , SelectionSkeleton
    )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..), DerivationIndex )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase )
import Cardano.Wallet.Primitive.Slotting
    ( PastHorizonException, TimeInterpreter )
import Cardano.Wallet.Primitive.Types
    ( Certificate
    , FeePolicy
    , PoolId
    , ProtocolParameters
    , SlotNo (..)
    , TokenBundleMaxSize (..)
    , WalletId
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash )
import Cardano.Wallet.Primitive.Types.Redeemer
    ( Redeemer )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId, TokenMap )
import Cardano.Wallet.Primitive.Types.TokenPolicy
    ( TokenPolicyId )
import Cardano.Wallet.Primitive.Types.Tx
    ( TokenBundleSizeAssessor
    , Tx (..)
    , TxConstraints
    , TxIn
    , TxMetadata
    , TxOut
    , TxSize
    )
import Cardano.Wallet.Primitive.Types.UTxO
    ( UTxO )
import Cardano.Wallet.Util
    ( ShowFmt (..) )
import Control.DeepSeq
    ( NFData (..) )
import Control.Monad
    ( (>=>) )
import Data.Aeson.Types
    ( FromJSON (..)
    , Parser
    , ToJSON (..)
    , camelTo2
    , genericParseJSON
    , genericToJSON
    )
import Data.Bifunctor
    ( bimap )
import Data.List.NonEmpty
    ( NonEmpty )
import Data.Map.Strict
    ( Map )
import Data.Quantity
    ( Quantity (..) )
import Data.Text
    ( Text )
import Data.Text.Class
    ( FromText (..), TextDecodingError (..), ToText (..) )
import Data.Word
    ( Word64 )
import Fmt
    ( Buildable (..), genericF )
import GHC.Generics
    ( Generic )

import qualified Cardano.Api as Cardano
import qualified Cardano.Api.Shelley as Cardano
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Data.Aeson.Types as Aeson
import qualified Data.Map.Strict as Map

data TransactionLayer k tx = TransactionLayer
    { TransactionLayer k tx
-> AnyCardanoEra
-> (XPrv, Passphrase "encryption")
-> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
-> ProtocolParameters
-> TransactionCtx
-> SelectionOf TxOut
-> Either ErrMkTransaction (Tx, tx)
mkTransaction
        :: AnyCardanoEra
            -- Era for which the transaction should be created.
        -> (XPrv, Passphrase "encryption")
            -- Reward account
        -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
            -- Key store
        -> ProtocolParameters
            -- Current protocol parameters
        -> TransactionCtx
            -- An additional context about the transaction
        -> SelectionOf TxOut
            -- A balanced coin selection where all change addresses have been
            -- assigned.
        -> Either ErrMkTransaction (Tx, tx)
        -- ^ Construct a standard transaction
        --
        -- " Standard " here refers to the fact that we do not deal with redemption,
        -- multisignature transactions, etc.
        --
        -- This expects as a first argument a mean to compute or lookup private
        -- key corresponding to a particular address.

    , TransactionLayer k tx
-> AnyCardanoEra
-> (XPrv, Passphrase "encryption")
-> (KeyHash, XPrv, Passphrase "encryption")
-> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
-> (TxIn -> Maybe Address)
-> tx
-> tx
addVkWitnesses
        :: AnyCardanoEra
            -- Preferred latest era
        -> (XPrv, Passphrase "encryption")
            -- Reward account
        -> (KeyHash, XPrv, Passphrase "encryption")
            -- policy public and private key
        -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
            -- Key store / address resolution
        -> (TxIn -> Maybe Address)
            -- Input resolution
        -> tx
            -- The transaction to sign
        -> tx
        -- ^ Add Vk witnesses to a transaction for known inputs.
        --
        -- If inputs can't be resolved, they are simply skipped, hence why this
        -- function cannot fail.

    , TransactionLayer k tx
-> AnyCardanoEra
-> XPub
-> ProtocolParameters
-> TransactionCtx
-> SelectionOf TxOut
-> Either ErrMkTransaction tx
mkUnsignedTransaction
        :: AnyCardanoEra
            -- Era for which the transaction should be created.
        -> XPub
            -- Reward account public key
        -> ProtocolParameters
            -- Current protocol parameters
        -> TransactionCtx
            -- An additional context about the transaction
        -> SelectionOf TxOut
            -- A balanced coin selection where all change addresses have been
            -- assigned.
        -> Either ErrMkTransaction tx
        -- ^ Construct a standard unsigned transaction
        --
        -- " Standard " here refers to the fact that we do not deal with redemption,
        -- multisignature transactions, etc.
        --
        -- The function returns CBOR-ed transaction body to be signed in another step.

    , TransactionLayer k tx
-> AnyCardanoEra
-> ProtocolParameters
-> TransactionCtx
-> SelectionSkeleton
-> Coin
calcMinimumCost
        :: AnyCardanoEra
            -- Era for which the transaction should be created.
        -> ProtocolParameters
            -- Current protocol parameters
        -> TransactionCtx
            -- Additional information about the transaction
        -> SelectionSkeleton
            -- An intermediate representation of an ongoing selection
        -> Coin
        -- ^ Compute a minimal fee amount necessary to pay for a given selection
        -- This also includes necessary deposits.

    , TransactionLayer k tx -> ProtocolParameters -> [Redeemer] -> Coin
maxScriptExecutionCost
        :: ProtocolParameters
            -- Current protocol parameters
        -> [Redeemer]
            -- Redeemers for this transaction
        -> Coin
        -- ^ Compute the maximum execution cost of scripts in a given transaction.

    , TransactionLayer k tx
-> forall era.
   IsShelleyBasedEra era =>
   ProtocolParameters -> Tx era -> Coin
evaluateMinimumFee
        :: forall era. Cardano.IsShelleyBasedEra era
        => Cardano.ProtocolParameters
            -- Current protocol parameters
        -> Cardano.Tx era
            -- The sealed transaction
        -> Coin
        -- ^ Evaluate a minimal fee amount necessary to pay for a given tx
        -- using ledger's functionality
        --
        -- Will estimate how many witnesses there /should be/, so it works even
        -- for unsigned transactions.

    , TransactionLayer k tx
-> forall era.
   IsShelleyBasedEra era =>
   ProtocolParameters -> Tx era -> TxSize
estimateSignedTxSize
        :: forall era. Cardano.IsShelleyBasedEra era
        => Cardano.ProtocolParameters
        -> Cardano.Tx era
        -> TxSize
        -- ^ Estimate the size of the transaction when fully signed.

    , TransactionLayer k tx
-> forall era.
   IsShelleyBasedEra era =>
   Tx era
   -> ProtocolParameters
   -> UTxO
   -> [(TxIn, TxOut, Maybe (Hash "Datum"))]
   -> Value
evaluateTransactionBalance
        :: forall era. Cardano.IsShelleyBasedEra era
        => Cardano.Tx era
        -> Cardano.ProtocolParameters
        -> UTxO
        -> [(TxIn, TxOut, Maybe (Hash "Datum"))] -- Extra UTxO
        -> Cardano.Value
        -- ^ Evaluate the balance of a transaction using the ledger. The balance
        -- is defined as @(value consumed by transaction) - (value produced by
        -- transaction)@. For a transaction to be valid, it must have a balance
        -- of zero.
        --
        -- Note that the fee-field of the transaction affects the balance, and
        -- is not automatically the minimum fee.
        --
        -- The function takes two UTxOs of different types and merges them. The
        -- reason is to workaround a combination of:
        -- 1. The wallet 'UTxO' type doesn't support Datum hashes
        -- 2. A 'UTxO -> Cardano.UTxO' conversion function is not available in
        -- the cardano-wallet-core package, only cardano-wallet. (This package
        -- boundary will soon hopefully go away, however)

    , TransactionLayer k tx
-> FeePolicy
-> Coin
-> TxFeeAndChange [TxOut]
-> Either ErrMoreSurplusNeeded (TxFeeAndChange [TxOut])
distributeSurplus
        :: FeePolicy
        -> Coin
        -- Surplus transaction balance to distribute.
        -> TxFeeAndChange [TxOut]
        -- Original fee and change outputs.
        -> Either ErrMoreSurplusNeeded (TxFeeAndChange [TxOut])
        --
        -- ^ Distributes a surplus transaction balance between the given change
        -- outputs and the given fee. This function is aware of the fact that
        -- any increase in a 'Coin' value could increase the size and fee
        -- requirement of a transaction.
        --
        -- When comparing the original fee and change outputs to the adjusted
        -- fee and change outputs, this function guarantees that:
        --
        --    - The number of the change outputs remains constant;
        --
        --    - The fee quantity either remains the same or increases.
        --
        --    - For each change output:
        --        - the ada quantity either remains constant or increases.
        --        - non-ada quantities remain the same.
        --
        --    - The surplus is conserved:
        --        The total increase in the fee and change ada quantities is
        --        exactly equal to the surplus.
        --
        --    - Any increase in cost is covered:
        --        If the total cost has increased by 𝛿c, then the fee value
        --        will have increased by at least 𝛿c.
        --
        -- If the cost of distributing the provided surplus is greater than the
        -- surplus itself, the function will return 'ErrMoreSurplusNeeded'. If
        -- the provided surplus is greater or equal to
        -- @maximumCostOfIncreasingCoin feePolicy@, the function will always
        -- return 'Right'.

    , TransactionLayer k tx
-> AnyCardanoEra
-> ProtocolParameters
-> TransactionCtx
-> [TxOut]
-> SelectionLimit
computeSelectionLimit
        :: AnyCardanoEra
        -> ProtocolParameters
        -> TransactionCtx
        -> [TxOut]
        -> SelectionLimit

    , TransactionLayer k tx
-> TokenBundleMaxSize -> TokenBundleSizeAssessor
tokenBundleSizeAssessor
        :: TokenBundleMaxSize -> TokenBundleSizeAssessor
        -- ^ A function to assess the size of a token bundle.

    , TransactionLayer k tx
-> AnyCardanoEra -> ProtocolParameters -> TxConstraints
constraints
        :: AnyCardanoEra
        -- Era for which the transaction should be created.
        -> ProtocolParameters
        -- Current protocol parameters.
        -> TxConstraints
        -- The set of constraints that apply to all transactions.

    , TransactionLayer k tx
-> AnyCardanoEra
-> tx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
decodeTx
        :: AnyCardanoEra
        -> tx ->
            ( Tx
            , TokenMapWithScripts
            , TokenMapWithScripts
            , [Certificate]
            , Maybe ValidityIntervalExplicit
            )
    -- ^ Decode an externally-created transaction.

    , TransactionLayer k tx
-> forall era.
   IsShelleyBasedEra era =>
   Tx era -> TxUpdate -> Either ErrUpdateSealedTx (Tx era)
updateTx
        :: forall era. Cardano.IsShelleyBasedEra era
        => Cardano.Tx era
        -> TxUpdate
        -> Either ErrUpdateSealedTx (Cardano.Tx era)
        -- ^ Update tx by adding additional inputs and outputs

    , TransactionLayer k tx
-> forall era.
   IsShelleyBasedEra era =>
   ProtocolParameters
   -> TimeInterpreter (Either PastHorizonException)
   -> (TxIn -> Maybe (TxOut, Maybe (Hash "Datum")))
   -> [Redeemer]
   -> Tx era
   -> Either ErrAssignRedeemers (Tx era)
assignScriptRedeemers
        :: forall era. Cardano.IsShelleyBasedEra era
        => Cardano.ProtocolParameters
            -- Current protocol parameters
        -> TimeInterpreter (Either PastHorizonException)
            -- Time interpreter in the Monad m
        -> (TxIn -> Maybe (TxOut, Maybe (Hash "Datum")))
            -- A input resolver for transactions' inputs containing scripts.
        -> [Redeemer]
            -- A list of redeemers to set on the transaction.
        -> (Cardano.Tx era)
            -- Transaction containing scripts
        -> (Either ErrAssignRedeemers (Cardano.Tx era))
    }

-- | Method to use when updating the fee of a transaction.
data TxFeeUpdate = UseOldTxFee
                 -- ^ Instead of updating the fee, just use the old fee of the
                 -- Tx (no-op for fee update).
                 | UseNewTxFee Coin
                 -- ^ Specify a new fee to use instead.
    deriving (TxFeeUpdate -> TxFeeUpdate -> Bool
(TxFeeUpdate -> TxFeeUpdate -> Bool)
-> (TxFeeUpdate -> TxFeeUpdate -> Bool) -> Eq TxFeeUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxFeeUpdate -> TxFeeUpdate -> Bool
$c/= :: TxFeeUpdate -> TxFeeUpdate -> Bool
== :: TxFeeUpdate -> TxFeeUpdate -> Bool
$c== :: TxFeeUpdate -> TxFeeUpdate -> Bool
Eq, Int -> TxFeeUpdate -> ShowS
[TxFeeUpdate] -> ShowS
TxFeeUpdate -> String
(Int -> TxFeeUpdate -> ShowS)
-> (TxFeeUpdate -> String)
-> ([TxFeeUpdate] -> ShowS)
-> Show TxFeeUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFeeUpdate] -> ShowS
$cshowList :: [TxFeeUpdate] -> ShowS
show :: TxFeeUpdate -> String
$cshow :: TxFeeUpdate -> String
showsPrec :: Int -> TxFeeUpdate -> ShowS
$cshowsPrec :: Int -> TxFeeUpdate -> ShowS
Show)

-- | Describes modifications that can be made to a `Tx` using `updateTx`.
data TxUpdate = TxUpdate
    { TxUpdate -> [(TxIn, TxOut)]
extraInputs :: [(TxIn, TxOut)]
    , TxUpdate -> [TxIn]
extraCollateral :: [TxIn]
       -- ^ Only used in the Alonzo era and later. Will be silently ignored in
       -- previous eras.
    , TxUpdate -> [TxOut]
extraOutputs :: [TxOut]
    , TxUpdate -> TxFeeUpdate
feeUpdate :: TxFeeUpdate
        -- ^ Set a new fee or use the old one.
    }

-- | Some additional context about a transaction. This typically contains
-- details that are known upfront about the transaction and are used to
-- construct it from inputs selected from the wallet's UTxO.
data TransactionCtx = TransactionCtx
    { TransactionCtx -> Withdrawal
txWithdrawal :: Withdrawal
    -- ^ Withdrawal amount from a reward account, can be zero.
    , TransactionCtx -> Maybe TxMetadata
txMetadata :: Maybe TxMetadata
    -- ^ User or application-defined metadata to embed in the transaction.
    , TransactionCtx -> (Maybe SlotNo, SlotNo)
txValidityInterval :: (Maybe SlotNo, SlotNo)
    -- ^ Transaction optional starting slot and expiry (TTL) slot for which the
    -- transaction is valid.
    , TransactionCtx -> Maybe DelegationAction
txDelegationAction :: Maybe DelegationAction
    -- ^ An additional delegation to take.
    , TransactionCtx -> Coin
txPlutusScriptExecutionCost :: Coin
    -- ^ Total execution cost of plutus scripts, determined by their execution units
    -- and prices obtained from network.
    , TransactionCtx -> (TokenMap, Map AssetId (Script KeyHash))
txAssetsToMint :: (TokenMap, Map AssetId (Script KeyHash))
    -- ^ The assets to mint.
    , TransactionCtx -> (TokenMap, Map AssetId (Script KeyHash))
txAssetsToBurn :: (TokenMap, Map AssetId (Script KeyHash))
    -- ^ The assets to burn.
    , TransactionCtx -> SelectionCollateralRequirement
txCollateralRequirement :: SelectionCollateralRequirement
    -- ^ The collateral requirement.
    , TransactionCtx -> Coin
txFeePadding :: !Coin
    -- ^ Extra fees. Some parts of a transaction are not representable using
    -- cardano-wallet types, which makes it useful to account for them like
    -- this. For instance: datums.
    } deriving (Int -> TransactionCtx -> ShowS
[TransactionCtx] -> ShowS
TransactionCtx -> String
(Int -> TransactionCtx -> ShowS)
-> (TransactionCtx -> String)
-> ([TransactionCtx] -> ShowS)
-> Show TransactionCtx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionCtx] -> ShowS
$cshowList :: [TransactionCtx] -> ShowS
show :: TransactionCtx -> String
$cshow :: TransactionCtx -> String
showsPrec :: Int -> TransactionCtx -> ShowS
$cshowsPrec :: Int -> TransactionCtx -> ShowS
Show, (forall x. TransactionCtx -> Rep TransactionCtx x)
-> (forall x. Rep TransactionCtx x -> TransactionCtx)
-> Generic TransactionCtx
forall x. Rep TransactionCtx x -> TransactionCtx
forall x. TransactionCtx -> Rep TransactionCtx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransactionCtx x -> TransactionCtx
$cfrom :: forall x. TransactionCtx -> Rep TransactionCtx x
Generic, TransactionCtx -> TransactionCtx -> Bool
(TransactionCtx -> TransactionCtx -> Bool)
-> (TransactionCtx -> TransactionCtx -> Bool) -> Eq TransactionCtx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionCtx -> TransactionCtx -> Bool
$c/= :: TransactionCtx -> TransactionCtx -> Bool
== :: TransactionCtx -> TransactionCtx -> Bool
$c== :: TransactionCtx -> TransactionCtx -> Bool
Eq)

data Withdrawal
    = WithdrawalSelf RewardAccount (NonEmpty DerivationIndex) Coin
    | WithdrawalExternal RewardAccount (NonEmpty DerivationIndex) Coin
    | NoWithdrawal
    deriving (Int -> Withdrawal -> ShowS
[Withdrawal] -> ShowS
Withdrawal -> String
(Int -> Withdrawal -> ShowS)
-> (Withdrawal -> String)
-> ([Withdrawal] -> ShowS)
-> Show Withdrawal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Withdrawal] -> ShowS
$cshowList :: [Withdrawal] -> ShowS
show :: Withdrawal -> String
$cshow :: Withdrawal -> String
showsPrec :: Int -> Withdrawal -> ShowS
$cshowsPrec :: Int -> Withdrawal -> ShowS
Show, Withdrawal -> Withdrawal -> Bool
(Withdrawal -> Withdrawal -> Bool)
-> (Withdrawal -> Withdrawal -> Bool) -> Eq Withdrawal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Withdrawal -> Withdrawal -> Bool
$c/= :: Withdrawal -> Withdrawal -> Bool
== :: Withdrawal -> Withdrawal -> Bool
$c== :: Withdrawal -> Withdrawal -> Bool
Eq)

withdrawalToCoin :: Withdrawal -> Coin
withdrawalToCoin :: Withdrawal -> Coin
withdrawalToCoin = \case
    WithdrawalSelf RewardAccount
_ NonEmpty DerivationIndex
_ Coin
c -> Coin
c
    WithdrawalExternal RewardAccount
_ NonEmpty DerivationIndex
_ Coin
c -> Coin
c
    Withdrawal
NoWithdrawal -> Natural -> Coin
Coin Natural
0

-- | A default context with sensible placeholder. Can be used to reduce
-- repetition for changing only sub-part of the default context.
defaultTransactionCtx :: TransactionCtx
defaultTransactionCtx :: TransactionCtx
defaultTransactionCtx = TransactionCtx :: Withdrawal
-> Maybe TxMetadata
-> (Maybe SlotNo, SlotNo)
-> Maybe DelegationAction
-> Coin
-> (TokenMap, Map AssetId (Script KeyHash))
-> (TokenMap, Map AssetId (Script KeyHash))
-> SelectionCollateralRequirement
-> Coin
-> TransactionCtx
TransactionCtx
    { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
NoWithdrawal
    , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
forall a. Maybe a
Nothing
    , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (Maybe SlotNo
forall a. Maybe a
Nothing, SlotNo
forall a. Bounded a => a
maxBound)
    , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = Maybe DelegationAction
forall a. Maybe a
Nothing
    , $sel:txPlutusScriptExecutionCost:TransactionCtx :: Coin
txPlutusScriptExecutionCost = Natural -> Coin
Coin Natural
0
    , $sel:txAssetsToMint:TransactionCtx :: (TokenMap, Map AssetId (Script KeyHash))
txAssetsToMint = (TokenMap
TokenMap.empty, Map AssetId (Script KeyHash)
forall k a. Map k a
Map.empty)
    , $sel:txAssetsToBurn:TransactionCtx :: (TokenMap, Map AssetId (Script KeyHash))
txAssetsToBurn = (TokenMap
TokenMap.empty, Map AssetId (Script KeyHash)
forall k a. Map k a
Map.empty)
    , $sel:txCollateralRequirement:TransactionCtx :: SelectionCollateralRequirement
txCollateralRequirement = SelectionCollateralRequirement
SelectionCollateralNotRequired
    , $sel:txFeePadding:TransactionCtx :: Coin
txFeePadding = Natural -> Coin
Coin Natural
0
    }

-- | Whether the user is attempting any particular delegation action.
data DelegationAction = RegisterKeyAndJoin PoolId | Join PoolId | Quit
    deriving (Int -> DelegationAction -> ShowS
[DelegationAction] -> ShowS
DelegationAction -> String
(Int -> DelegationAction -> ShowS)
-> (DelegationAction -> String)
-> ([DelegationAction] -> ShowS)
-> Show DelegationAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelegationAction] -> ShowS
$cshowList :: [DelegationAction] -> ShowS
show :: DelegationAction -> String
$cshow :: DelegationAction -> String
showsPrec :: Int -> DelegationAction -> ShowS
$cshowsPrec :: Int -> DelegationAction -> ShowS
Show, DelegationAction -> DelegationAction -> Bool
(DelegationAction -> DelegationAction -> Bool)
-> (DelegationAction -> DelegationAction -> Bool)
-> Eq DelegationAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelegationAction -> DelegationAction -> Bool
$c/= :: DelegationAction -> DelegationAction -> Bool
== :: DelegationAction -> DelegationAction -> Bool
$c== :: DelegationAction -> DelegationAction -> Bool
Eq, (forall x. DelegationAction -> Rep DelegationAction x)
-> (forall x. Rep DelegationAction x -> DelegationAction)
-> Generic DelegationAction
forall x. Rep DelegationAction x -> DelegationAction
forall x. DelegationAction -> Rep DelegationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DelegationAction x -> DelegationAction
$cfrom :: forall x. DelegationAction -> Rep DelegationAction x
Generic)

instance Buildable DelegationAction where
    build :: DelegationAction -> Builder
build = DelegationAction -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF

data PlutusVersion =
    PlutusVersionV1 | PlutusVersionV2
    deriving (PlutusVersion -> PlutusVersion -> Bool
(PlutusVersion -> PlutusVersion -> Bool)
-> (PlutusVersion -> PlutusVersion -> Bool) -> Eq PlutusVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusVersion -> PlutusVersion -> Bool
$c/= :: PlutusVersion -> PlutusVersion -> Bool
== :: PlutusVersion -> PlutusVersion -> Bool
$c== :: PlutusVersion -> PlutusVersion -> Bool
Eq, (forall x. PlutusVersion -> Rep PlutusVersion x)
-> (forall x. Rep PlutusVersion x -> PlutusVersion)
-> Generic PlutusVersion
forall x. Rep PlutusVersion x -> PlutusVersion
forall x. PlutusVersion -> Rep PlutusVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlutusVersion x -> PlutusVersion
$cfrom :: forall x. PlutusVersion -> Rep PlutusVersion x
Generic, Int -> PlutusVersion -> ShowS
[PlutusVersion] -> ShowS
PlutusVersion -> String
(Int -> PlutusVersion -> ShowS)
-> (PlutusVersion -> String)
-> ([PlutusVersion] -> ShowS)
-> Show PlutusVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusVersion] -> ShowS
$cshowList :: [PlutusVersion] -> ShowS
show :: PlutusVersion -> String
$cshow :: PlutusVersion -> String
showsPrec :: Int -> PlutusVersion -> ShowS
$cshowsPrec :: Int -> PlutusVersion -> ShowS
Show)
    deriving anyclass PlutusVersion -> ()
(PlutusVersion -> ()) -> NFData PlutusVersion
forall a. (a -> ()) -> NFData a
rnf :: PlutusVersion -> ()
$crnf :: PlutusVersion -> ()
NFData

instance ToText PlutusVersion where
    toText :: PlutusVersion -> Text
toText PlutusVersion
PlutusVersionV1 = Text
"v1"
    toText PlutusVersion
PlutusVersionV2 = Text
"v2"

instance FromText PlutusVersion where
    fromText :: Text -> Either TextDecodingError PlutusVersion
fromText Text
txt = case Text
txt of
        Text
"v1" -> PlutusVersion -> Either TextDecodingError PlutusVersion
forall a b. b -> Either a b
Right PlutusVersion
PlutusVersionV1
        Text
"v2" -> PlutusVersion -> Either TextDecodingError PlutusVersion
forall a b. b -> Either a b
Right PlutusVersion
PlutusVersionV2
        Text
_ -> TextDecodingError -> Either TextDecodingError PlutusVersion
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError PlutusVersion)
-> TextDecodingError -> Either TextDecodingError PlutusVersion
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"I couldn't parse the given plutus version."
            , String
"I am expecting one of the words 'v1' or"
            , String
"'v2'."]

newtype PlutusScriptInfo = PlutusScriptInfo
    { PlutusScriptInfo -> PlutusVersion
languageVersion :: PlutusVersion
    }
    deriving (PlutusScriptInfo -> PlutusScriptInfo -> Bool
(PlutusScriptInfo -> PlutusScriptInfo -> Bool)
-> (PlutusScriptInfo -> PlutusScriptInfo -> Bool)
-> Eq PlutusScriptInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScriptInfo -> PlutusScriptInfo -> Bool
$c/= :: PlutusScriptInfo -> PlutusScriptInfo -> Bool
== :: PlutusScriptInfo -> PlutusScriptInfo -> Bool
$c== :: PlutusScriptInfo -> PlutusScriptInfo -> Bool
Eq, (forall x. PlutusScriptInfo -> Rep PlutusScriptInfo x)
-> (forall x. Rep PlutusScriptInfo x -> PlutusScriptInfo)
-> Generic PlutusScriptInfo
forall x. Rep PlutusScriptInfo x -> PlutusScriptInfo
forall x. PlutusScriptInfo -> Rep PlutusScriptInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlutusScriptInfo x -> PlutusScriptInfo
$cfrom :: forall x. PlutusScriptInfo -> Rep PlutusScriptInfo x
Generic, Int -> PlutusScriptInfo -> ShowS
[PlutusScriptInfo] -> ShowS
PlutusScriptInfo -> String
(Int -> PlutusScriptInfo -> ShowS)
-> (PlutusScriptInfo -> String)
-> ([PlutusScriptInfo] -> ShowS)
-> Show PlutusScriptInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusScriptInfo] -> ShowS
$cshowList :: [PlutusScriptInfo] -> ShowS
show :: PlutusScriptInfo -> String
$cshow :: PlutusScriptInfo -> String
showsPrec :: Int -> PlutusScriptInfo -> ShowS
$cshowsPrec :: Int -> PlutusScriptInfo -> ShowS
Show)
    deriving anyclass PlutusScriptInfo -> ()
(PlutusScriptInfo -> ()) -> NFData PlutusScriptInfo
forall a. (a -> ()) -> NFData a
rnf :: PlutusScriptInfo -> ()
$crnf :: PlutusScriptInfo -> ()
NFData

instance FromJSON PlutusScriptInfo where
    parseJSON :: Value -> Parser PlutusScriptInfo
parseJSON = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser PlutusScriptInfo)
-> Value
-> Parser PlutusScriptInfo
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        Either (ShowFmt TextDecodingError) PlutusScriptInfo
-> Parser PlutusScriptInfo
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) PlutusScriptInfo
 -> Parser PlutusScriptInfo)
-> (Text -> Either (ShowFmt TextDecodingError) PlutusScriptInfo)
-> Text
-> Parser PlutusScriptInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (PlutusVersion -> PlutusScriptInfo)
-> Either TextDecodingError PlutusVersion
-> Either (ShowFmt TextDecodingError) PlutusScriptInfo
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt PlutusVersion -> PlutusScriptInfo
PlutusScriptInfo (Either TextDecodingError PlutusVersion
 -> Either (ShowFmt TextDecodingError) PlutusScriptInfo)
-> (Text -> Either TextDecodingError PlutusVersion)
-> Text
-> Either (ShowFmt TextDecodingError) PlutusScriptInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError PlutusVersion
forall a. FromText a => Text -> Either TextDecodingError a
fromText
      where
          eitherToParser :: Show s => Either s a -> Parser a
          eitherToParser :: Either s a -> Parser a
eitherToParser = (s -> Parser a) -> (a -> Parser a) -> Either s a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> (s -> String) -> s -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show) a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance ToJSON PlutusScriptInfo where
    toJSON :: PlutusScriptInfo -> Value
toJSON (PlutusScriptInfo PlutusVersion
v) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ PlutusVersion -> Text
forall a. ToText a => a -> Text
toText PlutusVersion
v

data AnyScript =
      NativeScript !(Script KeyHash)
    | PlutusScript !PlutusScriptInfo
    deriving (AnyScript -> AnyScript -> Bool
(AnyScript -> AnyScript -> Bool)
-> (AnyScript -> AnyScript -> Bool) -> Eq AnyScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyScript -> AnyScript -> Bool
$c/= :: AnyScript -> AnyScript -> Bool
== :: AnyScript -> AnyScript -> Bool
$c== :: AnyScript -> AnyScript -> Bool
Eq, (forall x. AnyScript -> Rep AnyScript x)
-> (forall x. Rep AnyScript x -> AnyScript) -> Generic AnyScript
forall x. Rep AnyScript x -> AnyScript
forall x. AnyScript -> Rep AnyScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnyScript x -> AnyScript
$cfrom :: forall x. AnyScript -> Rep AnyScript x
Generic, Int -> AnyScript -> ShowS
[AnyScript] -> ShowS
AnyScript -> String
(Int -> AnyScript -> ShowS)
-> (AnyScript -> String)
-> ([AnyScript] -> ShowS)
-> Show AnyScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyScript] -> ShowS
$cshowList :: [AnyScript] -> ShowS
show :: AnyScript -> String
$cshow :: AnyScript -> String
showsPrec :: Int -> AnyScript -> ShowS
$cshowsPrec :: Int -> AnyScript -> ShowS
Show)
    deriving anyclass AnyScript -> ()
(AnyScript -> ()) -> NFData AnyScript
forall a. (a -> ()) -> NFData a
rnf :: AnyScript -> ()
$crnf :: AnyScript -> ()
NFData

data TokenMapWithScripts = TokenMapWithScripts
    { TokenMapWithScripts -> TokenMap
txTokenMap :: !TokenMap
    , TokenMapWithScripts -> Map TokenPolicyId AnyScript
txScripts :: !(Map TokenPolicyId AnyScript)
    } deriving (Int -> TokenMapWithScripts -> ShowS
[TokenMapWithScripts] -> ShowS
TokenMapWithScripts -> String
(Int -> TokenMapWithScripts -> ShowS)
-> (TokenMapWithScripts -> String)
-> ([TokenMapWithScripts] -> ShowS)
-> Show TokenMapWithScripts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenMapWithScripts] -> ShowS
$cshowList :: [TokenMapWithScripts] -> ShowS
show :: TokenMapWithScripts -> String
$cshow :: TokenMapWithScripts -> String
showsPrec :: Int -> TokenMapWithScripts -> ShowS
$cshowsPrec :: Int -> TokenMapWithScripts -> ShowS
Show, (forall x. TokenMapWithScripts -> Rep TokenMapWithScripts x)
-> (forall x. Rep TokenMapWithScripts x -> TokenMapWithScripts)
-> Generic TokenMapWithScripts
forall x. Rep TokenMapWithScripts x -> TokenMapWithScripts
forall x. TokenMapWithScripts -> Rep TokenMapWithScripts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenMapWithScripts x -> TokenMapWithScripts
$cfrom :: forall x. TokenMapWithScripts -> Rep TokenMapWithScripts x
Generic, TokenMapWithScripts -> TokenMapWithScripts -> Bool
(TokenMapWithScripts -> TokenMapWithScripts -> Bool)
-> (TokenMapWithScripts -> TokenMapWithScripts -> Bool)
-> Eq TokenMapWithScripts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenMapWithScripts -> TokenMapWithScripts -> Bool
$c/= :: TokenMapWithScripts -> TokenMapWithScripts -> Bool
== :: TokenMapWithScripts -> TokenMapWithScripts -> Bool
$c== :: TokenMapWithScripts -> TokenMapWithScripts -> Bool
Eq)

emptyTokenMapWithScripts :: TokenMapWithScripts
emptyTokenMapWithScripts :: TokenMapWithScripts
emptyTokenMapWithScripts = TokenMapWithScripts :: TokenMap -> Map TokenPolicyId AnyScript -> TokenMapWithScripts
TokenMapWithScripts
    { $sel:txTokenMap:TokenMapWithScripts :: TokenMap
txTokenMap = TokenMap
forall a. Monoid a => a
mempty
    , $sel:txScripts:TokenMapWithScripts :: Map TokenPolicyId AnyScript
txScripts = Map TokenPolicyId AnyScript
forall k a. Map k a
Map.empty
    }

data ErrMkTransaction
    = ErrMkTransactionNoSuchWallet WalletId
    | ErrMkTransactionTxBodyError Text
    -- ^ We failed to construct a transaction for some reasons.
    | ErrMkTransactionInvalidEra AnyCardanoEra
    -- ^ Should never happen, means that that we have programmatically provided
    -- an invalid era.
    | ErrMkTransactionJoinStakePool ErrCannotJoin
    | ErrMkTransactionQuitStakePool ErrCannotQuit
    | ErrMkTransactionIncorrectTTL PastHorizonException
    deriving ((forall x. ErrMkTransaction -> Rep ErrMkTransaction x)
-> (forall x. Rep ErrMkTransaction x -> ErrMkTransaction)
-> Generic ErrMkTransaction
forall x. Rep ErrMkTransaction x -> ErrMkTransaction
forall x. ErrMkTransaction -> Rep ErrMkTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrMkTransaction x -> ErrMkTransaction
$cfrom :: forall x. ErrMkTransaction -> Rep ErrMkTransaction x
Generic, ErrMkTransaction -> ErrMkTransaction -> Bool
(ErrMkTransaction -> ErrMkTransaction -> Bool)
-> (ErrMkTransaction -> ErrMkTransaction -> Bool)
-> Eq ErrMkTransaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrMkTransaction -> ErrMkTransaction -> Bool
$c/= :: ErrMkTransaction -> ErrMkTransaction -> Bool
== :: ErrMkTransaction -> ErrMkTransaction -> Bool
$c== :: ErrMkTransaction -> ErrMkTransaction -> Bool
Eq, Int -> ErrMkTransaction -> ShowS
[ErrMkTransaction] -> ShowS
ErrMkTransaction -> String
(Int -> ErrMkTransaction -> ShowS)
-> (ErrMkTransaction -> String)
-> ([ErrMkTransaction] -> ShowS)
-> Show ErrMkTransaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrMkTransaction] -> ShowS
$cshowList :: [ErrMkTransaction] -> ShowS
show :: ErrMkTransaction -> String
$cshow :: ErrMkTransaction -> String
showsPrec :: Int -> ErrMkTransaction -> ShowS
$cshowsPrec :: Int -> ErrMkTransaction -> ShowS
Show)

data ErrAssignRedeemers
    = ErrAssignRedeemersScriptFailure Redeemer String
    -- ^ Failed to assign execution units for a particular redeemer. The
    -- 'String' indicates the reason of the failure.
    --
    -- TODO: Refine this type to avoid the 'String' and provides a better
    -- sum-type of possible errors.
    | ErrAssignRedeemersTargetNotFound Redeemer
    -- ^ The given redeemer target couldn't be located in the transaction.
    | ErrAssignRedeemersInvalidData Redeemer String
    -- ^ Redeemer's data isn't a valid Plutus' data.
    | ErrAssignRedeemersTranslationError (TranslationError StandardCrypto)
    -- ^ Mistranslating of hashes, credentials, certificates etc.
    deriving ((forall x. ErrAssignRedeemers -> Rep ErrAssignRedeemers x)
-> (forall x. Rep ErrAssignRedeemers x -> ErrAssignRedeemers)
-> Generic ErrAssignRedeemers
forall x. Rep ErrAssignRedeemers x -> ErrAssignRedeemers
forall x. ErrAssignRedeemers -> Rep ErrAssignRedeemers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrAssignRedeemers x -> ErrAssignRedeemers
$cfrom :: forall x. ErrAssignRedeemers -> Rep ErrAssignRedeemers x
Generic, ErrAssignRedeemers -> ErrAssignRedeemers -> Bool
(ErrAssignRedeemers -> ErrAssignRedeemers -> Bool)
-> (ErrAssignRedeemers -> ErrAssignRedeemers -> Bool)
-> Eq ErrAssignRedeemers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrAssignRedeemers -> ErrAssignRedeemers -> Bool
$c/= :: ErrAssignRedeemers -> ErrAssignRedeemers -> Bool
== :: ErrAssignRedeemers -> ErrAssignRedeemers -> Bool
$c== :: ErrAssignRedeemers -> ErrAssignRedeemers -> Bool
Eq, Int -> ErrAssignRedeemers -> ShowS
[ErrAssignRedeemers] -> ShowS
ErrAssignRedeemers -> String
(Int -> ErrAssignRedeemers -> ShowS)
-> (ErrAssignRedeemers -> String)
-> ([ErrAssignRedeemers] -> ShowS)
-> Show ErrAssignRedeemers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrAssignRedeemers] -> ShowS
$cshowList :: [ErrAssignRedeemers] -> ShowS
show :: ErrAssignRedeemers -> String
$cshow :: ErrAssignRedeemers -> String
showsPrec :: Int -> ErrAssignRedeemers -> ShowS
$cshowsPrec :: Int -> ErrAssignRedeemers -> ShowS
Show)

-- | Possible signing error
data ErrSignTx
    = ErrSignTxAddressUnknown TxIn
    -- ^ We tried to sign a transaction with inputs that are unknown to us?
    | ErrSignTxUnimplemented
    -- ^ TODO: [ADP-919] Remove ErrSignTxUnimplemented
    deriving ((forall x. ErrSignTx -> Rep ErrSignTx x)
-> (forall x. Rep ErrSignTx x -> ErrSignTx) -> Generic ErrSignTx
forall x. Rep ErrSignTx x -> ErrSignTx
forall x. ErrSignTx -> Rep ErrSignTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrSignTx x -> ErrSignTx
$cfrom :: forall x. ErrSignTx -> Rep ErrSignTx x
Generic, ErrSignTx -> ErrSignTx -> Bool
(ErrSignTx -> ErrSignTx -> Bool)
-> (ErrSignTx -> ErrSignTx -> Bool) -> Eq ErrSignTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrSignTx -> ErrSignTx -> Bool
$c/= :: ErrSignTx -> ErrSignTx -> Bool
== :: ErrSignTx -> ErrSignTx -> Bool
$c== :: ErrSignTx -> ErrSignTx -> Bool
Eq, Int -> ErrSignTx -> ShowS
[ErrSignTx] -> ShowS
ErrSignTx -> String
(Int -> ErrSignTx -> ShowS)
-> (ErrSignTx -> String)
-> ([ErrSignTx] -> ShowS)
-> Show ErrSignTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrSignTx] -> ShowS
$cshowList :: [ErrSignTx] -> ShowS
show :: ErrSignTx -> String
$cshow :: ErrSignTx -> String
showsPrec :: Int -> ErrSignTx -> ShowS
$cshowsPrec :: Int -> ErrSignTx -> ShowS
Show)

data ErrCannotJoin
    = ErrAlreadyDelegating PoolId
    | ErrNoSuchPool PoolId
    deriving ((forall x. ErrCannotJoin -> Rep ErrCannotJoin x)
-> (forall x. Rep ErrCannotJoin x -> ErrCannotJoin)
-> Generic ErrCannotJoin
forall x. Rep ErrCannotJoin x -> ErrCannotJoin
forall x. ErrCannotJoin -> Rep ErrCannotJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrCannotJoin x -> ErrCannotJoin
$cfrom :: forall x. ErrCannotJoin -> Rep ErrCannotJoin x
Generic, ErrCannotJoin -> ErrCannotJoin -> Bool
(ErrCannotJoin -> ErrCannotJoin -> Bool)
-> (ErrCannotJoin -> ErrCannotJoin -> Bool) -> Eq ErrCannotJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrCannotJoin -> ErrCannotJoin -> Bool
$c/= :: ErrCannotJoin -> ErrCannotJoin -> Bool
== :: ErrCannotJoin -> ErrCannotJoin -> Bool
$c== :: ErrCannotJoin -> ErrCannotJoin -> Bool
Eq, Int -> ErrCannotJoin -> ShowS
[ErrCannotJoin] -> ShowS
ErrCannotJoin -> String
(Int -> ErrCannotJoin -> ShowS)
-> (ErrCannotJoin -> String)
-> ([ErrCannotJoin] -> ShowS)
-> Show ErrCannotJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrCannotJoin] -> ShowS
$cshowList :: [ErrCannotJoin] -> ShowS
show :: ErrCannotJoin -> String
$cshow :: ErrCannotJoin -> String
showsPrec :: Int -> ErrCannotJoin -> ShowS
$cshowsPrec :: Int -> ErrCannotJoin -> ShowS
Show)

data ErrCannotQuit
    = ErrNotDelegatingOrAboutTo
    | ErrNonNullRewards Coin
    deriving (ErrCannotQuit -> ErrCannotQuit -> Bool
(ErrCannotQuit -> ErrCannotQuit -> Bool)
-> (ErrCannotQuit -> ErrCannotQuit -> Bool) -> Eq ErrCannotQuit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrCannotQuit -> ErrCannotQuit -> Bool
$c/= :: ErrCannotQuit -> ErrCannotQuit -> Bool
== :: ErrCannotQuit -> ErrCannotQuit -> Bool
$c== :: ErrCannotQuit -> ErrCannotQuit -> Bool
Eq, Int -> ErrCannotQuit -> ShowS
[ErrCannotQuit] -> ShowS
ErrCannotQuit -> String
(Int -> ErrCannotQuit -> ShowS)
-> (ErrCannotQuit -> String)
-> ([ErrCannotQuit] -> ShowS)
-> Show ErrCannotQuit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrCannotQuit] -> ShowS
$cshowList :: [ErrCannotQuit] -> ShowS
show :: ErrCannotQuit -> String
$cshow :: ErrCannotQuit -> String
showsPrec :: Int -> ErrCannotQuit -> ShowS
$cshowsPrec :: Int -> ErrCannotQuit -> ShowS
Show)

newtype ErrUpdateSealedTx
    = ErrExistingKeyWitnesses Int
    -- ^ The `SealedTx` couldn't not be updated because the *n* existing
    -- key-witnesses would have been rendered invalid.
    deriving ((forall x. ErrUpdateSealedTx -> Rep ErrUpdateSealedTx x)
-> (forall x. Rep ErrUpdateSealedTx x -> ErrUpdateSealedTx)
-> Generic ErrUpdateSealedTx
forall x. Rep ErrUpdateSealedTx x -> ErrUpdateSealedTx
forall x. ErrUpdateSealedTx -> Rep ErrUpdateSealedTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrUpdateSealedTx x -> ErrUpdateSealedTx
$cfrom :: forall x. ErrUpdateSealedTx -> Rep ErrUpdateSealedTx x
Generic, ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool
(ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool)
-> (ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool)
-> Eq ErrUpdateSealedTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool
$c/= :: ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool
== :: ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool
$c== :: ErrUpdateSealedTx -> ErrUpdateSealedTx -> Bool
Eq, Int -> ErrUpdateSealedTx -> ShowS
[ErrUpdateSealedTx] -> ShowS
ErrUpdateSealedTx -> String
(Int -> ErrUpdateSealedTx -> ShowS)
-> (ErrUpdateSealedTx -> String)
-> ([ErrUpdateSealedTx] -> ShowS)
-> Show ErrUpdateSealedTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrUpdateSealedTx] -> ShowS
$cshowList :: [ErrUpdateSealedTx] -> ShowS
show :: ErrUpdateSealedTx -> String
$cshow :: ErrUpdateSealedTx -> String
showsPrec :: Int -> ErrUpdateSealedTx -> ShowS
$cshowsPrec :: Int -> ErrUpdateSealedTx -> ShowS
Show)

-- | Error for when its impossible for 'distributeSurplus' to distribute the
-- surplus. As long as the surplus is larger than 'costOfIncreasingCoin', this
-- should never happen.
newtype ErrMoreSurplusNeeded = ErrMoreSurplusNeeded Coin
    deriving ((forall x. ErrMoreSurplusNeeded -> Rep ErrMoreSurplusNeeded x)
-> (forall x. Rep ErrMoreSurplusNeeded x -> ErrMoreSurplusNeeded)
-> Generic ErrMoreSurplusNeeded
forall x. Rep ErrMoreSurplusNeeded x -> ErrMoreSurplusNeeded
forall x. ErrMoreSurplusNeeded -> Rep ErrMoreSurplusNeeded x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrMoreSurplusNeeded x -> ErrMoreSurplusNeeded
$cfrom :: forall x. ErrMoreSurplusNeeded -> Rep ErrMoreSurplusNeeded x
Generic, ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool
(ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool)
-> (ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool)
-> Eq ErrMoreSurplusNeeded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool
$c/= :: ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool
== :: ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool
$c== :: ErrMoreSurplusNeeded -> ErrMoreSurplusNeeded -> Bool
Eq, Int -> ErrMoreSurplusNeeded -> ShowS
[ErrMoreSurplusNeeded] -> ShowS
ErrMoreSurplusNeeded -> String
(Int -> ErrMoreSurplusNeeded -> ShowS)
-> (ErrMoreSurplusNeeded -> String)
-> ([ErrMoreSurplusNeeded] -> ShowS)
-> Show ErrMoreSurplusNeeded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrMoreSurplusNeeded] -> ShowS
$cshowList :: [ErrMoreSurplusNeeded] -> ShowS
show :: ErrMoreSurplusNeeded -> String
$cshow :: ErrMoreSurplusNeeded -> String
showsPrec :: Int -> ErrMoreSurplusNeeded -> ShowS
$cshowsPrec :: Int -> ErrMoreSurplusNeeded -> ShowS
Show)

-- | Small helper record to disambiguate between a fee and change Coin values.
-- Used by 'distributeSurplus'.
data TxFeeAndChange change = TxFeeAndChange
    { TxFeeAndChange change -> Coin
fee :: Coin
    , TxFeeAndChange change -> change
change :: change
    }
    deriving (TxFeeAndChange change -> TxFeeAndChange change -> Bool
(TxFeeAndChange change -> TxFeeAndChange change -> Bool)
-> (TxFeeAndChange change -> TxFeeAndChange change -> Bool)
-> Eq (TxFeeAndChange change)
forall change.
Eq change =>
TxFeeAndChange change -> TxFeeAndChange change -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxFeeAndChange change -> TxFeeAndChange change -> Bool
$c/= :: forall change.
Eq change =>
TxFeeAndChange change -> TxFeeAndChange change -> Bool
== :: TxFeeAndChange change -> TxFeeAndChange change -> Bool
$c== :: forall change.
Eq change =>
TxFeeAndChange change -> TxFeeAndChange change -> Bool
Eq, Int -> TxFeeAndChange change -> ShowS
[TxFeeAndChange change] -> ShowS
TxFeeAndChange change -> String
(Int -> TxFeeAndChange change -> ShowS)
-> (TxFeeAndChange change -> String)
-> ([TxFeeAndChange change] -> ShowS)
-> Show (TxFeeAndChange change)
forall change. Show change => Int -> TxFeeAndChange change -> ShowS
forall change. Show change => [TxFeeAndChange change] -> ShowS
forall change. Show change => TxFeeAndChange change -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFeeAndChange change] -> ShowS
$cshowList :: forall change. Show change => [TxFeeAndChange change] -> ShowS
show :: TxFeeAndChange change -> String
$cshow :: forall change. Show change => TxFeeAndChange change -> String
showsPrec :: Int -> TxFeeAndChange change -> ShowS
$cshowsPrec :: forall change. Show change => Int -> TxFeeAndChange change -> ShowS
Show)

-- | Manipulates a 'TxFeeAndChange' value.
--
mapTxFeeAndChange
    :: (Coin -> Coin)
    -- ^ A function to transform the fee
    -> (change1 -> change2)
    -- ^ A function to transform the change
    -> TxFeeAndChange change1
    -- ^ The original fee and change
    -> TxFeeAndChange change2
    -- ^ The transformed fee and change
mapTxFeeAndChange :: (Coin -> Coin)
-> (change1 -> change2)
-> TxFeeAndChange change1
-> TxFeeAndChange change2
mapTxFeeAndChange Coin -> Coin
mapFee change1 -> change2
mapChange TxFeeAndChange {Coin
fee :: Coin
$sel:fee:TxFeeAndChange :: forall change. TxFeeAndChange change -> Coin
fee, change1
change :: change1
$sel:change:TxFeeAndChange :: forall change. TxFeeAndChange change -> change
change} =
    Coin -> change2 -> TxFeeAndChange change2
forall change. Coin -> change -> TxFeeAndChange change
TxFeeAndChange (Coin -> Coin
mapFee Coin
fee) (change1 -> change2
mapChange change1
change)

data ValidityIntervalExplicit = ValidityIntervalExplicit
    { ValidityIntervalExplicit -> Quantity "slot" Word64
invalidBefore :: !(Quantity "slot" Word64)
    , ValidityIntervalExplicit -> Quantity "slot" Word64
invalidHereafter :: !(Quantity "slot" Word64)
    }
    deriving ((forall x.
 ValidityIntervalExplicit -> Rep ValidityIntervalExplicit x)
-> (forall x.
    Rep ValidityIntervalExplicit x -> ValidityIntervalExplicit)
-> Generic ValidityIntervalExplicit
forall x.
Rep ValidityIntervalExplicit x -> ValidityIntervalExplicit
forall x.
ValidityIntervalExplicit -> Rep ValidityIntervalExplicit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ValidityIntervalExplicit x -> ValidityIntervalExplicit
$cfrom :: forall x.
ValidityIntervalExplicit -> Rep ValidityIntervalExplicit x
Generic, ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool
(ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool)
-> (ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool)
-> Eq ValidityIntervalExplicit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool
$c/= :: ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool
== :: ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool
$c== :: ValidityIntervalExplicit -> ValidityIntervalExplicit -> Bool
Eq, Int -> ValidityIntervalExplicit -> ShowS
[ValidityIntervalExplicit] -> ShowS
ValidityIntervalExplicit -> String
(Int -> ValidityIntervalExplicit -> ShowS)
-> (ValidityIntervalExplicit -> String)
-> ([ValidityIntervalExplicit] -> ShowS)
-> Show ValidityIntervalExplicit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidityIntervalExplicit] -> ShowS
$cshowList :: [ValidityIntervalExplicit] -> ShowS
show :: ValidityIntervalExplicit -> String
$cshow :: ValidityIntervalExplicit -> String
showsPrec :: Int -> ValidityIntervalExplicit -> ShowS
$cshowsPrec :: Int -> ValidityIntervalExplicit -> ShowS
Show)
    deriving anyclass ValidityIntervalExplicit -> ()
(ValidityIntervalExplicit -> ()) -> NFData ValidityIntervalExplicit
forall a. (a -> ()) -> NFData a
rnf :: ValidityIntervalExplicit -> ()
$crnf :: ValidityIntervalExplicit -> ()
NFData

instance ToJSON ValidityIntervalExplicit where
    toJSON :: ValidityIntervalExplicit -> Value
toJSON = Options -> ValidityIntervalExplicit -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions
instance FromJSON ValidityIntervalExplicit where
    parseJSON :: Value -> Parser ValidityIntervalExplicit
parseJSON = Options -> Value -> Parser ValidityIntervalExplicit
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions

defaultRecordTypeOptions :: Aeson.Options
defaultRecordTypeOptions :: Options
defaultRecordTypeOptions = Options
Aeson.defaultOptions
    { fieldLabelModifier :: ShowS
Aeson.fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
    , omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True
    }