{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Provides Shelley Tx internals
--
-- = Warning
--
-- This module is considered __internal__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
module Cardano.Ledger.Shelley.Tx.Internal (
  -- * Transaction
  ShelleyTx (
    ..,
    ShelleyTx,
    body,
    wits,
    auxiliaryData
  ),
  ShelleyTxRaw (..),
  bodyShelleyTxL,
  witsShelleyTxL,
  auxDataShelleyTxL,
  sizeShelleyTxF,
  wireSizeShelleyTxF,
  segwitTx,
  mkBasicShelleyTx,
  shelleyMinFeeTx,
  witsFromTxWitnesses,
  shelleyEqTxRaw,
)
where

import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (decCBOR),
  EncCBOR (encCBOR),
  ToCBOR,
  decodeNullMaybe,
  encodeNullMaybe,
  runAnnotator,
 )
import Cardano.Ledger.Binary.Coders
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.Keys (KeyHash, KeyRole (Witness))
import Cardano.Ledger.Keys.Bootstrap (bootstrapWitKeyHash)
import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  Memoized (..),
  memoBytes,
  mkMemoBytes,
  pattern Memo,
 )
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.Scripts (validateMultiSig)
import Cardano.Ledger.Shelley.TxAuxData ()
import Cardano.Ledger.Shelley.TxBody ()
import Cardano.Ledger.Shelley.TxWits ()
import Cardano.Ledger.Val ((<+>), (<×>))
import Control.DeepSeq (NFData)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Short as SBS
import Data.Functor.Classes (Eq1 (liftEq))
import Data.Maybe.Strict (
  StrictMaybe (..),
  maybeToStrictMaybe,
  strictMaybeToMaybe,
 )
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro (Lens', SimpleGetter, lens, to, (^.))
import NoThunks.Class (NoThunks (..))

-- ========================================================

data ShelleyTxRaw era = ShelleyTxRaw
  { forall era. ShelleyTxRaw era -> TxBody era
strBody :: !(TxBody era)
  , forall era. ShelleyTxRaw era -> TxWits era
strWits :: !(TxWits era)
  , forall era. ShelleyTxRaw era -> StrictMaybe (TxAuxData era)
strAuxiliaryData :: !(StrictMaybe (TxAuxData era))
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTxRaw era) x -> ShelleyTxRaw era
forall era x. ShelleyTxRaw era -> Rep (ShelleyTxRaw era) x
$cto :: forall era x. Rep (ShelleyTxRaw era) x -> ShelleyTxRaw era
$cfrom :: forall era x. ShelleyTxRaw era -> Rep (ShelleyTxRaw era) x
Generic, Typeable)

instance
  ( NFData (TxBody era)
  , NFData (TxWits era)
  , NFData (TxAuxData era)
  ) =>
  NFData (ShelleyTxRaw era)

deriving instance
  ( Era era
  , Eq (TxBody era)
  , Eq (TxWits era)
  , Eq (TxAuxData era)
  ) =>
  Eq (ShelleyTxRaw era)

deriving instance
  ( Era era
  , Show (TxBody era)
  , Show (TxWits era)
  , Show (TxAuxData era)
  ) =>
  Show (ShelleyTxRaw era)

instance
  ( Era era
  , NoThunks (TxAuxData era)
  , NoThunks (TxBody era)
  , NoThunks (TxWits era)
  ) =>
  NoThunks (ShelleyTxRaw era)

newtype ShelleyTx era = TxConstr (MemoBytes ShelleyTxRaw era)
  deriving newtype (ShelleyTx era -> Int
ShelleyTx era -> ByteString
forall era. ShelleyTx era -> Int
forall era. ShelleyTx era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTx era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTx era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTx era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTx era -> SafeHash c index
originalBytesSize :: ShelleyTx era -> Int
$coriginalBytesSize :: forall era. ShelleyTx era -> Int
originalBytes :: ShelleyTx era -> ByteString
$coriginalBytes :: forall era. ShelleyTx era -> ByteString
SafeToHash, ShelleyTx era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTx era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTx era) -> Size
forall {era}. Typeable era => Typeable (ShelleyTx era)
forall era. Typeable era => ShelleyTx era -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTx era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTx era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTx era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTx era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTx era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTx era) -> Size
toCBOR :: ShelleyTx era -> Encoding
$ctoCBOR :: forall era. Typeable era => ShelleyTx era -> Encoding
ToCBOR)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTx era) x -> ShelleyTx era
forall era x. ShelleyTx era -> Rep (ShelleyTx era) x
$cto :: forall era x. Rep (ShelleyTx era) x -> ShelleyTx era
$cfrom :: forall era x. ShelleyTx era -> Rep (ShelleyTx era) x
Generic)

