-- | age recipient stanzas.
module Crypto.Age.Recipient.Stanza
  ( -- * @scrypt@ recipient stanza
    ScryptRecipientStanza (..)
  , wrapFileKeyForScryptRecipient
  , ParseScryptStanzaError (..)
  , toScryptRecipientStanza
  , fromScryptRecipientStanza
  , scryptStanzaTag

    -- * X25519 recipient stanza
  , X25519RecipientStanza (..)
  , WrapX25519StanzaFileKeyError (..)
  , wrapFileKeyForX25519Recipient
  , ParseX25519StanzaError (..)
  , toX25519RecipientStanza
  , fromX25519RecipientStanza
  , x25519StanzaTag
  ) where

import Control.Monad ( unless, when )
import Crypto.Age.Header ( Stanza (..) )
import Crypto.Age.Identity ( X25519Identity (..) )
import Crypto.Age.Key ( FileKey, fileKeyToBytes )
import Crypto.Age.Recipient ( ScryptRecipient (..), X25519Recipient (..) )
import Crypto.Age.Scrypt
  ( Passphrase (..)
  , Salt
  , WorkFactor (..)
  , bytesToSalt
  , saltToBytes
  , workFactorBuilder
  , workFactorParser
  )
import qualified Crypto.Cipher.ChaChaPoly1305 as ChaCha20Poly1305
import qualified Crypto.Error as Crypto
import qualified Crypto.Hash as Crypto
import qualified Crypto.KDF.HKDF as HKDF
import qualified Crypto.KDF.Scrypt as Scrypt
import qualified Crypto.MAC.Poly1305 as Poly1305
import qualified Crypto.PubKey.Curve25519 as Curve25519
import Data.Attoparsec.ByteString ( parseOnly )
import Data.ByteArray ( ScrubbedBytes )
import qualified Data.ByteArray as BA
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import Data.ByteString.Base64.Extra
  ( decodeBase64StdUnpadded, encodeBase64StdUnpadded )
import qualified Data.ByteString.Builder as Builder
import Data.Text ( Text )
import Prelude

