{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Alonzo.TxInfoSpec (
  txInfoSpec,
  validBetweenEpochInfo,
  testEpochInfo,
  testSystemStart,
) where

import Cardano.Ledger.Alonzo.Plutus.TxInfo (AlonzoContextError (..), transValidityInterval)
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Slot (EpochInfo)
import Cardano.Slotting.EpochInfo (EpochInfo (..), fixedEpochInfo)
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
import Data.Either (isRight)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Test.Cardano.Ledger.Alonzo.ImpTest
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary (genOrderedPair)

txInfoSpec :: forall era. AlonzoEraImp era => Spec
txInfoSpec :: forall era. AlonzoEraImp era => Spec
txInfoSpec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Alonzo TxInfoSpec" (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
"Translation" (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
"transValidityInterval" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"translates successfully if bounds are valid" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
        (hi, lo) <- Gen (SlotNo, SlotNo)
forall a. (Arbitrary a, Ord a) => Gen (a, a)
genOrderedPair
        validityInterval <- genGoodValidityInterval lo hi
        pure $
          transValidityInterval
            (Proxy @era)
            (validBetweenEpochInfo lo hi)
            testSystemStart
            validityInterval
            `shouldSatisfy` isRight
      String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"fails to translate if the bounds are invalid" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
        (hi, lo) <- Gen (SlotNo, SlotNo)
forall a. (Arbitrary a, Ord a) => Gen (a, a)
genOrderedPair
        validityInterval <- genBadValidityInterval lo hi
        pure $
          transValidityInterval
            (Proxy @era)
            (validBetweenEpochInfo lo hi)
            testSystemStart
            validityInterval
            `shouldBeLeft` inject (TimeTranslationPastHorizon @era "out of valid range")

validBetweenEpochInfo :: SlotNo -> SlotNo -> EpochInfo (Either Text)
validBetweenEpochInfo :: SlotNo -> SlotNo -> EpochInfo (Either Text)
validBetweenEpochInfo SlotNo
start SlotNo
end =
  EpochInfo (Either Text)
forall a. EpochInfo (Either a)
testEpochInfo
    { epochInfoSlotToRelativeTime_ = \SlotNo
slot ->
        if SlotNo
slot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
> SlotNo
end Bool -> Bool -> Bool
|| SlotNo
slot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
start
          then Text -> Either Text RelativeTime
forall a b. a -> Either a b
Left Text
"out of valid range"
          else EpochInfo (Either Text)
-> HasCallStack => SlotNo -> Either Text RelativeTime
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ EpochInfo (Either Text)
forall a. EpochInfo (Either a)
testEpochInfo SlotNo
slot
    }

testEpochInfo :: EpochInfo (Either a)
testEpochInfo :: forall a. EpochInfo (Either a)
testEpochInfo = EpochSize -> SlotLength -> EpochInfo (Either a)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
100) (POSIXTime -> SlotLength
mkSlotLength POSIXTime
1)

testSystemStart :: SystemStart
testSystemStart :: SystemStart
testSystemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0