module Test.Cardano.Slotting.EpochInfo where

import Cardano.Slotting.EpochInfo.API (EpochInfo (..))
import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo)
import Cardano.Slotting.EpochInfo.Impl (fixedEpochInfo)
import Cardano.Slotting.Slot (EpochNo (EpochNo), EpochSize (EpochSize), SlotNo (SlotNo))
import Cardano.Slotting.Time (slotLengthFromSec)
import Data.Functor.Identity (Identity)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck as QC (
  Arbitrary (arbitrary),
  choose,
  testProperty,
  (===),
 )

baseEpochInfo :: EpochInfo Identity
baseEpochInfo :: EpochInfo Identity
baseEpochInfo = EpochSize -> SlotLength -> EpochInfo Identity
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
10) (Integer -> SlotLength
slotLengthFromSec Integer
10)

-- An extended epoch info from a fixedEpochInfo should act as identity.
extendedEpochInfo :: SlotNo -> EpochInfo Identity
extendedEpochInfo :: SlotNo -> EpochInfo Identity
extendedEpochInfo SlotNo
sn = SlotNo -> EpochInfo Identity -> EpochInfo Identity
forall (m :: * -> *).
Monad m =>
SlotNo -> EpochInfo m -> EpochInfo m
unsafeLinearExtendEpochInfo SlotNo
sn EpochInfo Identity
baseEpochInfo

newtype TestSlotNo = TestSlotNo SlotNo
  deriving (TestSlotNo -> TestSlotNo -> Bool
(TestSlotNo -> TestSlotNo -> Bool)
-> (TestSlotNo -> TestSlotNo -> Bool) -> Eq TestSlotNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestSlotNo -> TestSlotNo -> Bool
== :: TestSlotNo -> TestSlotNo -> Bool
$c/= :: TestSlotNo -> TestSlotNo -> Bool
/= :: TestSlotNo -> TestSlotNo -> Bool
Eq, Int -> TestSlotNo -> ShowS
[TestSlotNo] -> ShowS
TestSlotNo -> String
(Int -> TestSlotNo -> ShowS)
-> (TestSlotNo -> String)
-> ([TestSlotNo] -> ShowS)
-> Show TestSlotNo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestSlotNo -> ShowS
showsPrec :: Int -> TestSlotNo -> ShowS
$cshow :: TestSlotNo -> String
show :: TestSlotNo -> String
$cshowList :: [TestSlotNo] -> ShowS
showList :: [TestSlotNo] -> ShowS
Show)

instance Arbitrary TestSlotNo where
  arbitrary :: Gen TestSlotNo
arbitrary = SlotNo -> TestSlotNo
TestSlotNo (SlotNo -> TestSlotNo)
-> (Word64 -> SlotNo) -> Word64 -> TestSlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo (Word64 -> TestSlotNo) -> Gen Word64 -> Gen TestSlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
200)

newtype TestEpochNo = TestEpochNo EpochNo
  deriving (TestEpochNo -> TestEpochNo -> Bool
(TestEpochNo -> TestEpochNo -> Bool)
-> (TestEpochNo -> TestEpochNo -> Bool) -> Eq TestEpochNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestEpochNo -> TestEpochNo -> Bool
== :: TestEpochNo -> TestEpochNo -> Bool
$c/= :: TestEpochNo -> TestEpochNo -> Bool
/= :: TestEpochNo -> TestEpochNo -> Bool
Eq, Int -> TestEpochNo -> ShowS
[TestEpochNo] -> ShowS
TestEpochNo -> String
(Int -> TestEpochNo -> ShowS)
-> (TestEpochNo -> String)
-> ([TestEpochNo] -> ShowS)
-> Show TestEpochNo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestEpochNo -> ShowS
showsPrec :: Int -> TestEpochNo -> ShowS
$cshow :: TestEpochNo -> String
show :: TestEpochNo -> String
$cshowList :: [TestEpochNo] -> ShowS
showList :: [TestEpochNo] -> ShowS
Show)

instance Arbitrary TestEpochNo where
  arbitrary :: Gen TestEpochNo
arbitrary = EpochNo -> TestEpochNo
TestEpochNo (EpochNo -> TestEpochNo)
-> (Word64 -> EpochNo) -> Word64 -> TestEpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochNo
EpochNo (Word64 -> TestEpochNo) -> Gen Word64 -> Gen TestEpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
20)

epochInfoTests :: TestTree
epochInfoTests :: TestTree
epochInfoTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"linearExtend"
    [ String -> ((TestSlotNo, TestEpochNo) -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
QC.testProperty String
"epochSize matches" (((TestSlotNo, TestEpochNo) -> Property) -> TestTree)
-> ((TestSlotNo, TestEpochNo) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(TestSlotNo SlotNo
basisSlot, TestEpochNo EpochNo
sn) ->
        EpochInfo Identity -> HasCallStack => EpochNo -> Identity EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo Identity
baseEpochInfo EpochNo
sn Identity EpochSize -> Identity EpochSize -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochInfo Identity -> HasCallStack => EpochNo -> Identity EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ (SlotNo -> EpochInfo Identity
extendedEpochInfo SlotNo
basisSlot) EpochNo
sn
    , String -> ((TestSlotNo, TestEpochNo) -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
QC.testProperty String
"epochFirst matches" (((TestSlotNo, TestEpochNo) -> Property) -> TestTree)
-> ((TestSlotNo, TestEpochNo) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(TestSlotNo SlotNo
basisSlot, TestEpochNo EpochNo
sn) ->
        EpochInfo Identity -> HasCallStack => EpochNo -> Identity SlotNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo Identity
baseEpochInfo EpochNo
sn Identity SlotNo -> Identity SlotNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochInfo Identity -> HasCallStack => EpochNo -> Identity SlotNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ (SlotNo -> EpochInfo Identity
extendedEpochInfo SlotNo
basisSlot) EpochNo
sn
    , String -> ((TestSlotNo, TestSlotNo) -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
QC.testProperty String
"epochEpoch matches" (((TestSlotNo, TestSlotNo) -> Property) -> TestTree)
-> ((TestSlotNo, TestSlotNo) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(TestSlotNo SlotNo
basisSlot, TestSlotNo SlotNo
sn) ->
        EpochInfo Identity -> HasCallStack => SlotNo -> Identity EpochNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_ EpochInfo Identity
baseEpochInfo SlotNo
sn Identity EpochNo -> Identity EpochNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochInfo Identity -> HasCallStack => SlotNo -> Identity EpochNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_ (SlotNo -> EpochInfo Identity
extendedEpochInfo SlotNo
basisSlot) SlotNo
sn
    , String -> ((TestSlotNo, TestSlotNo) -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
QC.testProperty String
"epochTime matches" (((TestSlotNo, TestSlotNo) -> Property) -> TestTree)
-> ((TestSlotNo, TestSlotNo) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(TestSlotNo SlotNo
basisSlot, TestSlotNo SlotNo
sn) ->
        EpochInfo Identity
-> HasCallStack => SlotNo -> Identity RelativeTime
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ EpochInfo Identity
baseEpochInfo SlotNo
sn
          Identity RelativeTime -> Identity RelativeTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochInfo Identity
-> HasCallStack => SlotNo -> Identity RelativeTime
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ (SlotNo -> EpochInfo Identity
extendedEpochInfo SlotNo
basisSlot) SlotNo
sn
    ]