{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

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

module Test.Cardano.Ledger.ShelleyMA.TxBody (
  txBodyTest,
) where

import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.TxBody (MaryEraTxBody (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.MemoBytes (getMemoRawBytes)
import Cardano.Ledger.Shelley.Scripts
import Cardano.Ledger.Shelley.TxBody (ShelleyEraTxBody (..), Withdrawals (..))
import Cardano.Slotting.Slot (SlotNo (..))
import qualified Data.ByteString.Short as Short
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (fromList)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (empty)
import Data.String (fromString)
import Lens.Micro
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Tasty
import Test.Tasty.HUnit

-- ====================================================================================================
-- Make a TxBody to test with

txM :: TxBody TopTx MaryEra
txM :: TxBody TopTx MaryEra
txM =
  TxBody TopTx MaryEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l MaryEra
mkBasicTxBody
    TxBody TopTx MaryEra
-> (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> TxBody TopTx MaryEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx MaryEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra))
-> Coin -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
6
    TxBody TopTx MaryEra
-> (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> TxBody TopTx MaryEra
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra)
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l MaryEra) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra))
-> ValidityInterval -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
3)) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
42))
    TxBody TopTx MaryEra
-> (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> TxBody TopTx MaryEra
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra)
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l MaryEra) MultiAsset
mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra))
-> MultiAsset -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
testMint

testMint :: MultiAsset
testMint :: MultiAsset
testMint = Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$ PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
policyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
aname Integer
2)
  where
    policyId :: PolicyID
policyId = ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID)
-> (StrictSeq (NativeScript MaryEra) -> ScriptHash)
-> StrictSeq (NativeScript MaryEra)
-> PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash
hashScript @MaryEra (Timelock MaryEra -> ScriptHash)
-> (StrictSeq (NativeScript MaryEra) -> Timelock MaryEra)
-> StrictSeq (NativeScript MaryEra)
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (NativeScript MaryEra) -> Timelock MaryEra
StrictSeq (NativeScript MaryEra) -> NativeScript MaryEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (StrictSeq (NativeScript MaryEra) -> PolicyID)
-> StrictSeq (NativeScript MaryEra) -> PolicyID
forall a b. (a -> b) -> a -> b
$ [NativeScript MaryEra] -> StrictSeq (NativeScript MaryEra)
forall a. [a] -> StrictSeq a
fromList []
    aname :: AssetName
aname = ShortByteString -> AssetName
AssetName (ShortByteString -> AssetName) -> ShortByteString -> AssetName
forall a b. (a -> b) -> a -> b
$ String -> ShortByteString
forall a. IsString a => String -> a
fromString String
"asset name"

fieldTests :: TestTree
fieldTests :: TestTree
fieldTests =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Tests for lenses"
    [ HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"inputs" (String -> Set TxIn -> Set TxIn -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"inputs" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting (Set TxIn) (TxBody TopTx MaryEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx MaryEra) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l MaryEra) (Set TxIn)
inputsTxBodyL) Set TxIn
forall a. Set a
empty)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"outputs" (String
-> StrictSeq (ShelleyTxOut MaryEra)
-> StrictSeq (ShelleyTxOut MaryEra)
-> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"outputs" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting
     (StrictSeq (ShelleyTxOut MaryEra))
     (TxBody TopTx MaryEra)
     (StrictSeq (ShelleyTxOut MaryEra))
-> StrictSeq (ShelleyTxOut MaryEra)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxOut MaryEra)
 -> Const
      (StrictSeq (ShelleyTxOut MaryEra)) (StrictSeq (TxOut MaryEra)))
-> TxBody TopTx MaryEra
-> Const (StrictSeq (ShelleyTxOut MaryEra)) (TxBody TopTx MaryEra)
Getting
  (StrictSeq (ShelleyTxOut MaryEra))
  (TxBody TopTx MaryEra)
  (StrictSeq (ShelleyTxOut MaryEra))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l MaryEra) (StrictSeq (TxOut MaryEra))
