module Hydra.Chain.Direct.TimeHandleSpec where

import Hydra.Prelude hiding (label)
import Test.Hydra.Prelude

import Cardano.Ledger.Slot (SlotNo (SlotNo))
import Cardano.Slotting.Time (SystemStart (SystemStart))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Hydra.Chain.Direct.TimeHandle (TimeHandle (..), mkTimeHandle)
import Hydra.Ledger.Cardano.Evaluate (eraHistoryWithHorizonAt)
import Test.QuickCheck (counterexample, forAllBlind, property, (===))

spec :: Spec
spec :: Spec
spec = do
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"can roundtrip currentPointInTime" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen TimeHandle -> (TimeHandle -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen TimeHandle
forall a. Arbitrary a => Gen a
arbitrary ((TimeHandle -> Property) -> Property)
-> (TimeHandle -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \TimeHandle{Either Text PointInTime
currentPointInTime :: Either Text PointInTime
$sel:currentPointInTime:TimeHandle :: TimeHandle -> Either Text PointInTime
currentPointInTime, SlotNo -> Either Text UTCTime
slotToUTCTime :: SlotNo -> Either Text UTCTime
$sel:slotToUTCTime:TimeHandle :: TimeHandle -> SlotNo -> Either Text UTCTime
slotToUTCTime, UTCTime -> Either Text SlotNo
slotFromUTCTime :: UTCTime -> Either Text SlotNo
$sel:slotFromUTCTime:TimeHandle :: TimeHandle -> UTCTime -> Either Text SlotNo
slotFromUTCTime} ->
      let onLeft :: a -> Property
onLeft a
err = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Conversion failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. ToString a => a -> String
toString a
err)
       in (Text -> Property)
-> (Property -> Property) -> Either Text Property -> Property
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Property
forall {a}. ToString a => a -> Property
onLeft Property -> Property
forall a. a -> a
id (Either Text Property -> Property)
-> Either Text Property -> Property
forall a b. (a -> b) -> a -> b
$ do
            (SlotNo
slot, UTCTime
_) <- Either Text PointInTime
currentPointInTime
            SlotNo
res <- UTCTime -> Either Text SlotNo
slotFromUTCTime (UTCTime -> Either Text SlotNo)
-> Either Text UTCTime -> Either Text SlotNo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SlotNo -> Either Text UTCTime
slotToUTCTime SlotNo
slot
            Property -> Either Text Property
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> Either Text Property)
-> Property -> Either Text Property
forall a b. (a -> b) -> a -> b
$ SlotNo
res SlotNo -> SlotNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SlotNo
slot

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should convert slot within latest/current era" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let currentSlotNo :: SlotNo
currentSlotNo = Word64 -> SlotNo
SlotNo Word64
13
        systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
        eraHistory :: EraHistory
eraHistory = SlotNo -> EraHistory
eraHistoryWithHorizonAt SlotNo
15
        timeHandle :: TimeHandle
timeHandle = HasCallStack => SlotNo -> SystemStart -> EraHistory -> TimeHandle
SlotNo -> SystemStart -> EraHistory -> TimeHandle
mkTimeHandle SlotNo
currentSlotNo SystemStart
systemStart EraHistory
eraHistory
        slotInside :: SlotNo
slotInside = Word64 -> SlotNo
SlotNo Word64
14
        converted :: Either Text UTCTime
converted = TimeHandle -> SlotNo -> Either Text UTCTime
slotToUTCTime TimeHandle
timeHandle SlotNo
slotInside
        expected :: Either a UTCTime
expected = UTCTime -> Either a UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either a UTCTime) -> UTCTime -> Either a UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
14
    Either Text UTCTime
converted Either Text UTCTime -> Either Text UTCTime -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Either Text UTCTime
forall {a}. Either a UTCTime
expected