hOpenPGP-3.6: 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.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 Data.Either (isRight)
import qualified Data.Set as Set
import qualified "crypton" Crypto.Cipher.Types as CCT

import Codec.Encryption.OpenPGP.Internal.CryptoAES
    ( withAESCipher
    )
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
            withAESCipher
                (SEIPDv2CipherFailed . CipherInitFailed symalgo . show)
                ( SEIPDv2CipherFailed
                    (CipherInitFailed symalgo "unsupported symmetric algorithm")
                )
                symalgo
                kek
                ( \cipher ->
                    if mode == CCT.AEAD_OCB
                        then do
                            (tag, ciphertext) <-
                                encryptWithOCBRFC7253
                                    cipher
                                    iv
                                    (skeskV6Info symalgo aead)
                                    sessionKey
                            pure (ciphertext, authTagToBS tag)
                        else do
                            aeadCtx <-
                                first (SEIPDv2CipherFailed . CipherInitFailed symalgo . show)
                                    . CE.eitherCryptoError
                                    $ CCT.aeadInit mode cipher 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 symalgo aead kek iv ciphertext tag = do
    (mode, nonceSize) <- aeadModeAndNonceSizeForSEIPDv2 aead
    if B.length iv /= nonceSize
        then Left SEIPDv2InvalidIVLength
        else
            withAESCipher
                (SEIPDv2CipherFailed . CipherInitFailed symalgo . show)
                ( SEIPDv2CipherFailed
                    (CipherInitFailed symalgo "unsupported symmetric algorithm")
                )
                symalgo
                kek
                ( \cipher ->
                    if mode == CCT.AEAD_OCB
                        then
                            decryptWithOCBRFC7253With
                                (\_ _ _ _ _ _ -> SEIPDv2AuthFailed)
                                cipher
                                iv
                                (skeskV6Info symalgo aead)
                                ciphertext
                                (mkAuthTag tag)
                        else do
                            aeadCtx <-
                                first (SEIPDv2CipherFailed . CipherInitFailed symalgo . show)
                                    . CE.eitherCryptoError
                                    $ CCT.aeadInit mode cipher iv
                            note
                                SEIPDv2AuthFailed
                                ( CCT.aeadSimpleDecrypt
                                    aeadCtx
                                    (skeskV6Info symalgo aead)
                                    ciphertext
                                    (mkAuthTag tag)
                                )
                )

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

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