{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

-- | age cryptographic keys.
module Crypto.Age.Key
  ( -- * File key
    FileKey (FileKey)
  , bytesToFileKey
  , fileKeyToBytes
  , generateFileKey

    -- * Payload key nonce
  , PayloadKeyNonce (PayloadKeyNonce)
  , bytesToPayloadKeyNonce
  , payloadKeyNonceToBytes
  , generatePayloadKeyNonce
  , payloadKeyNonceBuilder
  , payloadKeyNonceParser

    -- * Payload key
  , PayloadKey (PayloadKey)
  , bytesToPayloadKey
  , payloadKeyToBytes
  , mkPayloadKey
  ) where

import qualified Crypto.Hash as Crypto
import qualified Crypto.KDF.HKDF as Crypto
import qualified Crypto.Random as Crypto
import Data.Attoparsec.ByteString ( Parser, take )
import Data.ByteArray ( ScrubbedBytes )
import qualified Data.ByteArray as BA
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import Data.ByteString.Builder ( Builder )
import qualified Data.ByteString.Builder as Builder
import Prelude hiding ( take )

-- | Symmetric
-- [file key](https://github.com/C2SP/C2SP/blob/91935d7157cb3860351ffebbad1e6f6153e8efc8/age.md#file-key).
--
-- Note that this type's 'Eq' instance performs a constant-time equality check.
newtype FileKey = MkFileKey
  { FileKey -> ScrubbedBytes
unFileKey :: ScrubbedBytes }
  deriving newtype (FileKey -> FileKey -> Bool
(FileKey -> FileKey -> Bool)
-> (FileKey -> FileKey -> Bool) -> Eq FileKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileKey -> FileKey -> Bool
== :: FileKey -> FileKey -> Bool
$c/= :: FileKey -> FileKey -> Bool
/= :: FileKey -> FileKey -> Bool
Eq)

pattern FileKey :: ScrubbedBytes -> FileKey
pattern $mFileKey :: forall {r}. FileKey -> (ScrubbedBytes -> r) -> ((# #) -> r) -> r
FileKey bs <- MkFileKey bs

{-# COMPLETE FileKey #-}

-- | Construct a 'FileKey' from bytes.
--
-- If the provided byte string does not have a length of 16 (128 bits),
-- 'Nothing' is returned.
bytesToFileKey :: ScrubbedBytes -> Maybe FileKey
bytesToFileKey :: ScrubbedBytes -> Maybe FileKey
bytesToFileKey ScrubbedBytes
bs
  | ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = FileKey -> Maybe FileKey
forall a. a -> Maybe a
Just (ScrubbedBytes -> FileKey
MkFileKey ScrubbedBytes
bs)
  | Bool
otherwise = Maybe FileKey
forall a. Maybe a
Nothing

-- | Get the raw bytes associated with a 'FileKey'.
fileKeyToBytes :: FileKey -> ScrubbedBytes
fileKeyToBytes :: FileKey -> ScrubbedBytes
fileKeyToBytes = FileKey -> ScrubbedBytes
unFileKey

-- | Randomly generate a 'FileKey' as defined in the
-- [age specification](https://github.com/C2SP/C2SP/blob/91935d7157cb3860351ffebbad1e6f6153e8efc8/age.md#file-key).
generateFileKey :: IO FileKey
generateFileKey :: IO FileKey
generateFileKey = do
  ScrubbedBytes
bs <- Int -> IO ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
Crypto.getRandomBytes Int
16 :: IO ScrubbedBytes
  case ScrubbedBytes -> Maybe FileKey
bytesToFileKey ScrubbedBytes
bs of
    Just FileKey
x -> FileKey -> IO FileKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileKey
x
    Maybe FileKey
Nothing -> [Char] -> IO FileKey
forall a. HasCallStack => [Char] -> a
error [Char]
"generateFileKey: impossible: failed to randomly generate 16 bytes"

-- | Payload key nonce.
--
-- In accordance with the
-- [age specification](https://github.com/C2SP/C2SP/blob/34a9210873230d2acaa4a4c9c5d4d1119b2ee77d/age.md#payload),
-- this value is used as an extractor salt in the @HKDF-Extract@ step when
-- deriving a 'PayloadKey' with @HKDF-SHA256@.
newtype PayloadKeyNonce = MkPayloadKeyNonce
  { PayloadKeyNonce -> ByteString
unPayloadKeyNonce :: ByteString }
  deriving newtype (Int -> PayloadKeyNonce -> ShowS
[PayloadKeyNonce] -> ShowS
PayloadKeyNonce -> [Char]
(Int -> PayloadKeyNonce -> ShowS)
-> (PayloadKeyNonce -> [Char])
-> ([PayloadKeyNonce] -> ShowS)
-> Show PayloadKeyNonce
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadKeyNonce -> ShowS
showsPrec :: Int -> PayloadKeyNonce -> ShowS
$cshow :: PayloadKeyNonce -> [Char]
show :: PayloadKeyNonce -> [Char]
$cshowList :: [PayloadKeyNonce] -> ShowS
showList :: [PayloadKeyNonce] -> ShowS
Show, PayloadKeyNonce -> PayloadKeyNonce -> Bool
(PayloadKeyNonce -> PayloadKeyNonce -> Bool)
-> (PayloadKeyNonce -> PayloadKeyNonce -> Bool)
-> Eq PayloadKeyNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadKeyNonce -> PayloadKeyNonce -> Bool
== :: PayloadKeyNonce -> PayloadKeyNonce -> Bool
$c/= :: PayloadKeyNonce -> PayloadKeyNonce -> Bool
/= :: PayloadKeyNonce -> PayloadKeyNonce -> Bool
Eq)

pattern PayloadKeyNonce :: ByteString -> PayloadKeyNonce
pattern $mPayloadKeyNonce :: forall {r}.
PayloadKeyNonce -> (ByteString -> r) -> ((# #) -> r) -> r
PayloadKeyNonce bs <- MkPayloadKeyNonce bs

{-# COMPLETE PayloadKeyNonce #-}

-- | Construct a 'PayloadKeyNonce' from bytes.
--
-- If the provided byte string does not have a length of 16 (128 bits),
-- 'Nothing' is returned.
bytesToPayloadKeyNonce :: ByteString -> Maybe PayloadKeyNonce
bytesToPayloadKeyNonce :: ByteString -> Maybe PayloadKeyNonce
bytesToPayloadKeyNonce ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = PayloadKeyNonce -> Maybe PayloadKeyNonce
forall a. a -> Maybe a
Just (ByteString -> PayloadKeyNonce
MkPayloadKeyNonce ByteString
bs)
  | Bool
otherwise = Maybe PayloadKeyNonce
forall a. Maybe a
Nothing

-- | Get the raw bytes associated with a 'PayloadKeyNonce'.
payloadKeyNonceToBytes :: PayloadKeyNonce -> ByteString
payloadKeyNonceToBytes :: PayloadKeyNonce -> ByteString
payloadKeyNonceToBytes = PayloadKeyNonce -> ByteString
unPayloadKeyNonce

-- | Randomly generate a 'PayloadKeyNonce' as defined in the
-- [age specification](https://github.com/C2SP/C2SP/blob/34a9210873230d2acaa4a4c9c5d4d1119b2ee77d/age.md#payload).
generatePayloadKeyNonce :: IO PayloadKeyNonce
generatePayloadKeyNonce :: IO PayloadKeyNonce
generatePayloadKeyNonce = do
  ByteString
bs <- Int -> IO ByteString
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
Crypto.getRandomBytes Int
16 :: IO ByteString
  case ByteString -> Maybe PayloadKeyNonce
bytesToPayloadKeyNonce ByteString
bs of
    Just PayloadKeyNonce
x -> PayloadKeyNonce -> IO PayloadKeyNonce
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PayloadKeyNonce
x
    Maybe PayloadKeyNonce
Nothing -> [Char] -> IO PayloadKeyNonce
forall a. HasCallStack => [Char] -> a
error [Char]
"generatePayloadKeyNonce: impossible: failed to randomly generate 16 bytes"

-- | 'PayloadKeyNonce' encoder.
payloadKeyNonceBuilder :: PayloadKeyNonce -> Builder
payloadKeyNonceBuilder :: PayloadKeyNonce -> Builder
payloadKeyNonceBuilder = ByteString -> Builder
Builder.byteString (ByteString -> Builder)
-> (PayloadKeyNonce -> ByteString) -> PayloadKeyNonce -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PayloadKeyNonce -> ByteString
payloadKeyNonceToBytes

-- | 'PayloadKeyNonce' parser.
payloadKeyNonceParser :: Parser PayloadKeyNonce
payloadKeyNonceParser :: Parser PayloadKeyNonce
payloadKeyNonceParser = ByteString -> Maybe PayloadKeyNonce
bytesToPayloadKeyNonce (ByteString -> Maybe PayloadKeyNonce)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe PayloadKeyNonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
take Int
16 Parser ByteString (Maybe PayloadKeyNonce)
-> (Maybe PayloadKeyNonce -> Parser PayloadKeyNonce)
-> Parser PayloadKeyNonce
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just PayloadKeyNonce
x -> PayloadKeyNonce -> Parser PayloadKeyNonce
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PayloadKeyNonce
x
  Maybe PayloadKeyNonce
Nothing -> [Char] -> Parser PayloadKeyNonce
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: could not construct a PayloadKeyNonce from 16 bytes."

-- | Symmetric
-- [payload key](https://github.com/C2SP/C2SP/blob/91935d7157cb3860351ffebbad1e6f6153e8efc8/age.md#payload).
--
-- Note that this type's 'Eq' instance performs a constant-time equality check.
newtype PayloadKey = MkPayloadKey
  { PayloadKey -> ScrubbedBytes
unPayloadKey :: ScrubbedBytes }
  deriving newtype (PayloadKey -> PayloadKey -> Bool
(PayloadKey -> PayloadKey -> Bool)
-> (PayloadKey -> PayloadKey -> Bool) -> Eq PayloadKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadKey -> PayloadKey -> Bool
== :: PayloadKey -> PayloadKey -> Bool
$c/= :: PayloadKey -> PayloadKey -> Bool
/= :: PayloadKey -> PayloadKey -> Bool
Eq)

pattern PayloadKey :: ScrubbedBytes -> PayloadKey
pattern $mPayloadKey :: forall {r}. PayloadKey -> (ScrubbedBytes -> r) -> ((# #) -> r) -> r
PayloadKey bs <- MkPayloadKey bs

{-# COMPLETE PayloadKey #-}

-- | Construct a 'PayloadKey' from bytes.
--
-- If the provided byte string does not have a length of 32 (256 bits),
-- 'Nothing' is returned.
bytesToPayloadKey :: ScrubbedBytes -> Maybe PayloadKey
bytesToPayloadKey :: ScrubbedBytes -> Maybe PayloadKey
bytesToPayloadKey ScrubbedBytes
bs
  | ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = PayloadKey -> Maybe PayloadKey
forall a. a -> Maybe a
Just (ScrubbedBytes -> PayloadKey
MkPayloadKey ScrubbedBytes
bs)
  | Bool
otherwise = Maybe PayloadKey
forall a. Maybe a
Nothing

-- | Get the raw bytes associated with a 'PayloadKey'.
payloadKeyToBytes :: PayloadKey -> ScrubbedBytes
payloadKeyToBytes :: PayloadKey -> ScrubbedBytes
payloadKeyToBytes = PayloadKey -> ScrubbedBytes
unPayloadKey

-- | Construct a 'PayloadKey' as defined in the
-- [age specification](https://github.com/C2SP/C2SP/blob/91935d7157cb3860351ffebbad1e6f6153e8efc8/age.md#payload).
--
-- The 'PayloadKey' is derived via @HKDF-SHA256@ given a 'PayloadKeyNonce' as
-- the extractor salt, a 'FileKey' as the input keying material, and the string
-- @payload@ as the expansion context/info.
mkPayloadKey :: PayloadKeyNonce -> FileKey -> PayloadKey
mkPayloadKey :: PayloadKeyNonce -> FileKey -> PayloadKey
mkPayloadKey PayloadKeyNonce
nonce FileKey
fileKey =
  case ScrubbedBytes -> Maybe PayloadKey
bytesToPayloadKey (PRK SHA256 -> ByteString -> Int -> ScrubbedBytes
forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
Crypto.expand PRK SHA256
prk ByteString
payloadKeyHkdfInfo Int
32) of
    Just PayloadKey
x -> PayloadKey
x
    Maybe PayloadKey
Nothing -> [Char] -> PayloadKey
forall a. HasCallStack => [Char] -> a
error [Char]
"mkPayloadKey: impossible: could not construct PayloadKey from 32 bytes"
  where
    payloadKeyHkdfInfo :: ByteString
    payloadKeyHkdfInfo :: ByteString
payloadKeyHkdfInfo = ByteString
"payload"

    prk :: Crypto.PRK Crypto.SHA256
    prk :: PRK SHA256
prk = ByteString -> ScrubbedBytes -> PRK SHA256
forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
Crypto.extract (PayloadKeyNonce -> ByteString
unPayloadKeyNonce PayloadKeyNonce
nonce) (FileKey -> ScrubbedBytes
unFileKey FileKey
fileKey)