instance Memoized ShelleyTx where
  type RawType ShelleyTx = ShelleyTxRaw

-- | `TxBody` setter and getter for `ShelleyTx`. The setter does update
-- memoized binary representation.
bodyShelleyTxL :: EraTx era => Lens' (ShelleyTx era) (TxBody era)
bodyShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (TxBody era)
bodyShelleyTxL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(TxConstr (Memo ShelleyTxRaw era
tx ShortByteString
_)) -> forall era. ShelleyTxRaw era -> TxBody era
strBody ShelleyTxRaw era
tx) forall a b. (a -> b) -> a -> b
$
    \(TxConstr (Memo ShelleyTxRaw era
tx ShortByteString
_)) TxBody era
txBody ->
      forall era. MemoBytes ShelleyTxRaw era -> ShelleyTx era
TxConstr forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes forall a b. (a -> b) -> a -> b
$ forall era.
(EncCBOR (TxWits era), EncCBOR (TxBody era),
 EncCBOR (TxAuxData era)) =>
ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
encodeShelleyTxRaw forall a b. (a -> b) -> a -> b
$ ShelleyTxRaw era
tx {strBody :: TxBody era
strBody = TxBody era
txBody}
{-# INLINEABLE bodyShelleyTxL #-}

-- | `TxWits` setter and getter for `ShelleyTx`. The setter does update
-- memoized binary representation.
witsShelleyTxL :: EraTx era => Lens' (ShelleyTx era) (TxWits era)
witsShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (TxWits era)
witsShelleyTxL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(TxConstr (Memo ShelleyTxRaw era
tx ShortByteString
_)) -> forall era. ShelleyTxRaw era -> TxWits era
strWits ShelleyTxRaw era
tx) forall a b. (a -> b) -> a -> b
$
    \(TxConstr (Memo ShelleyTxRaw era
tx ShortByteString
_)) TxWits era
txWits ->
      forall era. MemoBytes ShelleyTxRaw era -> ShelleyTx era
