{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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 (
    MkShelleyTx,
    ShelleyTx,
    body,
    wits,
    auxiliaryData
  ),
  ShelleyTxRaw (..),
  bodyShelleyTxL,
  witsShelleyTxL,
  auxDataShelleyTxL,
  sizeShelleyTxF,
  wireSizeShelleyTxF,
  segWitTx,
  mkBasicShelleyTx,
  shelleyMinFeeTx,
  witsFromTxWitnesses,
  shelleyEqTxRaw,
  unsafeConstructTxWithBytes,
) where

import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  EncCBOR (encCBOR),
  ToCBOR,
  decodeNullStrictMaybe,
  encodeNullMaybe,
 )
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.MemoBytes (
  EqRaw (..),
  MemoBytes,
  Memoized (..),
  getMemoRawBytes,
  getMemoRawType,
  lensMemoRawType,
 )
import Cardano.Ledger.MemoBytes.Internal (memoBytesEra, mkMemoBytes)
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 Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro (Lens', SimpleGetter, 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)
strAuxData :: !(StrictMaybe (TxAuxData era))
  }
  deriving ((forall x. ShelleyTxRaw era -> Rep (ShelleyTxRaw era) x)
-> (forall x. Rep (ShelleyTxRaw era) x -> ShelleyTxRaw era)
-> Generic (ShelleyTxRaw era)
forall x. Rep (ShelleyTxRaw era) x -> ShelleyTxRaw era
forall x. ShelleyTxRaw era -> Rep (ShelleyTxRaw era) x
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
$cfrom :: forall era x. ShelleyTxRaw era -> Rep (ShelleyTxRaw era) x
from :: forall x. ShelleyTxRaw era -> Rep (ShelleyTxRaw era) x
$cto :: forall era x. Rep (ShelleyTxRaw era) x -> ShelleyTxRaw era
to :: forall x. Rep (ShelleyTxRaw era) x -> ShelleyTxRaw era
Generic)

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 = MkShelleyTx (MemoBytes (ShelleyTxRaw era))
  deriving newtype (ShelleyTx era -> Int
ShelleyTx era -> ByteString
(ShelleyTx era -> ByteString)
-> (ShelleyTx era -> Int)
-> (forall i. Proxy i -> ShelleyTx era -> SafeHash i)
-> SafeToHash (ShelleyTx era)
forall i. Proxy i -> ShelleyTx era -> SafeHash i
forall era. ShelleyTx era -> Int
forall era. ShelleyTx era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> ShelleyTx era -> SafeHash i
$coriginalBytes :: forall era. ShelleyTx era -> ByteString
originalBytes :: ShelleyTx era -> ByteString
$coriginalBytesSize :: forall era. ShelleyTx era -> Int
originalBytesSize :: ShelleyTx era -> Int
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> ShelleyTx era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> ShelleyTx era -> SafeHash i
SafeToHash, Typeable (ShelleyTx era)
Typeable (ShelleyTx era) =>
(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)
-> ToCBOR (ShelleyTx era)
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
$ctoCBOR :: forall era. Typeable era => ShelleyTx era -> Encoding
toCBOR :: ShelleyTx era -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
ToCBOR)
  deriving ((forall x. ShelleyTx era -> Rep (ShelleyTx era) x)
-> (forall x. Rep (ShelleyTx era) x -> ShelleyTx era)
-> Generic (ShelleyTx era)
forall x. Rep (ShelleyTx era) x -> ShelleyTx era
forall x. ShelleyTx era -> Rep (ShelleyTx era) x
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
$cfrom :: forall era x. ShelleyTx era -> Rep (ShelleyTx era) x
from :: forall x. ShelleyTx era -> Rep (ShelleyTx era) x
$cto :: forall era x. Rep (ShelleyTx era) x -> ShelleyTx era
to :: forall x. Rep (ShelleyTx era) x -> ShelleyTx era
Generic)

