{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Shelley.Fees (
  sizeTests,
) where

import Cardano.Ledger.Address (Withdrawals (..))
import Cardano.Ledger.BaseTypes (
  Network (..),
  StrictMaybe (..),
  textToDns,
  textToUrl,
 )
import Cardano.Ledger.Binary.Plain as Plain (serialize)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.PoolParams (PoolMetadata (..), StakePoolRelay (..))
import Cardano.Ledger.Shelley (ShelleyEra, TxBody (..))
import Cardano.Ledger.Shelley.API (
  Addr,
  Credential (..),
  PoolParams (..),
  RewardAccount (..),
  ShelleyTxOut (..),
  TxIn (..),
 )
import Cardano.Ledger.Shelley.Scripts (
  ShelleyEraScript,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.Tx (
  ShelleyTx (..),
 )
import Cardano.Ledger.Shelley.TxAuxData
import Cardano.Ledger.Shelley.TxCert (
  pattern DelegStakeTxCert,
  pattern RegTxCert,
  pattern UnRegTxCert,
 )
import Cardano.Ledger.Shelley.TxWits (
  addrWits,
 )
import Cardano.Ledger.Shelley.UTxO (getShelleyMinFeeTxUtxo)
import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..))
import Cardano.Ledger.Tools (estimateMinFeeTx)
import Cardano.Ledger.TxIn (mkTxInPartial)
import qualified Cardano.Ledger.Val as Val
import Cardano.Protocol.Crypto (StandardCrypto, hashVerKeyVRF)
import qualified Data.ByteString.Base16.Lazy as Base16
import qualified Data.ByteString.Char8 as BS (pack)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map.Strict as Map (empty, singleton)
import Data.Maybe (fromJust)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import GHC.Stack (HasCallStack)
import Lens.Micro
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessesVKey, vKey)
import Test.Cardano.Ledger.Shelley.Generator.Core (VRFKeyPair (..))
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Utils (
  RawSeed (..),
  mkKeyPair,
  mkVRFKeyPair,
  unsafeBoundRational,
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

sizeTest :: HasCallStack => BSL.ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest :: HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
b16 ShelleyTx ShelleyEra
tx = do
  ByteString -> ByteString
Base16.encode (ShelleyTx ShelleyEra -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize ShelleyTx ShelleyEra
tx) ByteString -> ByteString -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ByteString
b16
  (ShelleyTx ShelleyEra
tx ShelleyTx ShelleyEra
-> Getting Integer (ShelleyTx ShelleyEra) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer (Tx ShelleyEra) Integer
Getting Integer (ShelleyTx ShelleyEra) Integer
forall era. EraTx era => SimpleGetter (Tx era) Integer
SimpleGetter (Tx ShelleyEra) Integer
sizeTxF) Integer -> Integer -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Int64
BSL.length ByteString
b16 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
2)

alicePay :: KeyPair 'Payment
alicePay :: KeyPair 'Payment
alicePay = VKey 'Payment -> SignKeyDSIGN DSIGN -> KeyPair 'Payment
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Payment
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0)

aliceStake :: KeyPair 'Staking
aliceStake :: KeyPair 'Staking
aliceStake = VKey 'Staking -> SignKeyDSIGN DSIGN -> KeyPair 'Staking
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Staking
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
1)

aliceSHK :: Credential 'Staking
aliceSHK :: Credential 'Staking
aliceSHK = (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> (KeyPair 'Staking -> KeyHash 'Staking)
-> KeyPair 'Staking
-> Credential 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> (KeyPair 'Staking -> VKey 'Staking)
-> KeyPair 'Staking
-> KeyHash 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) KeyPair 'Staking
aliceStake

alicePool :: KeyPair 'StakePool
alicePool :: KeyPair 'StakePool
alicePool = VKey 'StakePool -> SignKeyDSIGN DSIGN -> KeyPair 'StakePool
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'StakePool
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)