-- | [@scrypt@ recipient stanza](https://github.com/C2SP/C2SP/blob/34a9210873230d2acaa4a4c9c5d4d1119b2ee77d/age.md#scrypt-recipient-stanza).
data ScryptRecipientStanza = ScryptRecipientStanza
  { -- | Salt.
    ScryptRecipientStanza -> Salt
srsSalt :: !Salt
  , -- | @scrypt@ work factor.
    ScryptRecipientStanza -> WorkFactor
srsWorkFactor :: !WorkFactor
  , -- | Encrypted file key.
    ScryptRecipientStanza -> ByteString
srsEncryptedFileKey :: !ByteString
  } deriving stock (Int -> ScryptRecipientStanza -> ShowS
[ScryptRecipientStanza] -> ShowS
ScryptRecipientStanza -> String
(Int -> ScryptRecipientStanza -> ShowS)
-> (ScryptRecipientStanza -> String)
-> ([ScryptRecipientStanza] -> ShowS)
-> Show ScryptRecipientStanza
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScryptRecipientStanza -> ShowS
showsPrec :: Int -> ScryptRecipientStanza -> ShowS
$cshow :: ScryptRecipientStanza -> String
show :: ScryptRecipientStanza -> String
$cshowList :: [ScryptRecipientStanza] -> ShowS
showList :: [ScryptRecipientStanza] -> ShowS
Show, ScryptRecipientStanza -> ScryptRecipientStanza -> Bool
(ScryptRecipientStanza -> ScryptRecipientStanza -> Bool)
-> (ScryptRecipientStanza -> ScryptRecipientStanza -> Bool)
-> Eq ScryptRecipientStanza
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScryptRecipientStanza -> ScryptRecipientStanza -> Bool
== :: ScryptRecipientStanza -> ScryptRecipientStanza -> Bool
$c/= :: ScryptRecipientStanza -> ScryptRecipientStanza -> Bool
/= :: ScryptRecipientStanza -> ScryptRecipientStanza -> Bool
Eq)

-- | Wrap a 'FileKey' for an 'ScryptRecipient'.
wrapFileKeyForScryptRecipient ::
  ScryptRecipient ->
  FileKey ->
  ScryptRecipientStanza
wrapFileKeyForScryptRecipient :: ScryptRecipient -> FileKey -> ScryptRecipientStanza
wrapFileKeyForScryptRecipient ScryptRecipient
r FileKey
fk = do
  let salt :: ByteString
      salt :: ByteString
salt = ByteString
"age-encryption.org/v1/scrypt" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Salt -> ByteString
saltToBytes Salt
srSalt

      params :: Scrypt.Parameters
      params :: Parameters
params =
        Scrypt.Parameters
          { n :: Word64
Scrypt.n = Word64
2 Word64 -> Word8 -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
workFactorW8
          , r :: Int
Scrypt.r = Int
8
          , p :: Int
Scrypt.p = Int
1
          , outputLength :: Int
Scrypt.outputLength = Int
32
          }

      wrapKey :: ScrubbedBytes
      wrapKey :: ScrubbedBytes
wrapKey = Parameters -> ScrubbedBytes -> ByteString -> ScrubbedBytes
forall password salt output.
(ByteArrayAccess password, ByteArrayAccess salt,
 ByteArray output) =>
Parameters -> password -> salt -> output
Scrypt.generate Parameters
params ScrubbedBytes
passphrase ByteString
salt

      nonce :: ChaCha20Poly1305.Nonce
      nonce :: Nonce
nonce = CryptoFailable Nonce -> Nonce
forall a. CryptoFailable a -> a
Crypto.throwCryptoError (CryptoFailable Nonce -> Nonce) -> CryptoFailable Nonce -> Nonce
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
ChaCha20Poly1305.nonce12 (Int -> Word8 -> ByteString
BS.replicate Int
12 Word8
0x00)

      st :: ChaCha20Poly1305.State
      st :: State
st = CryptoFailable State -> State
forall a. CryptoFailable a -> a
Crypto.throwCryptoError (CryptoFailable State -> State) -> CryptoFailable State -> State
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
ChaCha20Poly1305.initialize ScrubbedBytes
wrapKey Nonce
nonce

      ciphertext :: ByteString
      st2 :: ChaCha20Poly1305.State
      (ByteString
ciphertext, State
st2) = ByteString -> State -> (ByteString, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
ChaCha20Poly1305.encrypt (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> ByteString
forall a b. (a -> b) -> a -> b
$ FileKey -> ScrubbedBytes
fileKeyToBytes FileKey
fk) State
st

      authTag :: Poly1305.Auth
      authTag :: Auth
authTag = State -> Auth
ChaCha20Poly1305.finalize State
st2

  ScryptRecipientStanza
    { srsSalt :: Salt
srsSalt = Salt
srSalt
    , srsWorkFactor :: WorkFactor
srsWorkFactor = WorkFactor
srWorkFactor
    , srsEncryptedFileKey :: ByteString
srsEncryptedFileKey = ByteString
ciphertext ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Auth
authTag
    }
  where
    ScryptRecipient
      { srPassphrase :: ScryptRecipient -> Passphrase
srPassphrase = Passphrase ScrubbedBytes
passphrase
      , Salt
srSalt :: Salt
srSalt :: ScryptRecipient -> Salt
srSalt
      , WorkFactor
srWorkFactor :: WorkFactor
srWorkFactor :: ScryptRecipient -> WorkFactor
srWorkFactor
      } = ScryptRecipient
r

    WorkFactor Word8
workFactorW8 = WorkFactor
srWorkFactor

-- | @scrypt@ recipient stanza tag (i.e. the first stanza argument).
--
-- According to the
-- [age specification](https://github.com/C2SP/C2SP/blob/03ab74455beb3a6d6e0fb7dd1de5a932e2257cd0/age.md#scrypt-recipient-stanza),
-- this is expected to be the string, @scrypt@.
scryptStanzaTag :: ByteString
scryptStanzaTag :: ByteString
scryptStanzaTag = ByteString
"scrypt"

-- | Error converting a 'Stanza' to an 'ScryptRecipientStanza'.
data ParseScryptStanzaError
  = -- | Invalid tag.
    ParseScryptStanzaInvalidTagError
      -- | Expected tag.
      !ByteString
      -- | Actual tag.
      !ByteString
  | -- | Invalid number of arguments.
    ParseScryptStanzaInvalidNumberOfArgumentsError
      -- | Expected number of arguments.
      !Int
      -- | Actual number of arguments.
      !Int
  | -- | Error decoding the @scrypt@ salt from base64.
    ParseScryptStanzaSaltBase64DecodingError
      -- | Base64 decoding error.
      !Text
  | -- | Invalid @scrypt@ salt size.
    ParseScryptStanzaInvalidSaltSizeError
      -- | Expected body size in bytes.
      !Int
      -- | Actual body size in bytes.
      !Int
  | -- | Error parsing the @scrypt@ work factor.
    ParseScryptStanzaWorkFactorParseError !String
  | -- | Invalid stanza body size.
    ParseScryptStanzaInvalidBodySizeError
      -- | Expected body size in bytes.
      !Int
      -- | Actual body size in bytes.
      !Int
  deriving stock (Int -> ParseScryptStanzaError -> ShowS
[ParseScryptStanzaError] -> ShowS
ParseScryptStanzaError -> String
(Int -> ParseScryptStanzaError -> ShowS)
-> (ParseScryptStanzaError -> String)
-> ([ParseScryptStanzaError] -> ShowS)
-> Show ParseScryptStanzaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseScryptStanzaError -> ShowS
showsPrec :: Int -> ParseScryptStanzaError -> ShowS
$cshow :: ParseScryptStanzaError -> String
show :: ParseScryptStanzaError -> String
$cshowList :: [ParseScryptStanzaError] -> ShowS
showList :: [ParseScryptStanzaError] -> ShowS
Show, ParseScryptStanzaError -> ParseScryptStanzaError -> Bool
(ParseScryptStanzaError -> ParseScryptStanzaError -> Bool)
-> (ParseScryptStanzaError -> ParseScryptStanzaError -> Bool)
-> Eq ParseScryptStanzaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseScryptStanzaError -> ParseScryptStanzaError -> Bool
== :: ParseScryptStanzaError -> ParseScryptStanzaError -> Bool
$c/= :: ParseScryptStanzaError -> ParseScryptStanzaError -> Bool
/= :: ParseScryptStanzaError -> ParseScryptStanzaError -> Bool
Eq)

-- | Convert a 'Stanza' in an 'ScryptRecipientStanza'.
toScryptRecipientStanza :: Stanza -> Either ParseScryptStanzaError ScryptRecipientStanza
toScryptRecipientStanza :: Stanza -> Either ParseScryptStanzaError ScryptRecipientStanza
toScryptRecipientStanza Stanza
s = do
  Bool
-> Either ParseScryptStanzaError ()
-> Either ParseScryptStanzaError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
sTag ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
scryptStanzaTag) (Either ParseScryptStanzaError ()
 -> Either ParseScryptStanzaError ())
-> Either ParseScryptStanzaError ()
-> Either ParseScryptStanzaError ()
forall a b. (a -> b) -> a -> b
$ ParseScryptStanzaError -> Either ParseScryptStanzaError ()
forall a b. a -> Either a b
Left (ByteString -> ByteString -> ParseScryptStanzaError
ParseScryptStanzaInvalidTagError ByteString
scryptStanzaTag ByteString
sTag)

  (ByteString
saltB64, ByteString
workFactorBs) <-
    case [ByteString]
sArgs of
      [ByteString
arg1, ByteString
arg2] -> (ByteString, ByteString)
-> Either ParseScryptStanzaError (ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
arg1, ByteString
arg2)
      [ByteString]
_ ->
        -- We add 1 because, technically, the tag is a stanza argument too.
        ParseScryptStanzaError
-> Either ParseScryptStanzaError (ByteString, ByteString)
forall a b. a -> Either a b
Left (ParseScryptStanzaError
 -> Either ParseScryptStanzaError (ByteString, ByteString))
-> ParseScryptStanzaError
-> Either ParseScryptStanzaError (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ParseScryptStanzaError
ParseScryptStanzaInvalidNumberOfArgumentsError Int
3 ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
sArgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

  Salt
salt <-
    case ByteString -> Either Text ByteString
decodeBase64StdUnpadded ByteString
saltB64 of
      Left Text
err -> ParseScryptStanzaError -> Either ParseScryptStanzaError Salt
forall a b. a -> Either a b
Left (Text -> ParseScryptStanzaError
ParseScryptStanzaSaltBase64DecodingError Text
err)
      Right ByteString
bs ->
        case ByteString -> Maybe Salt
bytesToSalt ByteString
bs of
          Maybe Salt
Nothing -> ParseScryptStanzaError -> Either ParseScryptStanzaError Salt
forall a b. a -> Either a b
Left (Int -> Int -> ParseScryptStanzaError
ParseScryptStanzaInvalidSaltSizeError Int
16 (ByteString -> Int
BS.length ByteString
bs))
          Just Salt
salt -> Salt -> Either ParseScryptStanzaError Salt
forall a b. b -> Either a b
Right Salt
salt

  WorkFactor
workFactor <-
    case Parser WorkFactor -> ByteString -> Either String WorkFactor
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser WorkFactor
workFactorParser ByteString
workFactorBs of
      Left String
err -> ParseScryptStanzaError -> Either ParseScryptStanzaError WorkFactor
forall a b. a -> Either a b
Left (String -> ParseScryptStanzaError
ParseScryptStanzaWorkFactorParseError String
err)
      Right WorkFactor
wf -> WorkFactor -> Either ParseScryptStanzaError WorkFactor
forall a b. b -> Either a b
Right WorkFactor
wf

  Bool
-> Either ParseScryptStanzaError ()
-> Either ParseScryptStanzaError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
actualBodyLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedBodyLength) (Either ParseScryptStanzaError ()
 -> Either ParseScryptStanzaError ())
-> Either ParseScryptStanzaError ()
-> Either ParseScryptStanzaError ()
forall a b. (a -> b) -> a -> b
$ ParseScryptStanzaError -> Either ParseScryptStanzaError ()
forall a b. a -> Either a b
Left (Int -> Int -> ParseScryptStanzaError
ParseScryptStanzaInvalidBodySizeError Int
expectedBodyLength Int
actualBodyLength)

  ScryptRecipientStanza
-> Either ParseScryptStanzaError ScryptRecipientStanza
forall a b. b -> Either a b
Right (ScryptRecipientStanza
 -> Either ParseScryptStanzaError ScryptRecipientStanza)
-> ScryptRecipientStanza
-> Either ParseScryptStanzaError ScryptRecipientStanza
forall a b. (a -> b) -> a -> b
$
    ScryptRecipientStanza
      { srsSalt :: Salt
srsSalt = Salt
salt
      , srsWorkFactor :: WorkFactor
srsWorkFactor = WorkFactor
workFactor
      , srsEncryptedFileKey :: ByteString
srsEncryptedFileKey = ByteString
sBody
      }
  where
    Stanza
      { ByteString
sTag :: ByteString
sTag :: Stanza -> ByteString
sTag
      , [ByteString]
sArgs :: [ByteString]
sArgs :: Stanza -> [ByteString]
sArgs
      , ByteString
sBody :: ByteString
sBody :: Stanza -> ByteString
sBody
      } = Stanza
s

    expectedBodyLength :: Int
    expectedBodyLength :: Int
expectedBodyLength = Int
32

    actualBodyLength :: Int
    actualBodyLength :: Int
actualBodyLength = ByteString -> Int
BS.length ByteString
sBody

-- | Convert an 'ScryptRecipientStanza' to a 'Stanza'.
fromScryptRecipientStanza :: ScryptRecipientStanza -> Stanza
fromScryptRecipientStanza :: ScryptRecipientStanza -> Stanza
fromScryptRecipientStanza ScryptRecipientStanza
s =
  Stanza
    { sTag :: ByteString
sTag = ByteString
scryptStanzaTag
    , sArgs :: [ByteString]
sArgs =
        [ ByteString -> ByteString
encodeBase64StdUnpadded (Salt -> ByteString
saltToBytes Salt
srsSalt)
        , LazyByteString -> ByteString
BS.toStrict (Builder -> LazyByteString
Builder.toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
forall a b. (a -> b) -> a -> b
$ WorkFactor -> Builder
workFactorBuilder WorkFactor
srsWorkFactor)
        ]
    , sBody :: ByteString
sBody = ByteString
srsEncryptedFileKey
    }
  where
    ScryptRecipientStanza
      { Salt
srsSalt :: ScryptRecipientStanza -> Salt
srsSalt :: Salt
srsSalt
      , WorkFactor
srsWorkFactor :: ScryptRecipientStanza -> WorkFactor
srsWorkFactor :: WorkFactor
srsWorkFactor
      , ByteString
srsEncryptedFileKey :: ScryptRecipientStanza -> ByteString
srsEncryptedFileKey :: ByteString
srsEncryptedFileKey
      } = ScryptRecipientStanza
s

-- | [X25519 recipient stanza](https://github.com/C2SP/C2SP/blob/34a9210873230d2acaa4a4c9c5d4d1119b2ee77d/age.md#x25519-recipient-stanza).
data X25519RecipientStanza = X25519RecipientStanza
  { -- | Sender's ephemeral Curve25519 public key.
    --
    -- Referred to as the \"ephemeral share\" in the age specification.
    X25519RecipientStanza -> PublicKey
xrsSenderPublicKey :: !Curve25519.PublicKey
  , -- | Encrypted file key.
    X25519RecipientStanza -> ByteString
xrsEncryptedFileKey :: !ByteString
  } deriving stock (Int -> X25519RecipientStanza -> ShowS
[X25519RecipientStanza] -> ShowS
X25519RecipientStanza -> String
(Int -> X25519RecipientStanza -> ShowS)
-> (X25519RecipientStanza -> String)
-> ([X25519RecipientStanza] -> ShowS)
-> Show X25519RecipientStanza
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> X25519RecipientStanza -> ShowS
showsPrec :: Int -> X25519RecipientStanza -> ShowS
$cshow :: X25519RecipientStanza -> String
show :: X25519RecipientStanza -> String
$cshowList :: [X25519RecipientStanza] -> ShowS
showList :: [X25519RecipientStanza] -> ShowS
Show, X25519RecipientStanza -> X25519RecipientStanza -> Bool
(X25519RecipientStanza -> X25519RecipientStanza -> Bool)
-> (X25519RecipientStanza -> X25519RecipientStanza -> Bool)
-> Eq X25519RecipientStanza
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: X25519RecipientStanza -> X25519RecipientStanza -> Bool
== :: X25519RecipientStanza -> X25519RecipientStanza -> Bool
$c/= :: X25519RecipientStanza -> X25519RecipientStanza -> Bool
/= :: X25519RecipientStanza -> X25519RecipientStanza -> Bool
Eq)

-- | Error wrapping a file key in an X25519 recipient stanza.
data WrapX25519StanzaFileKeyError
  = -- | DH shared secret is an all-zero value.
    WrapX25519StanzaFileKeyAllZeroSharedSecretError
  deriving stock (Int -> WrapX25519StanzaFileKeyError -> ShowS
[WrapX25519StanzaFileKeyError] -> ShowS
WrapX25519StanzaFileKeyError -> String
(Int -> WrapX25519StanzaFileKeyError -> ShowS)
-> (WrapX25519StanzaFileKeyError -> String)
-> ([WrapX25519StanzaFileKeyError] -> ShowS)
-> Show WrapX25519StanzaFileKeyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WrapX25519StanzaFileKeyError -> ShowS
showsPrec :: Int -> WrapX25519StanzaFileKeyError -> ShowS
$cshow :: WrapX25519StanzaFileKeyError -> String
show :: WrapX25519StanzaFileKeyError -> String
$cshowList :: [WrapX25519StanzaFileKeyError] -> ShowS
showList :: [WrapX25519StanzaFileKeyError] -> ShowS
Show, WrapX25519StanzaFileKeyError
-> WrapX25519StanzaFileKeyError -> Bool
(WrapX25519StanzaFileKeyError
 -> WrapX25519StanzaFileKeyError -> Bool)
-> (WrapX25519StanzaFileKeyError
    -> WrapX25519StanzaFileKeyError -> Bool)
-> Eq WrapX25519StanzaFileKeyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WrapX25519StanzaFileKeyError
-> WrapX25519StanzaFileKeyError -> Bool
== :: WrapX25519StanzaFileKeyError
-> WrapX25519StanzaFileKeyError -> Bool
$c/= :: WrapX25519StanzaFileKeyError
-> WrapX25519StanzaFileKeyError -> Bool
/= :: WrapX25519StanzaFileKeyError
-> WrapX25519StanzaFileKeyError -> Bool
Eq)

-- | Wrap a 'FileKey' in an 'X25519RecipientStanza'.
wrapFileKeyForX25519Recipient ::
  X25519Recipient ->
  X25519Identity ->
  FileKey ->
  Either WrapX25519StanzaFileKeyError X25519RecipientStanza
wrapFileKeyForX25519Recipient :: X25519Recipient
-> X25519Identity
-> FileKey
-> Either WrapX25519StanzaFileKeyError X25519RecipientStanza
wrapFileKeyForX25519Recipient (X25519Recipient PublicKey
recipientPk) (X25519Identity SecretKey
senderSk) FileKey
fk = do
  let senderPk :: Curve25519.PublicKey
      senderPk :: PublicKey
senderPk = SecretKey -> PublicKey
Curve25519.toPublic SecretKey
senderSk

      salt :: ByteString
      salt :: ByteString
salt = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
senderPk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
recipientPk

      info :: ByteString
      info :: ByteString
info = ByteString
"age-encryption.org/v1/X25519"

      zeroSharedSecret :: Curve25519.DhSecret
      zeroSharedSecret :: DhSecret
zeroSharedSecret = CryptoFailable DhSecret -> DhSecret
forall a. CryptoFailable a -> a
Crypto.throwCryptoError (CryptoFailable DhSecret -> DhSecret)
-> CryptoFailable DhSecret -> DhSecret
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> CryptoFailable DhSecret
forall b. ByteArrayAccess b => b -> CryptoFailable DhSecret
Curve25519.dhSecret (Int -> Word8 -> ScrubbedBytes
forall ba. ByteArray ba => Int -> Word8 -> ba
BA.replicate Int
32 Word8
0x00 :: ScrubbedBytes)

      sharedSecret :: Curve25519.DhSecret
      sharedSecret :: DhSecret
sharedSecret = PublicKey -> SecretKey -> DhSecret
Curve25519.dh PublicKey
recipientPk SecretKey
senderSk

  Bool
-> Either WrapX25519StanzaFileKeyError ()
-> Either WrapX25519StanzaFileKeyError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DhSecret
sharedSecret DhSecret -> DhSecret -> Bool
forall a. Eq a => a -> a -> Bool
== DhSecret
zeroSharedSecret) (WrapX25519StanzaFileKeyError
-> Either WrapX25519StanzaFileKeyError ()
forall a b. a -> Either a b
Left WrapX25519StanzaFileKeyError
WrapX25519StanzaFileKeyAllZeroSharedSecretError)

  let prk :: HKDF.PRK Crypto.SHA256
      prk :: PRK SHA256
prk = ByteString -> DhSecret -> PRK SHA256
forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
HKDF.extract ByteString
salt DhSecret
sharedSecret

      wrapKey :: ScrubbedBytes
      wrapKey :: ScrubbedBytes
wrapKey = PRK SHA256 -> ByteString -> Int -> ScrubbedBytes
forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
HKDF.expand PRK SHA256
prk ByteString
info Int
32

      nonce :: ChaCha20Poly1305.Nonce
      nonce :: Nonce
nonce = CryptoFailable Nonce -> Nonce
forall a. CryptoFailable a -> a
Crypto.throwCryptoError (CryptoFailable Nonce -> Nonce) -> CryptoFailable Nonce -> Nonce
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
ChaCha20Poly1305.nonce12 (Int -> Word8 -> ByteString
BS.replicate Int
12 Word8
0x00)

      st :: ChaCha20Poly1305.State
      st :: State
st = CryptoFailable State -> State
forall a. CryptoFailable a -> a
Crypto.throwCryptoError (CryptoFailable State -> State) -> CryptoFailable State -> State
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
ChaCha20Poly1305.initialize ScrubbedBytes
wrapKey Nonce
nonce

      ciphertext :: ByteString
      st2 :: ChaCha20Poly1305.State
      (ByteString
ciphertext, State
st2) = ByteString -> State -> (ByteString, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
ChaCha20Poly1305.encrypt (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> ByteString
forall a b. (a -> b) -> a -> b
$ FileKey -> ScrubbedBytes
fileKeyToBytes FileKey
fk) State
st

      authTag :: Poly1305.Auth
      authTag :: Auth
authTag = State -> Auth
ChaCha20Poly1305.finalize State
st2

  X25519RecipientStanza
-> Either WrapX25519StanzaFileKeyError X25519RecipientStanza
forall a b. b -> Either a b
Right (X25519RecipientStanza
 -> Either WrapX25519StanzaFileKeyError X25519RecipientStanza)
-> X25519RecipientStanza
-> Either WrapX25519StanzaFileKeyError X25519RecipientStanza
forall a b. (a -> b) -> a -> b
$
    X25519RecipientStanza
      { xrsSenderPublicKey :: PublicKey
xrsSenderPublicKey = PublicKey
senderPk
      , xrsEncryptedFileKey :: ByteString
xrsEncryptedFileKey = ByteString
ciphertext ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Auth
authTag
      }

-- | X25519 recipient stanza tag (i.e. the first stanza argument).
--
-- According to the
-- [age specification](https://github.com/C2SP/C2SP/blob/03ab74455beb3a6d6e0fb7dd1de5a932e2257cd0/age.md#x25519-recipient-stanza),
-- this is expected to be the string, @X25519@.
x25519StanzaTag :: ByteString
x25519StanzaTag :: ByteString
x25519StanzaTag = ByteString
"X25519"

-- | Error converting a 'Stanza' to an 'X25519RecipientStanza'.
data ParseX25519StanzaError
  = -- | Invalid tag.
    ParseX25519StanzaInvalidTagError
      -- | Expected tag.
      !ByteString
      -- | Actual tag.
      !ByteString
  | -- | Invalid number of arguments.
    ParseX25519StanzaInvalidNumberOfArgumentsError
      -- | Expected number of arguments.
      !Int
      -- | Actual number of arguments.
      !Int
  | -- | Error decoding the sender's ephemeral public key from base64.
    ParseX25519StanzaEphemeralShareBase64DecodingError
      -- | Base64 decoding error.
      !Text
  | -- | Invalid ephemeral share.
    ParseX25519StanzaInvalidEphemeralShareError
      -- | Error that occurred.
      !Crypto.CryptoError
      -- | Invalid ephemeral share bytes.
      !ByteString
  | -- | Invalid stanza body size.
    ParseX25519StanzaInvalidBodySizeError
      -- | Expected body size in bytes.
      !Int
      -- | Actual body size in bytes.
      !Int
  deriving stock (Int -> ParseX25519StanzaError -> ShowS
[ParseX25519StanzaError] -> ShowS
ParseX25519StanzaError -> String
(Int -> ParseX25519StanzaError -> ShowS)
-> (ParseX25519StanzaError -> String)
-> ([ParseX25519StanzaError] -> ShowS)
-> Show ParseX25519StanzaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseX25519StanzaError -> ShowS
showsPrec :: Int -> ParseX25519StanzaError -> ShowS
$cshow :: ParseX25519StanzaError -> String
show :: ParseX25519StanzaError -> String
$cshowList :: [ParseX25519StanzaError] -> ShowS
showList :: [ParseX25519StanzaError] -> ShowS
Show, ParseX25519StanzaError -> ParseX25519StanzaError -> Bool
(ParseX25519StanzaError -> ParseX25519StanzaError -> Bool)
-> (ParseX25519StanzaError -> ParseX25519StanzaError -> Bool)
-> Eq ParseX25519StanzaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseX25519StanzaError -> ParseX25519StanzaError -> Bool
== :: ParseX25519StanzaError -> ParseX25519StanzaError -> Bool
$c/= :: ParseX25519StanzaError -> ParseX25519StanzaError -> Bool
/= :: ParseX25519StanzaError -> ParseX25519StanzaError -> Bool
Eq)

-- | Convert a 'Stanza' to an 'X25519RecipientStanza'.
toX25519RecipientStanza :: Stanza -> Either ParseX25519StanzaError X25519RecipientStanza
toX25519RecipientStanza :: Stanza -> Either ParseX25519StanzaError X25519RecipientStanza
toX25519RecipientStanza Stanza
s = do
  Bool
-> Either ParseX25519StanzaError ()
-> Either ParseX25519StanzaError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
sTag ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
x25519StanzaTag) (Either ParseX25519StanzaError ()
 -> Either ParseX25519StanzaError ())
-> Either ParseX25519StanzaError ()
-> Either ParseX25519StanzaError ()
forall a b. (a -> b) -> a -> b
$ ParseX25519StanzaError -> Either ParseX25519StanzaError ()
forall a b. a -> Either a b
Left (ByteString -> ByteString -> ParseX25519StanzaError
ParseX25519StanzaInvalidTagError ByteString
x25519StanzaTag ByteString
sTag)

  ByteString
ephemeralShareB64 <-
    case [ByteString]
sArgs of
      [ByteString
arg] -> ByteString -> Either ParseX25519StanzaError ByteString
forall a b. b -> Either a b
Right ByteString
arg
      [ByteString]
_ ->
        -- We add 1 because, technically, the tag is a stanza argument too.
        ParseX25519StanzaError -> Either ParseX25519StanzaError ByteString
forall a b. a -> Either a b
Left (ParseX25519StanzaError
 -> Either ParseX25519StanzaError ByteString)
-> ParseX25519StanzaError
-> Either ParseX25519StanzaError ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ParseX25519StanzaError
ParseX25519StanzaInvalidNumberOfArgumentsError Int
2 ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
sArgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

  ByteString
ephemeralShareBs <-
    case ByteString -> Either Text ByteString
decodeBase64StdUnpadded ByteString
ephemeralShareB64 of
      Left Text
err -> ParseX25519StanzaError -> Either ParseX25519StanzaError ByteString
forall a b. a -> Either a b
Left (Text -> ParseX25519StanzaError
ParseX25519StanzaEphemeralShareBase64DecodingError Text
err)
      Right ByteString
bs -> ByteString -> Either ParseX25519StanzaError ByteString
forall a b. b -> Either a b
Right ByteString
bs

  PublicKey
ephemeralShare <-
    case ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve25519.publicKey ByteString
ephemeralShareBs of
      Crypto.CryptoFailed CryptoError
err -> ParseX25519StanzaError -> Either ParseX25519StanzaError PublicKey
forall a b. a -> Either a b
Left (CryptoError -> ByteString -> ParseX25519StanzaError
ParseX25519StanzaInvalidEphemeralShareError CryptoError
err ByteString
ephemeralShareBs)
      Crypto.CryptoPassed PublicKey
pk -> PublicKey -> Either ParseX25519StanzaError PublicKey
forall a b. b -> Either a b
Right PublicKey
pk

  Bool
-> Either ParseX25519StanzaError ()
-> Either ParseX25519StanzaError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
actualBodyLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedBodyLength) (Either ParseX25519StanzaError ()
 -> Either ParseX25519StanzaError ())
-> Either ParseX25519StanzaError ()
-> Either ParseX25519StanzaError ()
forall a b. (a -> b) -> a -> b
$ ParseX25519StanzaError -> Either ParseX25519StanzaError ()
forall a b. a -> Either a b
Left (Int -> Int -> ParseX25519StanzaError
ParseX25519StanzaInvalidBodySizeError Int
expectedBodyLength Int
actualBodyLength)

  X25519RecipientStanza
-> Either ParseX25519StanzaError X25519RecipientStanza
forall a b. b -> Either a b
Right (X25519RecipientStanza
 -> Either ParseX25519StanzaError X25519RecipientStanza)
-> X25519RecipientStanza
-> Either ParseX25519StanzaError X25519RecipientStanza
forall a b. (a -> b) -> a -> b
$
    X25519RecipientStanza
      { xrsSenderPublicKey :: PublicKey
xrsSenderPublicKey = PublicKey
ephemeralShare
      , xrsEncryptedFileKey :: ByteString
xrsEncryptedFileKey = ByteString
sBody
      }
  where
    Stanza
      { ByteString
sTag :: Stanza -> ByteString
sTag :: ByteString
sTag
      , [ByteString]
sArgs :: Stanza -> [ByteString]
sArgs :: [ByteString]
sArgs
      , ByteString
sBody :: Stanza -> ByteString
sBody :: ByteString
sBody
      } = Stanza
s

    expectedBodyLength :: Int
    expectedBodyLength :: Int
expectedBodyLength = Int
32

    actualBodyLength :: Int
    actualBodyLength :: Int
actualBodyLength = ByteString -> Int
BS.length ByteString
sBody

-- | Convert an 'X25519RecipientStanza' to a 'Stanza'.
fromX25519RecipientStanza :: X25519RecipientStanza -> Stanza
fromX25519RecipientStanza :: X25519RecipientStanza -> Stanza
fromX25519RecipientStanza X25519RecipientStanza
s =
  Stanza
    { sTag :: ByteString
sTag = ByteString
x25519StanzaTag
    , sArgs :: [ByteString]
sArgs = [ByteString -> ByteString
encodeBase64StdUnpadded (PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
ephemeralShare)]
    , sBody :: ByteString
sBody = ByteString
xrsEncryptedFileKey
    }
  where
    X25519RecipientStanza
      { xrsSenderPublicKey :: X25519RecipientStanza -> PublicKey
xrsSenderPublicKey = PublicKey
ephemeralShare
      , ByteString
xrsEncryptedFileKey :: X25519RecipientStanza -> ByteString
xrsEncryptedFileKey :: ByteString
xrsEncryptedFileKey
      } = X25519RecipientStanza
s