{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Api.Tx.Out (spec) where

import Cardano.Ledger.Api.Era
import Cardano.Ledger.Api.Tx.Out
import Cardano.Ledger.BaseTypes (pvMajor, strictMaybeToMaybe)
import Cardano.Ledger.Binary (Sized (sizedValue), mkSized, serialize)
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
import qualified Cardano.Ledger.Val as Val
import qualified Data.ByteString.Lazy as BSL
import Data.Functor.Identity
import Lens.Micro
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary ()

propSetShelleyMinTxOut ::
  forall era.
  ( EraTxOut era
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (TxOut era)
  , AtMostEra MaryEra era
  ) =>
  Spec
propSetShelleyMinTxOut :: forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era), AtMostEra MaryEra era) =>
Spec
propSetShelleyMinTxOut =
  String -> (PParams era -> TxOut era -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setShelleyMinTxOut" ((PParams era -> TxOut era -> Property) -> Spec)
-> (PParams era -> TxOut era -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \(PParams era
pp :: PParams era) (TxOut era
txOut :: TxOut era) ->
    Int -> Expectation -> Property
forall prop. Testable prop => Int -> prop -> Property
within Int
1000000 (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$ -- just in case if there is a problem with termination
      let txOut' :: TxOut era
txOut' = PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp TxOut era
txOut
          val :: Value era
val = TxOut era
txOut' TxOut era
-> Getting (Value era) (TxOut era) (Value era) -> Value era
forall s a. s -> Getting a s a -> a
^. Getting (Value era) (TxOut era) (Value era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL
          minUTxOValue :: Integer
minUTxOValue = Coin -> Integer
unCoin (Coin -> Integer) -> Coin -> Integer
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinUTxOValueL
          minVal :: Integer
minVal
            | Value era -> Bool
forall t. Val t => t -> Bool
Val.isAdaOnly Value era
val = Integer
0
            | Bool
otherwise = (Integer
27 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Value era -> Integer
forall t. Val t => t -> Integer
Val.size Value era
val) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
minUTxOValue Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
27)
       in Value era -> Coin
forall t. Val t => t -> Coin
Val.coin Value era
val Coin -> Coin -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Integer -> Coin
Coin (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
minVal Integer
minUTxOValue)
  where
    _atMostMary :: ()
_atMostMary = forall eraName era. AtMostEra eraName era => ()
atMostEra @MaryEra @era

propSetAlonzoMinTxOut :: Spec
propSetAlonzoMinTxOut :: Spec
propSetAlonzoMinTxOut =
  String
-> (PParams AlonzoEra -> AlonzoTxOut AlonzoEra -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setAlonzoMinTxOut" ((PParams AlonzoEra -> AlonzoTxOut AlonzoEra -> Property) -> Spec)
-> (PParams AlonzoEra -> AlonzoTxOut AlonzoEra -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \(PParams AlonzoEra
pp :: PParams AlonzoEra) (TxOut AlonzoEra
txOut :: TxOut AlonzoEra) ->
    Int -> Expectation -> Property
forall prop. Testable prop => Int -> prop -> Property
within Int
1000000 (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$ -- just in case if there is a problem with termination
      let txOut' :: TxOut AlonzoEra
txOut' = PParams AlonzoEra -> TxOut AlonzoEra -> TxOut AlonzoEra
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams AlonzoEra
pp TxOut AlonzoEra
txOut
          valSize :: Integer
valSize = Value AlonzoEra -> Integer
forall t. Val t => t -> Integer
Val.size (AlonzoTxOut AlonzoEra
txOut' AlonzoTxOut AlonzoEra
-> Getting
     (Value AlonzoEra) (AlonzoTxOut AlonzoEra) (Value AlonzoEra)
-> Value AlonzoEra
forall s a. s -> Getting a s a -> a
^. (Value AlonzoEra -> Const (Value AlonzoEra) (Value AlonzoEra))
-> TxOut AlonzoEra -> Const (Value AlonzoEra) (TxOut AlonzoEra)
Getting (Value AlonzoEra) (AlonzoTxOut AlonzoEra) (Value AlonzoEra)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut AlonzoEra) (Value AlonzoEra)
valueTxOutL)
          dataHashSize :: Integer
dataHashSize = Integer -> (DataHash -> Integer) -> Maybe DataHash -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (Integer -> DataHash -> Integer
forall a b. a -> b -> a
const Integer
10) (Maybe DataHash -> Integer) -> Maybe DataHash -> Integer
forall a b. (a -> b) -> a -> b
$ StrictMaybe DataHash -> Maybe DataHash
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (AlonzoTxOut AlonzoEra
txOut' AlonzoTxOut AlonzoEra
-> Getting
     (StrictMaybe DataHash)
     (AlonzoTxOut AlonzoEra)
     (StrictMaybe DataHash)
-> StrictMaybe DataHash
forall s a. s -> Getting a s a -> a
^. (StrictMaybe DataHash
 -> Const (StrictMaybe DataHash) (StrictMaybe DataHash))
-> TxOut AlonzoEra
-> Const (StrictMaybe DataHash) (TxOut AlonzoEra)
Getting
  (StrictMaybe DataHash)
  (AlonzoTxOut AlonzoEra)
  (StrictMaybe DataHash)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut AlonzoEra) (StrictMaybe DataHash)
dataHashTxOutL)
          sz :: Integer
sz = Integer
27 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
valSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
dataHashSize
       in (AlonzoTxOut AlonzoEra
txOut' AlonzoTxOut AlonzoEra
-> Getting Coin (AlonzoTxOut AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut AlonzoEra -> Const Coin (TxOut AlonzoEra)
Getting Coin (AlonzoTxOut AlonzoEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut AlonzoEra) Coin
coinTxOutL)
            Coin -> Coin -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Integer -> Coin
Coin (Integer
sz Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Coin -> Integer
unCoin (CoinPerWord -> Coin
unCoinPerWord (PParams AlonzoEra
pp PParams AlonzoEra
-> Getting CoinPerWord (PParams AlonzoEra) CoinPerWord
-> CoinPerWord
forall s a. s -> Getting a s a -> a
^. Getting CoinPerWord (PParams AlonzoEra) CoinPerWord
forall era.
(AlonzoEraPParams era, ExactEra AlonzoEra era) =>
Lens' (PParams era) CoinPerWord
Lens' (PParams AlonzoEra) CoinPerWord
ppCoinsPerUTxOWordL)))

propSetBabbageMinTxOut ::
  forall era.
  ( EraTxOut era
  , BabbageEraPParams era
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (TxOut era)
  ) =>
  Spec
propSetBabbageMinTxOut :: forall era.
(EraTxOut era, BabbageEraPParams era,
 Arbitrary (PParamsHKD Identity era), Arbitrary (TxOut era)) =>
Spec
propSetBabbageMinTxOut =
  String -> (PParams era -> TxOut era -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setBabbageMinTxOut" ((PParams era -> TxOut era -> Property) -> Spec)
-> (PParams era -> TxOut era -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \(PParams era
pp :: PParams era) (TxOut era
txOut :: TxOut era) ->
    Int -> Expectation -> Property
forall prop. Testable prop => Int -> prop -> Property
within Int
1000000 (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$ -- just in case if there is a problem with termination
      let txOut' :: TxOut era
txOut' = PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp TxOut era
txOut
          sz :: Integer
sz = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Int64
BSL.length (Version -> TxOut era -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize (ProtVer -> Version
pvMajor (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL)) TxOut era
txOut'))
       in (TxOut era
txOut' TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL)
            Coin -> Coin -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Integer -> Coin
Coin ((Integer
160 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sz) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Coin -> Integer
unCoin (CoinPerByte -> Coin
unCoinPerByte (PParams era
pp PParams era
-> Getting CoinPerByte (PParams era) CoinPerByte -> CoinPerByte
forall s a. s -> Getting a s a -> a
^. Getting CoinPerByte (PParams era) CoinPerByte
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL)))

propSetEnsureMinTxOut ::
  forall era.
  ( EraTxOut era
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (TxOut era)
  ) =>
  Spec
propSetEnsureMinTxOut :: forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut =
  String -> (PParams era -> TxOut era -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setEnsureMinTxOut" ((PParams era -> TxOut era -> Expectation) -> Spec)
-> (PParams era -> TxOut era -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ \(PParams era
pp :: PParams era) (TxOut era
txOut :: TxOut era) -> do
    PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams era
pp (TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall a. Monoid a => a
mempty)
      TxOut era -> TxOut era -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp (TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall a. Monoid a => a
mempty)
    (PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams era
pp TxOut era
txOut TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL)
      Coin -> (Coin -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= (PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp TxOut era
txOut TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL))
    let v :: Version
v = forall era. Era era => Version
eraProtVerHigh @era
        txOutSz :: Sized (TxOut era)
txOutSz = Version -> TxOut era -> Sized (TxOut era)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
v TxOut era
txOut
    PParams era -> Sized (TxOut era) -> Sized (TxOut era)
forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
ensureMinCoinSizedTxOut PParams era
pp (Version -> TxOut era -> Sized (TxOut era)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
v (TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall a. Monoid a => a
mempty))
      Sized (TxOut era) -> Sized (TxOut era) -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` PParams era -> Sized (TxOut era) -> Sized (TxOut era)
forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOut PParams era
pp (Version -> TxOut era -> Sized (TxOut era)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
v (TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall a. Monoid a => a
mempty))
    (Sized (TxOut era) -> TxOut era
forall a. Sized a -> a
sizedValue (PParams era -> Sized (TxOut era) -> Sized (TxOut era)
forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
ensureMinCoinSizedTxOut PParams era
pp Sized (TxOut era)
txOutSz) TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL)
      Coin -> (Coin -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= (Sized (TxOut era) -> TxOut era
forall a. Sized a -> a
sizedValue (PParams era -> Sized (TxOut era) -> Sized (TxOut era)
forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOut PParams era
pp Sized (TxOut era)
txOutSz) TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL))

spec :: Spec
spec :: Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxOut" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ShelleyEra" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era), AtMostEra MaryEra era) =>
Spec
propSetShelleyMinTxOut @ShelleyEra
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut @ShelleyEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"AllegraEra" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era), AtMostEra MaryEra era) =>
Spec
propSetShelleyMinTxOut @AllegraEra
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut @AllegraEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MaryEra" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era), AtMostEra MaryEra era) =>
Spec
propSetShelleyMinTxOut @MaryEra
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut @MaryEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"AlonzoEra" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      Spec
propSetAlonzoMinTxOut
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut @AlonzoEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"BabbageEra" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era.
(EraTxOut era, BabbageEraPParams era,
 Arbitrary (PParamsHKD Identity era), Arbitrary (TxOut era)) =>
Spec
propSetBabbageMinTxOut @BabbageEra
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut @BabbageEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ConwayEra" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era.
(EraTxOut era, BabbageEraPParams era,
 Arbitrary (PParamsHKD Identity era), Arbitrary (TxOut era)) =>
Spec
propSetBabbageMinTxOut @ConwayEra
      forall era.
(EraTxOut era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (TxOut era)) =>
Spec
propSetEnsureMinTxOut @ConwayEra