{-# 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 MaryEra
txM :: TxBody MaryEra
txM =
  TxBody MaryEra
forall era. EraTxBody era => TxBody era
mkBasicTxBody
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody MaryEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> Coin -> TxBody MaryEra -> TxBody MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
6
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody MaryEra) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> ValidityInterval -> TxBody MaryEra -> TxBody 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 MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody MaryEra) MultiAsset
mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> MultiAsset -> TxBody MaryEra -> TxBody 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
testGroup
    String
"Tests for lenses"
    [ String -> Assertion -> TestTree
testCase String
"inputs" (String -> Set TxIn -> Set TxIn -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"inputs" (TxBody MaryEra
txM TxBody MaryEra
-> Getting (Set TxIn) (TxBody MaryEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody MaryEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody MaryEra) (Set TxIn)
inputsTxBodyL) Set TxIn
forall a. Set a
empty)
    , String -> Assertion -> TestTree
testCase String
"outputs" (String
-> StrictSeq (ShelleyTxOut MaryEra)
-> StrictSeq (ShelleyTxOut MaryEra)
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"outputs" (TxBody MaryEra
txM TxBody MaryEra
-> Getting
     (StrictSeq (ShelleyTxOut MaryEra))
     (TxBody 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 MaryEra
-> Const (StrictSeq (ShelleyTxOut MaryEra)) (TxBody MaryEra)
Getting
  (StrictSeq (ShelleyTxOut MaryEra))
  (TxBody MaryEra)
  (StrictSeq (ShelleyTxOut MaryEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody MaryEra) (StrictSeq (TxOut MaryEra))
outputsTxBodyL) StrictSeq (ShelleyTxOut MaryEra)
forall a. StrictSeq a
StrictSeq.empty)
    , String -> Assertion -> TestTree
testCase String
"certs" (String
-> StrictSeq (ShelleyTxCert MaryEra)
-> StrictSeq (ShelleyTxCert MaryEra)
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"certs" (TxBody MaryEra
txM TxBody MaryEra
-> Getting
     (StrictSeq (ShelleyTxCert MaryEra))
     (TxBody 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 MaryEra
-> Const (StrictSeq (ShelleyTxCert MaryEra)) (TxBody MaryEra)
Getting
  (StrictSeq (ShelleyTxCert MaryEra))
  (TxBody MaryEra)
  (StrictSeq (ShelleyTxCert MaryEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody MaryEra) (StrictSeq (TxCert MaryEra))
certsTxBodyL) StrictSeq (ShelleyTxCert MaryEra)
forall a. StrictSeq a
StrictSeq.empty)
    , String -> Assertion -> TestTree
testCase
        String
"withdrawals"
        (String -> Withdrawals -> Withdrawals -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"withdrawals" (TxBody MaryEra
txM TxBody MaryEra
-> Getting Withdrawals (TxBody MaryEra) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody MaryEra) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody MaryEra) Withdrawals
withdrawalsTxBodyL) (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty))
    , String -> Assertion -> TestTree
testCase String
"txfree" (String -> Coin -> Coin -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"txfree" (TxBody MaryEra
txM TxBody MaryEra -> Getting Coin (TxBody MaryEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody MaryEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody MaryEra) Coin
feeTxBodyL) (Integer -> Coin
Coin Integer
6))
    , String -> Assertion -> TestTree
testCase String
"vldt" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        String -> ValidityInterval -> ValidityInterval -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"vldt" (TxBody MaryEra
txM TxBody MaryEra
-> Getting ValidityInterval (TxBody MaryEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody MaryEra) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody MaryEra) ValidityInterval
vldtTxBodyL) (ValidityInterval -> Assertion) -> ValidityInterval -> Assertion
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))
    , String -> Assertion -> TestTree
testCase String
"update" (String
-> StrictMaybe (Update MaryEra)
-> StrictMaybe (Update MaryEra)
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"update" (TxBody MaryEra
txM TxBody MaryEra
-> Getting
     (StrictMaybe (Update MaryEra))
     (TxBody MaryEra)
     (StrictMaybe (Update MaryEra))
-> StrictMaybe (Update MaryEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Update MaryEra))
  (TxBody MaryEra)
  (StrictMaybe (Update MaryEra))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody MaryEra) (StrictMaybe (Update MaryEra))
updateTxBodyL) StrictMaybe (Update MaryEra)
forall a. StrictMaybe a
SNothing)
    , String -> Assertion -> TestTree
testCase String
"adHash" (String
-> StrictMaybe TxAuxDataHash
-> StrictMaybe TxAuxDataHash
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"adHash" (TxBody MaryEra
txM TxBody MaryEra
-> Getting
     (StrictMaybe TxAuxDataHash)
     (TxBody MaryEra)
     (StrictMaybe TxAuxDataHash)
-> StrictMaybe TxAuxDataHash
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe TxAuxDataHash)
  (TxBody MaryEra)
  (StrictMaybe TxAuxDataHash)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
Lens' (TxBody MaryEra) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL) StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing)
    , String -> Assertion -> TestTree
testCase String
"mint" (String -> MultiAsset -> MultiAsset -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"mint" (TxBody MaryEra
txM TxBody MaryEra
-> Getting MultiAsset (TxBody MaryEra) MultiAsset -> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody MaryEra) MultiAsset
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody MaryEra) MultiAsset
mintTxBodyL) MultiAsset
testMint)
    ]

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