module Signet.Unstable.Type.SecretKey where

import qualified Crypto.Error as Error
import qualified Crypto.PubKey.Ed25519 as Ed25519
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.InvalidSecretKey as InvalidSecretKey
import qualified Signet.Unstable.Extra.Either as Either
import qualified Signet.Unstable.Extra.Maybe as Maybe

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

unwrap :: SecretKey -> Ed25519.SecretKey
unwrap :: SecretKey -> SecretKey
unwrap (MkSecretKey SecretKey
secretKey) = SecretKey
secretKey

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

parse :: ByteString.ByteString -> Either InvalidSecretKey.InvalidSecretKey SecretKey
parse :: ByteString -> Either InvalidSecretKey SecretKey
parse ByteString
prefixed = InvalidSecretKey
-> Maybe SecretKey -> Either InvalidSecretKey SecretKey
forall e a. e -> Maybe a -> Either e a
Maybe.note (ByteString -> InvalidSecretKey
InvalidSecretKey.MkInvalidSecretKey ByteString
prefixed) (Maybe SecretKey -> Either InvalidSecretKey SecretKey)
-> Maybe SecretKey -> Either InvalidSecretKey SecretKey
forall a b. (a -> b) -> a -> b
$ do
  encoded <- ByteString -> ByteString -> Maybe ByteString
ByteString.stripPrefix ByteString
prefix ByteString
prefixed
  byteString <- Either.hush $ Encoding.convertFromBase Encoding.Base64 encoded
  fmap MkSecretKey
    . Error.maybeCryptoError
    $ Ed25519.secretKey (byteString :: ByteString.ByteString)

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