alicePoolKH :: KeyHash 'StakePool
alicePoolKH :: KeyHash 'StakePool
alicePoolKH = VKey 'StakePool -> KeyHash 'StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'StakePool -> KeyHash 'StakePool)
-> VKey 'StakePool -> KeyHash 'StakePool
forall a b. (a -> b) -> a -> b
$ KeyPair 'StakePool -> VKey 'StakePool
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'StakePool
alicePool

alicePoolParams :: PoolParams
alicePoolParams :: PoolParams
alicePoolParams =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = KeyHash 'StakePool
alicePoolKH
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @StandardCrypto (VerKeyVRF PraosVRF -> VRFVerKeyHash 'StakePoolVRF)
-> (VRFKeyPair StandardCrypto -> VerKeyVRF PraosVRF)
-> VRFKeyPair StandardCrypto
-> VRFVerKeyHash 'StakePoolVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VRFKeyPair StandardCrypto -> VerKeyVRF PraosVRF
VRFKeyPair StandardCrypto -> VerKeyVRF (VRF StandardCrypto)
forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey (VRFKeyPair StandardCrypto -> VRFVerKeyHash 'StakePoolVRF)
-> VRFKeyPair StandardCrypto -> VRFVerKeyHash 'StakePoolVRF
forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair @StandardCrypto (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
3)
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
1
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
5
    , ppMargin :: UnitInterval
ppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
aliceSHK
    , ppOwners :: Set (KeyHash 'Staking)
ppOwners = KeyHash 'Staking -> Set (KeyHash 'Staking)
forall a. a -> Set a
Set.singleton (KeyHash 'Staking -> Set (KeyHash 'Staking))
-> KeyHash 'Staking -> Set (KeyHash 'Staking)
forall a b. (a -> b) -> a -> b
$ (VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> (KeyPair 'Staking -> VKey 'Staking)
-> KeyPair 'Staking
-> KeyHash 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) KeyPair 'Staking
aliceStake
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays =
        StakePoolRelay -> StrictSeq StakePoolRelay
forall a. a -> StrictSeq a
StrictSeq.singleton (StakePoolRelay -> StrictSeq StakePoolRelay)
-> StakePoolRelay -> StrictSeq StakePoolRelay
forall a b. (a -> b) -> a -> b
$
          StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName StrictMaybe Port
forall a. StrictMaybe a
SNothing (DnsName -> StakePoolRelay) -> DnsName -> StakePoolRelay
forall a b. (a -> b) -> a -> b
$
            Maybe DnsName -> DnsName
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DnsName -> DnsName) -> Maybe DnsName -> DnsName
forall a b. (a -> b) -> a -> b
$
              Int -> Text -> Maybe DnsName
forall (m :: * -> *). MonadFail m => Int -> Text -> m DnsName
textToDns Int
64 Text
"relay.io"
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata =
        PoolMetadata -> StrictMaybe PoolMetadata
forall a. a -> StrictMaybe a
SJust (PoolMetadata -> StrictMaybe PoolMetadata)
-> PoolMetadata -> StrictMaybe PoolMetadata
forall a b. (a -> b) -> a -> b
$
          PoolMetadata
            { pmUrl :: Url
pmUrl = Maybe Url -> Url
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"alice.pool"
            , pmHash :: ByteString
pmHash = String -> ByteString
BS.pack String
"{}"
            }
    }

aliceAddr :: Addr
aliceAddr :: Addr
aliceAddr = KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
alicePay KeyPair 'Staking
aliceStake

bobPay :: KeyPair 'Payment
bobPay :: KeyPair 'Payment
bobPay = VKey 'Payment -> SignKeyDSIGN DSIGN -> KeyPair 'Payment
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Payment
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
0)

bobStake :: KeyPair 'Staking
bobStake :: KeyPair 'Staking
bobStake = VKey 'Staking -> SignKeyDSIGN DSIGN -> KeyPair 'Staking
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Staking
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
1)

bobSHK :: Credential 'Staking
bobSHK :: Credential 'Staking
bobSHK = KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking
-> Credential 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> Credential 'Staking)
-> VKey 'Staking -> Credential 'Staking
forall a b. (a -> b) -> a -> b
$ KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
bobStake

bobAddr :: Addr
bobAddr :: Addr
bobAddr = KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
bobPay KeyPair 'Staking
bobStake

