{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Test.Cardano.Ledger.Mary.Golden
-- Description : Golden Tests for the Mary era
module Test.Cardano.Ledger.Mary.Golden (
  goldenScaledMinDeposit,
  pid1,
  pid2,
  pid3,
  smallName,
  smallestName,
  realName,
  minUTxO,
  largestName,
)
where

import Cardano.Ledger.Allegra.Scripts (
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (hashScript)
import Cardano.Ledger.Mary (Mary)
import Cardano.Ledger.Mary.TxOut (scaledMinDeposit)
import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Shelley.Scripts
import Cardano.Ledger.Slot (SlotNo (..))
import qualified Data.ByteString.Short as SBS
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Word (Word8)
import Test.Cardano.Ledger.EraBuffet (StandardCrypto)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))

--
-- Golden Tests for the scaled MinUTxO function
--

pid1 :: PolicyID StandardCrypto
pid1 :: PolicyID StandardCrypto
pid1 =
  forall c. ScriptHash c -> PolicyID c
PolicyID forall a b. (a -> b) -> a -> b
$
    forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @Mary forall a b. (a -> b) -> a -> b
$
      forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [])

pid2 :: PolicyID StandardCrypto
pid2 :: PolicyID StandardCrypto
pid2 =
  forall c. ScriptHash c -> PolicyID c
PolicyID forall a b. (a -> b) -> a -> b
$
    forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @Mary forall a b. (a -> b) -> a -> b
$
      forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Word64 -> SlotNo
SlotNo Word64
1)])

pid3 :: PolicyID StandardCrypto
pid3 :: PolicyID StandardCrypto
pid3 =
  forall c. ScriptHash c -> PolicyID c
PolicyID forall a b. (a -> b) -> a -> b
$
    forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @Mary forall a b. (a -> b) -> a -> b
$
      forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Word64 -> SlotNo
SlotNo Word64
1)])

-- | The smallest asset name has length zero
smallestName :: AssetName
smallestName :: AssetName
smallestName = ShortByteString -> AssetName
AssetName forall a b. (a -> b) -> a -> b
$ [Word8] -> ShortByteString
SBS.pack []

-- | The small asset names have length one
smallName :: Word8 -> AssetName
smallName :: Word8 -> AssetName
smallName Word8
c = ShortByteString -> AssetName
AssetName forall a b. (a -> b) -> a -> b
$ [Word8] -> ShortByteString
SBS.pack [Word8
c]

-- | The largest asset names have length thirty-two
largestName :: Word8 -> AssetName
largestName :: Word8 -> AssetName
largestName Word8
c = ShortByteString -> AssetName
AssetName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShortByteString
SBS.pack forall a b. (a -> b) -> a -> b
$ Word8
c forall a. a -> [a] -> [a]
: [Word8
1 .. Word8
31]

-- | try using a real asset name the way the CLI handles input
realName :: AssetName
realName :: AssetName
realName = ShortByteString -> AssetName
AssetName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"ATADAcoin"

-- | This is the current value of the protocol parameter
--  at the time this comment was written, namely one Ada.
minUTxO :: Coin
minUTxO :: Coin
minUTxO = Integer -> Coin
Coin forall a b. (a -> b) -> a -> b
$ Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000

goldenScaledMinDeposit :: TestTree
goldenScaledMinDeposit :: TestTree
goldenScaledMinDeposit =
  String -> [TestTree] -> TestTree
testGroup
    String
"golden tests - scaledMinDeposit"
    [ String -> Assertion -> TestTree
testCase String
"one policy, one (smallest) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1407406) forall a b. (a -> b) -> a -> b
$
              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
pid1 (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
smallestName, Integer
1)])
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1407406
    , String -> Assertion -> TestTree
testCase String
"one policy, one (small) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1444443) forall a b. (a -> b) -> a -> b
$
              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
pid1
                  (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word8 -> AssetName
smallName Word8
1, Integer
1)])
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1444443
    , String -> Assertion -> TestTree
testCase String
"one policy, one (real) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1444443) forall a b. (a -> b) -> a -> b
$
              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
pid1
                  (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
realName, Integer
1)])
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1481480
    , String -> Assertion -> TestTree
testCase String
"one policy, three (small) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1555554) forall a b. (a -> b) -> a -> b
$
              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
pid1
                  ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      [ (Word8 -> AssetName
smallName Word8
1, Integer
1)
                      , (Word8 -> AssetName
smallName Word8
2, Integer
1)
                      , (Word8 -> AssetName
smallName Word8
3, Integer
1)
                      ]
                  )
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1555554
    , String -> Assertion -> TestTree
testCase String
"one policy, one (largest) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1555554) forall a b. (a -> b) -> a -> b
$
              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
pid1
                  (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word8 -> AssetName
largestName Word8
65, Integer
1)])
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1555554
    , String -> Assertion -> TestTree
testCase String
"one policy, three (largest) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1962961) forall a b. (a -> b) -> a -> b
$
              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
pid1
                  ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      [ (Word8 -> AssetName
largestName Word8
65, Integer
1)
                      , (Word8 -> AssetName
largestName Word8
66, Integer
1)
                      , (Word8 -> AssetName
largestName Word8
67, Integer
1)
                      ]
                  )
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1962961
    , String -> Assertion -> TestTree
testCase String
"two policies, one (smallest) name" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1592591) forall a b. (a -> b) -> a -> b
$
              forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( PolicyID StandardCrypto
pid1
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
smallestName, Integer
1)]
                    )
                  ,
                    ( PolicyID StandardCrypto
pid2
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
smallestName, Integer
1)]
                    )
                  ]
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1592591
    , String -> Assertion -> TestTree
testCase String
"two policies, two (small) names" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
1629628) forall a b. (a -> b) -> a -> b
$
              forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( PolicyID StandardCrypto
pid1
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word8 -> AssetName
smallName Word8
1, Integer
1)]
                    )
                  ,
                    ( PolicyID StandardCrypto
pid2
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word8 -> AssetName
smallName Word8
2, Integer
1)]
                    )
                  ]
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1629628
    , String -> Assertion -> TestTree
testCase String
"three policies, ninety-six (small) names" forall a b. (a -> b) -> a -> b
$
        forall v. Val v => v -> Coin -> Coin
scaledMinDeposit
          ( forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
7407400) forall a b. (a -> b) -> a -> b
$
              forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( PolicyID StandardCrypto
pid1
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AssetName
smallName) [Word8
32 .. Word8
63]
                    )
                  ,
                    ( PolicyID StandardCrypto
pid2
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AssetName
smallName) [Word8
64 .. Word8
95]
                    )
                  ,
                    ( PolicyID StandardCrypto
pid3
                    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AssetName
smallName) [Word8
96 .. Word8
127]
                    )
                  ]
          )
          Coin
minUTxO
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
7407400
    ]