{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
-- The Shelley ledger uses promoted data kinds which we have to use, but we do
-- not export any from this API. We also use them unticked as nature intended.
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

-- | Creating complete, signed transactions.
module Cardano.Api.Internal.Tx.Sign
  ( -- * Example: Creating a 'ShelleyWitnessSigningKey'

    -- |
    -- Signing a transaction requires a witness, for example, a 'ShelleyWitnessSigningKey'.
    --
    -- This example uses the following qualified module:
    --
    -- @
    -- import qualified Cardano.Api as Api                -- the general `cardano-api` exports (including the old API)
    -- @
    --
    -- There are several ways of signing a transaction and representing a signing key. If the
    -- bech32 representation of the signing key is available, it is possible to use the
    -- 'deserialiseFromBech32' function as follows:
    --
    -- @
    -- let (Right signingKey) = Api.deserialiseFromBech32 (Api.AsSigningKey Api.AsPaymentKey) "addr_sk1648253w4tf6fv5fk28dc7crsjsaw7d9ymhztd4favg3cwkhz7x8sl5u3ms"
    -- @
    --
    -- Then, simply wrap the signing key in a 'ShelleyWitnessSigningKey' value:
    --
    -- @
    -- let witness = Api.WitnessPaymentKey signingKey
    -- @
    --
    -- This could also be done using an extended key, such as 'AsPaymentExtendedKey' and 'WitnessPaymentExtendedKey'.

    -- * Contents

    -- ** Signing transactions

    -- | Creating transaction witnesses one by one, or all in one go.
    Tx (.., Tx)
  , Byron.ATxAux (..)
  , getTxBody
  , getByronTxBody
  , getTxWitnesses
  , getTxWitnessesByron
  , ScriptValidity (..)

    -- *** Signing in one go
  , ShelleySigningKey (..)
  , toShelleySigningKey
  , signByronTransaction
  , signShelleyTransaction

    -- *** Incremental signing and separate witnesses
  , makeSignedByronTransaction
  , makeSignedTransaction
  , makeSignedTransaction'
  , KeyWitness (..)
  , makeByronKeyWitness
  , ShelleyWitnessSigningKey (..)
  , makeShelleyKeyWitness
  , makeShelleyKeyWitness'
  , WitnessNetworkIdOrByronAddress (..)
  , makeShelleyBootstrapWitness
  , makeShelleyBasedBootstrapWitness
  , makeShelleySignature
  , getShelleyKeyWitnessVerificationKey
  , getTxBodyAndWitnesses

    -- ** Data family instances
  , AsType
    ( AsTx
    , AsMaryTx
    , AsAllegraTx
    , AsAlonzoTx
    , AsKeyWitness
    , AsByronWitness
    , AsShelleyWitness
    , AsTxId
    , AsTxBody
    , AsByronTxBody
    , AsShelleyTxBody
    , AsMaryTxBody
    )
  , TxBody (..)
  , TxScriptValidity (..)
  , scriptValidityToIsValid
  , isValidToScriptValidity
  , txScriptValidityToIsValid
  , txScriptValidityToScriptValidity
  , TxBodyScriptData (..)
  )
where

import Cardano.Api.Internal.Address
import Cardano.Api.Internal.Certificate
import Cardano.Api.Internal.Eon.AlonzoEraOnwards
import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Eras
import Cardano.Api.Internal.HasTypeProxy
import Cardano.Api.Internal.Keys.Byron
import Cardano.Api.Internal.Keys.Class
import Cardano.Api.Internal.Keys.Shelley
import Cardano.Api.Internal.NetworkId
import Cardano.Api.Internal.Serialise.Cbor
import Cardano.Api.Internal.SerialiseTextEnvelope

import Cardano.Chain.Common qualified as Byron
import Cardano.Chain.UTxO qualified as Byron
import Cardano.Crypto.DSIGN.Class qualified as Crypto
import Cardano.Crypto.Hash qualified as Hash
import Cardano.Crypto.Hashing qualified as Byron
import Cardano.Crypto.ProtocolMagic qualified as Byron
import Cardano.Crypto.Signing qualified as Byron
import Cardano.Crypto.Util qualified as Crypto
import Cardano.Crypto.Wallet qualified as Crypto.HD
import Cardano.Ledger.Alonzo.Core qualified as L
import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe)
import Cardano.Ledger.Binary (Annotated (..))
import Cardano.Ledger.Binary qualified as CBOR
import Cardano.Ledger.Binary.Plain qualified as Plain
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Keys qualified as Shelley

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
import GHC.Exts (IsList (..))
import Lens.Micro

-- ----------------------------------------------------------------------------
-- Signed transactions
--

data Tx era where
  ShelleyTx
    :: ShelleyBasedEra era
    -> L.Tx (ShelleyLedgerEra era)
    -> Tx era

-- | This pattern will be deprecated in the future. We advise against introducing new usage of it.
pattern Tx :: TxBody era -> [KeyWitness era] -> Tx era
pattern $bTx :: forall era. TxBody era -> [KeyWitness era] -> Tx era
$mTx :: forall {r} {era}.
Tx era
-> (TxBody era -> [KeyWitness era] -> r) -> ((# #) -> r) -> r
Tx txbody ws <- (getTxBodyAndWitnesses -> (txbody, ws))
  where
    Tx TxBody era
txbody [KeyWitness era]
ws = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
ws TxBody era
txbody

instance Show (InAnyCardanoEra Tx) where
  show :: InAnyCardanoEra Tx -> String
show (InAnyCardanoEra CardanoEra era
_ Tx era
tx) = Tx era -> String
forall a. Show a => a -> String
show Tx era
tx

instance Eq (InAnyCardanoEra Tx) where
  == :: InAnyCardanoEra Tx -> InAnyCardanoEra Tx -> Bool
(==) (InAnyCardanoEra CardanoEra era
eraA Tx era
txA) (InAnyCardanoEra CardanoEra era
eraB Tx era
txB) =
    case CardanoEra era -> CardanoEra era -> Maybe (era :~: era)
forall a b. CardanoEra a -> CardanoEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
eraA CardanoEra era
eraB of
      Maybe (era :~: era)
Nothing -> Bool
False
      Just era :~: era
Refl -> Tx era
txA Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
txB

instance Show (InAnyShelleyBasedEra Tx) where
  show :: InAnyShelleyBasedEra Tx -> String
show (InAnyShelleyBasedEra ShelleyBasedEra era
_ Tx era
tx) = Tx era -> String
forall a. Show a => a -> String
show Tx era
tx

instance Eq (InAnyShelleyBasedEra Tx) where
  == :: InAnyShelleyBasedEra Tx -> InAnyShelleyBasedEra Tx -> Bool
(==) (InAnyShelleyBasedEra ShelleyBasedEra era
eraA Tx era
txA) (InAnyShelleyBasedEra ShelleyBasedEra era
eraB Tx era
txB) =
    case ShelleyBasedEra era -> ShelleyBasedEra era -> Maybe (era :~: era)
forall a b.
ShelleyBasedEra a -> ShelleyBasedEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality ShelleyBasedEra era
eraA ShelleyBasedEra era
eraB of
      Maybe (era :~: era)
Nothing -> Bool
False
      Just era :~: era
Refl -> Tx era
txA Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
txB

-- The GADT in the ShelleyTx case requires a custom instance
instance Eq (Tx era) where
  == :: Tx era -> Tx era -> Bool
(==)
    (ShelleyTx ShelleyBasedEra era
sbe Tx (ShelleyLedgerEra era)
txA)
    (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
txB) =
      ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Bool) -> Bool)
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ Tx (ShelleyLedgerEra era)
txA Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== Tx (ShelleyLedgerEra era)
txB

-- The GADT in the ShelleyTx case requires a custom instance
instance Show (Tx era) where
  showsPrec :: Int -> Tx era -> ShowS
showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraShelley Tx (ShelleyLedgerEra era)
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyTx ShelleyBasedEraShelley "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyTx ShelleyEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx (ShelleyLedgerEra era)
ShelleyTx ShelleyEra
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraAllegra Tx (ShelleyLedgerEra era)
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyTx ShelleyBasedEraAllegra "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyTx AllegraEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx (ShelleyLedgerEra era)
ShelleyTx AllegraEra
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraMary Tx (ShelleyLedgerEra era)
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyTx ShelleyBasedEraMary "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyTx MaryEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx (ShelleyLedgerEra era)
ShelleyTx MaryEra
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraAlonzo Tx (ShelleyLedgerEra era)
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyTx ShelleyBasedEraAlonzo "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AlonzoTx AlonzoEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx (ShelleyLedgerEra era)
AlonzoTx AlonzoEra
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraBabbage Tx (ShelleyLedgerEra era)
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyTx ShelleyBasedEraBabbage "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AlonzoTx BabbageEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx (ShelleyLedgerEra era)
AlonzoTx BabbageEra
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraConway Tx (ShelleyLedgerEra era)
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyTx ShelleyBasedEraConway "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AlonzoTx ConwayEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx (ShelleyLedgerEra era)
AlonzoTx ConwayEra
tx

instance HasTypeProxy era => HasTypeProxy (Tx era) where
  data AsType (Tx era) = AsTx (AsType era)
  proxyToAsType :: Proxy (Tx era) -> AsType (Tx era)
proxyToAsType Proxy (Tx era)
_ = AsType era -> AsType (Tx era)
forall era. AsType era -> AsType (Tx era)
AsTx (Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy era
forall {k} (t :: k). Proxy t
Proxy :: Proxy era))