instance Memoized (ShelleyTx era) where
  type RawType (ShelleyTx era) = ShelleyTxRaw era

-- | `TxBody` setter and getter for `ShelleyTx`. The setter does update
-- memoized binary representation.
bodyShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (TxBody era)
bodyShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (TxBody era)
bodyShelleyTxL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @era RawType (ShelleyTx era) -> TxBody era
ShelleyTxRaw era -> TxBody era
forall era. ShelleyTxRaw era -> TxBody era
strBody ((RawType (ShelleyTx era) -> TxBody era -> RawType (ShelleyTx era))
 -> forall {f :: * -> *}.
    Functor f =>
    (TxBody era -> f (TxBody era))
    -> ShelleyTx era -> f (ShelleyTx era))
-> (RawType (ShelleyTx era)
    -> TxBody era -> RawType (ShelleyTx era))
-> forall {f :: * -> *}.
   Functor f =>
   (TxBody era -> f (TxBody era))
   -> ShelleyTx era -> f (ShelleyTx era)
forall a b. (a -> b) -> a -> b
$ \RawType (ShelleyTx era)
tx TxBody era
txBody -> RawType (ShelleyTx era)
tx {strBody = txBody}
{-# INLINEABLE bodyShelleyTxL #-}

-- | `TxWits` setter and getter for `ShelleyTx`. The setter does update
-- memoized binary representation.
witsShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (TxWits era)
witsShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (TxWits era)
witsShelleyTxL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @era RawType (ShelleyTx era) -> TxWits era
ShelleyTxRaw era -> TxWits era
forall era. ShelleyTxRaw era -> TxWits era
strWits ((RawType (ShelleyTx era) -> TxWits era -> RawType (ShelleyTx era))
 -> forall {f :: * -> *}.
    Functor f =>
    (TxWits era -> f (TxWits era))
    -> ShelleyTx era -> f (ShelleyTx era))
-> (RawType (ShelleyTx era)
    -> TxWits era -> RawType (ShelleyTx era))
-> forall {f :: * -> *}.
   Functor f =>
   (TxWits era -> f (TxWits era))
   -> ShelleyTx era -> f (ShelleyTx era)
forall a b. (a -> b) -> a -> b
$ \RawType (ShelleyTx era)
tx TxWits era
txWits -> RawType (ShelleyTx era)
tx {strWits = txWits}
{-# INLINEABLE witsShelleyTxL #-}

-- | `TxAuxData` setter and getter for `ShelleyTx`. The setter does update
-- memoized binary representation.
auxDataShelleyTxL :: forall era. EraTx era => Lens' (ShelleyTx era) (StrictMaybe (TxAuxData era))
auxDataShelleyTxL :: forall era.
EraTx era =>
Lens' (ShelleyTx era) (StrictMaybe (TxAuxData era))
auxDataShelleyTxL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @era RawType (ShelleyTx era) -> StrictMaybe (TxAuxData era)
ShelleyTxRaw era -> StrictMaybe (TxAuxData era)
forall era. ShelleyTxRaw era -> StrictMaybe (TxAuxData era)
strAuxData ((RawType (ShelleyTx era)
  -> StrictMaybe (TxAuxData era) -> RawType (ShelleyTx era))
 -> forall {f :: * -> *}.
    Functor f =>
    (StrictMaybe (TxAuxData era) -> f (StrictMaybe (TxAuxData era)))
    -> ShelleyTx era -> f (ShelleyTx era))
-> (RawType (ShelleyTx era)
    -> StrictMaybe (TxAuxData era) -> RawType (ShelleyTx era))
-> forall {f :: * -> *}.
   Functor f =>
   (StrictMaybe (TxAuxData era) -> f (StrictMaybe (TxAuxData era)))
   -> ShelleyTx era -> f (ShelleyTx era)
forall a b. (a -> b) -> a -> b
$ \RawType (ShelleyTx era)
tx StrictMaybe (TxAuxData era)
txAuxData -> RawType (ShelleyTx era)
tx {strAuxData = txAuxData}
{-# INLINEABLE auxDataShelleyTxL #-}

-- | Size getter for `ShelleyTx`.
sizeShelleyTxF :: SimpleGetter (ShelleyTx era) Integer
sizeShelleyTxF :: forall era r. Getting r (ShelleyTx era) Integer
sizeShelleyTxF = (ShelleyTx era -> Integer) -> SimpleGetter (ShelleyTx era) Integer
forall s a. (s -> a) -> SimpleGetter s a
to (\(ShelleyTx era -> ShortByteString
forall t. Memoized t => t -> ShortByteString
getMemoRawBytes -> ShortByteString
bytes) -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
SBS.length ShortByteString
bytes)
{-# INLINEABLE sizeShelleyTxF #-}

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

mkShelleyTx :: forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx :: forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx = MemoBytes (ShelleyTxRaw era) -> ShelleyTx era
forall era. MemoBytes (ShelleyTxRaw era) -> ShelleyTx era
MkShelleyTx (MemoBytes (ShelleyTxRaw era) -> ShelleyTx era)
-> (ShelleyTxRaw era -> MemoBytes (ShelleyTxRaw era))
-> ShelleyTxRaw era
-> ShelleyTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (w :: Wrapped) t. Era era => Encode w t -> MemoBytes t
memoBytesEra @era (Encode ('Closed 'Dense) (ShelleyTxRaw era)
 -> MemoBytes (ShelleyTxRaw era))
-> (ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era))
-> ShelleyTxRaw era
-> MemoBytes (ShelleyTxRaw era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
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 =
  ShelleyTxRaw era -> ShelleyTx era
forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx (ShelleyTxRaw era -> ShelleyTx era)
-> ShelleyTxRaw era -> ShelleyTx era
forall a b. (a -> b) -> a -> b
$
    ShelleyTxRaw
      { strBody :: TxBody era
strBody = TxBody era
txBody
      , strWits :: TxWits era
strWits = TxWits era
forall era. EraTxWits era => TxWits era
mkBasicTxWits
      , strAuxData :: StrictMaybe (TxAuxData era)
strAuxData = StrictMaybe (TxAuxData era)
forall a. StrictMaybe a
SNothing
      }

instance EraTx ShelleyEra where
  type Tx ShelleyEra = ShelleyTx ShelleyEra

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

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

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

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

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

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

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

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

  upgradeTx :: EraTx (PreviousEra ShelleyEra) =>
Tx (PreviousEra ShelleyEra)
-> Either (TxUpgradeError ShelleyEra) (Tx ShelleyEra)
upgradeTx =
    String -> Tx ByronEra -> Either Void (ShelleyTx ShelleyEra)
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 = Tx era -> Tx era -> Bool
ShelleyTx era -> ShelleyTx era -> Bool
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 =
  TxBody era -> TxBody era -> Bool
forall a. EqRaw a => a -> a -> Bool
eqRaw (Tx era
tx1 Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL) (Tx era
tx2 Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)
    Bool -> Bool -> Bool
&& TxWits era -> TxWits era -> Bool
forall a. EqRaw a => a -> a -> Bool
eqRaw (Tx era
tx1 Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL) (Tx era
tx2 Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL)
    Bool -> Bool -> Bool
&& (TxAuxData era -> TxAuxData era -> Bool)
-> Maybe (TxAuxData era) -> Maybe (TxAuxData era) -> Bool
forall a b. (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq -- TODO: Implement Eq1 instance for StrictMaybe
      TxAuxData era -> TxAuxData era -> Bool
forall a. EqRaw a => a -> a -> Bool
eqRaw
      (StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (Tx era
tx1 Tx era
-> Getting
     (StrictMaybe (TxAuxData era))
     (Tx era)
     (StrictMaybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData era))
  (Tx era)
  (StrictMaybe (TxAuxData era))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL))
      (StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (Tx era
tx2 Tx era
-> Getting
     (StrictMaybe (TxAuxData era))
     (Tx era)
     (StrictMaybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData era))
  (Tx era)
  (StrictMaybe (TxAuxData era))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL))

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 $mShelleyTx :: forall {r} {era}.
EraTx era =>
ShelleyTx era
-> (TxBody era -> TxWits era -> StrictMaybe (TxAuxData era) -> r)
-> ((# #) -> r)
-> r
$bShelleyTx :: forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
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} <-
  ( getMemoRawType ->
      ShelleyTxRaw
        { strBody = body
        , strWits = wits
        , strAuxData = auxiliaryData
        }
    )
  where
    ShelleyTx TxBody era
b TxWits era
w StrictMaybe (TxAuxData era)
a = ShelleyTxRaw era -> ShelleyTx era
forall era. EraTx era => ShelleyTxRaw era -> ShelleyTx era
mkShelleyTx (ShelleyTxRaw era -> ShelleyTx era)
-> ShelleyTxRaw era -> ShelleyTx era
forall a b. (a -> b) -> a -> b
$ TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
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 :: forall era. ShelleyTxRaw era -> TxBody era
strBody :: TxBody era
strBody, TxWits era
strWits :: forall era. ShelleyTxRaw era -> TxWits era
strWits :: TxWits era
strWits, StrictMaybe (TxAuxData era)
strAuxData :: forall era. ShelleyTxRaw era -> StrictMaybe (TxAuxData era)
strAuxData :: StrictMaybe (TxAuxData era)
strAuxData} =
  (TxBody era
 -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Encode
     ('Closed 'Dense)
     (TxBody era
      -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall t. t -> Encode ('Closed 'Dense) t
Rec TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw
    Encode
  ('Closed 'Dense)
  (TxBody era
   -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Encode ('Closed 'Dense) (TxBody era)
-> Encode
     ('Closed 'Dense)
     (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxBody era -> Encode ('Closed 'Dense) (TxBody era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxBody era
strBody
    Encode
  ('Closed 'Dense)
  (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Encode ('Closed 'Dense) (TxWits era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxWits era -> Encode ('Closed 'Dense) (TxWits era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxWits era
strWits
    Encode
  ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Encode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
-> Encode ('Closed 'Dense) (ShelleyTxRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (TxAuxData era) -> Encoding)
-> StrictMaybe (TxAuxData era)
-> Encode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((TxAuxData era -> Encoding) -> Maybe (TxAuxData era) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe TxAuxData era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Maybe (TxAuxData era) -> Encoding)
-> (StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe) StrictMaybe (TxAuxData era)
strAuxData

instance
  (Era era, EncCBOR (TxWits era), EncCBOR (TxBody era), EncCBOR (TxAuxData era)) =>
  EncCBOR (ShelleyTxRaw era)
  where
  encCBOR :: ShelleyTxRaw era -> Encoding
encCBOR = Encode ('Closed 'Dense) (ShelleyTxRaw era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ShelleyTxRaw era) -> Encoding)
-> (ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era))
-> ShelleyTxRaw era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyTxRaw era -> Encode ('Closed 'Dense) (ShelleyTxRaw era)
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 (TxBody era)
  , DecCBOR (TxWits era)
  , DecCBOR (TxAuxData era)
  ) =>
  DecCBOR (ShelleyTxRaw era)
  where
  decCBOR :: forall s. Decoder s (ShelleyTxRaw era)
decCBOR =
    Decode ('Closed 'Dense) (ShelleyTxRaw era)
-> Decoder s (ShelleyTxRaw era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ShelleyTxRaw era)
 -> Decoder s (ShelleyTxRaw era))
-> Decode ('Closed 'Dense) (ShelleyTxRaw era)
-> Decoder s (ShelleyTxRaw era)
forall a b. (a -> b) -> a -> b
$
      (TxBody era
 -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Decode
     ('Closed 'Dense)
     (TxBody era
      -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall t. t -> Decode ('Closed 'Dense) t
RecD TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw
        Decode
  ('Closed 'Dense)
  (TxBody era
   -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Decode ('Closed Any) (TxBody era)
-> Decode
     ('Closed 'Dense)
     (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxBody era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Decode ('Closed Any) (TxWits era)
-> Decode
     ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxWits era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Decode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
-> Decode ('Closed 'Dense) (ShelleyTxRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictMaybe (TxAuxData era)))
-> Decode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxAuxData era)
-> Decoder s (StrictMaybe (TxAuxData era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (TxAuxData era)
forall s. Decoder s (TxAuxData era)
forall a s. DecCBOR a => Decoder s a
decCBOR)

deriving newtype instance
  ( Era era
  , DecCBOR (TxBody era)
  , DecCBOR (TxWits era)
  , DecCBOR (TxAuxData era)
  ) =>
  DecCBOR (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 ::
  TxBody era ->
  TxWits era ->
  StrictMaybe (TxAuxData era) ->
  LBS.ByteString ->
  ShelleyTx era
unsafeConstructTxWithBytes :: forall era.
TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
unsafeConstructTxWithBytes TxBody era
b TxWits era
w StrictMaybe (TxAuxData era)
a ByteString
bytes = MemoBytes (ShelleyTxRaw era) -> ShelleyTx era
forall era. MemoBytes (ShelleyTxRaw era) -> ShelleyTx era
MkShelleyTx (ShelleyTxRaw era -> ByteString -> MemoBytes (ShelleyTxRaw era)
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes (TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
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 =>
  TxBody era ->
  TxWits era ->
  Maybe (TxAuxData era) ->
  ShelleyTx era
segWitTx :: forall era.
EraTx era =>
TxBody era -> TxWits era -> Maybe (TxAuxData era) -> ShelleyTx era
segWitTx TxBody era
body' TxWits era
witnessSet Maybe (TxAuxData era)
auxData =
  let
    wrappedAuxDataBytes :: ByteString
wrappedAuxDataBytes = case Maybe (TxAuxData era)
auxData of
      Maybe (TxAuxData era)
Nothing -> Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize Encoding
Plain.encodeNull
      Just TxAuxData era
b -> TxAuxData era -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize TxAuxData era
b
    fullBytes :: ByteString
fullBytes =
      Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize (Word -> Encoding
Plain.encodeListLen Word
3)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TxBody era -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize TxBody era
body'
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TxWits era -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize TxWits era
witnessSet
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
wrappedAuxDataBytes
   in
    TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
forall era.
TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
unsafeConstructTxWithBytes
      TxBody era
body'
      TxWits era
witnessSet
      (Maybe (TxAuxData era) -> StrictMaybe (TxAuxData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (TxAuxData era)
auxData)
      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 Tx era -> Getting Integer (Tx era) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer (Tx era) Integer
forall era. EraTx era => SimpleGetter (Tx era) Integer
SimpleGetter (Tx era) Integer
sizeTxF Integer -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeBL

-- | Extract the witness hashes from the Transaction.
witsFromTxWitnesses ::
  EraTx era =>
  Tx era ->
  Set (KeyHash 'Witness)
witsFromTxWitnesses :: forall era. EraTx era => Tx era -> Set (KeyHash 'Witness)
witsFromTxWitnesses Tx era
tx = TxWits era -> Set (KeyHash 'Witness)
forall era. EraTxWits era => TxWits era -> Set (KeyHash 'Witness)
keyHashWitnessesTxWits (Tx era
tx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL)
{-# DEPRECATED witsFromTxWitnesses "In favor ot `keyHashWitnessesTxWits`" #-}