carlPay :: KeyPair 'Payment
carlPay :: KeyPair 'Payment
carlPay = VKey 'Payment -> SignKeyDSIGN DSIGN -> KeyPair 'Payment
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Payment
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
0 Word64
0 Word64
0 Word64
0)

-- | Simple Transaction which consumes one UTxO and creates one UTxO
-- | and has one witness
txbSimpleUTxO :: TxBody ShelleyEra
txbSimpleUTxO :: TxBody ShelleyEra
txbSimpleUTxO =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txSimpleUTxO :: ShelleyTx ShelleyEra
txSimpleUTxO :: ShelleyTx ShelleyEra
txSimpleUTxO =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbSimpleUTxO
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits = mkWitnessesVKey (hashAnnotated txbSimpleUTxO) [alicePay]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txSimpleUTxOBytes16 :: BSL.ByteString
txSimpleUTxOBytes16 :: ByteString
txSimpleUTxOBytes16 =
  ByteString
"83a4008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030aa100818258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e584089c20cb6246483bbd0b2006f658597eff3e8ab3b8a6e9b22cb3c5b95cf0d3a2b96107acef88319fa2dd0fb28adcfdb330bb99f1f0058918a75d951ca9b73660cf6"

-- | Transaction which consumes two UTxO and creates five UTxO
-- | and has two witness
txbMutiUTxO :: TxBody ShelleyEra
txbMutiUTxO :: TxBody ShelleyEra
txbMutiUTxO =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs =
        [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList
          [ HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
0
          , HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1
          ]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs =
        [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
          , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
20)
          , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
30)
          , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
40)
          , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
50)
          ]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
199
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txMutiUTxO :: ShelleyTx ShelleyEra
txMutiUTxO :: ShelleyTx ShelleyEra
txMutiUTxO =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbMutiUTxO
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits =
              mkWitnessesVKey
                (hashAnnotated txbMutiUTxO)
                [ alicePay
                , bobPay
                ]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txMutiUTxOBytes16 :: BSL.ByteString
txMutiUTxOBytes16 :: ByteString
txMutiUTxOBytes16 =
  ByteString
"83a4008282582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c1113140082582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131401018582583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a82583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df761482583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df76181e825839000d2a471489a90f2910ec67ded8e215bfcd669bae77e7f9ab15850abd4e130c0bdeb7768edf2e8f85007fd52073e3dc1871f4c47f9dfca92e1828825839000d2a471489a90f2910ec67ded8e215bfcd669bae77e7f9ab15850abd4e130c0bdeb7768edf2e8f85007fd52073e3dc1871f4c47f9dfca92e18320218c7030aa1008282582037139648f2c22bbf1d0ef9af37cfebc9014b1e0e2a55be87c4b3b231a8d84d2658405ef09b22172cd28678e76e600e899886852e03567e2e72b4815629471e736a0cd424dc71cdaa0d0403371d79ea3d0cb7f28cb0740ebfcd8947343eba99a6aa088258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e5840ea98ef8052776aa5c182621cfd2ec91011d327527fc2531be9e1a8356c10f25f3fe5a5a7f549a0dc3b17c4ad8e4b8673b63a87977ac899b675f3ce3d6badae01f6"

-- | Transaction which registers a stake key
txbRegisterStake :: TxBody ShelleyEra
txbRegisterStake :: TxBody ShelleyEra
txbRegisterStake =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Credential 'Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
aliceSHK]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txRegisterStake :: ShelleyTx ShelleyEra
txRegisterStake :: ShelleyTx ShelleyEra
txRegisterStake =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbRegisterStake
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits = mkWitnessesVKey (hashAnnotated txbRegisterStake) [alicePay]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txRegisterStakeBytes16 :: BSL.ByteString
txRegisterStakeBytes16 :: ByteString
txRegisterStakeBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a048182008200581cc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df76a100818258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e58403271792b002eb39bcb133668e851a5ffba9c13ad2b5c5a7bbc850a17de8309cbb9649d9e90eb4c9cc82f28f204408d513ccc575ce1f61808f67793429ff1880ef6"