{-# DEPRECATED AsMaryTx "Use 'AsTx AsMaryEra' instead." #-}
pattern AsMaryTx :: AsType (Tx MaryEra)
pattern $bAsMaryTx :: AsType (Tx MaryEra)
$mAsMaryTx :: forall {r}.
AsType (Tx MaryEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsMaryTx = AsTx AsMaryEra

{-# COMPLETE AsMaryTx #-}

{-# DEPRECATED AsAllegraTx "Use 'AsTx AsAllegraEra' instead." #-}
pattern AsAllegraTx :: AsType (Tx AllegraEra)
pattern $bAsAllegraTx :: AsType (Tx AllegraEra)
$mAsAllegraTx :: forall {r}.
AsType (Tx AllegraEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsAllegraTx = AsTx AsAllegraEra

{-# COMPLETE AsAllegraTx #-}

{-# DEPRECATED AsAlonzoTx "Use 'AsTx AsAlonzoEra' instead." #-}
pattern AsAlonzoTx :: AsType (Tx AlonzoEra)
pattern $bAsAlonzoTx :: AsType (Tx AlonzoEra)
$mAsAlonzoTx :: forall {r}.
AsType (Tx AlonzoEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsAlonzoTx = AsTx AsAlonzoEra

{-# COMPLETE AsAlonzoTx #-}

instance IsShelleyBasedEra era => SerialiseAsCBOR (Tx era) where
  serialiseToCBOR :: Tx era -> ByteString
serialiseToCBOR (ShelleyTx ShelleyBasedEra era
sbe Tx (ShelleyLedgerEra era)
tx) =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => ByteString) -> ByteString)
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx (ShelleyLedgerEra era) -> ByteString
forall ledgerera. EraTx ledgerera => Tx ledgerera -> ByteString
serialiseShelleyBasedTx Tx (ShelleyLedgerEra era)
tx

  deserialiseFromCBOR :: AsType (Tx era) -> ByteString -> Either DecoderError (Tx era)
deserialiseFromCBOR AsType (Tx era)
_ ByteString
bs =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Either DecoderError (Tx era))
-> Either DecoderError (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra :: ShelleyBasedEra era) ((ShelleyBasedEraConstraints era => Either DecoderError (Tx era))
 -> Either DecoderError (Tx era))
-> (ShelleyBasedEraConstraints era => Either DecoderError (Tx era))
-> Either DecoderError (Tx era)
forall a b. (a -> b) -> a -> b
$
      (Tx (ShelleyLedgerEra era) -> Tx era)
-> ByteString -> Either DecoderError (Tx era)
forall ledgerera tx'.
EraTx ledgerera =>
(Tx ledgerera -> tx') -> ByteString -> Either DecoderError tx'
deserialiseShelleyBasedTx (ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra) ByteString
bs

-- | The serialisation format for the different Shelley-based eras are not the
-- same, but they can be handled generally with one overloaded implementation.
serialiseShelleyBasedTx
  :: forall ledgerera
   . L.EraTx ledgerera
  => L.Tx ledgerera
  -> ByteString
serialiseShelleyBasedTx :: forall ledgerera. EraTx ledgerera => Tx ledgerera -> ByteString
serialiseShelleyBasedTx = Tx ledgerera -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize'

deserialiseShelleyBasedTx
  :: forall ledgerera tx'
   . L.EraTx ledgerera
  => (L.Tx ledgerera -> tx')
  -> ByteString
  -> Either CBOR.DecoderError tx'
deserialiseShelleyBasedTx :: forall ledgerera tx'.
EraTx ledgerera =>
(Tx ledgerera -> tx') -> ByteString -> Either DecoderError tx'
deserialiseShelleyBasedTx Tx ledgerera -> tx'
mkTx ByteString
bs =
  Tx ledgerera -> tx'
mkTx
    (Tx ledgerera -> tx')
-> Either DecoderError (Tx ledgerera) -> Either DecoderError tx'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> Text
-> (forall s. Decoder s (Annotator (Tx ledgerera)))
-> ByteString
-> Either DecoderError (Tx ledgerera)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
      (forall era. Era era => Version
L.eraProtVerLow @ledgerera)
      Text
"Shelley Tx"
      Decoder s (Annotator (Tx ledgerera))
forall s. Decoder s (Annotator (Tx ledgerera))
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
      (ByteString -> ByteString
LBS.fromStrict ByteString
bs)

-- NB: This is called in getTxBodyAndWitnesses which is fine as
-- getTxBodyAndWitnesses is only called in the context of a
-- shelley based era anyways. ByronTx will eventually be removed.
getTxBody :: Tx era -> TxBody era
getTxBody :: forall era. Tx era -> TxBody era
getTxBody (ShelleyTx ShelleyBasedEra era
sbe Tx (ShelleyLedgerEra era)
tx) =
  (ShelleyToMaryEraConstraints era =>
 ShelleyToMaryEra era -> TxBody era)
-> (AlonzoEraOnwardsConstraints era =>
    AlonzoEraOnwards era -> TxBody era)
-> ShelleyBasedEra era
-> TxBody era
forall era a.
(ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a)
-> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToMaryOrAlonzoEraOnwards
    ( TxBody era -> ShelleyToMaryEra era -> TxBody era
forall a b. a -> b -> a
const (TxBody era -> ShelleyToMaryEra era -> TxBody era)
-> TxBody era -> ShelleyToMaryEra era -> TxBody era
forall a b. (a -> b) -> a -> b
$
        let txBody :: TxBody (ShelleyLedgerEra era)
txBody = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (TxBody (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (ShelleyLedgerEra era))
  (Tx (ShelleyLedgerEra era))
  (TxBody (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
L.bodyTxL
            txAuxData :: StrictMaybe (TxAuxData (ShelleyLedgerEra era))
txAuxData = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
     (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
-> StrictMaybe (TxAuxData (ShelleyLedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
  (Tx (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens'
  (Tx (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
L.auxDataTxL
            scriptWits :: Map ScriptHash (Script (ShelleyLedgerEra era))
scriptWits = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
-> Map ScriptHash (Script (ShelleyLedgerEra era))
forall s a. s -> Getting a s a -> a
^. (TxWits (ShelleyLedgerEra era)
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (TxWits (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (Map ScriptHash (Script (ShelleyLedgerEra era)))
       (TxWits (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (Tx (ShelleyLedgerEra era)))
-> ((Map ScriptHash (Script (ShelleyLedgerEra era))
     -> Const
          (Map ScriptHash (Script (ShelleyLedgerEra era)))
          (Map ScriptHash (Script (ShelleyLedgerEra era))))
    -> TxWits (ShelleyLedgerEra era)
    -> Const
         (Map ScriptHash (Script (ShelleyLedgerEra era)))
         (TxWits (ShelleyLedgerEra era)))
-> Getting
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script (ShelleyLedgerEra era))
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (Map ScriptHash (Script (ShelleyLedgerEra era))))
-> TxWits (ShelleyLedgerEra era)
-> Const
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Map ScriptHash (Script (ShelleyLedgerEra era)))
L.scriptTxWitsL
         in ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody
              ShelleyBasedEra era
sbe
              TxBody (ShelleyLedgerEra era)
txBody
              (Map ScriptHash (Script (ShelleyLedgerEra era))
-> [Script (ShelleyLedgerEra era)]
forall k a. Map k a -> [a]
Map.elems Map ScriptHash (Script (ShelleyLedgerEra era))
scriptWits)
              TxBodyScriptData era
forall era. TxBodyScriptData era
TxBodyNoScriptData
              (StrictMaybe (TxAuxData (ShelleyLedgerEra era))
-> Maybe (TxAuxData (ShelleyLedgerEra era))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (TxAuxData (ShelleyLedgerEra era))
txAuxData)
              TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
    )
    ( \AlonzoEraOnwards era
w ->
        let txBody :: TxBody (ShelleyLedgerEra era)
txBody = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (TxBody (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (ShelleyLedgerEra era))
  (Tx (ShelleyLedgerEra era))
  (TxBody (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
L.bodyTxL
            txAuxData :: StrictMaybe (TxAuxData (ShelleyLedgerEra era))
txAuxData = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
     (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
-> StrictMaybe (TxAuxData (ShelleyLedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
  (Tx (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens'
  (Tx (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
L.auxDataTxL
            scriptWits :: Map ScriptHash (Script (ShelleyLedgerEra era))
scriptWits = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
-> Map ScriptHash (Script (ShelleyLedgerEra era))
forall s a. s -> Getting a s a -> a
^. (TxWits (ShelleyLedgerEra era)
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (TxWits (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (Map ScriptHash (Script (ShelleyLedgerEra era)))
       (TxWits (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (Tx (ShelleyLedgerEra era)))
-> ((Map ScriptHash (Script (ShelleyLedgerEra era))
     -> Const
          (Map ScriptHash (Script (ShelleyLedgerEra era)))
          (Map ScriptHash (Script (ShelleyLedgerEra era))))
    -> TxWits (ShelleyLedgerEra era)
    -> Const
         (Map ScriptHash (Script (ShelleyLedgerEra era)))
         (TxWits (ShelleyLedgerEra era)))
-> Getting
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx (ShelleyLedgerEra era))
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script (ShelleyLedgerEra era))
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (Map ScriptHash (Script (ShelleyLedgerEra era))))
-> TxWits (ShelleyLedgerEra era)
-> Const
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Map ScriptHash (Script (ShelleyLedgerEra era)))
L.scriptTxWitsL
            datsWits :: TxDats (ShelleyLedgerEra era)
datsWits = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (TxDats (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (TxDats (ShelleyLedgerEra era))
-> TxDats (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. (TxWits (ShelleyLedgerEra era)
 -> Const
      (TxDats (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const
     (TxDats (ShelleyLedgerEra era)) (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (TxDats (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const
      (TxDats (ShelleyLedgerEra era)) (Tx (ShelleyLedgerEra era)))
-> ((TxDats (ShelleyLedgerEra era)
     -> Const
          (TxDats (ShelleyLedgerEra era)) (TxDats (ShelleyLedgerEra era)))
    -> TxWits (ShelleyLedgerEra era)
    -> Const
         (TxDats (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
-> Getting
     (TxDats (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (TxDats (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats (ShelleyLedgerEra era)
 -> Const
      (TxDats (ShelleyLedgerEra era)) (TxDats (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Const
     (TxDats (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens'
  (TxWits (ShelleyLedgerEra era)) (TxDats (ShelleyLedgerEra era))
L.datsTxWitsL
            redeemerWits :: Redeemers (ShelleyLedgerEra era)
redeemerWits = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting
     (Redeemers (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (Redeemers (ShelleyLedgerEra era))
-> Redeemers (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. (TxWits (ShelleyLedgerEra era)
 -> Const
      (Redeemers (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const
     (Redeemers (ShelleyLedgerEra era)) (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (Redeemers (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const
      (Redeemers (ShelleyLedgerEra era)) (Tx (ShelleyLedgerEra era)))
-> ((Redeemers (ShelleyLedgerEra era)
     -> Const
          (Redeemers (ShelleyLedgerEra era))
          (Redeemers (ShelleyLedgerEra era)))
    -> TxWits (ShelleyLedgerEra era)
    -> Const
         (Redeemers (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
-> Getting
     (Redeemers (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (Redeemers (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (ShelleyLedgerEra era)
 -> Const
      (Redeemers (ShelleyLedgerEra era))
      (Redeemers (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Const
     (Redeemers (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ShelleyLedgerEra era)) (Redeemers (ShelleyLedgerEra era))
L.rdmrsTxWitsL
            isValid :: IsValid
isValid = Tx (ShelleyLedgerEra era)
tx Tx (ShelleyLedgerEra era)
-> Getting IsValid (Tx (ShelleyLedgerEra era)) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx (ShelleyLedgerEra era)) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx (ShelleyLedgerEra era)) IsValid
L.isValidTxL
         in ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody
              ShelleyBasedEra era
sbe
              TxBody (ShelleyLedgerEra era)
txBody
              (Map ScriptHash (Script (ShelleyLedgerEra era))
-> [Script (ShelleyLedgerEra era)]
forall k a. Map k a -> [a]
Map.elems Map ScriptHash (Script (ShelleyLedgerEra era))
scriptWits)
              (AlonzoEraOnwards era
-> TxDats (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> TxBodyScriptData era
forall era.
AlonzoEraOnwardsConstraints era =>
AlonzoEraOnwards era
-> TxDats (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> TxBodyScriptData era
TxBodyScriptData AlonzoEraOnwards era
w TxDats (ShelleyLedgerEra era)
datsWits Redeemers (ShelleyLedgerEra era)
redeemerWits)
              (StrictMaybe (TxAuxData (ShelleyLedgerEra era))
-> Maybe (TxAuxData (ShelleyLedgerEra era))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (TxAuxData (ShelleyLedgerEra era))
txAuxData)
              (AlonzoEraOnwards era -> ScriptValidity -> TxScriptValidity era
forall era.
AlonzoEraOnwards era -> ScriptValidity -> TxScriptValidity era
TxScriptValidity AlonzoEraOnwards era
w (IsValid -> ScriptValidity
isValidToScriptValidity IsValid
isValid))
    )
    ShelleyBasedEra era
sbe

instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where
  textEnvelopeType :: AsType (Tx era) -> TextEnvelopeType
textEnvelopeType AsType (Tx era)
_ =
    case ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra :: ShelleyBasedEra era of
      ShelleyBasedEra era
ShelleyBasedEraShelley -> TextEnvelopeType
"TxSignedShelley"
      ShelleyBasedEra era
ShelleyBasedEraAllegra -> TextEnvelopeType
"Tx AllegraEra"
      ShelleyBasedEra era
ShelleyBasedEraMary -> TextEnvelopeType
"Tx MaryEra"
      ShelleyBasedEra era
ShelleyBasedEraAlonzo -> TextEnvelopeType
"Tx AlonzoEra"
      ShelleyBasedEra era
ShelleyBasedEraBabbage -> TextEnvelopeType
"Tx BabbageEra"
      ShelleyBasedEra era
ShelleyBasedEraConway -> TextEnvelopeType
"Tx ConwayEra"

-- ----------------------------------------------------------------------------
-- Transaction bodies
--
-- TODO: We can use Ledger.Tx era here however we would need to rename TxBody
-- as technically it is not strictly a transaction body.
data TxBody era where
  ShelleyTxBody
    :: ShelleyBasedEra era
    -> Ledger.TxBody (ShelleyLedgerEra era)
    -- We include the scripts along with the tx body, rather than the
    -- witnesses set, since they need to be known when building the body.
    -> [Ledger.Script (ShelleyLedgerEra era)]
    -- The info for each use of each script: the script input data, both
    -- the UTxO input data (called the "datum") and the supplied input
    -- data (called the "redeemer") and the execution units.
    -> TxBodyScriptData era
    -- The 'L.TxAuxData' consists of one or several things,
    -- depending on era:
    -- + transaction metadata  (in Shelley and later)
    -- + auxiliary scripts     (in Allegra and later)
    -- Note that there is no auxiliary script data as such, because the
    -- extra script data has to be passed to scripts and hence is needed
    -- for validation. It is thus part of the witness data, not the
    -- auxiliary data.
    -> Maybe (L.TxAuxData (ShelleyLedgerEra era))
    -> TxScriptValidity era
    -- ^ Mark script as expected to pass or fail validation
    -> TxBody era

-- The 'ShelleyBasedEra' GADT tells us what era we are in.
-- The 'ShelleyLedgerEra' type family maps that to the era type from the
-- ledger lib. The 'Ledger.TxBody' type family maps that to a specific
-- tx body type, which is different for each Shelley-based era.

-- The GADT in the ShelleyTxBody case requires a custom instance
instance Eq (TxBody era) where
  == :: TxBody era -> TxBody era -> Bool
(==)
    (ShelleyTxBody ShelleyBasedEra era
sbe TxBody (ShelleyLedgerEra era)
txbodyA [Script (ShelleyLedgerEra era)]
txscriptsA TxBodyScriptData era
redeemersA Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataA TxScriptValidity era
scriptValidityA)
    (ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
txbodyB [Script (ShelleyLedgerEra era)]
txscriptsB TxBodyScriptData era
redeemersB Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataB TxScriptValidity era
scriptValidityB) =
      (ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> Bool)
-> (AlonzoEraOnwardsConstraints era =>
    AlonzoEraOnwards era -> Bool)
-> ShelleyBasedEra era
-> Bool
forall era a.
(ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a)
-> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToMaryOrAlonzoEraOnwards
        ( Bool -> ShelleyToMaryEra era -> Bool
forall a b. a -> b -> a
const (Bool -> ShelleyToMaryEra era -> Bool)
-> Bool -> ShelleyToMaryEra era -> Bool
forall a b. (a -> b) -> a -> b
$
            TxBody (ShelleyLedgerEra era)
txbodyA TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody (ShelleyLedgerEra era)
txbodyB
              Bool -> Bool -> Bool
&& [Script (ShelleyLedgerEra era)]
txscriptsA [Script (ShelleyLedgerEra era)]
-> [Script (ShelleyLedgerEra era)] -> Bool
forall a. Eq a => a -> a -> Bool
== [Script (ShelleyLedgerEra era)]
txscriptsB
              Bool -> Bool -> Bool
&& Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataA Maybe (TxAuxData (ShelleyLedgerEra era))
-> Maybe (TxAuxData (ShelleyLedgerEra era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataB
        )
        ( Bool -> AlonzoEraOnwards era -> Bool
forall a b. a -> b -> a
const (Bool -> AlonzoEraOnwards era -> Bool)
-> Bool -> AlonzoEraOnwards era -> Bool
forall a b. (a -> b) -> a -> b
$
            TxBody (ShelleyLedgerEra era)
txbodyA TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody (ShelleyLedgerEra era)
txbodyB
              Bool -> Bool -> Bool
&& [Script (ShelleyLedgerEra era)]
[AlonzoScript (ShelleyLedgerEra era)]
txscriptsA [AlonzoScript (ShelleyLedgerEra era)]
-> [AlonzoScript (ShelleyLedgerEra era)] -> Bool
forall a. Eq a => a -> a -> Bool
== [Script (ShelleyLedgerEra era)]
[AlonzoScript (ShelleyLedgerEra era)]
txscriptsB
              Bool -> Bool -> Bool
&& TxBodyScriptData era
redeemersA TxBodyScriptData era -> TxBodyScriptData era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBodyScriptData era
redeemersB
              Bool -> Bool -> Bool
&& Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataA Maybe (TxAuxData (ShelleyLedgerEra era))
-> Maybe (TxAuxData (ShelleyLedgerEra era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataB
              Bool -> Bool -> Bool
&& TxScriptValidity era
scriptValidityA TxScriptValidity era -> TxScriptValidity era -> Bool
forall a. Eq a => a -> a -> Bool
== TxScriptValidity era
scriptValidityB
        )
        ShelleyBasedEra era
sbe

-- The GADT in the ShelleyTxBody case requires a custom instance
instance Show (TxBody era) where
  showsPrec :: Int -> TxBody era -> ShowS
showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraShelley
        TxBody (ShelleyLedgerEra era)
txbody
        [Script (ShelleyLedgerEra era)]
txscripts
        TxBodyScriptData era
redeemers
        Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
        TxScriptValidity era
scriptValidity
      ) =
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ShelleyTxBody ShelleyBasedEraShelley "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyTxBody ShelleyEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (ShelleyLedgerEra era)
ShelleyTxBody ShelleyEra
txbody
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [MultiSig ShelleyEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (ShelleyLedgerEra era)]
[MultiSig ShelleyEra]
txscripts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (ShelleyTxAuxData ShelleyEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (TxAuxData (ShelleyLedgerEra era))
Maybe (ShelleyTxAuxData ShelleyEra)
txmetadata
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )
  showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraAllegra
        TxBody (ShelleyLedgerEra era)
txbody
        [Script (ShelleyLedgerEra era)]
txscripts
        TxBodyScriptData era
redeemers
        Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
        TxScriptValidity era
scriptValidity
      ) =
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ShelleyTxBody ShelleyBasedEraAllegra "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AllegraTxBody AllegraEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 AllegraTxBody AllegraEra
TxBody (ShelleyLedgerEra era)
txbody
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Timelock AllegraEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Timelock AllegraEra]
[Script (ShelleyLedgerEra era)]
txscripts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (AllegraTxAuxData AllegraEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (AllegraTxAuxData AllegraEra)
Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )
  showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraMary
        TxBody (ShelleyLedgerEra era)
txbody
        [Script (ShelleyLedgerEra era)]
txscripts
        TxBodyScriptData era
redeemers
        Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
        TxScriptValidity era
scriptValidity
      ) =
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ShelleyTxBody ShelleyBasedEraMary "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MaryTxBody MaryEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (ShelleyLedgerEra era)
MaryTxBody MaryEra
txbody
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Timelock MaryEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Timelock MaryEra]
[Script (ShelleyLedgerEra era)]
txscripts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (AllegraTxAuxData MaryEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (AllegraTxAuxData MaryEra)
Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )
  showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraAlonzo
        TxBody (ShelleyLedgerEra era)
txbody
        [Script (ShelleyLedgerEra era)]
txscripts
        TxBodyScriptData era
redeemers
        Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
        TxScriptValidity era
scriptValidity
      ) =
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ShelleyTxBody ShelleyBasedEraAlonzo "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AlonzoTxBody AlonzoEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (ShelleyLedgerEra era)
AlonzoTxBody AlonzoEra
txbody
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [AlonzoScript AlonzoEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (ShelleyLedgerEra era)]
[AlonzoScript AlonzoEra]
txscripts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (AlonzoTxAuxData AlonzoEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (TxAuxData (ShelleyLedgerEra era))
Maybe (AlonzoTxAuxData AlonzoEra)
txmetadata
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )
  showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraBabbage
        TxBody (ShelleyLedgerEra era)
txbody
        [Script (ShelleyLedgerEra era)]
txscripts
        TxBodyScriptData era
redeemers
        Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
        TxScriptValidity era
scriptValidity
      ) =
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ShelleyTxBody ShelleyBasedEraBabbage "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BabbageTxBody BabbageEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (ShelleyLedgerEra era)
BabbageTxBody BabbageEra
txbody
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [AlonzoScript BabbageEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (ShelleyLedgerEra era)]
[AlonzoScript BabbageEra]
txscripts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (AlonzoTxAuxData BabbageEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (TxAuxData (ShelleyLedgerEra era))
Maybe (AlonzoTxAuxData BabbageEra)
txmetadata
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )
  showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraConway
        TxBody (ShelleyLedgerEra era)
txbody
        [Script (ShelleyLedgerEra era)]
txscripts
        TxBodyScriptData era
redeemers
        Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
        TxScriptValidity era
scriptValidity
      ) =
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ShelleyTxBody ShelleyBasedEraConway "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConwayTxBody ConwayEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (ShelleyLedgerEra era)
ConwayTxBody ConwayEra
txbody
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [AlonzoScript ConwayEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (ShelleyLedgerEra era)]
[AlonzoScript ConwayEra]
txscripts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (AlonzoTxAuxData ConwayEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (TxAuxData (ShelleyLedgerEra era))
Maybe (AlonzoTxAuxData ConwayEra)
txmetadata
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )

instance HasTypeProxy era => HasTypeProxy (TxBody era) where
  data AsType (TxBody era) = AsTxBody (AsType era)
  proxyToAsType :: Proxy (TxBody era) -> AsType (TxBody era)
proxyToAsType Proxy (TxBody era)
_ = AsType era -> AsType (TxBody era)
forall era. AsType era -> AsType (TxBody era)
AsTxBody (Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy era
forall {k} (t :: k). Proxy t
Proxy :: Proxy era))

{-# DEPRECATED AsByronTxBody "Use 'AsTxBody AsByronEra' instead." #-}
pattern AsByronTxBody :: AsType (TxBody ByronEra)
pattern $bAsByronTxBody :: AsType (TxBody ByronEra)
$mAsByronTxBody :: forall {r}.
AsType (TxBody ByronEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsByronTxBody = AsTxBody AsByronEra

{-# COMPLETE AsByronTxBody #-}

{-# DEPRECATED AsShelleyTxBody "Use 'AsTxBody AsShelleyEra' instead." #-}
pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra)
pattern $bAsShelleyTxBody :: AsType (TxBody ShelleyEra)
$mAsShelleyTxBody :: forall {r}.
AsType (TxBody ShelleyEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsShelleyTxBody = AsTxBody AsShelleyEra

{-# COMPLETE AsShelleyTxBody #-}

{-# DEPRECATED AsMaryTxBody "Use 'AsTxBody AsMaryEra' instead." #-}
pattern AsMaryTxBody :: AsType (TxBody MaryEra)
pattern $bAsMaryTxBody :: AsType (TxBody MaryEra)
$mAsMaryTxBody :: forall {r}.
AsType (TxBody MaryEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsMaryTxBody = AsTxBody AsMaryEra

{-# COMPLETE AsMaryTxBody #-}

instance IsShelleyBasedEra era => SerialiseAsCBOR (TxBody era) where
  serialiseToCBOR :: TxBody era -> ByteString
serialiseToCBOR TxBody era
body = Tx era -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR (Tx era -> ByteString) -> Tx era -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> TxBody era -> [ShelleyWitnessSigningKey] -> Tx era
forall era.
ShelleyBasedEra era
-> TxBody era -> [ShelleyWitnessSigningKey] -> Tx era
signShelleyTransaction ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra TxBody era
body [ShelleyWitnessSigningKey]
forall a. Monoid a => a
mempty

  deserialiseFromCBOR :: AsType (TxBody era)
-> ByteString -> Either DecoderError (TxBody era)
deserialiseFromCBOR AsType (TxBody era)
_ ByteString
bs =
    (TxBody era, [KeyWitness era]) -> TxBody era
forall a b. (a, b) -> a
fst ((TxBody era, [KeyWitness era]) -> TxBody era)
-> (Tx era -> (TxBody era, [KeyWitness era]))
-> Tx era
-> TxBody era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> (TxBody era, [KeyWitness era])
forall era. Tx era -> (TxBody era, [KeyWitness era])
getTxBodyAndWitnesses
      (Tx era -> TxBody era)
-> Either DecoderError (Tx era) -> Either DecoderError (TxBody era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Either DecoderError (Tx era))
-> Either DecoderError (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints
        (ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra :: ShelleyBasedEra era)
        ((Tx (ShelleyLedgerEra era) -> Tx era)
-> ByteString -> Either DecoderError (Tx era)
forall ledgerera tx'.
EraTx ledgerera =>
(Tx ledgerera -> tx') -> ByteString -> Either DecoderError tx'
deserialiseShelleyBasedTx (ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra) ByteString
bs)

instance IsShelleyBasedEra era => HasTextEnvelope (TxBody era) where
  textEnvelopeType :: AsType (TxBody era) -> TextEnvelopeType
textEnvelopeType AsType (TxBody era)
_ =
    case ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra :: ShelleyBasedEra era of
      ShelleyBasedEra era
ShelleyBasedEraShelley -> TextEnvelopeType
"TxUnsignedShelley"
      ShelleyBasedEra era
ShelleyBasedEraAllegra -> TextEnvelopeType
"TxBodyAllegra"
      ShelleyBasedEra era
ShelleyBasedEraMary -> TextEnvelopeType
"TxBodyMary"
      ShelleyBasedEra era
ShelleyBasedEraAlonzo -> TextEnvelopeType
"TxBodyAlonzo"
      ShelleyBasedEra era
ShelleyBasedEraBabbage -> TextEnvelopeType
"TxBodyBabbage"
      ShelleyBasedEra era
ShelleyBasedEraConway -> TextEnvelopeType
"TxBodyConway"

data TxBodyScriptData era where
  TxBodyNoScriptData :: TxBodyScriptData era
  TxBodyScriptData
    :: AlonzoEraOnwardsConstraints era
    => AlonzoEraOnwards era
    -> Alonzo.TxDats (ShelleyLedgerEra era)
    -> Alonzo.Redeemers (ShelleyLedgerEra era)
    -> TxBodyScriptData era

deriving instance Eq (TxBodyScriptData era)

deriving instance Show (TxBodyScriptData era)

-- | Indicates whether a script is expected to fail or pass validation.
data ScriptValidity
  = -- | Script is expected to fail validation.
    -- Transactions marked as such can include scripts that fail validation.
    -- Such transactions may be submitted to the chain, in which case the
    -- collateral will be taken upon on chain script validation failure.
    ScriptInvalid
  | -- | Script is expected to pass validation.
    -- Transactions marked as such cannot include scripts that fail validation.
    ScriptValid
  deriving (ScriptValidity -> ScriptValidity -> Bool
(ScriptValidity -> ScriptValidity -> Bool)
-> (ScriptValidity -> ScriptValidity -> Bool) -> Eq ScriptValidity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptValidity -> ScriptValidity -> Bool
== :: ScriptValidity -> ScriptValidity -> Bool
$c/= :: ScriptValidity -> ScriptValidity -> Bool
/= :: ScriptValidity -> ScriptValidity -> Bool
Eq, Int -> ScriptValidity -> ShowS
[ScriptValidity] -> ShowS
ScriptValidity -> String
(Int -> ScriptValidity -> ShowS)
-> (ScriptValidity -> String)
-> ([ScriptValidity] -> ShowS)
-> Show ScriptValidity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptValidity -> ShowS
showsPrec :: Int -> ScriptValidity -> ShowS
$cshow :: ScriptValidity -> String
show :: ScriptValidity -> String
$cshowList :: [ScriptValidity] -> ShowS
showList :: [ScriptValidity] -> ShowS
Show)

instance CBOR.EncCBOR ScriptValidity where
  encCBOR :: ScriptValidity -> Encoding
encCBOR = IsValid -> Encoding
forall a. EncCBOR a => a -> Encoding
CBOR.encCBOR (IsValid -> Encoding)
-> (ScriptValidity -> IsValid) -> ScriptValidity -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptValidity -> IsValid
scriptValidityToIsValid

instance CBOR.DecCBOR ScriptValidity where
  decCBOR :: forall s. Decoder s ScriptValidity
decCBOR = IsValid -> ScriptValidity
isValidToScriptValidity (IsValid -> ScriptValidity)
-> Decoder s IsValid -> Decoder s ScriptValidity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IsValid
forall s. Decoder s IsValid
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR

scriptValidityToIsValid :: ScriptValidity -> L.IsValid
scriptValidityToIsValid :: ScriptValidity -> IsValid
scriptValidityToIsValid ScriptValidity
ScriptInvalid = Bool -> IsValid
L.IsValid Bool
False
scriptValidityToIsValid ScriptValidity
ScriptValid = Bool -> IsValid
L.IsValid Bool
True

isValidToScriptValidity :: L.IsValid -> ScriptValidity
isValidToScriptValidity :: IsValid -> ScriptValidity
isValidToScriptValidity (L.IsValid Bool
False) = ScriptValidity
ScriptInvalid
isValidToScriptValidity (L.IsValid Bool
True) = ScriptValidity
ScriptValid

-- | A representation of whether the era supports tx script validity.
--
-- The Alonzo and subsequent eras support script validity.
data TxScriptValidity era where
  TxScriptValidityNone
    :: TxScriptValidity era
  -- | Tx script validity is supported in transactions in the 'Alonzo' era onwards.
  TxScriptValidity
    :: AlonzoEraOnwards era
    -> ScriptValidity
    -> TxScriptValidity era

deriving instance Eq (TxScriptValidity era)

deriving instance Show (TxScriptValidity era)

txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity :: forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidity era
TxScriptValidityNone = ScriptValidity
ScriptValid
txScriptValidityToScriptValidity (TxScriptValidity AlonzoEraOnwards era
_ ScriptValidity
scriptValidity) = ScriptValidity
scriptValidity

txScriptValidityToIsValid :: TxScriptValidity era -> L.IsValid
txScriptValidityToIsValid :: forall era. TxScriptValidity era -> IsValid
txScriptValidityToIsValid = ScriptValidity -> IsValid
scriptValidityToIsValid (ScriptValidity -> IsValid)
-> (TxScriptValidity era -> ScriptValidity)
-> TxScriptValidity era
-> IsValid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxScriptValidity era -> ScriptValidity
forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity

data KeyWitness era where
  ByronKeyWitness
    :: Byron.TxInWitness
    -> KeyWitness ByronEra
  ShelleyBootstrapWitness
    :: ShelleyBasedEra era
    -> Shelley.BootstrapWitness
    -> KeyWitness era
  ShelleyKeyWitness
    :: ShelleyBasedEra era
    -> L.WitVKey Shelley.Witness
    -> KeyWitness era

-- The GADT in the Shelley cases requires a custom instance
instance Eq (KeyWitness era) where
  == :: KeyWitness era -> KeyWitness era -> Bool
(==)
    (ByronKeyWitness TxInWitness
wA)
    (ByronKeyWitness TxInWitness
wB) = TxInWitness
wA TxInWitness -> TxInWitness -> Bool
forall a. Eq a => a -> a -> Bool
== TxInWitness
wB
  (==)
    (ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness
wA)
    (ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness
wB) =
      BootstrapWitness
wA BootstrapWitness -> BootstrapWitness -> Bool
forall a. Eq a => a -> a -> Bool
== BootstrapWitness
wB
  (==)
    (ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey 'Witness
wA)
    (ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey 'Witness
wB) =
      WitVKey 'Witness
wA WitVKey 'Witness -> WitVKey 'Witness -> Bool
forall a. Eq a => a -> a -> Bool
== WitVKey 'Witness
wB
  (==) KeyWitness era
_ KeyWitness era
_ = Bool
False

-- The GADT in the ShelleyTx case requires a custom instance
-- TODO: once we start providing custom patterns we should do the show in terms
-- of those. It'll be less verbose too!
instance Show (KeyWitness era) where
  showsPrec :: Int -> KeyWitness era -> ShowS
showsPrec Int
p (ByronKeyWitness TxInWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ByronKeyWitness "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxInWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxInWitness
tx
  showsPrec Int
p (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraShelley BootstrapWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyBootstrapWitness ShelleyBasedEraShelley "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BootstrapWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BootstrapWitness
tx
  showsPrec Int
p (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraAllegra BootstrapWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyBootstrapWitness ShelleyBasedEraAllegra "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BootstrapWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BootstrapWitness
tx
  showsPrec Int
p (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraMary BootstrapWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyBootstrapWitness ShelleyBasedEraMary "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BootstrapWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BootstrapWitness
tx
  showsPrec Int
p (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraAlonzo BootstrapWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyBootstrapWitness ShelleyBasedEraAlonzo "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BootstrapWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BootstrapWitness
tx
  showsPrec Int
p (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraBabbage BootstrapWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyBootstrapWitness ShelleyBasedEraBabbage "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BootstrapWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BootstrapWitness
tx
  showsPrec Int
p (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraConway BootstrapWitness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyBootstrapWitness ShelleyBasedEraConway "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BootstrapWitness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BootstrapWitness
tx
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraShelley WitVKey 'Witness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyKeyWitness ShelleyBasedEraShelley "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitVKey 'Witness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 WitVKey 'Witness
tx
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraAllegra WitVKey 'Witness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyKeyWitness ShelleyBasedEraAllegra "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitVKey 'Witness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 WitVKey 'Witness
tx
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraMary WitVKey 'Witness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyKeyWitness ShelleyBasedEraMary "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitVKey 'Witness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 WitVKey 'Witness
tx
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraAlonzo WitVKey 'Witness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyKeyWitness ShelleyBasedEraAlonzo "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitVKey 'Witness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 WitVKey 'Witness
tx
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraBabbage WitVKey 'Witness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyKeyWitness ShelleyBasedEraBabbage "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitVKey 'Witness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 WitVKey 'Witness
tx
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraConway WitVKey 'Witness
tx) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ShelleyKeyWitness ShelleyBasedEraConway "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitVKey 'Witness -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 WitVKey 'Witness
tx

instance HasTypeProxy era => HasTypeProxy (KeyWitness era) where
  data AsType (KeyWitness era) = AsKeyWitness (AsType era)
  proxyToAsType :: Proxy (KeyWitness era) -> AsType (KeyWitness era)
proxyToAsType Proxy (KeyWitness era)
_ = AsType era -> AsType (KeyWitness era)
forall era. AsType era -> AsType (KeyWitness era)
AsKeyWitness (Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy era
forall {k} (t :: k). Proxy t
Proxy :: Proxy era))

{-# DEPRECATED AsByronWitness "Use AsKeyWitness AsByronEra instead" #-}
pattern AsByronWitness :: AsType (KeyWitness ByronEra)
pattern $bAsByronWitness :: AsType (KeyWitness ByronEra)
$mAsByronWitness :: forall {r}.
AsType (KeyWitness ByronEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsByronWitness = AsKeyWitness AsByronEra

{-# COMPLETE AsByronWitness #-}

{-# DEPRECATED AsShelleyWitness "Use AsKeyWitness AsShelleyEra instead" #-}
pattern AsShelleyWitness :: AsType (KeyWitness ShelleyEra)
pattern $bAsShelleyWitness :: AsType (KeyWitness ShelleyEra)
$mAsShelleyWitness :: forall {r}.
AsType (KeyWitness ShelleyEra) -> ((# #) -> r) -> ((# #) -> r) -> r
AsShelleyWitness = AsKeyWitness AsShelleyEra

{-# COMPLETE AsShelleyWitness #-}

-- This custom instance differs from cardano-ledger
-- because we want to be able to tell the difference between
-- on disk witnesses for the cli's 'assemble' command.
instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where
  serialiseToCBOR :: KeyWitness era -> ByteString
serialiseToCBOR (ByronKeyWitness TxInWitness
wit) =
    TxInWitness -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize' TxInWitness
wit
  serialiseToCBOR (ShelleyKeyWitness ShelleyBasedEra era
sbe WitVKey 'Witness
wit) =
    Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
CBOR.serialize' (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerLow ShelleyBasedEra era
sbe) (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
      WitVKey 'Witness -> Encoding
forall a. EncCBOR a => a -> Encoding
encodeShelleyBasedKeyWitness WitVKey 'Witness
wit
  serialiseToCBOR (ShelleyBootstrapWitness ShelleyBasedEra era
sbe BootstrapWitness
wit) =
    Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
CBOR.serialize' (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerLow ShelleyBasedEra era
sbe) (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
      BootstrapWitness -> Encoding
forall a. EncCBOR a => a -> Encoding
encodeShelleyBasedBootstrapWitness BootstrapWitness
wit

  deserialiseFromCBOR :: AsType (KeyWitness era)
-> ByteString -> Either DecoderError (KeyWitness era)
deserialiseFromCBOR AsType (KeyWitness era)
_ ByteString
bs =
    case CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra :: CardanoEra era of
      CardanoEra era
ByronEra ->
        TxInWitness -> KeyWitness era
TxInWitness -> KeyWitness ByronEra
ByronKeyWitness (TxInWitness -> KeyWitness era)
-> Either DecoderError TxInWitness
-> Either DecoderError (KeyWitness era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError TxInWitness
forall a. FromCBOR a => ByteString -> Either DecoderError a
Plain.decodeFull' ByteString
bs
      -- Use the same derialisation impl, but at different types:
      CardanoEra era
ShelleyEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley ByteString
bs
      CardanoEra era
AllegraEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra ByteString
bs
      CardanoEra era
MaryEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra MaryEra
ShelleyBasedEraMary ByteString
bs
      CardanoEra era
AlonzoEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo ByteString
bs
      CardanoEra era
BabbageEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage ByteString
bs
      CardanoEra era
ConwayEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra ConwayEra
ShelleyBasedEraConway ByteString
bs

encodeShelleyBasedKeyWitness :: CBOR.EncCBOR w => w -> CBOR.Encoding
encodeShelleyBasedKeyWitness :: forall a. EncCBOR a => a -> Encoding
encodeShelleyBasedKeyWitness w
wit =
  Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> w -> Encoding
forall a. EncCBOR a => a -> Encoding
CBOR.encCBOR w
wit

encodeShelleyBasedBootstrapWitness :: CBOR.EncCBOR w => w -> CBOR.Encoding
encodeShelleyBasedBootstrapWitness :: forall a. EncCBOR a => a -> Encoding
encodeShelleyBasedBootstrapWitness w
wit =
  Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> w -> Encoding
forall a. EncCBOR a => a -> Encoding
CBOR.encCBOR w
wit

decodeShelleyBasedWitness
  :: forall era
   . L.Era (ShelleyLedgerEra era)
  => ShelleyBasedEra era
  -> ByteString
  -> Either CBOR.DecoderError (KeyWitness era)
decodeShelleyBasedWitness :: forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
sbe =
  Version
-> Text
-> (forall s. Decoder s (Annotator (KeyWitness era)))
-> ByteString
-> Either DecoderError (KeyWitness era)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
    (forall era. Era era => Version
L.eraProtVerLow @(ShelleyLedgerEra era))
    Text
"Shelley Witness"
    Decoder s (Annotator (KeyWitness era))
forall s. Decoder s (Annotator (KeyWitness era))
decode
    (ByteString -> Either DecoderError (KeyWitness era))
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError (KeyWitness era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict
 where
  decode :: CBOR.Decoder s (CBOR.Annotator (KeyWitness era))
  decode :: forall s. Decoder s (Annotator (KeyWitness era))
decode = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenOf Int
2
    Word
t <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
    case Word
t of
      Word
0 -> (Annotator (WitVKey 'Witness) -> Annotator (KeyWitness era))
-> Decoder s (Annotator (WitVKey 'Witness))
-> Decoder s (Annotator (KeyWitness era))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WitVKey 'Witness -> KeyWitness era)
-> Annotator (WitVKey 'Witness) -> Annotator (KeyWitness era)
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShelleyBasedEra era -> WitVKey 'Witness -> KeyWitness era
forall era.
ShelleyBasedEra era -> WitVKey 'Witness -> KeyWitness era
ShelleyKeyWitness ShelleyBasedEra era
sbe)) Decoder s (Annotator (WitVKey 'Witness))
forall s. Decoder s (Annotator (WitVKey 'Witness))
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
      Word
1 -> (Annotator BootstrapWitness -> Annotator (KeyWitness era))
-> Decoder s (Annotator BootstrapWitness)
-> Decoder s (Annotator (KeyWitness era))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BootstrapWitness -> KeyWitness era)
-> Annotator BootstrapWitness -> Annotator (KeyWitness era)
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
forall era.
ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
ShelleyBootstrapWitness ShelleyBasedEra era
sbe)) Decoder s (Annotator BootstrapWitness)
forall s. Decoder s (Annotator BootstrapWitness)
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
      Word
_ ->
        DecoderError -> Decoder s (Annotator (KeyWitness era))
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
CBOR.cborError (DecoderError -> Decoder s (Annotator (KeyWitness era)))
-> DecoderError -> Decoder s (Annotator (KeyWitness era))
forall a b. (a -> b) -> a -> b
$
          Text -> Word8 -> DecoderError
CBOR.DecoderErrorUnknownTag
            Text
"Shelley Witness"
            (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)

instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where
  textEnvelopeType :: AsType (KeyWitness era) -> TextEnvelopeType
textEnvelopeType AsType (KeyWitness era)
_ =
    case CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra :: CardanoEra era of
      CardanoEra era
ByronEra -> TextEnvelopeType
"TxWitnessByron"
      CardanoEra era
ShelleyEra -> TextEnvelopeType
"TxWitness ShelleyEra"
      CardanoEra era
AllegraEra -> TextEnvelopeType
"TxWitness AllegraEra"
      CardanoEra era
MaryEra -> TextEnvelopeType
"TxWitness MaryEra"
      CardanoEra era
AlonzoEra -> TextEnvelopeType
"TxWitness AlonzoEra"
      CardanoEra era
BabbageEra -> TextEnvelopeType
"TxWitness BabbageEra"
      CardanoEra era
ConwayEra -> TextEnvelopeType
"TxWitness ConwayEra"

getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era])
getTxBodyAndWitnesses :: forall era. Tx era -> (TxBody era, [KeyWitness era])
getTxBodyAndWitnesses Tx era
tx = (Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx, Tx era -> [KeyWitness era]
forall era. Tx era -> [KeyWitness era]
getTxWitnesses Tx era
tx)

{-# COMPLETE Tx #-}

data ShelleyWitnessSigningKey
  = WitnessPaymentKey (SigningKey PaymentKey)
  | WitnessPaymentExtendedKey (SigningKey PaymentExtendedKey)
  | WitnessStakeKey (SigningKey StakeKey)
  | WitnessStakeExtendedKey (SigningKey StakeExtendedKey)
  | WitnessStakePoolKey (SigningKey StakePoolKey)
  | WitnessStakePoolExtendedKey (SigningKey StakePoolExtendedKey)
  | WitnessGenesisKey (SigningKey GenesisKey)
  | WitnessGenesisExtendedKey (SigningKey GenesisExtendedKey)
  | WitnessGenesisDelegateKey (SigningKey GenesisDelegateKey)
  | WitnessGenesisDelegateExtendedKey
      (SigningKey GenesisDelegateExtendedKey)
  | WitnessGenesisUTxOKey (SigningKey GenesisUTxOKey)
  | WitnessCommitteeColdKey (SigningKey CommitteeColdKey)
  | WitnessCommitteeColdExtendedKey (SigningKey CommitteeColdExtendedKey)
  | WitnessCommitteeHotKey (SigningKey CommitteeHotKey)
  | WitnessCommitteeHotExtendedKey (SigningKey CommitteeHotExtendedKey)
  | WitnessDRepKey (SigningKey DRepKey)
  | WitnessDRepExtendedKey (SigningKey DRepExtendedKey)

-- | We support making key witnesses with both normal and extended signing keys.
data ShelleySigningKey
  = -- | A normal ed25519 signing key
    ShelleyNormalSigningKey (Crypto.SignKeyDSIGN Shelley.DSIGN)
  | -- | An extended ed25519 signing key
    ShelleyExtendedSigningKey Crypto.HD.XPrv

makeShelleySignature
  :: Crypto.SignableRepresentation tosign
  => tosign
  -> ShelleySigningKey
  -> (Crypto.SignedDSIGN Shelley.DSIGN) tosign
makeShelleySignature :: forall tosign.
SignableRepresentation tosign =>
tosign -> ShelleySigningKey -> SignedDSIGN DSIGN tosign
makeShelleySignature tosign
tosign (ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk) =
  ContextDSIGN DSIGN
-> tosign -> SignKeyDSIGN DSIGN -> SignedDSIGN DSIGN tosign
forall v a.
(DSIGNAlgorithm v, Signable v a) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SignedDSIGN v a
Crypto.signedDSIGN () tosign
tosign SignKeyDSIGN DSIGN
sk
makeShelleySignature tosign
tosign (ShelleyExtendedSigningKey XPrv
sk) =
  XSignature -> SignedDSIGN DSIGN tosign
forall b. XSignature -> SignedDSIGN DSIGN b
fromXSignature (XSignature -> SignedDSIGN DSIGN tosign)
-> XSignature -> SignedDSIGN DSIGN tosign
forall a b. (a -> b) -> a -> b
$
    ByteString -> XPrv -> ByteString -> XSignature
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
Crypto.HD.sign
      ByteString
BS.empty -- passphrase for (unused) in-memory encryption
      XPrv
sk
      (tosign -> ByteString
forall a. SignableRepresentation a => a -> ByteString
Crypto.getSignableRepresentation tosign
tosign)
 where
  fromXSignature
    :: Crypto.HD.XSignature
    -> (Crypto.SignedDSIGN Shelley.DSIGN) b
  fromXSignature :: forall b. XSignature -> SignedDSIGN DSIGN b
fromXSignature =
    SigDSIGN DSIGN -> SignedDSIGN DSIGN b
forall v a. SigDSIGN v -> SignedDSIGN v a
Crypto.SignedDSIGN
      (SigDSIGN DSIGN -> SignedDSIGN DSIGN b)
-> (XSignature -> SigDSIGN DSIGN)
-> XSignature
-> SignedDSIGN DSIGN b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigDSIGN DSIGN -> Maybe (SigDSIGN DSIGN) -> SigDSIGN DSIGN
forall a. a -> Maybe a -> a
fromMaybe SigDSIGN DSIGN
forall {a}. a
impossible
      (Maybe (SigDSIGN DSIGN) -> SigDSIGN DSIGN)
-> (XSignature -> Maybe (SigDSIGN DSIGN))
-> XSignature
-> SigDSIGN DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SigDSIGN DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
Crypto.rawDeserialiseSigDSIGN
      (ByteString -> Maybe (SigDSIGN DSIGN))
-> (XSignature -> ByteString)
-> XSignature
-> Maybe (SigDSIGN DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSignature -> ByteString
Crypto.HD.unXSignature

  impossible :: a
impossible =
    String -> a
forall a. HasCallStack => String -> a
error String
"makeShelleyKeyWitnessSignature: byron and shelley signature sizes do not match"

makeSignedTransaction'
  :: ()
  => CardanoEra era
  -> [KeyWitness era]
  -> TxBody era
  -> Tx era
makeSignedTransaction' :: forall era.
CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction' CardanoEra era
_ = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction

makeSignedByronTransaction
  :: [KeyWitness era] -> Annotated Byron.Tx ByteString -> Byron.ATxAux ByteString
makeSignedByronTransaction :: forall era.
[KeyWitness era] -> Annotated Tx ByteString -> ATxAux ByteString
makeSignedByronTransaction [KeyWitness era]
witnesses Annotated Tx ByteString
txbody =
  TxAux -> ATxAux ByteString
Byron.annotateTxAux (TxAux -> ATxAux ByteString) -> TxAux -> ATxAux ByteString
forall a b. (a -> b) -> a -> b
$
    Tx -> TxWitness -> TxAux
Byron.mkTxAux
      (Annotated Tx ByteString -> Tx
forall b a. Annotated b a -> b
unAnnotated Annotated Tx ByteString
txbody)
      ([Item TxWitness] -> TxWitness
forall l. IsList l => [Item l] -> l
fromList [Item TxWitness
TxInWitness
w | ByronKeyWitness TxInWitness
w <- [KeyWitness era]
witnesses])

-- order of signing keys must match txins
signByronTransaction
  :: NetworkId
  -> Annotated Byron.Tx ByteString
  -> [SigningKey ByronKey]
  -> Byron.ATxAux ByteString
signByronTransaction :: NetworkId
-> Annotated Tx ByteString
-> [SigningKey ByronKey]
-> ATxAux ByteString
signByronTransaction NetworkId
nw Annotated Tx ByteString
txbody [SigningKey ByronKey]
sks =
  [KeyWitness ByronEra]
-> Annotated Tx ByteString -> ATxAux ByteString
forall era.
[KeyWitness era] -> Annotated Tx ByteString -> ATxAux ByteString
makeSignedByronTransaction [KeyWitness ByronEra]
witnesses Annotated Tx ByteString
txbody
 where
  witnesses :: [KeyWitness ByronEra]
witnesses = (SigningKey ByronKey -> KeyWitness ByronEra)
-> [SigningKey ByronKey] -> [KeyWitness ByronEra]
forall a b. (a -> b) -> [a] -> [b]
map (NetworkId
-> Annotated Tx ByteString
-> SigningKey ByronKey
-> KeyWitness ByronEra
forall key.
IsByronKey key =>
NetworkId
-> Annotated Tx ByteString -> SigningKey key -> KeyWitness ByronEra
makeByronKeyWitness NetworkId
nw Annotated Tx ByteString
txbody) [SigningKey ByronKey]
sks

-- signing keys is a set
signShelleyTransaction
  :: ()
  => ShelleyBasedEra era
  -> TxBody era
  -> [ShelleyWitnessSigningKey]
  -> Tx era
signShelleyTransaction :: forall era.
ShelleyBasedEra era
-> TxBody era -> [ShelleyWitnessSigningKey] -> Tx era
signShelleyTransaction ShelleyBasedEra era
sbe TxBody era
txbody [ShelleyWitnessSigningKey]
sks =
  [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
witnesses TxBody era
txbody
 where
  witnesses :: [KeyWitness era]
witnesses = (ShelleyWitnessSigningKey -> KeyWitness era)
-> [ShelleyWitnessSigningKey] -> [KeyWitness era]
forall a b. (a -> b) -> [a] -> [b]
map (ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
sbe TxBody era
txbody) [ShelleyWitnessSigningKey]
sks

getByronTxBody :: Byron.ATxAux ByteString -> Annotated Byron.Tx ByteString
getByronTxBody :: ATxAux ByteString -> Annotated Tx ByteString
getByronTxBody (Byron.ATxAux{aTaTx :: forall a. ATxAux a -> Annotated Tx a
Byron.aTaTx = Annotated Tx ByteString
txbody}) = Annotated Tx ByteString
txbody

getTxWitnessesByron :: Byron.ATxAux ByteString -> [KeyWitness ByronEra]
getTxWitnessesByron :: ATxAux ByteString -> [KeyWitness ByronEra]
getTxWitnessesByron (Byron.ATxAux{aTaWitness :: forall a. ATxAux a -> Annotated TxWitness a
Byron.aTaWitness = Annotated TxWitness ByteString
witnesses}) =
  (TxInWitness -> KeyWitness ByronEra)
-> [TxInWitness] -> [KeyWitness ByronEra]
forall a b. (a -> b) -> [a] -> [b]
map TxInWitness -> KeyWitness ByronEra
ByronKeyWitness
    ([TxInWitness] -> [KeyWitness ByronEra])
-> (Annotated TxWitness ByteString -> [TxInWitness])
-> Annotated TxWitness ByteString
-> [KeyWitness ByronEra]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxWitness -> [Item TxWitness]
TxWitness -> [TxInWitness]
forall l. IsList l => l -> [Item l]
toList
    (TxWitness -> [TxInWitness])
-> (Annotated TxWitness ByteString -> TxWitness)
-> Annotated TxWitness ByteString
-> [TxInWitness]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated TxWitness ByteString -> TxWitness
forall b a. Annotated b a -> b
unAnnotated
    (Annotated TxWitness ByteString -> [KeyWitness ByronEra])
-> Annotated TxWitness ByteString -> [KeyWitness ByronEra]
forall a b. (a -> b) -> a -> b
$ Annotated TxWitness ByteString
witnesses

getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
getTxWitnesses (ShelleyTx ShelleyBasedEra era
sbe Tx (ShelleyLedgerEra era)
tx') =
  (ShelleyToMaryEraConstraints era =>
 ShelleyToMaryEra era -> [KeyWitness era])
-> (AlonzoEraOnwardsConstraints era =>
    AlonzoEraOnwards era -> [KeyWitness era])
-> ShelleyBasedEra era
-> [KeyWitness era]
forall era a.
(ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a)
-> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToMaryOrAlonzoEraOnwards
    ([KeyWitness era] -> ShelleyToMaryEra era -> [KeyWitness era]
forall a b. a -> b -> a
const (Tx (ShelleyLedgerEra era) -> [KeyWitness era]
forall ledgerera.
EraTx ledgerera =>
Tx ledgerera -> [KeyWitness era]
getShelleyTxWitnesses Tx (ShelleyLedgerEra era)
tx'))
    ([KeyWitness era] -> AlonzoEraOnwards era -> [KeyWitness era]
forall a b. a -> b -> a
const (Tx (ShelleyLedgerEra era) -> [KeyWitness era]
forall ledgerera.
EraTx ledgerera =>
Tx ledgerera -> [KeyWitness era]
getAlonzoTxWitnesses Tx (ShelleyLedgerEra era)
tx'))
    ShelleyBasedEra era
sbe
 where
  getShelleyTxWitnesses
    :: forall ledgerera
     . L.EraTx ledgerera
    => L.Tx ledgerera
    -> [KeyWitness era]
  getShelleyTxWitnesses :: forall ledgerera.
EraTx ledgerera =>
Tx ledgerera -> [KeyWitness era]
getShelleyTxWitnesses Tx ledgerera
tx =
    (BootstrapWitness -> KeyWitness era)
-> [BootstrapWitness] -> [KeyWitness era]
forall a b. (a -> b) -> [a] -> [b]
map (ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
forall era.
ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
ShelleyBootstrapWitness ShelleyBasedEra era
sbe) (Set BootstrapWitness -> [BootstrapWitness]
forall a. Set a -> [a]
Set.elems (Tx ledgerera
tx Tx ledgerera
-> Getting
     (Set BootstrapWitness) (Tx ledgerera) (Set BootstrapWitness)
-> Set BootstrapWitness
forall s a. s -> Getting a s a -> a
^. (TxWits ledgerera
 -> Const (Set BootstrapWitness) (TxWits ledgerera))
-> Tx ledgerera -> Const (Set BootstrapWitness) (Tx ledgerera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera
  -> Const (Set BootstrapWitness) (TxWits ledgerera))
 -> Tx ledgerera -> Const (Set BootstrapWitness) (Tx ledgerera))
-> ((Set BootstrapWitness
     -> Const (Set BootstrapWitness) (Set BootstrapWitness))
    -> TxWits ledgerera
    -> Const (Set BootstrapWitness) (TxWits ledgerera))
-> Getting
     (Set BootstrapWitness) (Tx ledgerera) (Set BootstrapWitness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set BootstrapWitness
 -> Const (Set BootstrapWitness) (Set BootstrapWitness))
-> TxWits ledgerera
-> Const (Set BootstrapWitness) (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits ledgerera) (Set BootstrapWitness)
L.bootAddrTxWitsL))
      [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ (WitVKey 'Witness -> KeyWitness era)
-> [WitVKey 'Witness] -> [KeyWitness era]
forall a b. (a -> b) -> [a] -> [b]
map (ShelleyBasedEra era -> WitVKey 'Witness -> KeyWitness era
forall era.
ShelleyBasedEra era -> WitVKey 'Witness -> KeyWitness era
ShelleyKeyWitness ShelleyBasedEra era
sbe) (Set (WitVKey 'Witness) -> [WitVKey 'Witness]
forall a. Set a -> [a]
Set.elems (Tx ledgerera
tx Tx ledgerera
-> Getting
     (Set (WitVKey 'Witness)) (Tx ledgerera) (Set (WitVKey 'Witness))
-> Set (WitVKey 'Witness)
forall s a. s -> Getting a s a -> a
^. (TxWits ledgerera
 -> Const (Set (WitVKey 'Witness)) (TxWits ledgerera))
-> Tx ledgerera -> Const (Set (WitVKey 'Witness)) (Tx ledgerera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera
  -> Const (Set (WitVKey 'Witness)) (TxWits ledgerera))
 -> Tx ledgerera -> Const (Set (WitVKey 'Witness)) (Tx ledgerera))
-> ((Set (WitVKey 'Witness)
     -> Const (Set (WitVKey 'Witness)) (Set (WitVKey 'Witness)))
    -> TxWits ledgerera
    -> Const (Set (WitVKey 'Witness)) (TxWits ledgerera))
-> Getting
     (Set (WitVKey 'Witness)) (Tx ledgerera) (Set (WitVKey 'Witness))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness)
 -> Const (Set (WitVKey 'Witness)) (Set (WitVKey 'Witness)))
-> TxWits ledgerera
-> Const (Set (WitVKey 'Witness)) (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits ledgerera) (Set (WitVKey 'Witness))
L.addrTxWitsL))

  getAlonzoTxWitnesses
    :: forall ledgerera
     . L.EraTx ledgerera
    => L.Tx ledgerera
    -> [KeyWitness era]
  getAlonzoTxWitnesses :: forall ledgerera.
EraTx ledgerera =>
Tx ledgerera -> [KeyWitness era]
getAlonzoTxWitnesses = Tx ledgerera -> [KeyWitness era]
forall ledgerera.
EraTx ledgerera =>
Tx ledgerera -> [KeyWitness era]
getShelleyTxWitnesses

makeSignedTransaction
  :: forall era
   . [KeyWitness era]
  -> TxBody era
  -> Tx era
makeSignedTransaction :: forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction
  [KeyWitness era]
witnesses
  ( ShelleyTxBody
      ShelleyBasedEra era
sbe
      TxBody (ShelleyLedgerEra era)
txbody
      [Script (ShelleyLedgerEra era)]
txscripts
      TxBodyScriptData era
txscriptdata
      Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata
      TxScriptValidity era
scriptValidity
    ) =
    case ShelleyBasedEra era
sbe of
      ShelleyBasedEra era
ShelleyBasedEraShelley -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx era
shelleySignedTransaction
      ShelleyBasedEra era
ShelleyBasedEraAllegra -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx era
shelleySignedTransaction
      ShelleyBasedEra era
ShelleyBasedEraMary -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx era
shelleySignedTransaction
      ShelleyBasedEra era
ShelleyBasedEraAlonzo -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, AlonzoEraTx ledgerera) =>
Tx era
alonzoSignedTransaction
      ShelleyBasedEra era
ShelleyBasedEraBabbage -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, AlonzoEraTx ledgerera) =>
Tx era
alonzoSignedTransaction
      ShelleyBasedEra era
ShelleyBasedEraConway -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, AlonzoEraTx ledgerera) =>
Tx era
alonzoSignedTransaction
   where
    txCommon
      :: forall ledgerera
       . ShelleyLedgerEra era ~ ledgerera
      => L.EraTx ledgerera
      => L.Tx ledgerera
    txCommon :: forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx ledgerera
txCommon =
      TxBody ledgerera -> Tx ledgerera
forall era. EraTx era => TxBody era -> Tx era
L.mkBasicTx TxBody ledgerera
TxBody (ShelleyLedgerEra era)
txbody
        Tx ledgerera -> (Tx ledgerera -> Tx ledgerera) -> Tx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx ledgerera -> Identity (Tx ledgerera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ledgerera) (TxWits ledgerera)
L.witsTxL
          ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> TxWits ledgerera -> Tx ledgerera -> Tx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( TxWits ledgerera
forall era. EraTxWits era => TxWits era
L.mkBasicTxWits
                 TxWits ledgerera
-> (TxWits ledgerera -> TxWits ledgerera) -> TxWits ledgerera
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits ledgerera) (Set (WitVKey 'Witness))
L.addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> Set (WitVKey 'Witness) -> TxWits ledgerera -> TxWits ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set (WitVKey 'Witness))] -> Set (WitVKey 'Witness)
forall l. IsList l => [Item l] -> l
fromList [Item (Set (WitVKey 'Witness))
WitVKey 'Witness
w | ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey 'Witness
w <- [KeyWitness era]
witnesses]
                 TxWits ledgerera
-> (TxWits ledgerera -> TxWits ledgerera) -> TxWits ledgerera
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script ledgerera)
 -> Identity (Map ScriptHash (Script ledgerera)))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits ledgerera) (Map ScriptHash (Script ledgerera))
L.scriptTxWitsL
                   ((Map ScriptHash (Script ledgerera)
  -> Identity (Map ScriptHash (Script ledgerera)))
 -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> Map ScriptHash (Script ledgerera)
-> TxWits ledgerera
-> TxWits ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Map ScriptHash (Script ledgerera))]
-> Map ScriptHash (Script ledgerera)
forall l. IsList l => [Item l] -> l
fromList
                     [ (forall era. EraScript era => Script era -> ScriptHash
Ledger.hashScript @ledgerera Script ledgerera
sw, Script ledgerera
sw)
                     | Script ledgerera
sw <- [Script ledgerera]
[Script (ShelleyLedgerEra era)]
txscripts
                     ]
                 TxWits ledgerera
-> (TxWits ledgerera -> TxWits ledgerera) -> TxWits ledgerera
forall a b. a -> (a -> b) -> b
& (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits ledgerera) (Set BootstrapWitness)
L.bootAddrTxWitsL
                   ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> Set BootstrapWitness -> TxWits ledgerera -> TxWits ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set BootstrapWitness)] -> Set BootstrapWitness
forall l. IsList l => [Item l] -> l
fromList [Item (Set BootstrapWitness)
BootstrapWitness
w | ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness
w <- [KeyWitness era]
witnesses]
             )
        Tx ledgerera -> (Tx ledgerera -> Tx ledgerera) -> Tx ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData ledgerera)
 -> Identity (StrictMaybe (TxAuxData ledgerera)))
-> Tx ledgerera -> Identity (Tx ledgerera)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx ledgerera) (StrictMaybe (TxAuxData ledgerera))
L.auxDataTxL ((StrictMaybe (TxAuxData ledgerera)
  -> Identity (StrictMaybe (TxAuxData ledgerera)))
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> StrictMaybe (TxAuxData ledgerera)
-> Tx ledgerera
-> Tx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (TxAuxData ledgerera) -> StrictMaybe (TxAuxData ledgerera)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (TxAuxData ledgerera)
Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadata

    shelleySignedTransaction
      :: forall ledgerera
       . ShelleyLedgerEra era ~ ledgerera
      => Ledger.EraTx ledgerera
      => Tx era
    shelleySignedTransaction :: forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx era
shelleySignedTransaction = ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
sbe Tx ledgerera
Tx (ShelleyLedgerEra era)
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx ledgerera
txCommon

    alonzoSignedTransaction
      :: forall ledgerera
       . ShelleyLedgerEra era ~ ledgerera
      => L.AlonzoEraTx ledgerera
      => Tx era
    alonzoSignedTransaction :: forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, AlonzoEraTx ledgerera) =>
Tx era
alonzoSignedTransaction =
      ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx
        ShelleyBasedEra era
sbe
        ( Tx ledgerera
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx ledgerera
txCommon
            Tx ledgerera -> (Tx ledgerera -> Tx ledgerera) -> Tx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx ledgerera -> Identity (Tx ledgerera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> ((TxDats ledgerera -> Identity (TxDats ledgerera))
    -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> (TxDats ledgerera -> Identity (TxDats ledgerera))
-> Tx ledgerera
-> Identity (Tx ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats ledgerera -> Identity (TxDats ledgerera))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits ledgerera) (TxDats ledgerera)
L.datsTxWitsL ((TxDats ledgerera -> Identity (TxDats ledgerera))
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> TxDats ledgerera -> Tx ledgerera -> Tx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats ledgerera
datums
            Tx ledgerera -> (Tx ledgerera -> Tx ledgerera) -> Tx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx ledgerera -> Identity (Tx ledgerera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> ((Redeemers ledgerera -> Identity (Redeemers ledgerera))
    -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> (Redeemers ledgerera -> Identity (Redeemers ledgerera))
-> Tx ledgerera
-> Identity (Tx ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers ledgerera -> Identity (Redeemers ledgerera))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits ledgerera) (Redeemers ledgerera)
L.rdmrsTxWitsL ((Redeemers ledgerera -> Identity (Redeemers ledgerera))
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> Redeemers ledgerera -> Tx ledgerera -> Tx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers ledgerera
redeemers
            Tx ledgerera -> (Tx ledgerera -> Tx ledgerera) -> Tx ledgerera
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> Tx ledgerera -> Identity (Tx ledgerera)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx ledgerera) IsValid
L.isValidTxL ((IsValid -> Identity IsValid)
 -> Tx ledgerera -> Identity (Tx ledgerera))
-> IsValid -> Tx ledgerera -> Tx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxScriptValidity era -> IsValid
forall era. TxScriptValidity era -> IsValid
txScriptValidityToIsValid TxScriptValidity era
scriptValidity
        )
     where
      (TxDats ledgerera
datums, Redeemers ledgerera
redeemers) =
        case TxBodyScriptData era
txscriptdata of
          TxBodyScriptData AlonzoEraOnwards era
_ TxDats (ShelleyLedgerEra era)
ds Redeemers (ShelleyLedgerEra era)
rs -> (TxDats ledgerera
TxDats (ShelleyLedgerEra era)
ds, Redeemers ledgerera
Redeemers (ShelleyLedgerEra era)
rs)
          TxBodyScriptData era
TxBodyNoScriptData -> (TxDats ledgerera
forall a. Monoid a => a
mempty, Map (PlutusPurpose AsIx ledgerera) (Data ledgerera, ExUnits)
-> Redeemers ledgerera
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
L.Redeemers Map (PlutusPurpose AsIx ledgerera) (Data ledgerera, ExUnits)
forall a. Monoid a => a
mempty)

makeByronKeyWitness
  :: forall key
   . IsByronKey key
  => NetworkId
  -> Annotated Byron.Tx ByteString
  -> SigningKey key
  -> KeyWitness ByronEra
makeByronKeyWitness :: forall key.
IsByronKey key =>
NetworkId
-> Annotated Tx ByteString -> SigningKey key -> KeyWitness ByronEra
makeByronKeyWitness NetworkId
nw Annotated Tx ByteString
txbody =
  let txhash :: Byron.Hash Byron.Tx
      txhash :: Hash Tx
txhash = Annotated Tx ByteString
-> Hash (BaseType (Annotated Tx ByteString))
forall t. Decoded t => t -> Hash (BaseType t)
Byron.hashDecoded Annotated Tx ByteString
txbody

      pm :: Byron.ProtocolMagicId
      pm :: ProtocolMagicId
pm = NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
nw
   in -- To allow sharing of the txhash computation across many signatures we
      -- define and share the txhash outside the lambda for the signing key:
      case ByronKeyFormat key
forall key. IsByronKey key => ByronKeyFormat key
byronKeyFormat :: ByronKeyFormat key of
        ByronKeyFormat key
ByronLegacyKeyFormat ->
          \(ByronSigningKeyLegacy SigningKey
sk) -> SigningKey -> ProtocolMagicId -> Hash Tx -> KeyWitness ByronEra
witness SigningKey
sk ProtocolMagicId
pm Hash Tx
txhash
        ByronKeyFormat key
ByronModernKeyFormat ->
          \(ByronSigningKey SigningKey
sk) -> SigningKey -> ProtocolMagicId -> Hash Tx -> KeyWitness ByronEra
witness SigningKey
sk ProtocolMagicId
pm Hash Tx
txhash
 where
  witness
    :: Byron.SigningKey
    -> Byron.ProtocolMagicId
    -> Byron.Hash Byron.Tx
    -> KeyWitness ByronEra
  witness :: SigningKey -> ProtocolMagicId -> Hash Tx -> KeyWitness ByronEra
witness SigningKey
sk ProtocolMagicId
pm Hash Tx
txHash =
    TxInWitness -> KeyWitness ByronEra
ByronKeyWitness (TxInWitness -> KeyWitness ByronEra)
-> TxInWitness -> KeyWitness ByronEra
forall a b. (a -> b) -> a -> b
$
      VerificationKey -> TxSig -> TxInWitness
Byron.VKWitness
        (SigningKey -> VerificationKey
Byron.toVerification SigningKey
sk)
        (ProtocolMagicId -> SignTag -> SigningKey -> TxSigData -> TxSig
forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
Byron.sign ProtocolMagicId
pm SignTag
Byron.SignTx SigningKey
sk (Hash Tx -> TxSigData
Byron.TxSigData Hash Tx
txHash))

-- | Either a network ID or a Byron address to be used in constructing a
-- Shelley bootstrap witness.
data WitnessNetworkIdOrByronAddress
  = -- | Network ID.
    --
    -- If this value is used in the construction of a Shelley bootstrap witness,
    -- the result will not consist of a derivation path. If that is required,
    -- specify a 'WitnessByronAddress' value instead.
    WitnessNetworkId !NetworkId
  | -- | Byron address.
    --
    -- If this value is used in the construction of a Shelley bootstrap witness,
    -- both the network ID and derivation path will be extracted from the
    -- address and used in the construction of the witness.
    WitnessByronAddress !(Address ByronAddr)

makeShelleyBootstrapWitness
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> WitnessNetworkIdOrByronAddress
  -> TxBody era
  -> SigningKey ByronKey
  -> KeyWitness era
makeShelleyBootstrapWitness :: forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody era
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBootstrapWitness ShelleyBasedEra era
sbe WitnessNetworkIdOrByronAddress
nwOrAddr TxBody era
txBody SigningKey ByronKey
sk =
  case TxBody era
txBody of
    ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
txbody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_ -> ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBasedBootstrapWitness ShelleyBasedEra era
sbe WitnessNetworkIdOrByronAddress
nwOrAddr TxBody (ShelleyLedgerEra era)
txbody SigningKey ByronKey
sk

makeShelleyBasedBootstrapWitness
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> WitnessNetworkIdOrByronAddress
  -> Ledger.TxBody (ShelleyLedgerEra era)
  -> SigningKey ByronKey
  -> KeyWitness era
makeShelleyBasedBootstrapWitness :: forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBasedBootstrapWitness ShelleyBasedEra era
sbe WitnessNetworkIdOrByronAddress
nwOrAddr TxBody (ShelleyLedgerEra era)
txbody (ByronSigningKey SigningKey
sk) =
  ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
forall era.
ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
ShelleyBootstrapWitness ShelleyBasedEra era
sbe (BootstrapWitness -> KeyWitness era)
-> BootstrapWitness -> KeyWitness era
forall a b. (a -> b) -> a -> b
$
    -- Byron era witnesses were weird. This reveals all that weirdness.
    Shelley.BootstrapWitness
      { bwKey :: VKey 'Witness
Shelley.bwKey = VKey 'Witness
vk
      , bwSig :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
Shelley.bwSig = SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature
      , bwChainCode :: ChainCode
Shelley.bwChainCode = ChainCode
chainCode
      , bwAttributes :: ByteString
Shelley.bwAttributes = ByteString
attributes
      }
 where
  -- Starting with the easy bits: we /can/ convert the Byron verification key
  -- to a the pair of a Shelley verification key plus the chain code.
  --
  (VKey 'Witness
vk, ChainCode
chainCode) = VerificationKey -> (VKey 'Witness, ChainCode)
Shelley.unpackByronVKey (SigningKey -> VerificationKey
Byron.toVerification SigningKey
sk)

  -- Now the hairy bits.
  --
  -- Byron era signing keys were all /extended/ ed25519 keys. We have to
  -- produce a signature using this extended signing key directly. They
  -- /cannot/ be converted to a plain (non-extended) signing keys. Since we
  -- now support extended signing keys for the Shelley too, we are able to
  -- reuse that here.
  --
  signature
    :: (Crypto.SignedDSIGN Shelley.DSIGN)
         (Hash.Hash Ledger.HASH Ledger.EraIndependentTxBody)
  signature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature =
    Hash HASH EraIndependentTxBody
-> ShelleySigningKey
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
forall tosign.
SignableRepresentation tosign =>
tosign -> ShelleySigningKey -> SignedDSIGN DSIGN tosign
makeShelleySignature
      Hash HASH EraIndependentTxBody
txhash
      -- Make the signature with the extended key directly:
      (XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey (SigningKey -> XPrv
Byron.unSigningKey SigningKey
sk))

  txhash :: Hash.Hash Ledger.HASH Ledger.EraIndependentTxBody
  txhash :: Hash HASH EraIndependentTxBody
txhash = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Hash HASH EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Hash HASH EraIndependentTxBody)
 -> Hash HASH EraIndependentTxBody)
-> (ShelleyBasedEraConstraints era =>
    Hash HASH EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
Ledger.extractHash (TxBody (ShelleyLedgerEra era) -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
Ledger.hashAnnotated TxBody (ShelleyLedgerEra era)
txbody)
  -- TODO: use Shelley.eraIndTxBodyHash txbody once that function has a
  -- suitably general type.

  -- And finally we need to provide the extra suffix bytes necessary to
  -- reconstruct the mini-Merkel tree that is a Byron address. The suffix
  -- bytes are the serialised address attributes.
  attributes :: ByteString
attributes =
    Attributes AddrAttributes -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize' (Attributes AddrAttributes -> ByteString)
-> Attributes AddrAttributes -> ByteString
forall a b. (a -> b) -> a -> b
$
      AddrAttributes -> Attributes AddrAttributes
forall h. h -> Attributes h
Byron.mkAttributes
        Byron.AddrAttributes
          { aaVKDerivationPath :: Maybe HDAddressPayload
Byron.aaVKDerivationPath = Maybe HDAddressPayload
derivationPath
          , aaNetworkMagic :: NetworkMagic
Byron.aaNetworkMagic = NetworkMagic
networkMagic
          }

  -- The 'WitnessNetworkIdOrByronAddress' value converted to an 'Either'.
  eitherNwOrAddr :: Either NetworkId (Address ByronAddr)
  eitherNwOrAddr :: Either NetworkId (Address ByronAddr)
eitherNwOrAddr =
    case WitnessNetworkIdOrByronAddress
nwOrAddr of
      WitnessNetworkId NetworkId
nw -> NetworkId -> Either NetworkId (Address ByronAddr)
forall a b. a -> Either a b
Left NetworkId
nw
      WitnessByronAddress Address ByronAddr
addr -> Address ByronAddr -> Either NetworkId (Address ByronAddr)
forall a b. b -> Either a b
Right Address ByronAddr
addr

  unByronAddr :: Address ByronAddr -> Byron.Address
  unByronAddr :: Address ByronAddr -> Address
unByronAddr (ByronAddress Address
addr) = Address
addr

  unAddrAttrs :: Address ByronAddr -> Byron.AddrAttributes
  unAddrAttrs :: Address ByronAddr -> AddrAttributes
unAddrAttrs = Attributes AddrAttributes -> AddrAttributes
forall h. Attributes h -> h
Byron.attrData (Attributes AddrAttributes -> AddrAttributes)
-> (Address ByronAddr -> Attributes AddrAttributes)
-> Address ByronAddr
-> AddrAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Attributes AddrAttributes
Byron.addrAttributes (Address -> Attributes AddrAttributes)
-> (Address ByronAddr -> Address)
-> Address ByronAddr
-> Attributes AddrAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ByronAddr -> Address
unByronAddr

  derivationPath :: Maybe Byron.HDAddressPayload
  derivationPath :: Maybe HDAddressPayload
derivationPath =
    (NetworkId -> Maybe HDAddressPayload)
-> (Address ByronAddr -> Maybe HDAddressPayload)
-> Either NetworkId (Address ByronAddr)
-> Maybe HDAddressPayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (Maybe HDAddressPayload -> NetworkId -> Maybe HDAddressPayload
forall a b. a -> b -> a
const Maybe HDAddressPayload
forall a. Maybe a
Nothing)
      (AddrAttributes -> Maybe HDAddressPayload
Byron.aaVKDerivationPath (AddrAttributes -> Maybe HDAddressPayload)
-> (Address ByronAddr -> AddrAttributes)
-> Address ByronAddr
-> Maybe HDAddressPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ByronAddr -> AddrAttributes
unAddrAttrs)
      Either NetworkId (Address ByronAddr)
eitherNwOrAddr

  networkMagic :: Byron.NetworkMagic
  networkMagic :: NetworkMagic
networkMagic =
    (NetworkId -> NetworkMagic)
-> (Address ByronAddr -> NetworkMagic)
-> Either NetworkId (Address ByronAddr)
-> NetworkMagic
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      NetworkId -> NetworkMagic
toByronNetworkMagic
      (AddrAttributes -> NetworkMagic
Byron.aaNetworkMagic (AddrAttributes -> NetworkMagic)
-> (Address ByronAddr -> AddrAttributes)
-> Address ByronAddr
-> NetworkMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ByronAddr -> AddrAttributes
unAddrAttrs)
      Either NetworkId (Address ByronAddr)
eitherNwOrAddr

makeShelleyKeyWitness
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> TxBody era
  -> ShelleyWitnessSigningKey
  -> KeyWitness era
makeShelleyKeyWitness :: forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
sbe (ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
txBody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =
  ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' ShelleyBasedEra era
sbe TxBody (ShelleyLedgerEra era)
txBody

makeShelleyKeyWitness'
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> L.TxBody (ShelleyLedgerEra era)
  -> ShelleyWitnessSigningKey
  -> KeyWitness era
makeShelleyKeyWitness' :: forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' ShelleyBasedEra era
sbe TxBody (ShelleyLedgerEra era)
txBody ShelleyWitnessSigningKey
wsk =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => KeyWitness era)
-> KeyWitness era
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => KeyWitness era)
 -> KeyWitness era)
-> (ShelleyBasedEraConstraints era => KeyWitness era)
-> KeyWitness era
forall a b. (a -> b) -> a -> b
$ do
    let txhash :: Hash.Hash Ledger.HASH Ledger.EraIndependentTxBody
        txhash :: Hash HASH EraIndependentTxBody
txhash = SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
Ledger.extractHash (TxBody (ShelleyLedgerEra era) -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
Ledger.hashAnnotated TxBody (ShelleyLedgerEra era)
txBody)
        -- To allow sharing of the txhash computation across many signatures we
        -- define and share the txhash outside the lambda for the signing key:
        sk :: ShelleySigningKey
sk = ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey ShelleyWitnessSigningKey
wsk
        vk :: VKey 'Witness
vk = ShelleySigningKey -> VKey 'Witness
getShelleyKeyWitnessVerificationKey ShelleySigningKey
sk
        signature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature = Hash HASH EraIndependentTxBody
-> ShelleySigningKey
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
forall tosign.
SignableRepresentation tosign =>
tosign -> ShelleySigningKey -> SignedDSIGN DSIGN tosign
makeShelleySignature Hash HASH EraIndependentTxBody
txhash ShelleySigningKey
sk
    ShelleyBasedEra era -> WitVKey 'Witness -> KeyWitness era
forall era.
ShelleyBasedEra era -> WitVKey 'Witness -> KeyWitness era
ShelleyKeyWitness ShelleyBasedEra era
sbe (WitVKey 'Witness -> KeyWitness era)
-> WitVKey 'Witness -> KeyWitness era
forall a b. (a -> b) -> a -> b
$
      VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> WitVKey 'Witness
forall (kr :: KeyRole).
Typeable kr =>
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
L.WitVKey VKey 'Witness
vk SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature

toShelleySigningKey :: ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey :: ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey ShelleyWitnessSigningKey
key = case ShelleyWitnessSigningKey
key of
  WitnessPaymentKey (PaymentSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessStakeKey (StakeSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessStakePoolKey (StakePoolSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessGenesisKey (GenesisSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessGenesisUTxOKey (GenesisUTxOSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessGenesisDelegateKey (GenesisDelegateSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessCommitteeColdKey (CommitteeColdSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessCommitteeHotKey (CommitteeHotSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  WitnessDRepKey (DRepSigningKey SignKeyDSIGN DSIGN
sk) -> SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk
  -- The cases for extended keys
  WitnessPaymentExtendedKey (PaymentExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessStakeExtendedKey (StakeExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessStakePoolExtendedKey (StakePoolExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessGenesisExtendedKey (GenesisExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessGenesisDelegateExtendedKey (GenesisDelegateExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessCommitteeColdExtendedKey (CommitteeColdExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessCommitteeHotExtendedKey (CommitteeHotExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk
  WitnessDRepExtendedKey (DRepExtendedSigningKey XPrv
sk) -> XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
sk

getShelleyKeyWitnessVerificationKey
  :: ShelleySigningKey
  -> Shelley.VKey Shelley.Witness
getShelleyKeyWitnessVerificationKey :: ShelleySigningKey -> VKey 'Witness
getShelleyKeyWitnessVerificationKey (ShelleyNormalSigningKey SignKeyDSIGN DSIGN
sk) =
  ( VKey 'Payment -> VKey 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Shelley.asWitness
      :: Shelley.VKey Shelley.Payment
      -> Shelley.VKey Shelley.Witness
  )
    (VKey 'Payment -> VKey 'Witness)
-> (SignKeyDSIGN DSIGN -> VKey 'Payment)
-> SignKeyDSIGN DSIGN
-> VKey 'Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(PaymentVerificationKey VKey 'Payment
vk) -> VKey 'Payment
vk)
    (VerificationKey PaymentKey -> VKey 'Payment)
-> (SignKeyDSIGN DSIGN -> VerificationKey PaymentKey)
-> SignKeyDSIGN DSIGN
-> VKey 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey
    (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> (SignKeyDSIGN DSIGN -> SigningKey PaymentKey)
-> SignKeyDSIGN DSIGN
-> VerificationKey PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN DSIGN -> SigningKey PaymentKey
PaymentSigningKey
    (SignKeyDSIGN DSIGN -> VKey 'Witness)
-> SignKeyDSIGN DSIGN -> VKey 'Witness
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN
sk
getShelleyKeyWitnessVerificationKey (ShelleyExtendedSigningKey XPrv
sk) =
  ( VKey 'Payment -> VKey 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Shelley.asWitness
      :: Shelley.VKey Shelley.Payment
      -> Shelley.VKey Shelley.Witness
  )
    (VKey 'Payment -> VKey 'Witness)
-> (XPrv -> VKey 'Payment) -> XPrv -> VKey 'Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(PaymentVerificationKey VKey 'Payment
vk) -> VKey 'Payment
vk)
    (VerificationKey PaymentKey -> VKey 'Payment)
-> (XPrv -> VerificationKey PaymentKey) -> XPrv -> VKey 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey
          :: VerificationKey PaymentExtendedKey
          -> VerificationKey PaymentKey
      )
    (VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey)
-> (XPrv -> VerificationKey PaymentExtendedKey)
-> XPrv
-> VerificationKey PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey PaymentExtendedKey -> VerificationKey PaymentExtendedKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey
    (SigningKey PaymentExtendedKey
 -> VerificationKey PaymentExtendedKey)
-> (XPrv -> SigningKey PaymentExtendedKey)
-> XPrv
-> VerificationKey PaymentExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey
    (XPrv -> VKey 'Witness) -> XPrv -> VKey 'Witness
forall a b. (a -> b) -> a -> b
$ XPrv
sk