module Hydra.Ledger.Cardano.TimeSpec where

import Hydra.Prelude

import Cardano.Slotting.Slot (SlotNo (..))
import Cardano.Slotting.Time (SlotLength, SystemStart (..), slotLengthFromMillisec)
import Data.Fixed (Milli)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime, slotNoToUTCTime)
import Test.Hspec (Spec)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (classify, forAll, getPositive, (===))

spec :: Spec
spec :: Spec
spec = do
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"roundtrip slotNoToUTCTime and slotNoFromUTCTime" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen SystemStart -> (SystemStart -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen SystemStart
genSystemStart ((SystemStart -> Property) -> Property)
-> (SystemStart -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \SystemStart
systemStart ->
      Gen SlotLength -> (SlotLength -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen SlotLength
genSlotLength ((SlotLength -> Property) -> Property)
-> (SlotLength -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \SlotLength
slotLength ->
        Gen SlotNo -> (SlotNo -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Word64 -> SlotNo
SlotNo (Word64 -> SlotNo)
-> (Positive Word64 -> Word64) -> Positive Word64 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Word64 -> Word64
forall a. Positive a -> a
getPositive (Positive Word64 -> SlotNo) -> Gen (Positive Word64) -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary) ((SlotNo -> Property) -> Property)
-> (SlotNo -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \SlotNo
slot ->
          SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime SystemStart
systemStart SlotLength
slotLength (SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
slot) SlotNo -> SlotNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SlotNo
slot

  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"slotNoFromUTCTime works for any time" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen SystemStart -> (SystemStart -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen SystemStart
genSystemStart ((SystemStart -> Property) -> Property)
-> (SystemStart -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \SystemStart
systemStart ->
      Gen SlotLength -> (SlotLength -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen SlotLength
genSlotLength ((SlotLength -> Property) -> Property)
-> (SlotLength -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \SlotLength
slotLength ->
        Gen UTCTime -> (UTCTime -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen UTCTime
genUTCTime ((UTCTime -> Property) -> Property)
-> (UTCTime -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \UTCTime
t ->
          SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime SystemStart
systemStart SlotLength
slotLength UTCTime
t SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> SlotNo
SlotNo Word64
0
            Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Bool -> String -> Bool -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> SystemStart -> UTCTime
getSystemStart SystemStart
systemStart) String
"after system start"
            Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== SystemStart -> UTCTime
getSystemStart SystemStart
systemStart) String
"equal to system start"
            Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< SystemStart -> UTCTime
getSystemStart SystemStart
systemStart) String
"before system start"

-- | Generate a UTCTime using millisecond precision time since epoch.
genUTCTime :: Gen UTCTime
genUTCTime :: Gen UTCTime
genUTCTime =
  POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (Milli -> POSIXTime) -> Milli -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milli -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Milli -> UTCTime) -> Gen Milli -> Gen UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen Milli
forall a. Arbitrary a => Gen a
arbitrary :: Gen Milli)

genSlotLength :: Gen SlotLength
genSlotLength :: Gen SlotLength
genSlotLength =
  Integer -> SlotLength
slotLengthFromMillisec (Integer -> SlotLength)
-> (Positive Integer -> Integer) -> Positive Integer -> SlotLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> SlotLength)
-> Gen (Positive Integer) -> Gen SlotLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary

genSystemStart :: Gen SystemStart
genSystemStart :: Gen SystemStart
genSystemStart =
  UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> Gen UTCTime -> Gen SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTCTime
genUTCTime