-- | Transaction which delegates a stake key
txbDelegateStake :: TxBody ShelleyEra
txbDelegateStake :: TxBody ShelleyEra
txbDelegateStake =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts =
        [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ Credential 'Staking -> KeyHash 'StakePool -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
bobSHK KeyHash 'StakePool
alicePoolKH
          ]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txDelegateStake :: ShelleyTx ShelleyEra
txDelegateStake :: ShelleyTx ShelleyEra
txDelegateStake =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbDelegateStake
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits =
              mkWitnessesVKey
                (hashAnnotated txbDelegateStake)
                [asWitness alicePay, asWitness bobStake]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txDelegateStakeBytes16 :: BSL.ByteString
txDelegateStakeBytes16 :: ByteString
txDelegateStakeBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a048183028200581c4e130c0bdeb7768edf2e8f85007fd52073e3dc1871f4c47f9dfca92e581c5d43e1f1048b2619f51abc0cf505e4d4f9cb84becefd468d1a2fe335a100828258209921fa37a7d167aab519bb937d7ac6e522ad6d259a6173523357b971e05f41ff58403bad563c201b4f62448db12711af2d916776194b5176e9d312d07a328ce7780a63032dce887abc67985629b7aeabb0c334e84094f44d7e51ae51b5c799a83c0d8258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e584064aef85b046d2d0072cd64844e9f13d86651a1db74d356a10ecd7fb35a664fc466e543ea55cfbffd74025dc092d62c4b22d7e2de4decb4f049df354cfae9790af6"

-- | Transaction which de-registers a stake key
txbDeregisterStake :: TxBody ShelleyEra
txbDeregisterStake :: TxBody ShelleyEra
txbDeregisterStake =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Credential 'Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
aliceSHK]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txDeregisterStake :: ShelleyTx ShelleyEra
txDeregisterStake :: ShelleyTx ShelleyEra
txDeregisterStake =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbDeregisterStake
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits = mkWitnessesVKey (hashAnnotated txbDeregisterStake) [alicePay]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txDeregisterStakeBytes16 :: BSL.ByteString
txDeregisterStakeBytes16 :: ByteString
txDeregisterStakeBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a048182018200581cc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df76a100818258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e5840409db925fa592b7f4c76e44d738789f4b0ffb2b9cf4567af127121d635491b4eb736e8c92571f1329f14d06aad7ec42ca654ae65eb63b0b01d30cc4454aee80cf6"

-- | Transaction which registers a stake pool
txbRegisterPool :: TxBody ShelleyEra
txbRegisterPool :: TxBody ShelleyEra
txbRegisterPool =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [PoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
alicePoolParams]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txRegisterPool :: ShelleyTx ShelleyEra
txRegisterPool :: ShelleyTx ShelleyEra
txRegisterPool =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbRegisterPool
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits = mkWitnessesVKey (hashAnnotated txbRegisterPool) [alicePay]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txRegisterPoolBytes16 :: BSL.ByteString
txRegisterPoolBytes16 :: ByteString
txRegisterPoolBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a04818a03581c5d43e1f1048b2619f51abc0cf505e4d4f9cb84becefd468d1a2fe33558208e61e1fa4855ea3aa0b8881a9e2e453c8c73536bdaabb64d36de86ee5a02519a0105d81e82010a581de0c6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df7681581cc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df76818301f66872656c61792e696f826a616c6963652e706f6f6c427b7da100818258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e5840165c6aa107571daafb1f9093d3cdc184a4068e8ff9243715c13335feb3652dc0d817b3b015a9929c9d83a0dd406fe71658fdccbf7925d2fff316237b499c2003f6"

