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==")