hOpenPGP-3.5.1: 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
( SEIPDv2Failure (..)
, aeadModeAndNonceSizeForSEIPDv2
, supportedSEIPDv2AEADAlgorithms
, supportedSEIPDv2SymmetricAlgorithms
, 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 Data.Either (isRight)
import qualified Data.Set as Set
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 (Eq, Show)
renderSEIPDv2Failure :: SEIPDv2Failure -> String
renderSEIPDv2Failure (SEIPDv2UnsupportedAEADAlgorithm EAX) =
"EAX is currently unsupported by the crypton AEAD backend"
renderSEIPDv2Failure (SEIPDv2UnsupportedAEADAlgorithm alg) =
"unsupported AEAD algorithm: " ++ show alg
renderSEIPDv2Failure (SEIPDv2UnsupportedSymmetricAlgorithm _) =
"SEIPD v2 encrypt currently supports AES-128/192/256 only"
renderSEIPDv2Failure SEIPDv2InvalidSaltLength =
"SEIPD v2 salt must be exactly 32 octets"
renderSEIPDv2Failure SEIPDv2InvalidIVLength =
"SKESK v6 IV length does not match AEAD algorithm"
renderSEIPDv2Failure SEIPDv2InvalidChunkSize =
"SEIPD v2 chunk size octet must be between 0 and 16"
renderSEIPDv2Failure SEIPDv2CiphertextTooShort =
"SEIPD v2 ciphertext must include at least one chunk tag and a final tag"
renderSEIPDv2Failure SEIPDv2MalformedChunkLengths =
"SEIPD v2 malformed chunk lengths"
renderSEIPDv2Failure SEIPDv2MissingFinalTag =
"SEIPD v2 missing final authentication tag"
renderSEIPDv2Failure (SEIPDv2ChunkAuthFailed algo chunk) =
"AEAD chunk authentication failed for "
++ show algo
++ " at chunk "
++ show chunk
renderSEIPDv2Failure (SEIPDv2FinalTagFailed algo) =
"AEAD final tag verification failed for " ++ show algo
renderSEIPDv2Failure SEIPDv2AuthFailed =
"SKESK v6 authentication failed"
renderSEIPDv2Failure (SEIPDv2CipherInitFailed err) =
"AEAD initialization failed: " ++ show err
renderSEIPDv2Failure (SEIPDv2CipherFailed err) =
"AEAD/cipher operation failed: " ++ renderCipherError err
renderSEIPDv2Failure (SEIPDv2SessionKeyError err) =
renderS2KError err
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
SEIPDv2CipherInitFailed
(SEIPDv2UnsupportedSymmetricAlgorithm symalgo)
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 SEIPDv2CipherInitFailed . 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
SEIPDv2CipherInitFailed
(SEIPDv2UnsupportedSymmetricAlgorithm symalgo)
symalgo
kek
( \cipher ->
if mode == CCT.AEAD_OCB
then
decryptWithOCBRFC7253With
(\_ _ _ _ _ _ -> SEIPDv2AuthFailed)
cipher
iv
(skeskV6Info symalgo aead)
ciphertext
(mkAuthTag tag)
else do
aeadCtx <-
first SEIPDv2CipherInitFailed . 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