module Signet.Unstable.Type.SecretTest where

import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString.Char8 as Ascii
import qualified Signet.Unstable.Exception.InvalidSecret as InvalidSecret
import qualified Signet.Unstable.Type.Secret as Secret
import qualified Signet.Unstable.Type.Test as Test

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.Secret" (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 prefix" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let byteString :: ByteString
byteString = String -> ByteString
Ascii.pack String
"invalid"
      let result :: Either InvalidSecret Secret
result = ByteString -> Either InvalidSecret Secret
Secret.parse ByteString
byteString
      Test io tree
-> Either InvalidSecret Secret
-> Either InvalidSecret Secret
-> 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 InvalidSecret Secret
result (InvalidSecret -> Either InvalidSecret Secret
forall a b. a -> Either a b
Left (ByteString -> InvalidSecret
InvalidSecret.MkInvalidSecret ByteString
byteString))

    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 input" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let byteString :: ByteString
byteString = String -> ByteString
Ascii.pack String
"whsec_invalid"
      let result :: Either InvalidSecret Secret
result = ByteString -> Either InvalidSecret Secret
Secret.parse ByteString
byteString
      Test io tree
-> Either InvalidSecret Secret
-> Either InvalidSecret Secret
-> 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 InvalidSecret Secret
result (InvalidSecret -> Either InvalidSecret Secret
forall a b. a -> Either a b
Left (ByteString -> InvalidSecret
InvalidSecret.MkInvalidSecret ByteString
byteString))

    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 InvalidSecret Secret
result = ByteString -> Either InvalidSecret Secret
Secret.parse (ByteString -> Either InvalidSecret Secret)
-> ByteString -> Either InvalidSecret Secret
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"whsec_MDEyMzQ1Njc4OQ=="
      let secret :: Secret
secret = ScrubbedBytes -> Secret
Secret.MkSecret (ScrubbedBytes -> Secret)
-> (ByteString -> ScrubbedBytes) -> ByteString -> Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> Secret) -> ByteString -> Secret
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"0123456789"
      Test io tree
-> Either InvalidSecret Secret
-> Either InvalidSecret Secret
-> 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 InvalidSecret Secret
result (Secret -> Either InvalidSecret Secret
forall a b. b -> Either a b
Right Secret
secret)

  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
"works" (io () -> tree ()) -> io () -> tree ()
forall a b. (a -> b) -> a -> b
$ do
      let secret :: Secret
secret = ScrubbedBytes -> Secret
Secret.MkSecret (ScrubbedBytes -> Secret)
-> (ByteString -> ScrubbedBytes) -> ByteString -> Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> Secret) -> ByteString -> Secret
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.pack String
"0123456789"
      Test io tree -> ByteString -> ByteString -> io ()
forall (io :: * -> *) a (tree :: * -> *).
(HasCallStack, Applicative io, Eq a, Show a) =>
Test io tree -> a -> a -> io ()
Test.assertEq Test io tree
test (Secret -> ByteString
Secret.render Secret
secret) (String -> ByteString
Ascii.pack String
"whsec_MDEyMzQ1Njc4OQ==")