module Signet.Unstable.Type.ToleranceTest where

import qualified Data.Time as Time
import qualified Signet.Unstable.Exception.ToleranceException as ToleranceException
import qualified Signet.Unstable.Type.Test as Test
import qualified Signet.Unstable.Type.Timestamp as Timestamp
import qualified Signet.Unstable.Type.Tolerance as Tolerance

spec :: (Applicative io, Monad tree) => Test.Test io tree -> tree ()
spec :: forall (io :: * -> *) (tree :: * -> *).
(Applicative io, Monad tree) =>
Test io tree -> tree ()
spec Test io tree
test = Test io tree -> String -> tree () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> tree () -> tree ()
Test.describe Test io tree
test String
"Signet.Unstable.Type.Tolerance" (tree () -> tree ()) -> tree () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
  Test io tree -> String -> tree () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> tree () -> tree ()
Test.describe Test io tree
test String
"check" (tree () -> tree ()) -> tree () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
    Test io tree -> String -> io () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> io () -> tree ()
Test.it Test io tree
test String
"succeeds when timestamp is within tolerance" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let tolerance :: Tolerance
tolerance = NominalDiffTime -> Tolerance
Tolerance.MkTolerance NominalDiffTime
1
      let utcTime :: UTCTime
utcTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> MonthOfYear -> MonthOfYear -> Day
Time.fromGregorian Integer
2001 MonthOfYear
1 MonthOfYear
1) DiffTime
60
      let timestamp :: Timestamp
timestamp = UTCTime -> Timestamp
Timestamp.MkTimestamp UTCTime
utcTime
      let result :: Either ToleranceException ()
result = Tolerance -> UTCTime -> Timestamp -> Either ToleranceException ()
Tolerance.check Tolerance
tolerance UTCTime
utcTime Timestamp
timestamp
      Test io tree
-> Either ToleranceException ()
-> Either ToleranceException ()
-> io ()
forall (io :: * -> *) a (tree :: * -> *).
(HasCallStack, Applicative io, Eq a, Show a) =>
Test io tree -> a -> a -> io ()
Test.assertEq Test io tree
test Either ToleranceException ()
result (() -> Either ToleranceException ()
forall a b. b -> Either a b
Right ())

    Test io tree -> String -> io () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> io () -> tree ()
Test.it Test io tree
test String
"fails when timestamp is too old" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let tolerance :: Tolerance
tolerance = NominalDiffTime -> Tolerance
Tolerance.MkTolerance NominalDiffTime
1
      let utcTime :: UTCTime
utcTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> MonthOfYear -> MonthOfYear -> Day
Time.fromGregorian Integer
2001 MonthOfYear
1 MonthOfYear
1) DiffTime
60
      let timestamp :: Timestamp
timestamp = UTCTime -> Timestamp
Timestamp.MkTimestamp UTCTime
utcTime
      let now :: UTCTime
now = NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime NominalDiffTime
2 UTCTime
utcTime
      let result :: Either ToleranceException ()
result = Tolerance -> UTCTime -> Timestamp -> Either ToleranceException ()
Tolerance.check Tolerance
tolerance UTCTime
now Timestamp
timestamp
      Test io tree
-> Either ToleranceException ()
-> Either ToleranceException ()
-> io ()
forall (io :: * -> *) a (tree :: * -> *).
(HasCallStack, Applicative io, Eq a, Show a) =>
Test io tree -> a -> a -> io ()
Test.assertEq Test io tree
test Either ToleranceException ()
result (ToleranceException -> Either ToleranceException ()
forall a b. a -> Either a b
Left (Timestamp -> ToleranceException
ToleranceException.MkToleranceException Timestamp
timestamp))

    Test io tree -> String -> io () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> io () -> tree ()
Test.it Test io tree
test String
"fails when timestamp is in the future" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let tolerance :: Tolerance
tolerance = NominalDiffTime -> Tolerance
Tolerance.MkTolerance NominalDiffTime
1
      let utcTime :: UTCTime
utcTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> MonthOfYear -> MonthOfYear -> Day
Time.fromGregorian Integer
2001 MonthOfYear
1 MonthOfYear
1) DiffTime
60
      let timestamp :: Timestamp
timestamp = UTCTime -> Timestamp
Timestamp.MkTimestamp UTCTime
utcTime
      let now :: UTCTime
now = NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime (-NominalDiffTime
2) UTCTime
utcTime
      let result :: Either ToleranceException ()
result = Tolerance -> UTCTime -> Timestamp -> Either ToleranceException ()
Tolerance.check Tolerance
tolerance UTCTime
now Timestamp
timestamp
      Test io tree
-> Either ToleranceException ()
-> Either ToleranceException ()
-> io ()
forall (io :: * -> *) a (tree :: * -> *).
(HasCallStack, Applicative io, Eq a, Show a) =>
Test io tree -> a -> a -> io ()
Test.assertEq Test io tree
test Either ToleranceException ()
result (ToleranceException -> Either ToleranceException ()
forall a b. a -> Either a b
Left (Timestamp -> ToleranceException
ToleranceException.MkToleranceException Timestamp
timestamp))