-- | Transaction which retires a stake pool
txbRetirePool :: TxBody ShelleyEra
txbRetirePool :: TxBody ShelleyEra
txbRetirePool =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [KeyHash 'StakePool -> EpochNo -> TxCert ShelleyEra
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
alicePoolKH (Word64 -> EpochNo
EpochNo Word64
5)]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txRetirePool :: ShelleyTx ShelleyEra
txRetirePool :: ShelleyTx ShelleyEra
txRetirePool =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbRetirePool
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits = mkWitnessesVKey (hashAnnotated txbRetirePool) [alicePay]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txRetirePoolBytes16 :: BSL.ByteString
txRetirePoolBytes16 :: ByteString
txRetirePoolBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a04818304581c5d43e1f1048b2619f51abc0cf505e4d4f9cb84becefd468d1a2fe33505a100818258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e58404ad8f782368857f26db548d4ef6eca276639db9f1e8536f505c049ec94e0f6325c5f9f62a5187eb077f51bcd51cdff7d142415796442f2631081b90bf74f7204f6"

-- | Simple Transaction which consumes one UTxO and creates one UTxO
-- | and has one witness
md :: Era era => ShelleyTxAuxData era
md :: forall era. Era era => ShelleyTxAuxData era
md = Map Word64 Metadatum -> ShelleyTxAuxData era
forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData (Map Word64 Metadatum -> ShelleyTxAuxData era)
-> Map Word64 Metadatum -> ShelleyTxAuxData era
forall a b. (a -> b) -> a -> b
$ Word64 -> Metadatum -> Map Word64 Metadatum
forall k a. k -> a -> Map k a
Map.singleton Word64
0 ([Metadatum] -> Metadatum
List [Integer -> Metadatum
I Integer
5, Text -> Metadatum
S Text
"hello"])

txbWithMD :: TxBody ShelleyEra
txbWithMD :: TxBody ShelleyEra
txbWithMD =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust (TxAuxDataHash -> StrictMaybe TxAuxDataHash)
-> TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a b. (a -> b) -> a -> b
$ forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData @ShelleyEra TxAuxData ShelleyEra
ShelleyTxAuxData ShelleyEra
forall era. Era era => ShelleyTxAuxData era
md
    }

txWithMD :: ShelleyTx ShelleyEra
txWithMD :: ShelleyTx ShelleyEra
txWithMD =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbWithMD
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits = mkWitnessesVKey (hashAnnotated txbWithMD) [alicePay]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = ShelleyTxAuxData ShelleyEra
-> StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. a -> StrictMaybe a
SJust ShelleyTxAuxData ShelleyEra
forall era. Era era => ShelleyTxAuxData era
md
    }

txWithMDBytes16 :: BSL.ByteString
txWithMDBytes16 :: ByteString
txWithMDBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a075820e2d7de09439ab222111cecd21545c5f9c338fd6653539031eb311d34fc97e718a100818258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e5840ab05c3933f5c7281386309a374f45eeee28b6f3a01bc76a5fa3bc9efdc603dd63059d0aebfd198e23bf848dae43a23be3e6f85149bca2f27d0e7f4f63be38e02a10082056568656c6c6f"

-- | Spending from a multi-sig address
msig :: forall era. ShelleyEraScript era => NativeScript era
msig :: forall era. ShelleyEraScript era => NativeScript era
msig =
  Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf
    Int
2
    ( [NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ (KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> NativeScript era)
-> (KeyPair 'Payment -> KeyHash 'Witness)
-> KeyPair 'Payment
-> NativeScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) KeyPair 'Payment
alicePay
        , (KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> NativeScript era)
-> (KeyPair 'Payment -> KeyHash 'Witness)
-> KeyPair 'Payment
-> NativeScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) KeyPair 'Payment
bobPay
        , (KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> NativeScript era)
-> (KeyPair 'Payment -> KeyHash 'Witness)
-> KeyPair 'Payment
-> NativeScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) KeyPair 'Payment
carlPay
        ]
    )

txbWithMultiSig :: TxBody ShelleyEra
txbWithMultiSig :: TxBody ShelleyEra
txbWithMultiSig =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound] -- acting as if this is multi-sig
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txWithMultiSig :: ShelleyTx ShelleyEra
txWithMultiSig :: ShelleyTx ShelleyEra
txWithMultiSig =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbWithMultiSig
    , wits :: TxWits ShelleyEra
wits =
        TxWits ShelleyEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits
          TxWits ShelleyEra
