module Signet.Unstable.Type.TimestampTest where

import qualified Control.Monad.Catch as Exception
import qualified Data.ByteString.Char8 as Ascii
import qualified Data.Time as Time
import qualified Heck as Test
import qualified Signet.Unstable.Exception.InvalidTimestamp as InvalidTimestamp
import qualified Signet.Unstable.Extra.Either as Either
import qualified Signet.Unstable.Type.Timestamp as Timestamp

spec :: (Exception.MonadThrow io, Monad tree) => Test.Test io tree -> tree ()
spec :: forall (io :: * -> *) (tree :: * -> *).
(MonadThrow io, Monad tree) =>
Test io tree -> tree ()
spec Test io tree
test = Test io tree -> String -> tree () -> tree ()
forall (m :: * -> *) (n :: * -> *).
Test m n -> String -> n () -> n ()
Test.describe Test io tree
test String
"Signet.Unstable.Type.Timestamp" (tree () -> tree ()) -> tree () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
  Test io tree -> String -> tree () -> tree ()
forall (m :: * -> *) (n :: * -> *).
Test m n -> String -> n () -> n ()
Test.describe Test io tree
test String
"parse" (tree () -> tree ()) -> tree () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
    Test io tree -> String -> io () -> tree ()
forall (m :: * -> *) (n :: * -> *).
Test m n -> String -> m () -> n ()
Test.it Test io tree
test String
"fails with invalid timestamp format" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let byteString :: ByteString
byteString = String -> ByteString
Ascii.pack String
"invalid-timestamp"
      let result :: Either InvalidTimestamp Timestamp
result = ByteString -> Either InvalidTimestamp Timestamp
Timestamp.parse ByteString
byteString
      Test io tree
-> Either InvalidTimestamp Timestamp
-> Either InvalidTimestamp Timestamp
-> io ()
forall (m :: * -> *) a (n :: * -> *).
(HasCallStack, Applicative m, Eq a, Show a) =>
Test m n -> a -> a -> m ()
Test.assertEq Test io tree
test Either InvalidTimestamp Timestamp
result (InvalidTimestamp -> Either InvalidTimestamp Timestamp
forall a b. a -> Either a b
Left (ByteString -> InvalidTimestamp
InvalidTimestamp.MkInvalidTimestamp ByteString
byteString))

    Test io tree -> String -> io () -> tree ()
forall (m :: * -> *) (n :: * -> *).
Test m n -> String -> m () -> n ()
Test.it Test io tree
test String
"succeeds with valid timestamp format" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let byteString :: ByteString
byteString = String -> ByteString
Ascii.pack String
"1617235200"
      let result :: Either InvalidTimestamp Timestamp
result = ByteString -> Either InvalidTimestamp Timestamp
Timestamp.parse ByteString
byteString
      timestamp <- Either InvalidTimestamp Timestamp -> io Timestamp
forall e (m :: * -> *) a.
(Exception e, MonadThrow m) =>
Either e a -> m a
Either.throw Either InvalidTimestamp Timestamp
result
      let utcTime = Timestamp -> UTCTime
Timestamp.unwrap Timestamp
timestamp
      let expectedTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Year -> MonthOfYear -> MonthOfYear -> Day
Time.fromGregorian Year
2021 MonthOfYear
4 MonthOfYear
1) DiffTime
0
      Test.assertEq test utcTime expectedTime

  Test io tree -> String -> tree () -> tree ()
forall (m :: * -> *) (n :: * -> *).
Test m n -> String -> n () -> n ()
Test.describe Test io tree
test String
"render" (tree () -> tree ()) -> tree () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
    Test io tree -> String -> io () -> tree ()
forall (m :: * -> *) (n :: * -> *).
Test m n -> String -> m () -> n ()
Test.it Test io tree
test String
"returns the correct ByteString representation" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let utcTime :: UTCTime
utcTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Year -> MonthOfYear -> MonthOfYear -> Day
Time.fromGregorian Year
2021 MonthOfYear
4 MonthOfYear
1) DiffTime
0
      let timestamp :: Timestamp
timestamp = UTCTime -> Timestamp
Timestamp.MkTimestamp UTCTime
utcTime
      let expected :: ByteString
expected = String -> ByteString
Ascii.pack String
"1617235200"
      Test io tree -> ByteString -> ByteString -> io ()
forall (m :: * -> *) a (n :: * -> *).
(HasCallStack, Applicative m, Eq a, Show a) =>
Test m n -> a -> a -> m ()
Test.assertEq Test io tree
test (Timestamp -> ByteString
Timestamp.render Timestamp
timestamp) ByteString
expected