-- SEIPDv2.hs: OpenPGP (RFC9580) SEIPDv2 and SKESK v6 crypto helpers
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}

module Codec.Encryption.OpenPGP.SEIPDv2
    ( SEIPDv2Failure (..)
    , aeadModeAndNonceSizeForSEIPDv2
    , seipdv2SymmetricKeySize
    , deriveSKESK6KEK
    , encryptSKESK6SessionKey
    , decryptSKESK6SessionKey
    , renderSEIPDv2Failure
    ) where

import Control.Error.Util (note)
import qualified Crypto.Error as CE
import qualified Crypto.Hash.Algorithms as CHA
import Crypto.KDF.HKDF (expand, extract)
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified "crypton" Crypto.Cipher.Types as CCT

import Codec.Encryption.OpenPGP.BlockCipher
    ( CipherError (..)
    , renderCipherError
    )
import Codec.Encryption.OpenPGP.Internal.CryptoAES
    ( withAESCipher
    )
import Codec.Encryption.OpenPGP.Internal.RFC7253OCB
    ( decryptWithOCBRFC7253With
    , encryptWithOCBRFC7253
    )
import Codec.Encryption.OpenPGP.S2K (S2KError, renderS2KError)
import Codec.Encryption.OpenPGP.Types

data SEIPDv2Failure
    = SEIPDv2UnsupportedAEADAlgorithm AEADAlgorithm
    | SEIPDv2UnsupportedSymmetricAlgorithm SymmetricAlgorithm
    | SEIPDv2InvalidSaltLength
    | SEIPDv2InvalidIVLength
    | SEIPDv2InvalidChunkSize
    | SEIPDv2CiphertextTooShort
    | SEIPDv2MalformedChunkLengths
    | SEIPDv2MissingFinalTag
    | SEIPDv2ChunkAuthFailed AEADAlgorithm Int
    | SEIPDv2FinalTagFailed AEADAlgorithm
    | SEIPDv2AuthFailed
    | SEIPDv2CipherInitFailed CE.CryptoError
    | SEIPDv2CipherFailed CipherError
    | SEIPDv2SessionKeyError S2KError
    deriving (SEIPDv2Failure -> SEIPDv2Failure -> Bool
(SEIPDv2Failure -> SEIPDv2Failure -> Bool)
-> (SEIPDv2Failure -> SEIPDv2Failure -> Bool) -> Eq SEIPDv2Failure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SEIPDv2Failure -> SEIPDv2Failure -> Bool
== :: SEIPDv2Failure -> SEIPDv2Failure -> Bool
$c/= :: SEIPDv2Failure -> SEIPDv2Failure -> Bool
/= :: SEIPDv2Failure -> SEIPDv2Failure -> Bool
Eq, Int -> SEIPDv2Failure -> ShowS
[SEIPDv2Failure] -> ShowS
SEIPDv2Failure -> [Char]
(Int -> SEIPDv2Failure -> ShowS)
-> (SEIPDv2Failure -> [Char])
-> ([SEIPDv2Failure] -> ShowS)
-> Show SEIPDv2Failure
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SEIPDv2Failure -> ShowS
showsPrec :: Int -> SEIPDv2Failure -> ShowS
$cshow :: SEIPDv2Failure -> [Char]
show :: SEIPDv2Failure -> [Char]
$cshowList :: [SEIPDv2Failure] -> ShowS
showList :: [SEIPDv2Failure] -> ShowS
Show)

renderSEIPDv2Failure :: SEIPDv2Failure -> String
renderSEIPDv2Failure :: SEIPDv2Failure -> [Char]
renderSEIPDv2Failure (SEIPDv2UnsupportedAEADAlgorithm AEADAlgorithm
EAX) =
    [Char]
"EAX is currently unsupported by the crypton AEAD backend"
renderSEIPDv2Failure (SEIPDv2UnsupportedAEADAlgorithm AEADAlgorithm
alg) =
    [Char]
"unsupported AEAD algorithm: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AEADAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show AEADAlgorithm
alg
renderSEIPDv2Failure (SEIPDv2UnsupportedSymmetricAlgorithm SymmetricAlgorithm
_) =
    [Char]
"SEIPD v2 encrypt currently supports AES-128/192/256 only"
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2InvalidSaltLength =
    [Char]
"SEIPD v2 salt must be exactly 32 octets"
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2InvalidIVLength =
    [Char]