-> (TxWits ShelleyEra -> TxWits ShelleyEra) -> TxWits ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits ShelleyEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Set (WitVKey 'Witness) -> TxWits ShelleyEra -> TxWits ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SafeHash EraIndependentTxBody
-> [KeyPair 'Payment] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody ShelleyEra
txbWithMultiSig) [KeyPair 'Payment
alicePay, KeyPair 'Payment
bobPay]
          TxWits ShelleyEra
-> (TxWits ShelleyEra -> ShelleyTxWits ShelleyEra)
-> ShelleyTxWits ShelleyEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script ShelleyEra)
 -> Identity (Map ScriptHash (Script ShelleyEra)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Map ScriptHash (Script ShelleyEra)
 -> Identity (Map ScriptHash (Script ShelleyEra)))
-> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits ShelleyEra) (Map ScriptHash (Script ShelleyEra))
scriptTxWitsL ((Map ScriptHash (Script ShelleyEra)
  -> Identity (Map ScriptHash (Script ShelleyEra)))
 -> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Map ScriptHash (Script ShelleyEra)
-> TxWits ShelleyEra
-> ShelleyTxWits ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptHash
-> Script ShelleyEra -> Map ScriptHash (Script ShelleyEra)
forall k a. k -> a -> Map k a
Map.singleton (forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra Script ShelleyEra
NativeScript ShelleyEra
forall era. ShelleyEraScript era => NativeScript era
msig) Script ShelleyEra
NativeScript ShelleyEra
forall era. ShelleyEraScript era => NativeScript era
msig
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txWithMultiSigBytes16 :: BSL.ByteString
txWithMultiSigBytes16 :: ByteString
txWithMultiSigBytes16 =
  ByteString
"83a4008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030aa2008282582037139648f2c22bbf1d0ef9af37cfebc9014b1e0e2a55be87c4b3b231a8d84d265840e3b8f50632325fbd1f82202ce5a8b4672bd96c50a338d70c0aa96720f6f7fbf60e0ce708f3a7e28faa0d78dc437a0b61e02205ddb1db22d02ba35b37a7fe03068258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e584089c20cb6246483bbd0b2006f658597eff3e8ab3b8a6e9b22cb3c5b95cf0d3a2b96107acef88319fa2dd0fb28adcfdb330bb99f1f0058918a75d951ca9b73660c0181830302838200581ce9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371f8200581c0d2a471489a90f2910ec67ded8e215bfcd669bae77e7f9ab15850abd8200581cd0671052191a58c554eee27808b2b836a03ca369ca7a847f8c37d6f9f6"

-- | Transaction with a Reward Withdrawal
txbWithWithdrawal :: TxBody ShelleyEra
txbWithWithdrawal :: TxBody ShelleyEra
txbWithWithdrawal =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts = StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    , stbWithdrawals :: Withdrawals
stbWithdrawals =
        Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$ RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
aliceSHK) (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)
    , stbTxFee :: Coin
stbTxFee = Integer -> Coin
Coin Integer
94
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
10
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txWithWithdrawal :: ShelleyTx ShelleyEra
txWithWithdrawal :: ShelleyTx ShelleyEra
txWithWithdrawal =
  ShelleyTx
    { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbWithWithdrawal
    , wits :: TxWits ShelleyEra
wits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits =
              mkWitnessesVKey
                (hashAnnotated txbWithWithdrawal)
                [asWitness alicePay, asWitness aliceStake]
          }
    , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    }

txWithWithdrawalBytes16 :: BSL.ByteString
txWithWithdrawalBytes16 :: ByteString
txWithWithdrawalBytes16 =
  ByteString
"83a5008182582003170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c11131400018182583900e9686d801fa32aeb4390c2f2a53bb0314a9c744c46a2cada394a371fc6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df760a02185e030a05a1581de0c6852b6aaed73bcf346a57ef99adae3000b51c7c59faaeb15993df761864a100828258208f40b25c9987eeb9c7f75eaf4f461f16384872a94dc353a4fb5c95bb657c59f85840c52adcbc184a497d1746ee962a762427e79e3f600a356378ffda6294c658ed91c0f0c7815cbaefb22bdabc09c5bf6c5f6724c0136701da26c77882f739f109038258204628aaf16d6e1baa061d1296419542cb09287c639163d0fdbdac0ff23699797e584012d30a6d3dbe0223e772dc183c138779449cd5fd9aac817b63af945b0a8e9f85be3bcc4457ad1a27f08fd36205717f8bafea1b1328f3a074febcfc62b6b99f06f6"