outputsTxBodyL) StrictSeq (ShelleyTxOut MaryEra)
forall a. StrictSeq a
StrictSeq.empty)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"certs" (String
-> StrictSeq (ShelleyTxCert MaryEra)
-> StrictSeq (ShelleyTxCert MaryEra)
-> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"certs" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting
     (StrictSeq (ShelleyTxCert MaryEra))
     (TxBody TopTx MaryEra)
     (StrictSeq (ShelleyTxCert MaryEra))
-> StrictSeq (ShelleyTxCert MaryEra)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxCert MaryEra)
 -> Const
      (StrictSeq (ShelleyTxCert MaryEra)) (StrictSeq (TxCert MaryEra)))
-> TxBody TopTx MaryEra
-> Const (StrictSeq (ShelleyTxCert MaryEra)) (TxBody TopTx MaryEra)
Getting
  (StrictSeq (ShelleyTxCert MaryEra))
  (TxBody TopTx MaryEra)
  (StrictSeq (ShelleyTxCert MaryEra))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l MaryEra) (StrictSeq (TxCert MaryEra))
certsTxBodyL) StrictSeq (ShelleyTxCert MaryEra)
forall a. StrictSeq a
StrictSeq.empty)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase
        String
"withdrawals"
        (String -> Withdrawals -> Withdrawals -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"withdrawals" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting Withdrawals (TxBody TopTx MaryEra) Withdrawals
-> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody TopTx MaryEra) Withdrawals
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l MaryEra) Withdrawals
withdrawalsTxBodyL) (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty))
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"txfree" (String -> Coin -> Coin -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"txfree" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting Coin (TxBody TopTx MaryEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx MaryEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx MaryEra) Coin
feeTxBodyL) (Integer -> Coin
Coin Integer
6))
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"vldt" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        String -> ValidityInterval -> ValidityInterval -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"vldt" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting ValidityInterval (TxBody TopTx MaryEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx MaryEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l MaryEra) ValidityInterval
vldtTxBodyL) (ValidityInterval -> Expectation)
-> ValidityInterval -> Expectation
forall a b. (a -> b) -> a -> b
$
          StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
3)) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
42))
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"update" (String
-> StrictMaybe (Update MaryEra)
-> StrictMaybe (Update MaryEra)
-> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"update" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting
     (StrictMaybe (Update MaryEra))
     (TxBody TopTx MaryEra)
     (StrictMaybe (Update MaryEra))
-> StrictMaybe (Update MaryEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Update MaryEra))
  (TxBody TopTx MaryEra)
  (StrictMaybe (Update MaryEra))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
Lens' (TxBody TopTx MaryEra) (StrictMaybe (Update MaryEra))
updateTxBodyL) StrictMaybe (Update MaryEra)
forall a. StrictMaybe a
SNothing)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"adHash" (String
-> StrictMaybe TxAuxDataHash
-> StrictMaybe TxAuxDataHash
-> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"adHash" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting
     (StrictMaybe TxAuxDataHash)
     (TxBody TopTx MaryEra)
     (StrictMaybe TxAuxDataHash)
-> StrictMaybe TxAuxDataHash
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe TxAuxDataHash)
  (TxBody TopTx MaryEra)
  (StrictMaybe TxAuxDataHash)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictMaybe TxAuxDataHash)
forall (l :: TxLevel).
Lens' (TxBody l MaryEra) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL) StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"mint" (String -> MultiAsset -> MultiAsset -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"mint" (TxBody TopTx MaryEra
txM TxBody TopTx MaryEra
-> Getting MultiAsset (TxBody TopTx MaryEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx MaryEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l MaryEra) MultiAsset
mintTxBodyL) MultiAsset
testMint)
    ]

txBodyTest :: TestTree
txBodyTest :: TestTree
txBodyTest =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"TxBody"
    [ TestTree
fieldTests
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"length" (String -> Int -> Int -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
String -> a -> a -> Expectation
assertEqual String
"length" Int
57 (ShortByteString -> Int
Short.length (TxBody TopTx MaryEra -> ShortByteString
forall t. Memoized t => t -> ShortByteString
getMemoRawBytes TxBody TopTx MaryEra
txM)))
    ]