"SKESK v6 IV length does not match AEAD algorithm"
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2InvalidChunkSize =
    [Char]
"SEIPD v2 chunk size octet must be between 0 and 16"
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2CiphertextTooShort =
    [Char]
"SEIPD v2 ciphertext must include at least one chunk tag and a final tag"
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2MalformedChunkLengths =
    [Char]
"SEIPD v2 malformed chunk lengths"
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2MissingFinalTag =
    [Char]
"SEIPD v2 missing final authentication tag"
renderSEIPDv2Failure (SEIPDv2ChunkAuthFailed AEADAlgorithm
algo Int
chunk) =
    [Char]
"AEAD chunk authentication failed for "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AEADAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show AEADAlgorithm
algo
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" at chunk "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
chunk
renderSEIPDv2Failure (SEIPDv2FinalTagFailed AEADAlgorithm
algo) =
    [Char]
"AEAD final tag verification failed for " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AEADAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show AEADAlgorithm
algo
renderSEIPDv2Failure SEIPDv2Failure
SEIPDv2AuthFailed =
    [Char]
"SKESK v6 authentication failed"
renderSEIPDv2Failure (SEIPDv2CipherInitFailed CryptoError
err) =
    [Char]
"AEAD initialization failed: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err
renderSEIPDv2Failure (SEIPDv2CipherFailed CipherError
err) =
    [Char]
"AEAD/cipher operation failed: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CipherError -> [Char]
renderCipherError CipherError
err
renderSEIPDv2Failure (SEIPDv2SessionKeyError S2KError
err) =
    S2KError -> [Char]
renderS2KError S2KError
err

