module Signet.Unstable.Type.MessageTest where

import qualified Control.Monad.Catch as Exception
import qualified Data.ByteString.Char8 as Ascii
import qualified Signet.Unstable.Exception.InvalidMessage as InvalidMessage
import qualified Signet.Unstable.Exception.InvalidTimestamp as InvalidTimestamp
import qualified Signet.Unstable.Extra.Either as Either
import qualified Signet.Unstable.Type.Id as Id
import qualified Signet.Unstable.Type.Message as Message
import qualified Signet.Unstable.Type.Payload as Payload
import qualified Signet.Unstable.Type.Test as Test
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 (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> tree () -> tree ()
Test.describe Test io tree
test String
"Signet.Unstable.Type.Message" (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
"parse" (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
"fails with invalid timestamp" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let timestamp :: ByteString
timestamp = String -> ByteString
Ascii.pack String
"invalid"
      let byteString :: ByteString
byteString = String -> ByteString
Ascii.pack String
"i." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
timestamp ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
Ascii.pack String
".p"
      let result :: Either InvalidMessage Message
result = ByteString -> Either InvalidMessage Message
Message.parse ByteString
byteString
      Test io tree
-> Either InvalidMessage Message
-> Either InvalidMessage Message
-> 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 InvalidMessage Message
result (InvalidMessage -> Either InvalidMessage Message
forall a b. a -> Either a b
Left (InvalidTimestamp -> InvalidMessage
InvalidMessage.InvalidTimestamp (InvalidTimestamp -> InvalidMessage)
-> InvalidTimestamp -> InvalidMessage
forall a b. (a -> b) -> a -> b
$ ByteString -> InvalidTimestamp
InvalidTimestamp.MkInvalidTimestamp ByteString
timestamp))

    Test io tree -> String -> io () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> io () -> tree ()
Test.it Test io tree
test String
"succeeds with valid input" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let result :: Either InvalidMessage Message
result = ByteString -> Either InvalidMessage Message
Message.parse (ByteString -> Either InvalidMessage Message)
-> ByteString -> Either InvalidMessage Message
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"i.0.p"
      id_ <- Either InvalidId Id -> io Id
forall e (m :: * -> *) a.
(Exception e, MonadThrow m) =>
Either e a -> m a
Either.throw (Either InvalidId Id -> io Id)
-> (ByteString -> Either InvalidId Id) -> ByteString -> io Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either InvalidId Id
Id.parse (ByteString -> io Id) -> ByteString -> io Id
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"i"
      timestamp <- Either.throw . Timestamp.parse $ Ascii.pack "0"
      let payload = ByteString -> Payload
Payload.MkPayload (ByteString -> Payload) -> ByteString -> Payload
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"p"
      Test.assertEq
        test
        result
        ( Right
            Message.MkMessage
              { Message.id_ = id_,
                Message.timestamp = timestamp,
                Message.payload = payload
              }
        )

  Test io tree -> String -> tree () -> tree ()
forall (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> tree () -> tree ()
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 (io :: * -> *) (tree :: * -> *).
Test io tree -> String -> io () -> tree ()
Test.it Test io tree
test String
"returns the correct ByteString representation" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      id_ <- Either InvalidId Id -> io Id
forall e (m :: * -> *) a.
(Exception e, MonadThrow m) =>
Either e a -> m a
Either.throw (Either InvalidId Id -> io Id)
-> (ByteString -> Either InvalidId Id) -> ByteString -> io Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either InvalidId Id
Id.parse (ByteString -> io Id) -> ByteString -> io Id
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"i"
      timestamp <- Either.throw . Timestamp.parse $ Ascii.pack "0"
      let payload = ByteString -> Payload
Payload.MkPayload (ByteString -> Payload) -> ByteString -> Payload
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"p"
      let message =
            Message.MkMessage
              { id_ :: Id
Message.id_ = Id
id_,
                timestamp :: Timestamp
Message.timestamp = Timestamp
timestamp,
                payload :: Payload
Message.payload = Payload
payload
              }
      Test.assertEq test (Message.render message) (Ascii.pack "i.0.p")