TxConstr forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes forall a b. (a -> b) -> a -> b
$ forall era.
(EncCBOR (TxWits era), EncCBOR (TxBody era),
 EncCBOR (TxAuxData era)) =>
ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
encodeShelleyTxRaw forall a b. (a -> b) -> a -> b
$ ShelleyTxRaw era
tx {strWits :: TxWits era
strWits = TxWits era
txWits}
{-# INLINEABLE witsShelleyTxL #-}

-- | `TxAuxData` setter and getter for `ShelleyTx`. The setter does update
-- memoized binary representation.
auxDataShelleyTxL :: EraTx era => Lens' (ShelleyTx era) (StrictMaybe (TxAuxData era))
auxDataShelleyTxL :: forall era.
EraTx era =>
Lens' (ShelleyTx era) (StrictMaybe (TxAuxData era))
auxDataShelleyTxL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(TxConstr (Memo ShelleyTxRaw era
tx ShortByteString
_)) -> forall era. ShelleyTxRaw era -> StrictMaybe (TxAuxData era)
strAuxiliaryData ShelleyTxRaw era
tx) forall a b. (a -> b) -> a -> b
$
    \(TxConstr (Memo ShelleyTxRaw era
tx ShortByteString
_)) StrictMaybe (TxAuxData era)
auxData -> forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx forall a b. (a -> b) -> a -> b
$ ShelleyTxRaw era
tx {strAuxiliaryData :: StrictMaybe (TxAuxData era)
strAuxiliaryData = StrictMaybe (TxAuxData era)
auxData}
{-# INLINEABLE auxDataShelleyTxL #-}

-- | Size getter for `ShelleyTx`.
sizeShelleyTxF :: Era era => SimpleGetter (ShelleyTx era) Integer
sizeShelleyTxF :: forall era. Era era => SimpleGetter (ShelleyTx era) Integer
sizeShelleyTxF = forall s a. (s -> a) -> SimpleGetter s a
to (\(TxConstr (Memo ShelleyTxRaw era
_ ShortByteString
bytes)) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
SBS.length ShortByteString
bytes)
{-# INLINEABLE sizeShelleyTxF #-}

wireSizeShelleyTxF :: Era era => SimpleGetter (ShelleyTx era) Word32
wireSizeShelleyTxF :: forall era. Era era => SimpleGetter (ShelleyTx era) Word32
wireSizeShelleyTxF = forall s a. (s -> a) -> SimpleGetter s a
to forall a b. (a -> b) -> a -> b
$ \(TxConstr (Memo ShelleyTxRaw era
_ ShortByteString
bytes)) ->
  let n :: Int
n = ShortByteString -> Int
SBS.length ShortByteString
bytes
   in if Int
n forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32)
        then forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Impossible: Size of the transaction is too big: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
{-# INLINEABLE wireSizeShelleyTxF #-}

mkShelleyTx :: EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx :: forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx = forall era. MemoBytes ShelleyTxRaw era -> ShelleyTx era
TxConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EncCBOR (TxWits era), EncCBOR (TxBody era),
 EncCBOR (TxAuxData era)) =>
ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
encodeShelleyTxRaw
{-# INLINEABLE mkShelleyTx #-}

mkBasicShelleyTx :: EraTx era => TxBody era -> ShelleyTx era
mkBasicShelleyTx :: forall era. EraTx era => TxBody era -> ShelleyTx era
mkBasicShelleyTx TxBody era
txBody =
  forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx forall a b. (a -> b) -> a -> b
$
    ShelleyTxRaw
      { strBody :: TxBody era
strBody = TxBody era
txBody
      , strWits :: TxWits era
strWits = forall era. EraTxWits era => TxWits era
mkBasicTxWits
      , strAuxiliaryData :: StrictMaybe (TxAuxData era)
strAuxiliaryData = forall a. StrictMaybe a
SNothing
      }

instance Crypto c => EraTx (ShelleyEra c) where
  {-# SPECIALIZE instance EraTx (ShelleyEra StandardCrypto) #-}

  type Tx (ShelleyEra c) = ShelleyTx (ShelleyEra c)

  mkBasicTx :: TxBody (ShelleyEra c) -> Tx (ShelleyEra c)
mkBasicTx = forall era. EraTx era => TxBody era -> ShelleyTx era
mkBasicShelleyTx

  bodyTxL :: Lens' (Tx (ShelleyEra c)) (TxBody (ShelleyEra c))
bodyTxL = forall era. EraTx era => Lens' (ShelleyTx era) (TxBody era)
bodyShelleyTxL
  {-# INLINE bodyTxL #-}

  witsTxL :: Lens' (Tx (ShelleyEra c)) (TxWits (ShelleyEra c))
witsTxL = forall era. EraTx era => Lens' (ShelleyTx era) (TxWits era)
witsShelleyTxL
  {-# INLINE witsTxL #-}

  auxDataTxL :: Lens' (Tx (ShelleyEra c)) (StrictMaybe (TxAuxData (ShelleyEra c)))
auxDataTxL = forall era.
EraTx era =>
Lens' (ShelleyTx era) (StrictMaybe (TxAuxData era))
auxDataShelleyTxL
  {-# INLINE auxDataTxL #-}

  sizeTxF :: SimpleGetter (Tx (ShelleyEra c)) Integer
sizeTxF = forall era. Era era => SimpleGetter (ShelleyTx era) Integer
sizeShelleyTxF
  {-# INLINE sizeTxF #-}

  wireSizeTxF :: SimpleGetter (Tx (ShelleyEra c)) Word32
wireSizeTxF = forall era. Era era => SimpleGetter (ShelleyTx era) Word32
wireSizeShelleyTxF
  {-# INLINE wireSizeTxF #-}

  validateNativeScript :: Tx (ShelleyEra c) -> NativeScript (ShelleyEra c) -> Bool
validateNativeScript = forall era.
(ShelleyEraScript era, EraTx era,
 NativeScript era ~ MultiSig era) =>
Tx era -> NativeScript era -> Bool
validateMultiSig
  {-# INLINE validateNativeScript #-}

  getMinFeeTx :: PParams (ShelleyEra c) -> Tx (ShelleyEra c) -> Int -> Coin
getMinFeeTx PParams (ShelleyEra c)
pp Tx (ShelleyEra c)
tx Int
_ = forall era. EraTx era => PParams era -> Tx era -> Coin
shelleyMinFeeTx PParams (ShelleyEra c)
pp Tx (ShelleyEra c)
tx

  upgradeTx :: EraTx (PreviousEra (ShelleyEra c)) =>
Tx (PreviousEra (ShelleyEra c))
-> Either (TxUpgradeError (ShelleyEra c)) (Tx (ShelleyEra c))
upgradeTx =
    forall a. HasCallStack => String -> a
error
      String
"Calling this function will cause a compilation error, since there is no Tx instance for Byron"

instance (Tx era ~ ShelleyTx era, EraTx era) => EqRaw (ShelleyTx era) where
  eqRaw :: ShelleyTx era -> ShelleyTx era -> Bool
eqRaw = forall era. EraTx era => Tx era -> Tx era -> Bool
shelleyEqTxRaw

shelleyEqTxRaw :: EraTx era => Tx era -> Tx era -> Bool
shelleyEqTxRaw :: forall era. EraTx era => Tx era -> Tx era -> Bool
shelleyEqTxRaw Tx era
tx1 Tx era
tx2 =
  forall a. EqRaw a => a -> a -> Bool
eqRaw (Tx era
tx1 forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL) (Tx era
tx2 forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL)
    Bool -> Bool -> Bool
&& forall a. EqRaw a => a -> a -> Bool
eqRaw (Tx era
tx1 forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL) (Tx era
tx2 forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL)
    Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq -- TODO: Implement Eq1 instance for StrictMaybe
      forall a. EqRaw a => a -> a -> Bool
eqRaw
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (Tx era
tx1 forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL))
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (Tx era
tx2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL))

deriving newtype instance
  ( NFData (TxBody era)
  , NFData (TxWits era)
  , NFData (TxAuxData era)
  ) =>
  NFData (ShelleyTx era)

deriving newtype instance
  ( Era era
  , Eq (TxBody era)
  , Eq (TxWits era)
  , Eq (TxAuxData era)
  ) =>
  Eq (ShelleyTx era)

deriving newtype instance
  (Era era, Show (TxBody era), Show (TxWits era), Show (TxAuxData era)) =>
  Show (ShelleyTx era)

deriving newtype instance
  ( Era era
  , NoThunks (TxAuxData era)
  , NoThunks (TxBody era)
  , NoThunks (TxWits era)
  ) =>
  NoThunks (ShelleyTx era)

pattern ShelleyTx ::
  EraTx era =>
  TxBody era ->
  TxWits era ->
  StrictMaybe (TxAuxData era) ->
  ShelleyTx era
pattern $bShelleyTx :: forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
$mShelleyTx :: forall {r} {era}.
EraTx era =>
ShelleyTx era
-> (TxBody era -> TxWits era -> StrictMaybe (TxAuxData era) -> r)
-> ((# #) -> r)
-> r
ShelleyTx {forall era. EraTx era => ShelleyTx era -> TxBody era
body, forall era. EraTx era => ShelleyTx era -> TxWits era
wits, forall era.
EraTx era =>
ShelleyTx era -> StrictMaybe (TxAuxData era)
auxiliaryData} <-
  TxConstr
    ( Memo
        ShelleyTxRaw
          { strBody = body
          , strWits = wits
          , strAuxiliaryData = auxiliaryData
          }
        _
      )
  where
    ShelleyTx TxBody era
b TxWits era
w StrictMaybe (TxAuxData era)
a = forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx forall a b. (a -> b) -> a -> b
$ forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw TxBody era
b TxWits era
w StrictMaybe (TxAuxData era)
a

{-# COMPLETE ShelleyTx #-}

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

encodeShelleyTxRaw ::
  (EncCBOR (TxWits era), EncCBOR (TxBody era), EncCBOR (TxAuxData era)) =>
  ShelleyTxRaw era ->
  Encode ('Closed 'Dense) (ShelleyTxRaw era)
encodeShelleyTxRaw :: forall era.
(EncCBOR (TxWits era), EncCBOR (TxBody era),
 EncCBOR (TxAuxData era)) =>
ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
encodeShelleyTxRaw ShelleyTxRaw {TxBody era
strBody :: TxBody era
strBody :: forall era. ShelleyTxRaw era -> TxBody era
strBody, TxWits era
strWits :: TxWits era
strWits :: forall era. ShelleyTxRaw era -> TxWits era
strWits, StrictMaybe (TxAuxData era)
strAuxiliaryData :: StrictMaybe (TxAuxData era)
strAuxiliaryData :: forall era. ShelleyTxRaw era -> StrictMaybe (TxAuxData era)
strAuxiliaryData} =
  forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxBody era
strBody
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxWits era
strWits
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe) StrictMaybe (TxAuxData era)
strAuxiliaryData

instance
  (Era era, EncCBOR (TxWits era), EncCBOR (TxBody era), EncCBOR (TxAuxData era)) =>
  EncCBOR (ShelleyTxRaw era)
  where
  encCBOR :: ShelleyTxRaw era -> Encoding
encCBOR = forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EncCBOR (TxWits era), EncCBOR (TxBody era),
 EncCBOR (TxAuxData era)) =>
ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
encodeShelleyTxRaw

-- | Encodes memoized bytes created upon construction.
instance Era era => EncCBOR (ShelleyTx era)

instance
  ( Era era
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  , DecCBOR (Annotator (TxAuxData era))
  ) =>
  DecCBOR (Annotator (ShelleyTxRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxRaw era))
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw)
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
          ( forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
          )

deriving via
  Mem ShelleyTxRaw era
  instance
    EraTx era => DecCBOR (Annotator (ShelleyTx era))

-- | Construct a Tx containing the explicit serialised bytes.
--
--   This function is marked as unsafe since it makes no guarantee that the
--   represented bytes are indeed the correct serialisation of the transaction.
--   Thus, when calling this function, the caller is responsible for making this
--   guarantee.
--
--   The only intended use case for this is for segregated witness.
unsafeConstructTxWithBytes ::
  Era era =>
  TxBody era ->
  TxWits era ->
  StrictMaybe (TxAuxData era) ->
  LBS.ByteString ->
  ShelleyTx era
unsafeConstructTxWithBytes :: forall era.
Era era =>
TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
unsafeConstructTxWithBytes TxBody era
b TxWits era
w StrictMaybe (TxAuxData era)
a ByteString
bytes = forall era. MemoBytes ShelleyTxRaw era -> ShelleyTx era
TxConstr (forall era (t :: * -> *).
Era era =>
t era -> ByteString -> MemoBytes t era
mkMemoBytes (forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw TxBody era
b TxWits era
w StrictMaybe (TxAuxData era)
a) ByteString
bytes)

--------------------------------------------------------------------------------
-- Segregated witness
--------------------------------------------------------------------------------

segwitTx ::
  forall era.
  EraTx era =>
  Annotator (TxBody era) ->
  Annotator (TxWits era) ->
  Maybe (Annotator (TxAuxData era)) ->
  Annotator (ShelleyTx era)
segwitTx :: forall era.
EraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> Maybe (Annotator (TxAuxData era))
-> Annotator (ShelleyTx era)
segwitTx
  Annotator (TxBody era)
bodyAnn
  Annotator (TxWits era)
witsAnn
  Maybe (Annotator (TxAuxData era))
metaAnn = forall a. (FullByteString -> a) -> Annotator a
Annotator forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
    let body' :: TxBody era
body' = forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
bodyAnn FullByteString
bytes
        witnessSet :: TxWits era
witnessSet = forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWits era)
witsAnn FullByteString
bytes
        metadata :: Maybe (TxAuxData era)
metadata = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (TxAuxData era))
metaAnn
        wrappedMetadataBytes :: ByteString
wrappedMetadataBytes = case Maybe (TxAuxData era)
metadata of
          Maybe (TxAuxData era)
Nothing -> forall a. ToCBOR a => a -> ByteString
Plain.serialize Encoding
Plain.encodeNull
          Just TxAuxData era
b -> forall a. ToCBOR a => a -> ByteString
Plain.serialize TxAuxData era
b
        fullBytes :: ByteString
fullBytes =
          forall a. ToCBOR a => a -> ByteString
Plain.serialize (Word -> Encoding
Plain.encodeListLen Word
3)
            forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> ByteString
Plain.serialize TxBody era
body'
            forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> ByteString
Plain.serialize TxWits era
witnessSet
            forall a. Semigroup a => a -> a -> a
<> ByteString
wrappedMetadataBytes
     in forall era.
Era era =>
TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
unsafeConstructTxWithBytes
          TxBody era
body'
          TxWits era
witnessSet
          (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (TxAuxData era)
metadata)
          ByteString
fullBytes

-- ========================================

-- | Minimum fee calculation
shelleyMinFeeTx :: EraTx era => PParams era -> Tx era -> Coin
shelleyMinFeeTx :: forall era. EraTx era => PParams era -> Tx era -> Coin
shelleyMinFeeTx PParams era
pp Tx era
tx =
  (Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => SimpleGetter (Tx era) Integer
sizeTxF forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL) forall t. Val t => t -> t -> t
<+> PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL

-- | Extract the witness hashes from the Transaction.
witsFromTxWitnesses ::
  EraTx era =>
  Tx era ->
  Set (KeyHash 'Witness (EraCrypto era))
witsFromTxWitnesses :: forall era.
EraTx era =>
Tx era -> Set (KeyHash 'Witness (EraCrypto era))
witsFromTxWitnesses Tx era
tx =
  forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall (kr :: KeyRole) c. WitVKey kr c -> KeyHash 'Witness c
witVKeyHash (Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
addrTxWitsL)
    forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall c. Crypto c => BootstrapWitness c -> KeyHash 'Witness c
bootstrapWitKeyHash (Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (BootstrapWitness (EraCrypto era)))
bootAddrTxWitsL)