-- A facade for working with secrets and their representations, without delving
-- into cryptography libraries.
module Cachix.Client.Secrets
  ( -- * NAR signing
    SigningKey (..),
    parseSigningKeyLenient,
    exportSigningKey,
  )
where

-- TODO: * Auth token
import Crypto.Sign.Ed25519
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import Data.Char (isSpace)
import Protolude

-- | A secret key for signing nars.
newtype SigningKey = SigningKey {SigningKey -> SecretKey
signingSecretKey :: SecretKey}

parseSigningKeyLenientBS ::
  -- | ASCII (Base64)
  ByteString ->
  -- | Error message or signing key
  Either Text SigningKey
parseSigningKeyLenientBS :: ByteString -> Either Text SigningKey
parseSigningKeyLenientBS raw :: ByteString
raw =
  let bcDropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
bcDropWhileEnd f :: Char -> Bool
f = ByteString -> ByteString
BC.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BC.dropWhile Char -> Bool
f (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BC.reverse
      bcDropAround :: (Char -> Bool) -> ByteString -> ByteString
bcDropAround f :: Char -> Bool
f = (Char -> Bool) -> ByteString -> ByteString
bcDropWhileEnd Char -> Bool
f (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BC.dropWhile Char -> Bool
f
      stripped :: ByteString
stripped = (Char -> Bool) -> ByteString -> ByteString
bcDropAround Char -> Bool
isSpace ByteString
raw
      nonNull :: Either Text ByteString
nonNull = if ByteString -> Bool
BC.null ByteString
stripped then Text -> Either Text ByteString
forall a b. a -> Either a b
Left "A signing key must not be empty" else ByteString -> Either Text ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
stripped
   in SecretKey -> SigningKey
SigningKey (SecretKey -> SigningKey)
-> (ByteString -> SecretKey) -> ByteString -> SigningKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
SecretKey (ByteString -> SecretKey)
-> (ByteString -> ByteString) -> ByteString -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.decodeLenient (ByteString -> SigningKey)
-> Either Text ByteString -> Either Text SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text ByteString
nonNull

parseSigningKeyLenient ::
  -- | Base64
  Text ->
  -- | Error message or signing key
  Either Text SigningKey
parseSigningKeyLenient :: Text -> Either Text SigningKey
parseSigningKeyLenient = ByteString -> Either Text SigningKey
parseSigningKeyLenientBS (ByteString -> Either Text SigningKey)
-> (Text -> ByteString) -> Text -> Either Text SigningKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. StringConv a b => a -> b
toSL

exportSigningKeyBS ::
  SigningKey ->
  -- | ASCII (Base64)
  ByteString
exportSigningKeyBS :: SigningKey -> ByteString
exportSigningKeyBS (SigningKey (SecretKey bs :: ByteString
bs)) = ByteString -> ByteString
B64.encode ByteString
bs

exportSigningKey :: SigningKey -> Text
exportSigningKey :: SigningKey -> Text
exportSigningKey = ByteString -> Text
forall a b. StringConv a b => a -> b
toS (ByteString -> Text)
-> (SigningKey -> ByteString) -> SigningKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey -> ByteString
exportSigningKeyBS