-- | age file recipients.
module Crypto.Age.Recipient
  ( -- * Recipients
    Recipients (..)
    -- * @scrypt@
  , ScryptRecipient (..)
    -- * X25519
  , X25519Recipient (..)
  , bytesToX25519Recipient
  , x25519RecipientToBytes
  , encodeX25519Recipient
  , DecodeX25519RecipientError (..)
  , decodeX25519Recipient
  ) where

import qualified Codec.Binary.Bech32 as Bech32
import Control.Monad ( when )
import Crypto.Age.Scrypt ( Passphrase, Salt, WorkFactor )
import qualified Crypto.Error as Crypto
import qualified Crypto.PubKey.Curve25519 as Curve25519
import Data.Bifunctor ( first )
import qualified Data.ByteArray as BA
import Data.ByteString ( ByteString )
import Data.List.NonEmpty ( NonEmpty )
import Data.Text ( Text )
import Prelude

-- | [@scrypt@ recipient](https://github.com/C2SP/C2SP/blob/91935d7157cb3860351ffebbad1e6f6153e8efc8/age.md#the-scrypt-recipient-type).
data ScryptRecipient = ScryptRecipient
  { -- | Passphrase.
    ScryptRecipient -> Passphrase
srPassphrase :: !Passphrase
  , -- | Salt.
    ScryptRecipient -> Salt
srSalt :: !Salt
  , -- | @scrypt@ work factor.
    ScryptRecipient -> WorkFactor
srWorkFactor :: !WorkFactor
  } deriving stock (Int -> ScryptRecipient -> ShowS
[ScryptRecipient] -> ShowS
ScryptRecipient -> String
(Int -> ScryptRecipient -> ShowS)
-> (ScryptRecipient -> String)
-> ([ScryptRecipient] -> ShowS)
-> Show ScryptRecipient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScryptRecipient -> ShowS
showsPrec :: Int -> ScryptRecipient -> ShowS
$cshow :: ScryptRecipient -> String
show :: ScryptRecipient -> String
$cshowList :: [ScryptRecipient] -> ShowS
showList :: [ScryptRecipient] -> ShowS
Show, ScryptRecipient -> ScryptRecipient -> Bool
(ScryptRecipient -> ScryptRecipient -> Bool)
-> (ScryptRecipient -> ScryptRecipient -> Bool)
-> Eq ScryptRecipient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScryptRecipient -> ScryptRecipient -> Bool
== :: ScryptRecipient -> ScryptRecipient -> Bool
$c/= :: ScryptRecipient -> ScryptRecipient -> Bool
/= :: ScryptRecipient -> ScryptRecipient -> Bool
Eq)

-- | [X25519 recipient](https://github.com/C2SP/C2SP/blob/91935d7157cb3860351ffebbad1e6f6153e8efc8/age.md#the-x25519-recipient-type).
newtype X25519Recipient = X25519Recipient
  { -- | Recipient's Curve25519 public key.
    X25519Recipient -> PublicKey
unX25519Recipient :: Curve25519.PublicKey
  } deriving stock (Int -> X25519Recipient -> ShowS
[X25519Recipient] -> ShowS
X25519Recipient -> String
(Int -> X25519Recipient -> ShowS)
-> (X25519Recipient -> String)
-> ([X25519Recipient] -> ShowS)
-> Show X25519Recipient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> X25519Recipient -> ShowS
showsPrec :: Int -> X25519Recipient -> ShowS
$cshow :: X25519Recipient -> String
show :: X25519Recipient -> String
$cshowList :: [X25519Recipient] -> ShowS
showList :: [X25519Recipient] -> ShowS
Show, X25519Recipient -> X25519Recipient -> Bool
(X25519Recipient -> X25519Recipient -> Bool)
-> (X25519Recipient -> X25519Recipient -> Bool)
-> Eq X25519Recipient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: X25519Recipient -> X25519Recipient -> Bool
== :: X25519Recipient -> X25519Recipient -> Bool
$c/= :: X25519Recipient -> X25519Recipient -> Bool
/= :: X25519Recipient -> X25519Recipient -> Bool
Eq)

-- | Construct an 'X25519Recipient' from the raw bytes of a Curve25519 public
-- key.
--
-- If the provided byte string does not have a length of 32 (256 bits),
-- 'Nothing' is returned.
bytesToX25519Recipient :: ByteString -> Maybe X25519Recipient
bytesToX25519Recipient :: ByteString -> Maybe X25519Recipient
bytesToX25519Recipient =
  (PublicKey -> X25519Recipient
X25519Recipient (PublicKey -> X25519Recipient)
-> Maybe PublicKey -> Maybe X25519Recipient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    (Maybe PublicKey -> Maybe X25519Recipient)
-> (ByteString -> Maybe PublicKey)
-> ByteString
-> Maybe X25519Recipient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable PublicKey -> Maybe PublicKey
forall a. CryptoFailable a -> Maybe a
Crypto.maybeCryptoError
    (CryptoFailable PublicKey -> Maybe PublicKey)
-> (ByteString -> CryptoFailable PublicKey)
-> ByteString
-> Maybe PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve25519.publicKey

-- | Get the raw Curve25519 public key bytes associated with an
-- 'X25519Recipient'.
x25519RecipientToBytes :: X25519Recipient -> ByteString
x25519RecipientToBytes :: X25519Recipient -> ByteString
x25519RecipientToBytes = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (PublicKey -> ByteString)
-> (X25519Recipient -> PublicKey) -> X25519Recipient -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X25519Recipient -> PublicKey
unX25519Recipient

x25519RecipientBech32Hrp :: Bech32.HumanReadablePart
x25519RecipientBech32Hrp :: HumanReadablePart
x25519RecipientBech32Hrp =
  case Text -> Either HumanReadablePartError HumanReadablePart
Bech32.humanReadablePartFromText Text
"age" of
    Left HumanReadablePartError
_ -> String -> HumanReadablePart
forall a. HasCallStack => String -> a
error String
"x25519RecipientBech32Hrp: impossible: \"age\" is an invalid HRP"
    Right HumanReadablePart
hrp -> HumanReadablePart
hrp

-- | Encode an 'X25519Recipient' as
-- [Bech32](https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki).
encodeX25519Recipient :: X25519Recipient -> Either Bech32.EncodingError Text
encodeX25519Recipient :: X25519Recipient -> Either EncodingError Text
encodeX25519Recipient X25519Recipient
r =
  HumanReadablePart -> DataPart -> Either EncodingError Text
Bech32.encode
    HumanReadablePart
x25519RecipientBech32Hrp
    (ByteString -> DataPart
Bech32.dataPartFromBytes (ByteString -> DataPart) -> ByteString -> DataPart
forall a b. (a -> b) -> a -> b
$ X25519Recipient -> ByteString
x25519RecipientToBytes X25519Recipient
r)

-- | Error decoding an 'X25519Recipient' from Bech32.
data DecodeX25519RecipientError
  = -- | Bech32 decoding error.
    DecodeX25519RecipientBech32DecodingError !Bech32.DecodingError
  | -- | Invalid Bech32 human-readable part.
    DecodeX25519RecipientInvalidHumanReadablePartError
      -- | Expected Bech32 human-readable part.
      !Bech32.HumanReadablePart
      -- | Actual Bech32 human-readable part.
      !Bech32.HumanReadablePart
  | -- | Invalid Bech32 data part.
    DecodeX25519RecipientInvalidDataPartError
  | -- | Invalid Curve25519 secret key size.
    DecodeX25519RecipientInvalidSecretKeySizeError
  deriving stock (Int -> DecodeX25519RecipientError -> ShowS
[DecodeX25519RecipientError] -> ShowS
DecodeX25519RecipientError -> String
(Int -> DecodeX25519RecipientError -> ShowS)
-> (DecodeX25519RecipientError -> String)
-> ([DecodeX25519RecipientError] -> ShowS)
-> Show DecodeX25519RecipientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeX25519RecipientError -> ShowS
showsPrec :: Int -> DecodeX25519RecipientError -> ShowS
$cshow :: DecodeX25519RecipientError -> String
show :: DecodeX25519RecipientError -> String
$cshowList :: [DecodeX25519RecipientError] -> ShowS
showList :: [DecodeX25519RecipientError] -> ShowS
Show, DecodeX25519RecipientError -> DecodeX25519RecipientError -> Bool
(DecodeX25519RecipientError -> DecodeX25519RecipientError -> Bool)
-> (DecodeX25519RecipientError
    -> DecodeX25519RecipientError -> Bool)
-> Eq DecodeX25519RecipientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeX25519RecipientError -> DecodeX25519RecipientError -> Bool
== :: DecodeX25519RecipientError -> DecodeX25519RecipientError -> Bool
$c/= :: DecodeX25519RecipientError -> DecodeX25519RecipientError -> Bool
/= :: DecodeX25519RecipientError -> DecodeX25519RecipientError -> Bool
Eq)

-- | Decode an 'X25519Recipient' from
-- [Bech32](https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki).
decodeX25519Recipient :: Text -> Either DecodeX25519RecipientError X25519Recipient
decodeX25519Recipient :: Text -> Either DecodeX25519RecipientError X25519Recipient
decodeX25519Recipient Text
t = do
  (HumanReadablePart
hrp, DataPart
dp) <- (DecodingError -> DecodeX25519RecipientError)
-> Either DecodingError (HumanReadablePart, DataPart)
-> Either DecodeX25519RecipientError (HumanReadablePart, DataPart)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecodingError -> DecodeX25519RecipientError
DecodeX25519RecipientBech32DecodingError (Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decode Text
t)
  Bool
-> Either DecodeX25519RecipientError ()
-> Either DecodeX25519RecipientError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (HumanReadablePart
x25519RecipientBech32Hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
/= HumanReadablePart
hrp)
    (DecodeX25519RecipientError -> Either DecodeX25519RecipientError ()
forall a b. a -> Either a b
Left (DecodeX25519RecipientError
 -> Either DecodeX25519RecipientError ())
-> DecodeX25519RecipientError
-> Either DecodeX25519RecipientError ()
forall a b. (a -> b) -> a -> b
$ HumanReadablePart
-> HumanReadablePart -> DecodeX25519RecipientError
DecodeX25519RecipientInvalidHumanReadablePartError HumanReadablePart
x25519RecipientBech32Hrp HumanReadablePart
hrp)
  ByteString
dpBs <-
    case DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dp of
      Maybe ByteString
Nothing -> DecodeX25519RecipientError
-> Either DecodeX25519RecipientError ByteString
forall a b. a -> Either a b
Left DecodeX25519RecipientError
DecodeX25519RecipientInvalidDataPartError
      Just ByteString
bs -> ByteString -> Either DecodeX25519RecipientError ByteString
forall a b. b -> Either a b
Right ByteString
bs
  case ByteString -> Maybe X25519Recipient
bytesToX25519Recipient ByteString
dpBs of
    Maybe X25519Recipient
Nothing -> DecodeX25519RecipientError
-> Either DecodeX25519RecipientError X25519Recipient
forall a b. a -> Either a b
Left DecodeX25519RecipientError
DecodeX25519RecipientInvalidSecretKeySizeError
    Just X25519Recipient
r -> X25519Recipient
-> Either DecodeX25519RecipientError X25519Recipient
forall a b. b -> Either a b
Right X25519Recipient
r

-- | Collection of age file recipients.
data Recipients
  = -- | @scrypt@ recipient.
    --
    -- As noted in the
    -- [age specification](https://github.com/C2SP/C2SP/blob/34a9210873230d2acaa4a4c9c5d4d1119b2ee77d/age.md#scrypt-recipient-stanza),
    -- no other stanzas can be specified in the header when there is an
    -- @scrypt@ stanza. This is to uphold an expectation of authentication that
    -- is implicit in password-based encryption.
    --
    -- As a result, only one @scrypt@ recipient can be specified.
    RecipientsScrypt !ScryptRecipient
  | -- | X25519 recipients.
    RecipientsX25519 !(NonEmpty X25519Recipient)
  deriving stock (Int -> Recipients -> ShowS
[Recipients] -> ShowS
Recipients -> String
(Int -> Recipients -> ShowS)
-> (Recipients -> String)
-> ([Recipients] -> ShowS)
-> Show Recipients
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recipients -> ShowS
showsPrec :: Int -> Recipients -> ShowS
$cshow :: Recipients -> String
show :: Recipients -> String
$cshowList :: [Recipients] -> ShowS
showList :: [Recipients] -> ShowS
Show, Recipients -> Recipients -> Bool
(Recipients -> Recipients -> Bool)
-> (Recipients -> Recipients -> Bool) -> Eq Recipients
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Recipients -> Recipients -> Bool
== :: Recipients -> Recipients -> Bool
$c/= :: Recipients -> Recipients -> Bool
/= :: Recipients -> Recipients -> Bool
Eq)