{-# 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 =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
6
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
3)) (forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
42))
    forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL 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 forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID
policyId (forall k a. k -> a -> Map k a
Map.singleton AssetName
aname Integer
2)
  where
    policyId :: PolicyID
policyId = ScriptHash -> PolicyID
PolicyID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash
hashScript @MaryEra forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a b. (a -> b) -> a -> b
$ forall a. [a] -> StrictSeq a
fromList []
    aname :: AssetName
aname = ShortByteString -> AssetName
AssetName forall a b. (a -> b) -> a -> b
$ 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" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"inputs" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL) forall a. Set a
empty)
    , String -> Assertion -> TestTree
testCase String
"outputs" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"outputs" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL) forall a. StrictSeq a
StrictSeq.empty)
    , String -> Assertion -> TestTree
testCase String
"certs" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"certs" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL) forall a. StrictSeq a
StrictSeq.empty)
    , String -> Assertion -> TestTree
testCase
        String
"withdrawals"
        (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"withdrawals" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL) (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty))
    , String -> Assertion -> TestTree
testCase String
"txfree" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"txfree" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL) (Integer -> Coin
Coin Integer
6))
    , String -> Assertion -> TestTree
testCase String
"vldt" forall a b. (a -> b) -> a -> b
$
        forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"vldt" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL) forall a b. (a -> b) -> a -> b
$
          StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
3)) (forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
42))
    , String -> Assertion -> TestTree
testCase String
"update" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"update" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL) forall a. StrictMaybe a
SNothing)
    , String -> Assertion -> TestTree
testCase String
"adHash" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"adHash" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL) forall a. StrictMaybe a
SNothing)
    , String -> Assertion -> TestTree
testCase String
"mint" (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"mint" (TxBody MaryEra
txM forall s a. s -> Getting a s a -> a
^. forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL) MultiAsset
testMint)
    ]

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