module Signet.Unstable.Type.Secret where

import qualified Data.ByteArray as ByteArray
import qualified Data.ByteArray.Encoding as Encoding
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Ascii
import qualified Signet.Unstable.Exception.InvalidSecret as InvalidSecret
import qualified Signet.Unstable.Extra.Either as Either
import qualified Signet.Unstable.Extra.Maybe as Maybe

newtype Secret
  = MkSecret ByteArray.ScrubbedBytes
  deriving (Secret -> Secret -> Bool
(Secret -> Secret -> Bool)
-> (Secret -> Secret -> Bool) -> Eq Secret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Secret -> Secret -> Bool
== :: Secret -> Secret -> Bool
$c/= :: Secret -> Secret -> Bool
/= :: Secret -> Secret -> Bool
Eq, Int -> Secret -> ShowS
[Secret] -> ShowS
Secret -> String
(Int -> Secret -> ShowS)
-> (Secret -> String) -> ([Secret] -> ShowS) -> Show Secret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Secret -> ShowS
showsPrec :: Int -> Secret -> ShowS
$cshow :: Secret -> String
show :: Secret -> String
$cshowList :: [Secret] -> ShowS
showList :: [Secret] -> ShowS
Show)

unwrap :: Secret -> ByteArray.ScrubbedBytes
unwrap :: Secret -> ScrubbedBytes
unwrap (MkSecret ScrubbedBytes
scrubbedBytes) = ScrubbedBytes
scrubbedBytes

prefix :: ByteString.ByteString
prefix :: ByteString
prefix = String -> ByteString
Ascii.pack String
"whsec_"

parse :: ByteString.ByteString -> Either InvalidSecret.InvalidSecret Secret
parse :: ByteString -> Either InvalidSecret Secret
parse ByteString
prefixed = InvalidSecret -> Maybe Secret -> Either InvalidSecret Secret
forall e a. e -> Maybe a -> Either e a
Maybe.note (ByteString -> InvalidSecret
InvalidSecret.MkInvalidSecret ByteString
prefixed) (Maybe Secret -> Either InvalidSecret Secret)
-> Maybe Secret -> Either InvalidSecret Secret
forall a b. (a -> b) -> a -> b
$ do
  encoded <- ByteString -> ByteString -> Maybe ByteString
ByteString.stripPrefix ByteString
prefix ByteString
prefixed
  fmap MkSecret . Either.hush $ Encoding.convertFromBase Encoding.Base64 encoded

render :: Secret -> ByteString.ByteString
render :: Secret -> ByteString
render = ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
prefix (ByteString -> ByteString)
-> (Secret -> ByteString) -> Secret -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
Encoding.convertToBase Base
Encoding.Base64 (ScrubbedBytes -> ByteString)
-> (Secret -> ScrubbedBytes) -> Secret -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Secret -> ScrubbedBytes
unwrap