aeadModeAndNonceSizeForSEIPDv2
    :: AEADAlgorithm -> Either SEIPDv2Failure (CCT.AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2 :: AEADAlgorithm -> Either SEIPDv2Failure (AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2 AEADAlgorithm
EAX =
    SEIPDv2Failure -> Either SEIPDv2Failure (AEADMode, Int)
forall a b. a -> Either a b
Left (SEIPDv2Failure -> Either SEIPDv2Failure (AEADMode, Int))
-> SEIPDv2Failure -> Either SEIPDv2Failure (AEADMode, Int)
forall a b. (a -> b) -> a -> b
$ AEADAlgorithm -> SEIPDv2Failure
SEIPDv2UnsupportedAEADAlgorithm AEADAlgorithm
EAX
aeadModeAndNonceSizeForSEIPDv2 AEADAlgorithm
OCB = (AEADMode, Int) -> Either SEIPDv2Failure (AEADMode, Int)
forall a b. b -> Either a b
Right (AEADMode
CCT.AEAD_OCB, Int
15)
aeadModeAndNonceSizeForSEIPDv2 AEADAlgorithm
GCM = (AEADMode, Int) -> Either SEIPDv2Failure (AEADMode, Int)
forall a b. b -> Either a b
Right (AEADMode
CCT.AEAD_GCM, Int
12)
aeadModeAndNonceSizeForSEIPDv2 (OtherAEADAlgo Word8
_) =
    SEIPDv2Failure -> Either SEIPDv2Failure (AEADMode, Int)
forall a b. a -> Either a b
Left (SEIPDv2Failure -> Either SEIPDv2Failure (AEADMode, Int))
-> (AEADAlgorithm -> SEIPDv2Failure)
-> AEADAlgorithm
-> Either SEIPDv2Failure (AEADMode, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AEADAlgorithm -> SEIPDv2Failure
SEIPDv2UnsupportedAEADAlgorithm (AEADAlgorithm -> Either SEIPDv2Failure (AEADMode, Int))
-> AEADAlgorithm -> Either SEIPDv2Failure (AEADMode, Int)
forall a b. (a -> b) -> a -> b
$ Word8 -> AEADAlgorithm
OtherAEADAlgo Word8
0

seipdv2SymmetricKeySize
    :: SymmetricAlgorithm -> Either SEIPDv2Failure Int
seipdv2SymmetricKeySize :: SymmetricAlgorithm -> Either SEIPDv2Failure Int
seipdv2SymmetricKeySize SymmetricAlgorithm
symalgo =
    case SymmetricAlgorithm
symalgo of
        SymmetricAlgorithm
AES128 -> Int -> Either SEIPDv2Failure Int
forall a b. b -> Either a b
Right Int
16
        SymmetricAlgorithm
AES192 -> Int -> Either SEIPDv2Failure Int
forall a b. b -> Either a b
Right Int
24
        SymmetricAlgorithm
AES256 -> Int -> Either SEIPDv2Failure Int
forall a b. b -> Either a b
Right Int
32
        SymmetricAlgorithm
_ -> SEIPDv2Failure -> Either SEIPDv2Failure Int
forall a b. a -> Either a b
Left (SEIPDv2Failure -> Either SEIPDv2Failure Int)
-> SEIPDv2Failure -> Either SEIPDv2Failure Int
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> SEIPDv2Failure
SEIPDv2UnsupportedSymmetricAlgorithm SymmetricAlgorithm
symalgo

skeskV6Info
    :: SymmetricAlgorithm -> AEADAlgorithm -> B.ByteString
skeskV6Info :: SymmetricAlgorithm -> AEADAlgorithm -> ByteString
skeskV6Info SymmetricAlgorithm
symalgo AEADAlgorithm
aead = [Word8] -> ByteString
B.pack [Word8
0xc3, Word8
6, SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
symalgo, AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aead]

deriveSKESK6KEK
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> B.ByteString
    -> Either SEIPDv2Failure B.ByteString
deriveSKESK6KEK :: SymmetricAlgorithm
-> AEADAlgorithm -> ByteString -> Either SEIPDv2Failure ByteString
deriveSKESK6KEK SymmetricAlgorithm
symalgo AEADAlgorithm
aead ByteString
ikm = do
    keyLen <- SymmetricAlgorithm -> Either SEIPDv2Failure Int
seipdv2SymmetricKeySize SymmetricAlgorithm
symalgo
    let prk = forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
extract @CHA.SHA256 ByteString
B.empty ByteString
ikm
    pure (expand @CHA.SHA256 prk (skeskV6Info symalgo aead) keyLen)

encryptSKESK6SessionKey
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> Either SEIPDv2Failure (B.ByteString, B.ByteString)
encryptSKESK6SessionKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> ByteString
-> ByteString
-> ByteString
-> Either SEIPDv2Failure (ByteString, ByteString)
encryptSKESK6SessionKey SymmetricAlgorithm
symalgo AEADAlgorithm
aead ByteString
kek ByteString
iv ByteString
sessionKey = do
    (mode, nonceSize) <- AEADAlgorithm -> Either SEIPDv2Failure (AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2 AEADAlgorithm
aead
    if B.length iv /= nonceSize
        then Left SEIPDv2InvalidIVLength
        else
            withAESCipher
                SEIPDv2CipherInitFailed
                (SEIPDv2UnsupportedSymmetricAlgorithm symalgo)
                symalgo
                kek
                ( \cipher
cipher ->
                    if AEADMode
mode AEADMode -> AEADMode -> Bool
forall a. Eq a => a -> a -> Bool
== AEADMode
CCT.AEAD_OCB
                        then do
                            (tag, ciphertext) <-
                                cipher
-> ByteString
-> ByteString
-> ByteString
-> Either SEIPDv2Failure (AuthTag, ByteString)
forall c e.
BlockCipher c =>
c
-> ByteString
-> ByteString
-> ByteString
-> Either e (AuthTag, ByteString)
encryptWithOCBRFC7253
                                    cipher
cipher
                                    ByteString
iv
                                    (SymmetricAlgorithm -> AEADAlgorithm -> ByteString
skeskV6Info SymmetricAlgorithm
symalgo AEADAlgorithm
aead)
                                    ByteString
sessionKey
                            pure (ciphertext, authTagToBS tag)
                        else do
                            aeadCtx <-
                                (CryptoError -> SEIPDv2Failure)
-> Either CryptoError (AEAD cipher)
-> Either SEIPDv2Failure (AEAD cipher)
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 CryptoError -> SEIPDv2Failure
SEIPDv2CipherInitFailed (Either CryptoError (AEAD cipher)
 -> Either SEIPDv2Failure (AEAD cipher))
-> (CryptoFailable (AEAD cipher)
    -> Either CryptoError (AEAD cipher))
-> CryptoFailable (AEAD cipher)
-> Either SEIPDv2Failure (AEAD cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (CryptoFailable (AEAD cipher)
 -> Either SEIPDv2Failure (AEAD cipher))
-> CryptoFailable (AEAD cipher)
-> Either SEIPDv2Failure (AEAD cipher)
forall a b. (a -> b) -> a -> b
$
                                    AEADMode -> cipher -> ByteString -> CryptoFailable (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
forall iv.
ByteArrayAccess iv =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
CCT.aeadInit AEADMode
mode cipher
cipher ByteString
iv
                            let (tag, ciphertext) =
                                    CCT.aeadSimpleEncrypt
                                        aeadCtx
                                        (skeskV6Info symalgo aead)
                                        sessionKey
                                        16
                            pure (ciphertext, authTagToBS tag)
                )

decryptSKESK6SessionKey
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> Either SEIPDv2Failure B.ByteString
decryptSKESK6SessionKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Either SEIPDv2Failure ByteString
decryptSKESK6SessionKey SymmetricAlgorithm
symalgo AEADAlgorithm
aead ByteString
kek ByteString
iv ByteString
ciphertext ByteString
tag = do
    (mode, nonceSize) <- AEADAlgorithm -> Either SEIPDv2Failure (AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2 AEADAlgorithm
aead
    if B.length iv /= nonceSize
        then Left SEIPDv2InvalidIVLength
        else
            withAESCipher
                SEIPDv2CipherInitFailed
                (SEIPDv2UnsupportedSymmetricAlgorithm symalgo)
                symalgo
                kek
                ( \cipher
cipher ->
                    if AEADMode
mode AEADMode -> AEADMode -> Bool
forall a. Eq a => a -> a -> Bool
== AEADMode
CCT.AEAD_OCB
                        then
                            (ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> SEIPDv2Failure)
-> cipher
-> ByteString
-> ByteString
-> ByteString
-> AuthTag
-> Either SEIPDv2Failure ByteString
forall c e.
BlockCipher c =>
(ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> e)
-> c
-> ByteString
-> ByteString
-> ByteString
-> AuthTag
-> Either e ByteString
decryptWithOCBRFC7253With
                                (\ByteString
_ ByteString
_ ByteString
_ ByteString
_ ByteString
_ ByteString
_ -> SEIPDv2Failure
SEIPDv2AuthFailed)
                                cipher
cipher
                                ByteString
iv
                                (SymmetricAlgorithm -> AEADAlgorithm -> ByteString
skeskV6Info SymmetricAlgorithm
symalgo AEADAlgorithm
aead)
                                ByteString
ciphertext
                                (ByteString -> AuthTag
mkAuthTag ByteString
tag)
                        else do
                            aeadCtx <-
                                (CryptoError -> SEIPDv2Failure)
-> Either CryptoError (AEAD cipher)
-> Either SEIPDv2Failure (AEAD cipher)
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 CryptoError -> SEIPDv2Failure
SEIPDv2CipherInitFailed (Either CryptoError (AEAD cipher)
 -> Either SEIPDv2Failure (AEAD cipher))
-> (CryptoFailable (AEAD cipher)
    -> Either CryptoError (AEAD cipher))
-> CryptoFailable (AEAD cipher)
-> Either SEIPDv2Failure (AEAD cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (CryptoFailable (AEAD cipher)
 -> Either SEIPDv2Failure (AEAD cipher))
-> CryptoFailable (AEAD cipher)
-> Either SEIPDv2Failure (AEAD cipher)
forall a b. (a -> b) -> a -> b
$
                                    AEADMode -> cipher -> ByteString -> CryptoFailable (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
forall iv.
ByteArrayAccess iv =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
CCT.aeadInit AEADMode
mode cipher
cipher ByteString
iv
                            note
                                SEIPDv2AuthFailed
                                ( CCT.aeadSimpleDecrypt
                                    aeadCtx
                                    (skeskV6Info symalgo aead)
                                    ciphertext
                                    (mkAuthTag tag)
                                )
                )

authTagToBS :: CCT.AuthTag -> B.ByteString
authTagToBS :: AuthTag -> ByteString
authTagToBS = Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Bytes -> ByteString)
-> (AuthTag -> Bytes) -> AuthTag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthTag -> Bytes
CCT.unAuthTag

mkAuthTag :: B.ByteString -> CCT.AuthTag
mkAuthTag :: ByteString -> AuthTag
mkAuthTag = Bytes -> AuthTag
CCT.AuthTag (Bytes -> AuthTag)
-> (ByteString -> Bytes) -> ByteString -> AuthTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert