{-# 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.Crypto
import Cardano.Ledger.Mary (Mary)
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 Mary
txM :: TxBody (MaryEra StandardCrypto)
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 (EraCrypto era))
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset StandardCrypto
testMint

testMint :: MultiAsset StandardCrypto
testMint :: MultiAsset StandardCrypto
testMint = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID StandardCrypto
policyId (forall k a. k -> a -> Map k a
Map.singleton AssetName
aname Integer
2)
  where
    policyId :: PolicyID StandardCrypto
policyId = forall c. ScriptHash c -> PolicyID c
PolicyID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @Mary 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 StandardCrypto)
txM forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
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 StandardCrypto)
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 StandardCrypto)
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 StandardCrypto)
txM forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL) (forall c. Map (RewardAccount c) Coin -> Withdrawals c
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 StandardCrypto)
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 StandardCrypto)
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 StandardCrypto)
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 StandardCrypto)
txM forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
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 StandardCrypto)
txM forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL) MultiAsset StandardCrypto
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 StandardCrypto)
txM)))
    ]