BlockCipher.hs

-- BlockCipher.hs: OpenPGP (RFC9580) block cipher stuff
-- Copyright © 2013-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE RankNTypes #-}

module Codec.Encryption.OpenPGP.BlockCipher
    ( CipherError (..)
    , renderCipherError
    , keySize
    , supportedSymmetricAlgorithmsForCFB
    , withSymmetricCipher
    ) where

import qualified Crypto.Cipher.AES as AES
import qualified Crypto.Cipher.Blowfish as Blowfish
import qualified Crypto.Cipher.Camellia as Camellia
import qualified Crypto.Cipher.TripleDES as TripleDES
import qualified Crypto.Nettle.Ciphers as CNC
import qualified Data.ByteString as B
import qualified Data.Set as Set

import Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes
    ( HOWrappedOldCCT (..)
    )
import Codec.Encryption.OpenPGP.Internal.Crypton
    ( HOWrappedCCT (..)
    )
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher
import Codec.Encryption.OpenPGP.Types

-- | Errors that can arise from block-cipher operations in this library.
data CipherError
    = -- | The algorithm is not supported or not implemented.
      UnsupportedAlgorithm SymmetricAlgorithm
    | -- | Cipher initialization failed (bad key material).
      CipherInitFailed SymmetricAlgorithm String
    | -- | A CFB or other block-cipher operation failed.
      CipherOperationFailed String
    deriving (Eq, Show)

renderCipherError :: CipherError -> String
renderCipherError (UnsupportedAlgorithm sa) =
    "Unsupported symmetric algorithm: " ++ show sa
renderCipherError (CipherInitFailed sa msg) =
    "Cipher initialization failed for " ++ show sa ++ ": " ++ msg
renderCipherError (CipherOperationFailed msg) =
    "Cipher operation failed: " ++ msg

type HOCipher a =
    forall cipher
     . HOBlockCipher cipher
    => cipher -> Either String a

withSymmetricCipher
    :: SymmetricAlgorithm
    -> B.ByteString
    -> HOCipher a
    -> Either CipherError a
withSymmetricCipher Plaintext _ _ = Left (UnsupportedAlgorithm Plaintext)
withSymmetricCipher IDEA _ _ = Left (UnsupportedAlgorithm IDEA)
withSymmetricCipher ReservedSAFER _ _ = Left (UnsupportedAlgorithm ReservedSAFER)
withSymmetricCipher ReservedDES _ _ = Left (UnsupportedAlgorithm ReservedDES)
withSymmetricCipher (OtherSA n) _ _ = Left (UnsupportedAlgorithm (OtherSA n))
withSymmetricCipher CAST5 keyBytes f =
    initAndRun
        CAST5
        ( cipherInit keyBytes
            :: Either String (HOWrappedOldCCT CNC.CAST128)
        )
        f
withSymmetricCipher Twofish keyBytes f =
    initAndRun
        Twofish
        ( cipherInit keyBytes
            :: Either String (HOWrappedOldCCT CNC.TWOFISH)
        )
        f
withSymmetricCipher TripleDES keyBytes f =
    initAndRun
        TripleDES
        ( cipherInit keyBytes
            :: Either String (HOWrappedCCT TripleDES.DES_EDE3)
        )
        f
withSymmetricCipher Blowfish keyBytes f =
    initAndRun
        Blowfish
        ( cipherInit keyBytes
            :: Either String (HOWrappedCCT Blowfish.Blowfish128)
        )
        f
withSymmetricCipher AES128 keyBytes f =
    initAndRun
        AES128
        (cipherInit keyBytes :: Either String (HOWrappedCCT AES.AES128))
        f
withSymmetricCipher AES192 keyBytes f =
    initAndRun
        AES192
        (cipherInit keyBytes :: Either String (HOWrappedCCT AES.AES192))
        f
withSymmetricCipher AES256 keyBytes f =
    initAndRun
        AES256
        (cipherInit keyBytes :: Either String (HOWrappedCCT AES.AES256))
        f
withSymmetricCipher Camellia128 keyBytes f =
    initAndRun
        Camellia128
        ( cipherInit keyBytes
            :: Either String (HOWrappedCCT Camellia.Camellia128)
        )
        f
withSymmetricCipher Camellia192 keyBytes f =
    initAndRun
        Camellia192
        ( cipherInit keyBytes
            :: Either String (HOWrappedOldCCT CNC.Camellia192)
        )
        f
withSymmetricCipher Camellia256 keyBytes f =
    initAndRun
        Camellia256
        ( cipherInit keyBytes
            :: Either String (HOWrappedOldCCT CNC.Camellia256)
        )
        f

{- | Symmetric algorithms that the CFB (SEIPDv1) encryption backend can use for
new *encryption*, restricted to the RFC 9580 §9.3-permitted set.

This is the intersection of:
  * algorithms 'withSymmetricCipher' can actually encrypt
    (`CAST5`, `Twofish`, `TripleDES`, `Blowfish`, `AES128/192/256`,
    `Camellia128/192/256`), minus
  * algorithms RFC 9580 §9.3 forbids for new encryption (`IDEA`, `TripleDES`,
    `CAST5`).

Decryption backward-compatibility is unaffected: 'withSymmetricCipher' still
handles all ten algorithms, including the three forbidden above.
-}
supportedSymmetricAlgorithmsForCFB :: Set.Set SymmetricAlgorithm
supportedSymmetricAlgorithmsForCFB =
    Set.fromList
        [ Twofish
        , Blowfish
        , AES128
        , AES192
        , AES256
        , Camellia128
        , Camellia192
        , Camellia256
        ]

initAndRun
    :: HOBlockCipher cipher
    => SymmetricAlgorithm
    -> Either String cipher
    -> (cipher -> Either String a)
    -> Either CipherError a
initAndRun algo initResult f =
    case initResult of
        Left err -> Left (CipherInitFailed algo err)
        Right c ->
            case f c of
                Left err -> Left (CipherOperationFailed err)
                Right x -> Right x

-- In octets. Keep this as an explicit OpenPGP algorithm mapping so behavior
-- stays stable across mixed backends (crypton/nettle) and includes unsupported
-- algorithms that never reach backend cipher types.
keySize :: SymmetricAlgorithm -> Either CipherError Int
keySize Plaintext = Right 0
keySize IDEA = Right 16
keySize TripleDES = Right 24
keySize CAST5 = Right 16
keySize Blowfish = Right 16
keySize ReservedSAFER = Left (UnsupportedAlgorithm ReservedSAFER)
keySize ReservedDES = Left (UnsupportedAlgorithm ReservedDES)
keySize AES128 = Right 16
keySize AES192 = Right 24
keySize AES256 = Right 32
keySize Twofish = Right 32
keySize Camellia128 = Right 16
keySize Camellia192 = Right 24
keySize Camellia256 = Right 32
keySize (OtherSA n) = Left (UnsupportedAlgorithm (OtherSA n))