{-# 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.Tx.Internal.Sign
  ( 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 (..)
  , selectTxDatums
  -- Exporting for testing. Deprecate in the future.
  , legacyKeyWitnessEncode
  )
where

import Cardano.Api.Address
import Cardano.Api.Byron.Internal.Key
import Cardano.Api.Certificate.Internal
import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.HasTypeProxy
import Cardano.Api.Key.Internal
import Cardano.Api.Key.Internal.Class
import Cardano.Api.Network.Internal.NetworkId
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Serialise.TextEnvelope.Internal

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 (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
import Data.Validation qualified as Valid
import GHC.Exts (IsList (..))
import Lens.Micro

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

data Tx era where
  ShelleyTx
    :: ShelleyBasedEra era
    -> L.Tx L.TopTx (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 TopTx (ShelleyLedgerEra era)
txA)
    (ShelleyTx ShelleyBasedEra era
_ Tx TopTx (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 TopTx (ShelleyLedgerEra era)
txA Tx TopTx (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== Tx TopTx (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 TopTx (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 -> Tx TopTx ShelleyEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx ShelleyEra
Tx TopTx (ShelleyLedgerEra era)
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraAllegra Tx TopTx (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 -> Tx TopTx AllegraEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx AllegraEra
Tx TopTx (ShelleyLedgerEra era)
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraMary Tx TopTx (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 -> Tx TopTx MaryEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx MaryEra
Tx TopTx (ShelleyLedgerEra era)
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraAlonzo Tx TopTx (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 -> Tx TopTx AlonzoEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx AlonzoEra
Tx TopTx (ShelleyLedgerEra era)
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraBabbage Tx TopTx (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 -> Tx TopTx BabbageEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx BabbageEra
Tx TopTx (ShelleyLedgerEra era)
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraConway Tx TopTx (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 -> Tx TopTx ConwayEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx ConwayEra
Tx TopTx (ShelleyLedgerEra era)
tx
  showsPrec Int
p (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraDijkstra Tx TopTx (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 ShelleyBasedEraDijkstra "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tx TopTx DijkstraEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx TopTx DijkstraEra
Tx TopTx (ShelleyLedgerEra era)
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 TopTx (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 TopTx (ShelleyLedgerEra era) -> ByteString
forall ledgerera.
EraTx ledgerera =>
Tx TopTx ledgerera -> ByteString
serialiseShelleyBasedTx Tx TopTx (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 TopTx (ShelleyLedgerEra era) -> Tx era)
-> ByteString -> Either DecoderError (Tx era)
forall ledgerera tx'.
EraTx ledgerera =>
(Tx TopTx ledgerera -> tx')
-> ByteString -> Either DecoderError tx'
deserialiseShelleyBasedTx (ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx TopTx (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 L.TopTx ledgerera
  -> ByteString
serialiseShelleyBasedTx :: forall ledgerera.
EraTx ledgerera =>
Tx TopTx ledgerera -> ByteString
serialiseShelleyBasedTx = Tx TopTx ledgerera -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize'

deserialiseShelleyBasedTx
  :: forall ledgerera tx'
   . L.EraTx ledgerera
  => (L.Tx L.TopTx ledgerera -> tx')
  -> ByteString
  -> Either CBOR.DecoderError tx'
deserialiseShelleyBasedTx :: forall ledgerera tx'.
EraTx ledgerera =>
(Tx TopTx ledgerera -> tx')
-> ByteString -> Either DecoderError tx'
deserialiseShelleyBasedTx Tx TopTx ledgerera -> tx'
mkTx ByteString
bs =
  Tx TopTx ledgerera -> tx'
mkTx
    (Tx TopTx ledgerera -> tx')
-> Either DecoderError (Tx TopTx ledgerera)
-> Either DecoderError tx'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> Text
-> (forall s. Decoder s (Annotator (Tx TopTx ledgerera)))
-> ByteString
-> Either DecoderError (Tx TopTx ledgerera)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
      (forall era. Era era => Version
L.eraProtVerHigh @ledgerera)
      Text
"Shelley Tx"
      Decoder s (Annotator (Tx TopTx ledgerera))
forall s. Decoder s (Annotator (Tx TopTx 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 TopTx (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 TopTx (ShelleyLedgerEra era)
txBody = Tx TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (TxBody TopTx (ShelleyLedgerEra era))
     (Tx TopTx (ShelleyLedgerEra era))
     (TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (ShelleyLedgerEra era))
  (Tx TopTx (ShelleyLedgerEra era))
  (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens'
  (Tx l (ShelleyLedgerEra era)) (TxBody l (ShelleyLedgerEra era))
L.bodyTxL
            txAuxData :: StrictMaybe (TxAuxData (ShelleyLedgerEra era))
txAuxData = Tx TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
     (Tx TopTx (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 TopTx (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens'
  (Tx l (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
L.auxDataTxL
            scriptWits :: Map ScriptHash (Script (ShelleyLedgerEra era))
scriptWits = Tx TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx TopTx (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 TopTx (ShelleyLedgerEra era)
-> Const
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (Map ScriptHash (Script (ShelleyLedgerEra era)))
       (TxWits (ShelleyLedgerEra era)))
 -> Tx TopTx (ShelleyLedgerEra era)
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (Tx TopTx (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 TopTx (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 TopTx (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody
              ShelleyBasedEra era
sbe
              TxBody TopTx (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 TopTx (ShelleyLedgerEra era)
txBody = Tx TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (TxBody TopTx (ShelleyLedgerEra era))
     (Tx TopTx (ShelleyLedgerEra era))
     (TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (ShelleyLedgerEra era))
  (Tx TopTx (ShelleyLedgerEra era))
  (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens'
  (Tx l (ShelleyLedgerEra era)) (TxBody l (ShelleyLedgerEra era))
L.bodyTxL
            txAuxData :: StrictMaybe (TxAuxData (ShelleyLedgerEra era))
txAuxData = Tx TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
     (Tx TopTx (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 TopTx (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens'
  (Tx l (ShelleyLedgerEra era))
  (StrictMaybe (TxAuxData (ShelleyLedgerEra era)))
L.auxDataTxL
            scriptWits :: Map ScriptHash (Script (ShelleyLedgerEra era))
scriptWits = Tx TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx TopTx (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 TopTx (ShelleyLedgerEra era)
-> Const
     (Map ScriptHash (Script (ShelleyLedgerEra era)))
     (Tx TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (Map ScriptHash (Script (ShelleyLedgerEra era)))
       (TxWits (ShelleyLedgerEra era)))
 -> Tx TopTx (ShelleyLedgerEra era)
 -> Const
      (Map ScriptHash (Script (ShelleyLedgerEra era)))
      (Tx TopTx (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 TopTx (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 TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (TxDats (ShelleyLedgerEra era))
     (Tx TopTx (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 TopTx (ShelleyLedgerEra era)
-> Const
     (TxDats (ShelleyLedgerEra era)) (Tx TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (TxDats (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
 -> Tx TopTx (ShelleyLedgerEra era)
 -> Const
      (TxDats (ShelleyLedgerEra era)) (Tx TopTx (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 TopTx (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 TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (Redeemers (ShelleyLedgerEra era))
     (Tx TopTx (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 TopTx (ShelleyLedgerEra era)
-> Const
     (Redeemers (ShelleyLedgerEra era))
     (Tx TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL ((TxWits (ShelleyLedgerEra era)
  -> Const
       (Redeemers (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era)))
 -> Tx TopTx (ShelleyLedgerEra era)
 -> Const
      (Redeemers (ShelleyLedgerEra era))
      (Tx TopTx (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 TopTx (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 TopTx (ShelleyLedgerEra era)
tx Tx TopTx (ShelleyLedgerEra era)
-> Getting IsValid (Tx TopTx (ShelleyLedgerEra era)) IsValid
-> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx TopTx (ShelleyLedgerEra era)) IsValid
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx (ShelleyLedgerEra era)) IsValid
L.isValidTxL
         in ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody
              ShelleyBasedEra era
sbe
              TxBody TopTx (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"
      ShelleyBasedEra era
ShelleyBasedEraDijkstra -> TextEnvelopeType
"Tx DijkstraEra"

-- ----------------------------------------------------------------------------
-- 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 Ledger.TopTx (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 Ledger.TopTx' 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 TopTx (ShelleyLedgerEra era)
txbodyA [Script (ShelleyLedgerEra era)]
txscriptsA TxBodyScriptData era
redeemersA Maybe (TxAuxData (ShelleyLedgerEra era))
txmetadataA TxScriptValidity era
scriptValidityA)
    (ShelleyTxBody ShelleyBasedEra era
_ TxBody TopTx (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 TopTx (ShelleyLedgerEra era)
txbodyA TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody TopTx (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 TopTx (ShelleyLedgerEra era)
txbodyA TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody TopTx (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 TopTx (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 -> TxBody TopTx ShelleyEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx ShelleyEra
TxBody TopTx (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 -> [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 TopTx (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 -> TxBody TopTx AllegraEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx AllegraEra
TxBody TopTx (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 TopTx (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 -> TxBody TopTx MaryEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx MaryEra
TxBody TopTx (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 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 TopTx (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 -> TxBody TopTx AlonzoEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx AlonzoEra
TxBody TopTx (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 -> [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 TopTx (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 -> TxBody TopTx BabbageEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx BabbageEra
TxBody TopTx (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 -> [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 TopTx (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 -> TxBody TopTx ConwayEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx ConwayEra
TxBody TopTx (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 -> [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
        )
  showsPrec
    Int
p
    ( ShelleyTxBody
        ShelleyBasedEra era
ShelleyBasedEraDijkstra
        TxBody TopTx (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 ShelleyBasedEraDijkstra "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBody TopTx DijkstraEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody TopTx DijkstraEra
TxBody TopTx (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 -> [AlonzoScript DijkstraEra] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (ShelleyLedgerEra era)]
[AlonzoScript DijkstraEra]
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 DijkstraEra) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (TxAuxData (ShelleyLedgerEra era))
Maybe (AlonzoTxAuxData DijkstraEra)
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 TopTx (ShelleyLedgerEra era) -> Tx era)
-> ByteString -> Either DecoderError (Tx era)
forall ledgerera tx'.
EraTx ledgerera =>
(Tx TopTx ledgerera -> tx')
-> ByteString -> Either DecoderError tx'
deserialiseShelleyBasedTx (ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx TopTx (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"
      ShelleyBasedEra era
ShelleyBasedEraDijkstra -> TextEnvelopeType
"TxBodyDijkstra"

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)

selectTxDatums
  :: TxBodyScriptData era
  -> Map L.DataHash (L.Data (ShelleyLedgerEra era))
selectTxDatums :: forall era.
TxBodyScriptData era -> Map DataHash (Data (ShelleyLedgerEra era))
selectTxDatums TxBodyScriptData era
TxBodyNoScriptData = Map DataHash (Data (ShelleyLedgerEra era))
forall k a. Map k a
Map.empty
selectTxDatums (TxBodyScriptData AlonzoEraOnwards era
_ (Alonzo.TxDats Map DataHash (Data (ShelleyLedgerEra era))
datums) Redeemers (ShelleyLedgerEra era)
_) = Map DataHash (Data (ShelleyLedgerEra era))
datums

-- | 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 (ShelleyBootstrapWitness ShelleyBasedEra era
ShelleyBasedEraDijkstra 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 ShelleyBasedEraDijkstra "
        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
  showsPrec Int
p (ShelleyKeyWitness ShelleyBasedEra era
ShelleyBasedEraDijkstra 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 ShelleyBasedEraDijkstra "
        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 #-}

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 -> WitVKey Witness -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
CBOR.serialize' (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerHigh ShelleyBasedEra era
sbe) WitVKey Witness
wit
  serialiseToCBOR (ShelleyBootstrapWitness ShelleyBasedEra era
sbe BootstrapWitness
wit) =
    Version -> BootstrapWitness -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
CBOR.serialize' (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerHigh ShelleyBasedEra era
sbe) 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
      CardanoEra era
DijkstraEra -> ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
forall era.
Era (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> ByteString -> Either DecoderError (KeyWitness era)
decodeShelleyBasedWitness ShelleyBasedEra era
ShelleyBasedEra DijkstraEra
ShelleyBasedEraDijkstra ByteString
bs

-- | We no longer use the non-compliant CDDL legacy encoding.
-- Instead of depending on a tag to differentiate which key witness
-- we are dealing with, we opted to use `Validation` data type. This
-- provides a convenient way to try multiple decoders until one succeeds.
legacyKeyWitnessEncode :: KeyWitness era -> ByteString
legacyKeyWitnessEncode :: forall era. KeyWitness era -> ByteString
legacyKeyWitnessEncode (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
eraProtVerHigh ShelleyBasedEra era
sbe) (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
    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
<> WitVKey Witness -> Encoding
forall a. EncCBOR a => a -> Encoding
CBOR.encCBOR WitVKey Witness
wit
legacyKeyWitnessEncode (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
eraProtVerHigh ShelleyBasedEra era
sbe) (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
    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
<> BootstrapWitness -> Encoding
forall a. EncCBOR a => a -> Encoding
CBOR.encCBOR BootstrapWitness
wit
legacyKeyWitnessEncode (ByronKeyWitness TxInWitness
wit) =
  TxInWitness -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize' TxInWitness
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 ByteString
bs =
  let e :: Either [DecoderError] (KeyWitness era)
e =
        Validation [DecoderError] (KeyWitness era)
-> Either [DecoderError] (KeyWitness era)
forall e a. Validation e a -> Either e a
Valid.toEither (Validation [DecoderError] (KeyWitness era)
 -> Either [DecoderError] (KeyWitness era))
-> Validation [DecoderError] (KeyWitness era)
-> Either [DecoderError] (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
          [Validation [DecoderError] (KeyWitness era)]
-> Validation [DecoderError] (KeyWitness era)
forall a. Monoid a => [a] -> a
mconcat ([Validation [DecoderError] (KeyWitness era)]
 -> Validation [DecoderError] (KeyWitness era))
-> [Validation [DecoderError] (KeyWitness era)]
-> Validation [DecoderError] (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
            (Either DecoderError (KeyWitness era)
 -> Validation [DecoderError] (KeyWitness era))
-> [Either DecoderError (KeyWitness era)]
-> [Validation [DecoderError] (KeyWitness era)]
forall a b. (a -> b) -> [a] -> [b]
map
              ((DecoderError -> [DecoderError])
-> Either DecoderError (KeyWitness era)
-> Validation [DecoderError] (KeyWitness era)
forall b e a. (b -> e) -> Either b a -> Validation e a
Valid.liftError DecoderError -> [DecoderError]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return)
              [ ByteString -> Either DecoderError (KeyWitness era)
bootstrapWitnessDecoder ByteString
bs
              , ByteString -> Either DecoderError (KeyWitness era)
shelleyKeyWitnessDecoder ByteString
bs
              , ByteString -> Either DecoderError (KeyWitness era)
legacyKeyWitnessDecoder ByteString
bs
              ]
   in case Either [DecoderError] (KeyWitness era)
e of
        Left [DecoderError]
errs ->
          let allErrs :: Text
allErrs = [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DecoderError -> Text) -> [DecoderError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DecoderError -> Text
forall a. Buildable a => a -> Text
renderBuildable [DecoderError]
errs
           in DecoderError -> Either DecoderError (KeyWitness era)
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError (KeyWitness era))
-> DecoderError -> Either DecoderError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
CBOR.DecoderErrorCustom Text
"Failed to deserialise key witness" Text
allErrs
        Right KeyWitness era
res -> KeyWitness era -> Either DecoderError (KeyWitness era)
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return KeyWitness era
res
 where
  shelleyKeyWitnessDecoder :: ByteString -> Either DecoderError (KeyWitness era)
shelleyKeyWitnessDecoder ByteString
b =
    ShelleyBasedEra era -> WitVKey Witness -> KeyWitness era
forall era.
ShelleyBasedEra era -> WitVKey Witness -> KeyWitness era
ShelleyKeyWitness ShelleyBasedEra era
sbe
      (WitVKey Witness -> KeyWitness era)
-> Either DecoderError (WitVKey Witness)
-> Either DecoderError (KeyWitness era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> Text
-> (forall s. Decoder s (Annotator (WitVKey Witness)))
-> ByteString
-> Either DecoderError (WitVKey Witness)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
        (forall era. Era era => Version
L.eraProtVerHigh @(ShelleyLedgerEra era))
        Text
"Shelley Witness"
        Decoder s (Annotator (WitVKey Witness))
forall s. Decoder s (Annotator (WitVKey Witness))
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
        (ByteString -> ByteString
LBS.fromStrict ByteString
b)

  bootstrapWitnessDecoder :: ByteString -> Either DecoderError (KeyWitness era)
bootstrapWitnessDecoder ByteString
b =
    ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
forall era.
ShelleyBasedEra era -> BootstrapWitness -> KeyWitness era
ShelleyBootstrapWitness ShelleyBasedEra era
sbe
      (BootstrapWitness -> KeyWitness era)
-> Either DecoderError BootstrapWitness
-> Either DecoderError (KeyWitness era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> Text
-> (forall s. Decoder s (Annotator BootstrapWitness))
-> ByteString
-> Either DecoderError BootstrapWitness
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
        (forall era. Era era => Version
L.eraProtVerHigh @(ShelleyLedgerEra era))
        Text
"Shelley Witness"
        Decoder s (Annotator BootstrapWitness)
forall s. Decoder s (Annotator BootstrapWitness)
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
        (ByteString -> ByteString
LBS.fromStrict ByteString
b)

  legacyKeyWitnessDecoder :: ByteString -> Either DecoderError (KeyWitness era)
legacyKeyWitnessDecoder ByteString
b =
    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.eraProtVerHigh @(ShelleyLedgerEra era))
      Text
"Shelley Witness"
      Decoder s (Annotator (KeyWitness era))
forall s. Decoder s (Annotator (KeyWitness era))
decodeLegacy
      (ByteString -> ByteString
LBS.fromStrict ByteString
b)

  -- Non-CDDL compliant legacy decoder.
  decodeLegacy :: CBOR.Decoder s (CBOR.Annotator (KeyWitness era))
  decodeLegacy :: forall s. Decoder s (Annotator (KeyWitness era))
decodeLegacy = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenOf Int
2
    t <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
    case 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 -> Word -> DecoderError
CBOR.DecoderErrorUnknownTag
            Text
"Shelley Witness"
            (Word -> Word
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"
      CardanoEra era
DijkstraEra -> TextEnvelopeType
"TxWitness DijkstraEra"

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 -> Vector TxInWitness -> TxAux
Byron.mkTxAux
      (Annotated Tx ByteString -> Tx
forall b a. Annotated b a -> b
unAnnotated Annotated Tx ByteString
txbody)
      ([Item (Vector TxInWitness)] -> Vector TxInWitness
forall l. IsList l => [Item l] -> l
fromList [Item (Vector TxInWitness)
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 (Vector TxInWitness) a
Byron.aTaWitness = Annotated (Vector TxInWitness) ByteString
witnesses}) =
  (TxInWitness -> KeyWitness ByronEra)
-> [TxInWitness] -> [KeyWitness ByronEra]
forall a b. (a -> b) -> [a] -> [b]
map TxInWitness -> KeyWitness ByronEra
ByronKeyWitness
    ([TxInWitness] -> [KeyWitness ByronEra])
-> (Annotated (Vector TxInWitness) ByteString -> [TxInWitness])
-> Annotated (Vector TxInWitness) ByteString
-> [KeyWitness ByronEra]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector TxInWitness -> [Item (Vector TxInWitness)]
Vector TxInWitness -> [TxInWitness]
forall l. IsList l => l -> [Item l]
toList
    (Vector TxInWitness -> [TxInWitness])
-> (Annotated (Vector TxInWitness) ByteString
    -> Vector TxInWitness)
-> Annotated (Vector TxInWitness) ByteString
-> [TxInWitness]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated (Vector TxInWitness) ByteString -> Vector TxInWitness
forall b a. Annotated b a -> b
unAnnotated
    (Annotated (Vector TxInWitness) ByteString
 -> [KeyWitness ByronEra])
-> Annotated (Vector TxInWitness) ByteString
-> [KeyWitness ByronEra]
forall a b. (a -> b) -> a -> b
$ Annotated (Vector TxInWitness) ByteString
witnesses

getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
getTxWitnesses (ShelleyTx ShelleyBasedEra era
sbe Tx TopTx (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 TopTx (ShelleyLedgerEra era) -> [KeyWitness era]
forall ledgerera.
EraTx ledgerera =>
Tx TopTx ledgerera -> [KeyWitness era]
getShelleyTxWitnesses Tx TopTx (ShelleyLedgerEra era)
tx'))
    ([KeyWitness era] -> AlonzoEraOnwards era -> [KeyWitness era]
forall a b. a -> b -> a
const (Tx TopTx (ShelleyLedgerEra era) -> [KeyWitness era]
forall ledgerera.
EraTx ledgerera =>
Tx TopTx ledgerera -> [KeyWitness era]
getAlonzoTxWitnesses Tx TopTx (ShelleyLedgerEra era)
tx'))
    ShelleyBasedEra era
sbe
 where
  getShelleyTxWitnesses
    :: forall ledgerera
     . L.EraTx ledgerera
    => L.Tx L.TopTx ledgerera
    -> [KeyWitness era]
  getShelleyTxWitnesses :: forall ledgerera.
EraTx ledgerera =>
Tx TopTx ledgerera -> [KeyWitness era]
getShelleyTxWitnesses Tx TopTx 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 TopTx ledgerera
tx Tx TopTx ledgerera
-> Getting
     (Set BootstrapWitness) (Tx TopTx ledgerera) (Set BootstrapWitness)
-> Set BootstrapWitness
forall s a. s -> Getting a s a -> a
^. (TxWits ledgerera
 -> Const (Set BootstrapWitness) (TxWits ledgerera))
-> Tx TopTx ledgerera
-> Const (Set BootstrapWitness) (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera
  -> Const (Set BootstrapWitness) (TxWits ledgerera))
 -> Tx TopTx ledgerera
 -> Const (Set BootstrapWitness) (Tx TopTx ledgerera))
-> ((Set BootstrapWitness
     -> Const (Set BootstrapWitness) (Set BootstrapWitness))
    -> TxWits ledgerera
    -> Const (Set BootstrapWitness) (TxWits ledgerera))
-> Getting
     (Set BootstrapWitness) (Tx TopTx 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 TopTx ledgerera
tx Tx TopTx ledgerera
-> Getting
     (Set (WitVKey Witness))
     (Tx TopTx 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 TopTx ledgerera
-> Const (Set (WitVKey Witness)) (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera
  -> Const (Set (WitVKey Witness)) (TxWits ledgerera))
 -> Tx TopTx ledgerera
 -> Const (Set (WitVKey Witness)) (Tx TopTx ledgerera))
-> ((Set (WitVKey Witness)
     -> Const (Set (WitVKey Witness)) (Set (WitVKey Witness)))
    -> TxWits ledgerera
    -> Const (Set (WitVKey Witness)) (TxWits ledgerera))
-> Getting
     (Set (WitVKey Witness))
     (Tx TopTx 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 L.TopTx ledgerera
    -> [KeyWitness era]
  getAlonzoTxWitnesses :: forall ledgerera.
EraTx ledgerera =>
Tx TopTx ledgerera -> [KeyWitness era]
getAlonzoTxWitnesses = Tx TopTx ledgerera -> [KeyWitness era]
forall ledgerera.
EraTx ledgerera =>
Tx TopTx 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 TopTx (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
      ShelleyBasedEra era
ShelleyBasedEraDijkstra -> Tx era
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, AlonzoEraTx ledgerera) =>
Tx era
alonzoSignedTransaction
   where
    txCommon
      :: forall ledgerera
       . ShelleyLedgerEra era ~ ledgerera
      => L.EraTx ledgerera
      => L.Tx L.TopTx ledgerera
    txCommon :: forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx TopTx ledgerera
txCommon =
      TxBody TopTx ledgerera -> Tx TopTx ledgerera
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ledgerera -> Tx l ledgerera
L.mkBasicTx TxBody TopTx ledgerera
TxBody TopTx (ShelleyLedgerEra era)
txbody
        Tx TopTx ledgerera
-> (Tx TopTx ledgerera -> Tx TopTx ledgerera) -> Tx TopTx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ledgerera) (TxWits ledgerera)
L.witsTxL
          ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> TxWits ledgerera -> Tx TopTx ledgerera -> Tx TopTx 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 TopTx ledgerera
-> (Tx TopTx ledgerera -> Tx TopTx ledgerera) -> Tx TopTx ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData ledgerera)
 -> Identity (StrictMaybe (TxAuxData ledgerera)))
-> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l ledgerera) (StrictMaybe (TxAuxData ledgerera))
L.auxDataTxL ((StrictMaybe (TxAuxData ledgerera)
  -> Identity (StrictMaybe (TxAuxData ledgerera)))
 -> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> StrictMaybe (TxAuxData ledgerera)
-> Tx TopTx ledgerera
-> Tx TopTx 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 TopTx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
sbe Tx TopTx ledgerera
Tx TopTx (ShelleyLedgerEra era)
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx TopTx 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 TopTx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
ShelleyTx
        ShelleyBasedEra era
sbe
        ( Tx TopTx ledgerera
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx TopTx ledgerera
txCommon
            Tx TopTx ledgerera
-> (Tx TopTx ledgerera -> Tx TopTx ledgerera) -> Tx TopTx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> ((TxDats ledgerera -> Identity (TxDats ledgerera))
    -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> (TxDats ledgerera -> Identity (TxDats ledgerera))
-> Tx TopTx ledgerera
-> Identity (Tx TopTx 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 TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> TxDats ledgerera -> Tx TopTx ledgerera -> Tx TopTx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats ledgerera
datums
            Tx TopTx ledgerera
-> (Tx TopTx ledgerera -> Tx TopTx ledgerera) -> Tx TopTx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ledgerera) (TxWits ledgerera)
L.witsTxL ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> ((Redeemers ledgerera -> Identity (Redeemers ledgerera))
    -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> (Redeemers ledgerera -> Identity (Redeemers ledgerera))
-> Tx TopTx ledgerera
-> Identity (Tx TopTx 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 TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> Redeemers ledgerera -> Tx TopTx ledgerera -> Tx TopTx ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers ledgerera
redeemers
            Tx TopTx ledgerera
-> (Tx TopTx ledgerera -> Tx TopTx ledgerera) -> Tx TopTx ledgerera
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera)
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx ledgerera) IsValid
L.isValidTxL ((IsValid -> Identity IsValid)
 -> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> IsValid -> Tx TopTx ledgerera -> Tx TopTx 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 TopTx (ShelleyLedgerEra era)
txbody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_ -> ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody TopTx (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody TopTx (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBasedBootstrapWitness ShelleyBasedEra era
sbe WitnessNetworkIdOrByronAddress
nwOrAddr TxBody TopTx (ShelleyLedgerEra era)
txbody SigningKey ByronKey
sk

makeShelleyBasedBootstrapWitness
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> WitnessNetworkIdOrByronAddress
  -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era)
  -> SigningKey ByronKey
  -> KeyWitness era
makeShelleyBasedBootstrapWitness :: forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody TopTx (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBasedBootstrapWitness ShelleyBasedEra era
sbe WitnessNetworkIdOrByronAddress
nwOrAddr TxBody TopTx (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
      , bwSignature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
Shelley.bwSignature = 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 TopTx (ShelleyLedgerEra era)
-> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
Ledger.hashAnnotated TxBody TopTx (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 TopTx (ShelleyLedgerEra era)
txBody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =
  ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' ShelleyBasedEra era
sbe TxBody TopTx (ShelleyLedgerEra era)
txBody

makeShelleyKeyWitness'
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> L.TxBody L.TopTx (ShelleyLedgerEra era)
  -> ShelleyWitnessSigningKey
  -> KeyWitness era
makeShelleyKeyWitness' :: forall era.
ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' ShelleyBasedEra era
sbe TxBody TopTx (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 TopTx (ShelleyLedgerEra era)
-> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
Ledger.hashAnnotated TxBody TopTx (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).
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