-- | The transaction fee of txSimpleUTxO if one key witness were to be added,
-- given minfeeA and minfeeB are set to 1.
testEstimateMinFee :: Assertion
testEstimateMinFee :: Assertion
testEstimateMinFee =
  forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Int -> Coin
estimateMinFeeTx @ShelleyEra
    PParams ShelleyEra
pp
    Tx ShelleyEra
ShelleyTx ShelleyEra
txSimpleUTxONoWit
    Int
1
    Int
0
    Int
0
    Coin -> Coin -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= PParams ShelleyEra -> Tx ShelleyEra -> Coin
forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams ShelleyEra
pp Tx ShelleyEra
ShelleyTx ShelleyEra
txSimpleUTxO
  where
    pp :: PParams ShelleyEra
pp =
      PParams ShelleyEra
forall era. EraPParams era => PParams era
emptyPParams
        PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Coin -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1
        PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Coin -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1

    txSimpleUTxONoWit :: ShelleyTx ShelleyEra
txSimpleUTxONoWit =
      ShelleyTx
        { body :: TxBody ShelleyEra
body = TxBody ShelleyEra
txbSimpleUTxO
        , wits :: TxWits ShelleyEra
wits = TxWits ShelleyEra
ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
        , auxiliaryData :: StrictMaybe (TxAuxData ShelleyEra)
auxiliaryData = StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
        }

-- NOTE the txsize function takes into account which actual crypto parameter is in use.
-- These tests are using Blake2b and Ed25519 so that:
--       the regular hash length is ----> 32
--       the address hash length is ----> 28
--       the verification key size is --> 32
--       the signature size is ---------> 64

sizeTests :: TestTree
sizeTests :: TestTree
sizeTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"Fee Tests"
    [ String -> Assertion -> TestTree
testCase String
"simple utxo" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txSimpleUTxOBytes16 ShelleyTx ShelleyEra
txSimpleUTxO
    , String -> Assertion -> TestTree
testCase String
"multiple utxo" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txMutiUTxOBytes16 ShelleyTx ShelleyEra
txMutiUTxO
    , String -> Assertion -> TestTree
testCase String
"register stake key" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txRegisterStakeBytes16 ShelleyTx ShelleyEra
txRegisterStake
    , String -> Assertion -> TestTree
testCase String
"delegate stake key" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txDelegateStakeBytes16 ShelleyTx ShelleyEra
txDelegateStake
    , String -> Assertion -> TestTree
testCase String
"deregister stake key" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txDeregisterStakeBytes16 ShelleyTx ShelleyEra
txDeregisterStake
    , String -> Assertion -> TestTree
testCase String
"register stake pool" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txRegisterPoolBytes16 ShelleyTx ShelleyEra
txRegisterPool
    , String -> Assertion -> TestTree
testCase String
"retire stake pool" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txRetirePoolBytes16 ShelleyTx ShelleyEra
txRetirePool
    , String -> Assertion -> TestTree
testCase String
"auxiliaryData" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txWithMDBytes16 ShelleyTx ShelleyEra
txWithMD
    , String -> Assertion -> TestTree
testCase String
"multisig" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txWithMultiSigBytes16 ShelleyTx ShelleyEra
txWithMultiSig
    , String -> Assertion -> TestTree
testCase String
"reward withdrawal" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ShelleyTx ShelleyEra -> Assertion
ByteString -> ShelleyTx ShelleyEra -> Assertion
sizeTest ByteString
txWithWithdrawalBytes16 ShelleyTx ShelleyEra
txWithWithdrawal
    , String -> Assertion -> TestTree
testCase String
"estimate transaction fee" Assertion
testEstimateMinFee
    ]