hOpenPGP-3.7: Codec/Encryption/OpenPGP/SEIPDv2.hs

-- 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
    ( aeadModeAndNonceSizeForSEIPDv2
    , supportedSEIPDv2AEADAlgorithms
    , supportedSEIPDv2SymmetricAlgorithms
    , seipdv2SymmetricKeySize
    , deriveSKESK6KEK
    , encryptSKESK6SessionKey
    , decryptSKESK6SessionKey
    ) where

import Control.Error.Util (note)
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 Data.Either (isRight)
import qualified Data.Set as Set
import qualified "crypton" Crypto.Cipher.Types as CCT

import Codec.Encryption.OpenPGP.BlockCipher
    ( withAEADCipher
    )
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher
    ( HOBlockCipher (..)
    )
import Codec.Encryption.OpenPGP.Internal.RFC7253OCB
    ( decryptWithOCBRFC7253With
    , encryptWithOCBRFC7253
    )
import Codec.Encryption.OpenPGP.Types

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

{- | AEAD algorithms that the SEIPDv2 encryption backend can actually use,
in descending preference order. Derived directly from
'aeadModeAndNonceSizeForSEIPDv2' so that enabling backend support for an
algorithm (e.g. flipping the EAX case to 'Right') automatically makes it
available to capability negotiation without touching the negotiation code.
-}
supportedSEIPDv2AEADAlgorithms :: Set.Set AEADAlgorithm
supportedSEIPDv2AEADAlgorithms =
    Set.fromList
        [ a
        | a <- [OCB, EAX, GCM]
        , isRight (aeadModeAndNonceSizeForSEIPDv2 a)
        ]

{- | Symmetric algorithms that the SEIPDv2 encryption backend can actually use.
Derived directly from 'seipdv2SymmetricKeySize' so that enabling backend support
for an algorithm automatically makes it available to capability negotiation.
-}
supportedSEIPDv2SymmetricAlgorithms :: Set.Set SymmetricAlgorithm
supportedSEIPDv2SymmetricAlgorithms =
    Set.fromList
        [ a
        | a <- [AES128, AES192, AES256]
        , isRight (seipdv2SymmetricKeySize a)
        ]

seipdv2SymmetricKeySize
    :: SymmetricAlgorithm -> Either SEIPDv2Failure Int
seipdv2SymmetricKeySize symalgo =
    case symalgo of
        AES128 -> Right 16
        AES192 -> Right 24
        AES256 -> Right 32
        _ -> Left $ SEIPDv2UnsupportedSymmetricAlgorithm symalgo

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

deriveSKESK6KEK
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> B.ByteString
    -> Either SEIPDv2Failure B.ByteString
deriveSKESK6KEK symalgo aead ikm = do
    keyLen <- seipdv2SymmetricKeySize symalgo
    let prk = extract @CHA.SHA256 B.empty 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 symalgo aead kek iv sessionKey = do
    (mode, nonceSize) <- aeadModeAndNonceSizeForSEIPDv2 aead
    if B.length iv /= nonceSize
        then Left SEIPDv2InvalidIVLength
        else
            first
                SEIPDv2CipherFailed
                ( withAEADCipher
                    symalgo
                    kek
                    ( \cipher ->
                        if mode == CCT.AEAD_OCB
                            then do
                                (tag, ct) <-
                                    encryptWithOCBRFC7253
                                        cipher
                                        iv
                                        (skeskV6Info symalgo aead)
                                        sessionKey
                                pure (ct, authTagToBS tag)
                            else do
                                aeadCtx <-
                                    aeadInit mode cipher iv
                                let (tag, ciphertext) =
                                        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 symalgo aead kek iv ciphertext tag = do
    (mode, nonceSize) <- aeadModeAndNonceSizeForSEIPDv2 aead
    if B.length iv /= nonceSize
        then Left SEIPDv2InvalidIVLength
        else
            first
                SEIPDv2CipherFailed
                ( withAEADCipher
                    symalgo
                    kek
                    ( \cipher ->
                        if mode == CCT.AEAD_OCB
                            then
                                decryptWithOCBRFC7253With
                                    (\_ _ _ _ _ _ -> CipherAEADAuthFailed)
                                    cipher
                                    iv
                                    (skeskV6Info symalgo aead)
                                    ciphertext
                                    (mkAuthTag tag)
                            else do
                                aeadCtx <-
                                    aeadInit mode cipher iv
                                let decrypted =
                                        aeadSimpleDecrypt
                                            aeadCtx
                                            (skeskV6Info symalgo aead)
                                            ciphertext
                                            (mkAuthTag tag)
                                note
                                    CipherAEADDecryptFailed
                                    decrypted
                    )
                )

authTagToBS :: CCT.AuthTag -> B.ByteString
authTagToBS = BA.convert . CCT.unAuthTag

mkAuthTag :: B.ByteString -> CCT.AuthTag
mkAuthTag = CCT.AuthTag . BA.convert