{-# 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 =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setShelleyMinTxOut" forall a b. (a -> b) -> a -> b
$ \(PParams era
pp :: PParams era) (TxOut era
txOut :: TxOut era) ->
    forall prop. Testable prop => Int -> prop -> Property
within Int
1000000 forall a b. (a -> b) -> a -> b
$ -- just in case if there is a problem with termination
      let txOut' :: TxOut era
txOut' = forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp TxOut era
txOut
          val :: Value era
val = TxOut era
txOut' forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL
          minUTxOValue :: Integer
minUTxOValue = Coin -> Integer
unCoin forall a b. (a -> b) -> a -> b
$ PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL
          minVal :: Integer
minVal
            | forall t. Val t => t -> Bool
Val.isAdaOnly Value era
val = Integer
0
            | Bool
otherwise = (Integer
27 forall a. Num a => a -> a -> a
+ forall t. Val t => t -> Integer
Val.size Value era
val) forall a. Num a => a -> a -> a
* (Integer
minUTxOValue forall a. Integral a => a -> a -> a
`quot` Integer
27)
       in forall t. Val t => t -> Coin
Val.coin Value era
val forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Integer -> Coin
Coin (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 =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setAlonzoMinTxOut" forall a b. (a -> b) -> a -> b
$ \(PParams Alonzo
pp :: PParams Alonzo) (TxOut Alonzo
txOut :: TxOut Alonzo) ->
    forall prop. Testable prop => Int -> prop -> Property
within Int
1000000 forall a b. (a -> b) -> a -> b
$ -- just in case if there is a problem with termination
      let txOut' :: TxOut Alonzo
txOut' = forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams Alonzo
pp TxOut Alonzo
txOut
          valSize :: Integer
valSize = forall t. Val t => t -> Integer
Val.size (AlonzoTxOut Alonzo
txOut' forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL)
          dataHashSize :: Integer
dataHashSize = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (forall a b. a -> b -> a
const Integer
10) forall a b. (a -> b) -> a -> b
$ forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (AlonzoTxOut Alonzo
txOut' forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (DataHash (EraCrypto era)))
dataHashTxOutL)
          sz :: Integer
sz = Integer
27 forall a. Num a => a -> a -> a
+ Integer
valSize forall a. Num a => a -> a -> a
+ Integer
dataHashSize
       in (AlonzoTxOut Alonzo
txOut' forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL)
            forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Integer -> Coin
Coin (Integer
sz forall a. Num a => a -> a -> a
* Coin -> Integer
unCoin (CoinPerWord -> Coin
unCoinPerWord (PParams Alonzo
pp forall s a. s -> Getting a s a -> a
^. forall era.
(AlonzoEraPParams era, ExactEra AlonzoEra era) =>
Lens' (PParams era) 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 =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setBabbageMinTxOut" forall a b. (a -> b) -> a -> b
$ \(PParams era
pp :: PParams era) (TxOut era
txOut :: TxOut era) ->
    forall prop. Testable prop => Int -> prop -> Property
within Int
1000000 forall a b. (a -> b) -> a -> b
$ -- just in case if there is a problem with termination
      let txOut' :: TxOut era
txOut' = forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp TxOut era
txOut
          sz :: Integer
sz = forall a. Integral a => a -> Integer
toInteger (ByteString -> Int64
BSL.length (forall a. EncCBOR a => Version -> a -> ByteString
serialize (ProtVer -> Version
pvMajor (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)) TxOut era
txOut'))
       in (TxOut era
txOut' forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL)
            forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Integer -> Coin
Coin ((Integer
160 forall a. Num a => a -> a -> a
+ Integer
sz) forall a. Num a => a -> a -> a
* Coin -> Integer
unCoin (CoinPerByte -> Coin
unCoinPerByte (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraPParams era =>
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 =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"setEnsureMinTxOut" forall a b. (a -> b) -> a -> b
$ \(PParams era
pp :: PParams era) (TxOut era
txOut :: TxOut era) -> do
    forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams era
pp (TxOut era
txOut forall a b. a -> (a -> b) -> b
& forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty)
      forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp (TxOut era
txOut forall a b. a -> (a -> b) -> b
& forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty)
    (forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams era
pp TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL)
      forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => a -> a -> Bool
>= (forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut PParams era
pp TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL))
    let v :: Version
v = forall era. Era era => Version
eraProtVerHigh @era
        txOutSz :: Sized (TxOut era)
txOutSz = forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
v TxOut era
txOut
    forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
ensureMinCoinSizedTxOut PParams era
pp (forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
v (TxOut era
txOut forall a b. a -> (a -> b) -> b
& forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty))
      forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOut PParams era
pp (forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
v (TxOut era
txOut forall a b. a -> (a -> b) -> b
& forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty))
    (forall a. Sized a -> a
sizedValue (forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
ensureMinCoinSizedTxOut PParams era
pp Sized (TxOut era)
txOutSz) forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL)
      forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => a -> a -> Bool
>= (forall a. Sized a -> a
sizedValue (forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOut PParams era
pp Sized (TxOut era)
txOutSz) forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL))

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