{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module defines core type families which we know to vary from era to
-- era.
--
-- Families in this module should be indexed on era.
--
-- It is intended for qualified import:
-- > import qualified Cardano.Ledger.Core as Core
module Cardano.Ledger.Core (
  -- * Era-changing types
  EraTx (..),
  txIdTx,
  EraTxOut (..),
  bootAddrTxOutF,
  coinTxOutL,
  compactCoinTxOutL,
  isAdaOnlyTxOutF,
  EraTxBody (..),
  txIdTxBody,
  EraTxAuxData (..),
  hashTxAuxData,
  EraTxWits (..),
  EraScript (..),
  hashScript,
  isNativeScript,
  hashScriptTxWitsL,
  keyHashWitnessesTxWits,
  Value,
  EraPParams (..),
  mkCoinTxOut,

  -- * Era
  module Cardano.Ledger.Core.Era,
  -- $segWit
  EraSegWits (..),
  bBodySize,

  -- * Rewards
  RewardType (..),
  Reward (..),

  -- * Re-exports
  module Cardano.Ledger.Hashes,
  module Cardano.Ledger.Core.TxCert,
  module Cardano.Ledger.Core.PParams,
  module Cardano.Ledger.Core.Translation,
) where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Address (
  Addr (..),
  BootstrapAddress,
  CompactAddr,
  Withdrawals,
  compactAddr,
  decompactAddr,
  isBootstrapCompactAddr,
 )
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Cardano.Ledger.Binary (
  DecCBOR,
  DecShareCBOR (Share),
  EncCBOR,
  EncCBORGroup,
  Interns,
  Sized (sizedValue),
  ToCBOR,
  encCBORGroup,
  mkSized,
  serialize',
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Core.Era
import Cardano.Ledger.Core.PParams
import Cardano.Ledger.Core.Translation
import Cardano.Ledger.Core.TxCert
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Hashes hiding (GenDelegPair (..), GenDelegs (..), unsafeMakeSafeHash)
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness, bootstrapWitKeyHash)
import Cardano.Ledger.Keys.WitVKey (WitVKey, witVKeyHash)
import Cardano.Ledger.MemoBytes
import Cardano.Ledger.Metadata
import Cardano.Ledger.Rewards (Reward (..), RewardType (..))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.Val (Val (..), inject)
import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON)
import qualified Data.ByteString as BS
import Data.Kind (Type)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust)
import Data.Maybe.Strict (StrictMaybe, strictMaybe)
import Data.MemPack
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Void (Void)
import Data.Word (Word32, Word64)
import GHC.Stack (HasCallStack)
import Lens.Micro
import NoThunks.Class (NoThunks)

-- | A transaction.
class
  ( EraTxBody era
  , EraTxWits era
  , EraTxAuxData era
  , EraPParams era
  , NFData (Tx era)
  , NoThunks (Tx era)
  , DecCBOR (Tx era)
  , EncCBOR (Tx era)
  , ToCBOR (Tx era)
  , Show (Tx era)
  , Eq (Tx era)
  , EqRaw (Tx era)
  ) =>
  EraTx era
  where
  type Tx era = (r :: Type) | r -> era

  type TxUpgradeError era :: Type
  type TxUpgradeError era = Void

  mkBasicTx :: TxBody era -> Tx era

  bodyTxL :: Lens' (Tx era) (TxBody era)

  witsTxL :: Lens' (Tx era) (TxWits era)

  auxDataTxL :: Lens' (Tx era) (StrictMaybe (TxAuxData era))

  -- | For fee calculation and estimations of impact on block space
  sizeTxF :: SimpleGetter (Tx era) Integer

  -- | For end use by eg. diffusion layer in transaction submission protocol
  wireSizeTxF :: SimpleGetter (Tx era) Word32

  -- | For fee calculation and estimations of impact on block space
  -- To replace `sizeTxF` after it has been proved equivalent to it .
  sizeTxForFeeCalculation :: SafeToHash (TxWits era) => Tx era -> Integer
  sizeTxForFeeCalculation Tx era
tx =
    Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$
      TxBody era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TxWits era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize (Tx era
tx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (TxAuxData era -> Int) -> StrictMaybe (TxAuxData era) -> Int
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe Int
1 TxAuxData era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize (Tx era
tx Tx era
-> Getting
     (StrictMaybe (TxAuxData era))
     (Tx era)
     (StrictMaybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData era))
  (Tx era)
  (StrictMaybe (TxAuxData era))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- account for the top-level CBOR encoding tag

  -- | Using information from the transaction validate the supplied native script.
  validateNativeScript :: Tx era -> NativeScript era -> Bool

  -- | Minimum fee calculation excluding witnesses
  getMinFeeTx ::
    PParams era ->
    Tx era ->
    -- | Size in bytes of reference scripts present in this transaction
    Int ->
    Coin

  upgradeTx ::
    EraTx (PreviousEra era) =>
    Tx (PreviousEra era) ->
    Either (TxUpgradeError era) (Tx era)

class
  ( EraTxOut era
  , EraTxCert era
  , EraPParams era
  , HashAnnotated (TxBody era) EraIndependentTxBody
  , DecCBOR (TxBody era)
  , EncCBOR (TxBody era)
  , ToCBOR (TxBody era)
  , NoThunks (TxBody era)
  , NFData (TxBody era)
  , Show (TxBody era)
  , Eq (TxBody era)
  , EqRaw (TxBody era)
  ) =>
  EraTxBody era
  where
  -- | The body of a transaction.
  data TxBody era

  type TxBodyUpgradeError era :: Type
  type TxBodyUpgradeError era = Void

  mkBasicTxBody :: TxBody era

  inputsTxBodyL :: Lens' (TxBody era) (Set TxIn)

  outputsTxBodyL :: Lens' (TxBody era) (StrictSeq (TxOut era))

  feeTxBodyL :: Lens' (TxBody era) Coin

  withdrawalsTxBodyL :: Lens' (TxBody era) Withdrawals

  auxDataHashTxBodyL :: Lens' (TxBody era) (StrictMaybe TxAuxDataHash)

  -- | This getter will produce all inputs from the UTxO map that this transaction might
  -- spend, which ones will depend on the validity of the transaction itself. Starting in
  -- Alonzo this will include collateral inputs.
  spendableInputsTxBodyF :: SimpleGetter (TxBody era) (Set TxIn)

  -- | This getter will produce all inputs from the UTxO map that this transaction is
  -- referencing, even if some of them cannot be spent by the transaction. For example
  -- starting with Babbage era it will also include reference inputs.
  allInputsTxBodyF :: SimpleGetter (TxBody era) (Set TxIn)

  certsTxBodyL :: Lens' (TxBody era) (StrictSeq (TxCert era))

  -- | Compute the total deposits from the certificates in a TxBody.
  --
  -- This is the contribution of a TxBody towards the consumed amount by the transaction
  getTotalDepositsTxBody ::
    PParams era ->
    -- | Check whether stake pool is registered or not
    (KeyHash 'StakePool -> Bool) ->
    TxBody era ->
    Coin
  getTotalDepositsTxBody PParams era
pp KeyHash 'StakePool -> Bool
isPoolRegisted TxBody era
txBody =
    PParams era
-> (KeyHash 'StakePool -> Bool) -> StrictSeq (TxCert era) -> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
forall (f :: * -> *).
Foldable f =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
getTotalDepositsTxCerts PParams era
pp KeyHash 'StakePool -> Bool
isPoolRegisted (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)

  -- | Compute the total refunds from the Certs of a TxBody.
  --
  -- This is the contribution of a TxBody towards produced amount by the transaction
  getTotalRefundsTxBody ::
    PParams era ->
    -- | Lookup current deposit for Staking credential if one is registered
    (Credential 'Staking -> Maybe Coin) ->
    -- | Lookup current deposit for DRep credential if one is registered
    (Credential 'DRepRole -> Maybe Coin) ->
    TxBody era ->
    Coin
  getTotalRefundsTxBody PParams era
pp Credential 'Staking -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit TxBody era
txBody =
    PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> StrictSeq (TxCert era)
-> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
forall (f :: * -> *).
Foldable f =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
getTotalRefundsTxCerts PParams era
pp Credential 'Staking -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)

  -- | This function is not used in the ledger rules. It is only used by the downstream
  -- tooling to figure out how many witnesses should be supplied for Genesis keys.
  getGenesisKeyHashCountTxBody :: TxBody era -> Int
  getGenesisKeyHashCountTxBody TxBody era
_ = Int
0

  -- | Upgrade the transaction body from the previous era.
  --
  -- This can fail where elements of the transaction body are deprecated.
  -- Compare this to `translateEraThroughCBOR`:
  -- - `upgradeTxBody` will use the Haskell representation, but will not
  --   preserve the serialised form. However, it will be suitable for iterated
  --   translation through eras.
  -- - `translateEraThroughCBOR` will preserve the binary representation, but is
  --   not guaranteed to work through multiple eras - that is, the serialised
  --   representation from era n is guaranteed valid in era n + 1, but not
  --   necessarily in era n + 2.
  upgradeTxBody ::
    EraTxBody (PreviousEra era) =>
    TxBody (PreviousEra era) ->
    Either (TxBodyUpgradeError era) (TxBody era)

-- | Abstract interface into specific fields of a `TxOut`
class
  ( Val (Value era)
  , ToJSON (TxOut era)
  , DecCBOR (Value era)
  , DecCBOR (CompactForm (Value era))
  , MemPack (CompactForm (Value era))
  , EncCBOR (Value era)
  , ToCBOR (TxOut era)
  , EncCBOR (TxOut era)
  , DecCBOR (TxOut era)
  , DecShareCBOR (TxOut era)
  , Share (TxOut era) ~ Interns (Credential 'Staking)
  , NoThunks (TxOut era)
  , NFData (TxOut era)
  , Show (TxOut era)
  , Eq (TxOut era)
  , MemPack (TxOut era)
  , EraPParams era
  ) =>
  EraTxOut era
  where
  -- | The output of a UTxO for a particular era
  type TxOut era = (r :: Type) | r -> era

  {-# MINIMAL
    mkBasicTxOut
    , upgradeTxOut
    , valueEitherTxOutL
    , addrEitherTxOutL
    , (getMinCoinSizedTxOut | getMinCoinTxOut)
    #-}

  mkBasicTxOut :: HasCallStack => Addr -> Value era -> TxOut era

  -- | Every era, except Shelley, must be able to upgrade a `TxOut` from a previous era.
  upgradeTxOut :: EraTxOut (PreviousEra era) => TxOut (PreviousEra era) -> TxOut era

  valueTxOutL :: Lens' (TxOut era) (Value era)
  valueTxOutL =
    (TxOut era -> Value era)
-> (TxOut era -> Value era -> TxOut era)
-> Lens' (TxOut era) (Value era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      ( \TxOut era
txOut -> case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
          Left Value era
value -> Value era
value
          Right CompactForm (Value era)
cValue -> CompactForm (Value era) -> Value era
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cValue
      )
      (\TxOut era
txOut Value era
value -> TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Either (Value era) (CompactForm (Value era))
 -> Identity (Either (Value era) (CompactForm (Value era))))
-> TxOut era -> Identity (TxOut era)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL ((Either (Value era) (CompactForm (Value era))
  -> Identity (Either (Value era) (CompactForm (Value era))))
 -> TxOut era -> Identity (TxOut era))
-> Either (Value era) (CompactForm (Value era))
-> TxOut era
-> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Value era -> Either (Value era) (CompactForm (Value era))
forall a b. a -> Either a b
Left Value era
value)
  {-# INLINE valueTxOutL #-}

  compactValueTxOutL :: HasCallStack => Lens' (TxOut era) (CompactForm (Value era))
  compactValueTxOutL =
    (TxOut era -> CompactForm (Value era))
-> (TxOut era -> CompactForm (Value era) -> TxOut era)
-> Lens' (TxOut era) (CompactForm (Value era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      ( \TxOut era
txOut -> case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
          Left Value era
value -> Value era -> CompactForm (Value era)
forall a. (HasCallStack, Val a) => a -> CompactForm a
toCompactPartial Value era
value
          Right CompactForm (Value era)
cValue -> CompactForm (Value era)
cValue
      )
      (\TxOut era
txOut CompactForm (Value era)
cValue -> TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Either (Value era) (CompactForm (Value era))
 -> Identity (Either (Value era) (CompactForm (Value era))))
-> TxOut era -> Identity (TxOut era)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL ((Either (Value era) (CompactForm (Value era))
  -> Identity (Either (Value era) (CompactForm (Value era))))
 -> TxOut era -> Identity (TxOut era))
-> Either (Value era) (CompactForm (Value era))
-> TxOut era
-> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactForm (Value era)
-> Either (Value era) (CompactForm (Value era))
forall a b. b -> Either a b
Right CompactForm (Value era)
cValue)
  {-# INLINE compactValueTxOutL #-}

  -- | Lens for getting and setting in TxOut either an address or its compact
  -- version by doing the least amount of work.
  valueEitherTxOutL :: Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))

  addrTxOutL :: Lens' (TxOut era) Addr
  addrTxOutL =
    (TxOut era -> Addr)
-> (TxOut era -> Addr -> TxOut era) -> Lens' (TxOut era) Addr
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      ( \TxOut era
txOut -> case TxOut era
txOut TxOut era
-> Getting
     (Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
-> Either Addr CompactAddr
forall s a. s -> Getting a s a -> a
^. Getting
  (Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era) (Either Addr CompactAddr)
addrEitherTxOutL of
          Left Addr
addr -> Addr
addr
          Right CompactAddr
cAddr -> HasCallStack => CompactAddr -> Addr
CompactAddr -> Addr
decompactAddr CompactAddr
cAddr
      )
      (\TxOut era
txOut Addr
addr -> TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Either Addr CompactAddr -> Identity (Either Addr CompactAddr))
-> TxOut era -> Identity (TxOut era)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era) (Either Addr CompactAddr)
addrEitherTxOutL ((Either Addr CompactAddr -> Identity (Either Addr CompactAddr))
 -> TxOut era -> Identity (TxOut era))
-> Either Addr CompactAddr -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Addr -> Either Addr CompactAddr
forall a b. a -> Either a b
Left Addr
addr)
  {-# INLINE addrTxOutL #-}

  compactAddrTxOutL :: Lens' (TxOut era) CompactAddr
  compactAddrTxOutL =
    (TxOut era -> CompactAddr)
-> (TxOut era -> CompactAddr -> TxOut era)
-> Lens' (TxOut era) CompactAddr
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      ( \TxOut era
txOut -> case TxOut era
txOut TxOut era
-> Getting
     (Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
-> Either Addr CompactAddr
forall s a. s -> Getting a s a -> a
^. Getting
  (Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era) (Either Addr CompactAddr)
addrEitherTxOutL of
          Left Addr
addr -> Addr -> CompactAddr
compactAddr Addr
addr
          Right CompactAddr
cAddr -> CompactAddr
cAddr
      )
      (\TxOut era
txOut CompactAddr
cAddr -> TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Either Addr CompactAddr -> Identity (Either Addr CompactAddr))
-> TxOut era -> Identity (TxOut era)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era) (Either Addr CompactAddr)
addrEitherTxOutL ((Either Addr CompactAddr -> Identity (Either Addr CompactAddr))
 -> TxOut era -> Identity (TxOut era))
-> Either Addr CompactAddr -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactAddr -> Either Addr CompactAddr
forall a b. b -> Either a b
Right CompactAddr
cAddr)
  {-# INLINE compactAddrTxOutL #-}

  -- | Lens for getting and setting in TxOut either an address or its compact
  -- version by doing the least amount of work.
  --
  -- The utility of this function comes from the fact that TxOut usually stores
  -- the address in either one of two forms: compacted or unpacked. In order to
  -- avoid extroneous conversions in `getTxOutAddr` and `getTxOutCompactAddr` we
  -- can define just this functionality. Also sometimes it is crucial to know at
  -- the callsite which form of address we have readily available without any
  -- conversions (eg. searching millions of TxOuts for a particular address)
  addrEitherTxOutL :: Lens' (TxOut era) (Either Addr CompactAddr)

  -- | Produce the minimum lovelace that a given transaction output must
  -- contain. Information about the size of the TxOut is required in some eras.
  -- Use `getMinCoinTxOut` if you don't have the size readily available to you.
  getMinCoinSizedTxOut :: PParams era -> Sized (TxOut era) -> Coin
  getMinCoinSizedTxOut PParams era
pp = PParams era -> TxOut era -> Coin
forall era. EraTxOut era => PParams era -> TxOut era -> Coin
getMinCoinTxOut PParams era
pp (TxOut era -> Coin)
-> (Sized (TxOut era) -> TxOut era) -> Sized (TxOut era) -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sized (TxOut era) -> TxOut era
forall a. Sized a -> a
sizedValue

  -- | Same as `getMinCoinSizedTxOut`, except information about the size of
  -- TxOut will be computed by serializing the TxOut. If the size turns out to
  -- be not needed, then serialization will have no overhead, since it is
  -- computed lazily.
  getMinCoinTxOut :: PParams era -> TxOut era -> Coin
  getMinCoinTxOut PParams era
pp TxOut era
txOut =
    let ProtVer Version
version Natural
_ = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
     in PParams era -> Sized (TxOut era) -> Coin
forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Coin
getMinCoinSizedTxOut PParams era
pp (Version -> TxOut era -> Sized (TxOut era)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
version TxOut era
txOut)

bootAddrTxOutF ::
  EraTxOut era => SimpleGetter (TxOut era) (Maybe BootstrapAddress)
bootAddrTxOutF :: forall era.
EraTxOut era =>
SimpleGetter (TxOut era) (Maybe BootstrapAddress)
bootAddrTxOutF = (TxOut era -> Maybe BootstrapAddress)
-> SimpleGetter (TxOut era) (Maybe BootstrapAddress)
forall s a. (s -> a) -> SimpleGetter s a
to ((TxOut era -> Maybe BootstrapAddress)
 -> SimpleGetter (TxOut era) (Maybe BootstrapAddress))
-> (TxOut era -> Maybe BootstrapAddress)
-> SimpleGetter (TxOut era) (Maybe BootstrapAddress)
forall a b. (a -> b) -> a -> b
$ \TxOut era
txOut ->
  case TxOut era
txOut TxOut era
-> Getting
     (Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
-> Either Addr CompactAddr
forall s a. s -> Getting a s a -> a
^. Getting
  (Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era) (Either Addr CompactAddr)
addrEitherTxOutL of
    Left (AddrBootstrap BootstrapAddress
bootstrapAddr) -> BootstrapAddress -> Maybe BootstrapAddress
forall a. a -> Maybe a
Just BootstrapAddress
bootstrapAddr
    Right CompactAddr
cAddr
      | CompactAddr -> Bool
isBootstrapCompactAddr CompactAddr
cAddr -> do
          AddrBootstrap BootstrapAddress
bootstrapAddr <- Addr -> Maybe Addr
forall a. a -> Maybe a
Just (HasCallStack => CompactAddr -> Addr
CompactAddr -> Addr
decompactAddr CompactAddr
cAddr)
          BootstrapAddress -> Maybe BootstrapAddress
forall a. a -> Maybe a
Just BootstrapAddress
bootstrapAddr
    Either Addr CompactAddr
_ -> Maybe BootstrapAddress
forall a. Maybe a
Nothing
{-# INLINE bootAddrTxOutF #-}

coinTxOutL :: (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL :: forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL =
  (TxOut era -> Coin)
-> (TxOut era -> Coin -> TxOut era)
-> Lens (TxOut era) (TxOut era) Coin Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    ( \TxOut era
txOut ->
        case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
          Left Value era
val -> Value era -> Coin
forall t. Val t => t -> Coin
coin Value era
val
          Right CompactForm (Value era)
cVal -> CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm (Value era) -> CompactForm Coin
forall t. Val t => CompactForm t -> CompactForm Coin
coinCompact CompactForm (Value era)
cVal)
    )
    ( \TxOut era
txOut Coin
c ->
        case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
          Left Value era
val -> TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Value era -> Identity (Value era))
-> TxOut era -> Identity (TxOut era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL ((Value era -> Identity (Value era))
 -> TxOut era -> Identity (TxOut era))
-> Value era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Coin -> Coin) -> Value era -> Value era
forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin (Coin -> Coin -> Coin
forall a b. a -> b -> a
const Coin
c) Value era
val
          Right CompactForm (Value era)
cVal ->
            TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (CompactForm (Value era) -> Identity (CompactForm (Value era)))
-> TxOut era -> Identity (TxOut era)
forall era.
(EraTxOut era, HasCallStack) =>
Lens' (TxOut era) (CompactForm (Value era))
Lens' (TxOut era) (CompactForm (Value era))
compactValueTxOutL ((CompactForm (Value era) -> Identity (CompactForm (Value era)))
 -> TxOut era -> Identity (TxOut era))
-> CompactForm (Value era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (CompactForm Coin -> CompactForm Coin)
-> CompactForm (Value era) -> CompactForm (Value era)
forall t.
Val t =>
(CompactForm Coin -> CompactForm Coin)
-> CompactForm t -> CompactForm t
modifyCompactCoin (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a b. a -> b -> a
const (Coin -> CompactForm Coin
forall a. (HasCallStack, Val a) => a -> CompactForm a
toCompactPartial Coin
c)) CompactForm (Value era)
cVal
    )
{-# INLINE coinTxOutL #-}

compactCoinTxOutL :: (HasCallStack, EraTxOut era) => Lens' (TxOut era) (CompactForm Coin)
compactCoinTxOutL :: forall era.
(HasCallStack, EraTxOut era) =>
Lens' (TxOut era) (CompactForm Coin)
compactCoinTxOutL =
  (TxOut era -> CompactForm Coin)
-> (TxOut era -> CompactForm Coin -> TxOut era)
-> Lens
     (TxOut era) (TxOut era) (CompactForm Coin) (CompactForm Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    ( \TxOut era
txOut ->
        case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
          Left Value era
val -> Coin -> CompactForm Coin
forall a. (HasCallStack, Val a) => a -> CompactForm a
toCompactPartial (Value era -> Coin
forall t. Val t => t -> Coin
coin Value era
val)
          Right CompactForm (Value era)
cVal -> CompactForm (Value era) -> CompactForm Coin
forall t. Val t => CompactForm t -> CompactForm Coin
coinCompact CompactForm (Value era)
cVal
    )
    ( \TxOut era
txOut CompactForm Coin
cCoin ->
        case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
          Left Value era
val -> TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Value era -> Identity (Value era))
-> TxOut era -> Identity (TxOut era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL ((Value era -> Identity (Value era))
 -> TxOut era -> Identity (TxOut era))
-> Value era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Coin -> Coin) -> Value era -> Value era
forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin (Coin -> Coin -> Coin
forall a b. a -> b -> a
const (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
cCoin)) Value era
val
          Right CompactForm (Value era)
cVal ->
            TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (CompactForm (Value era) -> Identity (CompactForm (Value era)))
-> TxOut era -> Identity (TxOut era)
forall era.
(EraTxOut era, HasCallStack) =>
Lens' (TxOut era) (CompactForm (Value era))
Lens' (TxOut era) (CompactForm (Value era))
compactValueTxOutL ((CompactForm (Value era) -> Identity (CompactForm (Value era)))
 -> TxOut era -> Identity (TxOut era))
-> CompactForm (Value era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (CompactForm Coin -> CompactForm Coin)
-> CompactForm (Value era) -> CompactForm (Value era)
forall t.
Val t =>
(CompactForm Coin -> CompactForm Coin)
-> CompactForm t -> CompactForm t
modifyCompactCoin (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a b. a -> b -> a
const CompactForm Coin
cCoin) CompactForm (Value era)
cVal
    )
{-# INLINE compactCoinTxOutL #-}

-- | This is a getter that implements an efficient way to check whether 'TxOut'
-- contains ADA only.
isAdaOnlyTxOutF :: EraTxOut era => SimpleGetter (TxOut era) Bool
isAdaOnlyTxOutF :: forall era. EraTxOut era => SimpleGetter (TxOut era) Bool
isAdaOnlyTxOutF = (TxOut era -> Bool) -> SimpleGetter (TxOut era) Bool
forall s a. (s -> a) -> SimpleGetter s a
to ((TxOut era -> Bool) -> SimpleGetter (TxOut era) Bool)
-> (TxOut era -> Bool) -> SimpleGetter (TxOut era) Bool
forall a b. (a -> b) -> a -> b
$ \TxOut era
txOut ->
  case TxOut era
txOut TxOut era
-> Getting
     (Either (Value era) (CompactForm (Value era)))
     (TxOut era)
     (Either (Value era) (CompactForm (Value era)))
-> Either (Value era) (CompactForm (Value era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either (Value era) (CompactForm (Value era)))
  (TxOut era)
  (Either (Value era) (CompactForm (Value era)))
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherTxOutL of
    Left Value era
val -> Value era -> Bool
forall t. Val t => t -> Bool
isAdaOnly Value era
val
    Right CompactForm (Value era)
cVal -> CompactForm (Value era) -> Bool
forall t. Val t => CompactForm t -> Bool
isAdaOnlyCompact CompactForm (Value era)
cVal

toCompactPartial :: (HasCallStack, Val a) => a -> CompactForm a
toCompactPartial :: forall a. (HasCallStack, Val a) => a -> CompactForm a
toCompactPartial a
v =
  CompactForm a -> Maybe (CompactForm a) -> CompactForm a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> CompactForm a
forall a. HasCallStack => [Char] -> a
error ([Char] -> CompactForm a) -> [Char] -> CompactForm a
forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal value in TxOut: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
v) (Maybe (CompactForm a) -> CompactForm a)
-> Maybe (CompactForm a) -> CompactForm a
forall a b. (a -> b) -> a -> b
$ a -> Maybe (CompactForm a)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact a
v

-- A version of mkBasicTxOut, which has only a Coin (no multiAssets) for every EraTxOut era.
mkCoinTxOut :: EraTxOut era => Addr -> Coin -> TxOut era
mkCoinTxOut :: forall era. EraTxOut era => Addr -> Coin -> TxOut era
mkCoinTxOut Addr
addr = Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr (Value era -> TxOut era)
-> (Coin -> Value era) -> Coin -> TxOut era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value era
forall t s. Inject t s => t -> s
inject

-- | A value is something which quantifies a transaction output.
type family Value era :: Type

-- | TxAuxData which may be attached to a transaction
class
  ( Era era
  , Eq (TxAuxData era)
  , EqRaw (TxAuxData era)
  , Show (TxAuxData era)
  , NoThunks (TxAuxData era)
  , ToCBOR (TxAuxData era)
  , EncCBOR (TxAuxData era)
  , DecCBOR (TxAuxData era)
  , HashAnnotated (TxAuxData era) EraIndependentTxAuxData
  ) =>
  EraTxAuxData era
  where
  type TxAuxData era = (r :: Type) | r -> era

  mkBasicTxAuxData :: TxAuxData era

  metadataTxAuxDataL :: Lens' (TxAuxData era) (Map Word64 Metadatum)

  -- | Every era, except Shelley, must be able to upgrade a `TxAuxData` from a previous
  -- era.
  --
  -- /Warning/ - Important to note that any memoized binary representation will not be
  -- preserved. If you need to retain underlying bytes you can use `translateEraThroughCBOR`
  upgradeTxAuxData :: EraTxAuxData (PreviousEra era) => TxAuxData (PreviousEra era) -> TxAuxData era

  validateTxAuxData :: ProtVer -> TxAuxData era -> Bool

-- | Compute a hash of `TxAuxData`
hashTxAuxData :: EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData :: forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData = SafeHash EraIndependentTxAuxData -> TxAuxDataHash
TxAuxDataHash (SafeHash EraIndependentTxAuxData -> TxAuxDataHash)
-> (TxAuxData era -> SafeHash EraIndependentTxAuxData)
-> TxAuxData era
-> TxAuxDataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxAuxData era -> SafeHash EraIndependentTxAuxData
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated

-- | A collection of witnesses in a Tx
class
  ( EraScript era
  , Eq (TxWits era)
  , EqRaw (TxWits era)
  , Show (TxWits era)
  , Monoid (TxWits era)
  , NoThunks (TxWits era)
  , ToCBOR (TxWits era)
  , EncCBOR (TxWits era)
  , DecCBOR (TxWits era)
  ) =>
  EraTxWits era
  where
  type TxWits era = (r :: Type) | r -> era

  mkBasicTxWits :: TxWits era
  mkBasicTxWits = TxWits era
forall a. Monoid a => a
mempty

  addrTxWitsL :: Lens' (TxWits era) (Set (WitVKey 'Witness))

  bootAddrTxWitsL :: Lens' (TxWits era) (Set BootstrapWitness)

  scriptTxWitsL :: Lens' (TxWits era) (Map ScriptHash (Script era))

  upgradeTxWits :: EraTxWits (PreviousEra era) => TxWits (PreviousEra era) -> TxWits era

-- | This is a helper lens that will hash the scripts when adding as witnesses.
hashScriptTxWitsL ::
  EraTxWits era =>
  Lens (TxWits era) (TxWits era) (Map ScriptHash (Script era)) [Script era]
hashScriptTxWitsL :: forall era.
EraTxWits era =>
Lens
  (TxWits era)
  (TxWits era)
  (Map ScriptHash (Script era))
  [Script era]
hashScriptTxWitsL =
  (TxWits era -> Map ScriptHash (Script era))
-> (TxWits era -> [Script era] -> TxWits era)
-> Lens
     (TxWits era)
     (TxWits era)
     (Map ScriptHash (Script era))
     [Script era]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (TxWits era
-> Getting
     (Map ScriptHash (Script era))
     (TxWits era)
     (Map ScriptHash (Script era))
-> Map ScriptHash (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map ScriptHash (Script era))
  (TxWits era)
  (Map ScriptHash (Script era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL)
    (\TxWits era
wits [Script era]
ss -> TxWits era
wits TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(ScriptHash, Script era)] -> Map ScriptHash (Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
s, Script era
s) | Script era
s <- [Script era]
ss])
{-# INLINEABLE hashScriptTxWitsL #-}

-- | Extract all of the `KeyHash` witnesses provided in the `TxWits`
keyHashWitnessesTxWits ::
  EraTxWits era =>
  TxWits era ->
  Set (KeyHash 'Witness)
keyHashWitnessesTxWits :: forall era. EraTxWits era => TxWits era -> Set (KeyHash 'Witness)
keyHashWitnessesTxWits TxWits era
txWits =
  (WitVKey 'Witness -> KeyHash 'Witness)
-> Set (WitVKey 'Witness) -> Set (KeyHash 'Witness)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness -> KeyHash 'Witness
forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
witVKeyHash (TxWits era
txWits TxWits era
-> Getting
     (Set (WitVKey 'Witness)) (TxWits era) (Set (WitVKey 'Witness))
-> Set (WitVKey 'Witness)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (WitVKey 'Witness)) (TxWits era) (Set (WitVKey 'Witness))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL)
    Set (KeyHash 'Witness)
-> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (BootstrapWitness -> KeyHash 'Witness)
-> Set BootstrapWitness -> Set (KeyHash 'Witness)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map BootstrapWitness -> KeyHash 'Witness
bootstrapWitKeyHash (TxWits era
txWits TxWits era
-> Getting
     (Set BootstrapWitness) (TxWits era) (Set BootstrapWitness)
-> Set BootstrapWitness
forall s a. s -> Getting a s a -> a
^. Getting (Set BootstrapWitness) (TxWits era) (Set BootstrapWitness)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL)
{-# INLINEABLE keyHashWitnessesTxWits #-}

-----------------------------------------------------------------------------
-- Script Validation
-----------------------------------------------------------------------------

-- | Typeclass for script data types. Allows for script validation and hashing.
--   You must understand the role of SafeToHash and scriptPrefixTag to make new
--   instances. 'scriptPrefixTag' is a magic number representing the tag of the
--   script language. For each new script language defined, a new tag is chosen
--   and the tag is included in the script hash for a script. The safeToHash
--   constraint ensures that Scripts are never reserialised.
class
  ( Era era
  , Show (Script era)
  , Eq (Script era)
  , EqRaw (Script era)
  , ToCBOR (Script era)
  , EncCBOR (Script era)
  , DecCBOR (Script era)
  , NoThunks (Script era)
  , SafeToHash (Script era)
  , Eq (NativeScript era)
  , Show (NativeScript era)
  , NFData (NativeScript era)
  , NoThunks (NativeScript era)
  , EncCBOR (NativeScript era)
  , DecCBOR (NativeScript era)
  ) =>
  EraScript era
  where
  -- | Scripts which may lock transaction outputs in this era
  type Script era = (r :: Type) | r -> era

  type NativeScript era = (r :: Type) | r -> era

  -- | Every era, except Shelley, must be able to upgrade a `Script` from a previous era.
  --
  -- /Warning/ - Important to note that any memoized binary representation will not be
  -- preserved, you need to retain underlying bytes you can use `translateEraThroughCBOR`
  upgradeScript :: EraScript (PreviousEra era) => Script (PreviousEra era) -> Script era

  scriptPrefixTag :: Script era -> BS.ByteString

  getNativeScript :: Script era -> Maybe (NativeScript era)

  fromNativeScript :: NativeScript era -> Script era

isNativeScript :: EraScript era => Script era -> Bool
isNativeScript :: forall era. EraScript era => Script era -> Bool
isNativeScript = Maybe (NativeScript era) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (NativeScript era) -> Bool)
-> (Script era -> Maybe (NativeScript era)) -> Script era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script era -> Maybe (NativeScript era)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
getNativeScript

-- | Compute `ScriptHash` of a `Script` for a particular era.
hashScript :: forall era. EraScript era => Script era -> ScriptHash
hashScript :: forall era. EraScript era => Script era -> ScriptHash
hashScript =
  Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash
    (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> (Script era -> Hash ADDRHASH EraIndependentScript)
-> Script era
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (Script era) -> Hash ADDRHASH EraIndependentScript
forall h a b. Hash h a -> Hash h b
Hash.castHash
    (Hash ADDRHASH (Script era) -> Hash ADDRHASH EraIndependentScript)
-> (Script era -> Hash ADDRHASH (Script era))
-> Script era
-> Hash ADDRHASH EraIndependentScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Script era -> ByteString)
-> Script era -> Hash ADDRHASH (Script era)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith
      (\Script era
x -> forall era. EraScript era => Script era -> ByteString
scriptPrefixTag @era Script era
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Script era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes Script era
x)

--------------------------------------------------------------------------------
-- Segregated Witness
--------------------------------------------------------------------------------

-- $segWit
-- * Segregated Witness
--
-- The idea of segregated witnessing is to alter the encoding of transactions in
-- a block such that the witnesses (the information needed to verify the
-- validity of the transactions) can be stored separately from the body (the
-- information needed to update the ledger state). In this way, a node which
-- only cares about replaying transactions need not even decode the witness
-- information.
--
-- In order to do this, we introduce two concepts:
-- - A 'TxSeq`, which represents the decoded structure of a sequence of
--   transactions as represented in the encoded block; that is, with witnessing,
--   metadata and other non-body parts split separately.

-- | Indicates that an era supports segregated witnessing.
--
--   This class embodies an isomorphism between 'TxSeq era' and 'StrictSeq
--   (Tx era)', witnessed by 'fromTxSeq' and 'toTxSeq'.
class
  ( EraTx era
  , Eq (TxSeq era)
  , Show (TxSeq era)
  , EncCBORGroup (TxSeq era)
  , DecCBOR (TxSeq era)
  ) =>
  EraSegWits era
  where
  type TxSeq era = (r :: Type) | r -> era

  fromTxSeq :: TxSeq era -> StrictSeq (Tx era)
  toTxSeq :: StrictSeq (Tx era) -> TxSeq era

  -- | Get the block body hash from the TxSeq. Note that this is not a regular
  -- "hash the stored bytes" function since the block body hash forms a small
  -- Merkle tree.
  hashTxSeq :: TxSeq era -> Hash.Hash HASH EraIndependentBlockBody

  -- | The number of segregated components
  numSegComponents :: Word64

bBodySize :: forall era. EraSegWits era => ProtVer -> TxSeq era -> Int
bBodySize :: forall era. EraSegWits era => ProtVer -> TxSeq era -> Int
bBodySize (ProtVer Version
v Natural
_) = ByteString -> Int
BS.length (ByteString -> Int)
-> (TxSeq era -> ByteString) -> TxSeq era -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
v (Encoding -> ByteString)
-> (TxSeq era -> Encoding) -> TxSeq era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq era -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup

txIdTx :: EraTx era => Tx era -> TxId
txIdTx :: forall era. EraTx era => Tx era -> TxId
txIdTx Tx era
tx = TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)

txIdTxBody :: EraTxBody era => TxBody era -> TxId
txIdTxBody :: forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody = SafeHash EraIndependentTxBody -> TxId
TxId (SafeHash EraIndependentTxBody -> TxId)
-> (TxBody era -> SafeHash EraIndependentTxBody)
-> TxBody era
-> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated