-- CFB.hs: OpenPGP (RFC9580) CFB mode
-- Copyright © 2013-2026  Clint Adams
-- Copyright © 2013  Daniel Kahn Gillmor
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}

module Codec.Encryption.OpenPGP.CFB
    ( decrypt
    , decryptPreservingNonce
    , decryptNoNonce
    , decryptOpenPGPCfb
    , decryptOpenPGPCfbWithNonce
    , OpenPGPCFBMode (..)
    , OpenPGPCFBModeW (..)
    , encryptNoNonce
    , encryptOpenPGPCfbRaw
    ) where

import qualified Data.ByteString as B

import Codec.Encryption.OpenPGP.BlockCipher
    ( CipherError (..)
    , withSymmetricCipher
    )
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher
import Codec.Encryption.OpenPGP.Types

data OpenPGPCFBMode
    = OpenPGPCFBResync
    | OpenPGPCFBNoResync
    deriving (OpenPGPCFBMode -> OpenPGPCFBMode -> Bool
(OpenPGPCFBMode -> OpenPGPCFBMode -> Bool)
-> (OpenPGPCFBMode -> OpenPGPCFBMode -> Bool) -> Eq OpenPGPCFBMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenPGPCFBMode -> OpenPGPCFBMode -> Bool
== :: OpenPGPCFBMode -> OpenPGPCFBMode -> Bool
$c/= :: OpenPGPCFBMode -> OpenPGPCFBMode -> Bool
/= :: OpenPGPCFBMode -> OpenPGPCFBMode -> Bool
Eq, Int -> OpenPGPCFBMode -> ShowS
[OpenPGPCFBMode] -> ShowS
OpenPGPCFBMode -> String
(Int -> OpenPGPCFBMode -> ShowS)
-> (OpenPGPCFBMode -> String)
-> ([OpenPGPCFBMode] -> ShowS)
-> Show OpenPGPCFBMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenPGPCFBMode -> ShowS
showsPrec :: Int -> OpenPGPCFBMode -> ShowS
$cshow :: OpenPGPCFBMode -> String
show :: OpenPGPCFBMode -> String
$cshowList :: [OpenPGPCFBMode] -> ShowS
showList :: [OpenPGPCFBMode] -> ShowS
Show)

data OpenPGPCFBModeW (mode :: OpenPGPCFBMode) where
    OpenPGPCFBResyncW :: OpenPGPCFBModeW 'OpenPGPCFBResync
    OpenPGPCFBNoResyncW :: OpenPGPCFBModeW 'OpenPGPCFBNoResync

decryptOpenPGPCfb
    :: SymmetricAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> Either CipherError B.ByteString
decryptOpenPGPCfb :: SymmetricAlgorithm
-> ByteString -> ByteString -> Either CipherError ByteString
decryptOpenPGPCfb SymmetricAlgorithm
sa ByteString
ciphertext ByteString
keydata =
    (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> Either CipherError (ByteString, ByteString)
-> Either CipherError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SymmetricAlgorithm
-> ByteString
-> ByteString
-> Either CipherError (ByteString, ByteString)
decryptOpenPGPCfbWithNonce SymmetricAlgorithm
sa ByteString
ciphertext ByteString
keydata

decryptOpenPGPCfbWithNonce
    :: SymmetricAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> Either CipherError (B.ByteString, B.ByteString)
decryptOpenPGPCfbWithNonce :: SymmetricAlgorithm
-> ByteString
-> ByteString
-> Either CipherError (ByteString, ByteString)
decryptOpenPGPCfbWithNonce SymmetricAlgorithm
Plaintext ByteString
ciphertext ByteString
_ = (ByteString, ByteString)
-> Either CipherError (ByteString, ByteString)
forall a. a -> Either CipherError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
forall a. Monoid a => a
mempty, ByteString
ciphertext)
decryptOpenPGPCfbWithNonce SymmetricAlgorithm
sa ByteString
ciphertext ByteString
keydata =
    SymmetricAlgorithm
-> ByteString
-> HOCipher (ByteString, ByteString)
-> Either CipherError (ByteString, ByteString)
forall a.
SymmetricAlgorithm
-> ByteString -> HOCipher a -> Either CipherError a
withSymmetricCipher SymmetricAlgorithm
sa ByteString
keydata (HOCipher (ByteString, ByteString)
 -> Either CipherError (ByteString, ByteString))
-> HOCipher (ByteString, ByteString)
-> Either CipherError (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \cipher
bc -> do
        nonce <- ByteString -> cipher -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
decrypt1 ByteString
ciphertext cipher
bc
        cleartext <- decrypt2 ciphertext bc
        if nonceCheck bc nonce
            then return (nonce, cleartext)
            else Left "Session key quickcheck failed"
  where
    decrypt1
        :: HOBlockCipher cipher
        => B.ByteString
        -> cipher
        -> Either String B.ByteString
    decrypt1 :: forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
decrypt1 ByteString
ct cipher
cipher =
        cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbDecrypt
            cipher
cipher
            (Int -> Word8 -> ByteString
B.replicate (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
cipher) Word8
0)
            (Int -> ByteString -> ByteString
B.take (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
cipher Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ByteString
ct)
    decrypt2
        :: HOBlockCipher cipher
        => B.ByteString
        -> cipher
        -> Either String B.ByteString
    decrypt2 :: forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
decrypt2 ByteString
ct cipher
cipher =
        let i :: ByteString
i = Int -> ByteString -> ByteString
B.take (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
cipher) (Int -> ByteString -> ByteString
B.drop Int
2 ByteString
ct)
         in cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbDecrypt cipher
cipher ByteString
i (Int -> ByteString -> ByteString
B.drop (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
cipher Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ByteString
ct)

-- should deprecate this?
decrypt
    :: SymmetricAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> Either CipherError B.ByteString
decrypt :: SymmetricAlgorithm
-> ByteString -> ByteString -> Either CipherError ByteString
decrypt SymmetricAlgorithm
x ByteString
y ByteString
z = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> Either CipherError (ByteString, ByteString)
-> Either CipherError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SymmetricAlgorithm
-> ByteString
-> ByteString
-> Either CipherError (ByteString, ByteString)
decryptPreservingNonce SymmetricAlgorithm
x ByteString
y ByteString
z)

decryptPreservingNonce
    :: SymmetricAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> Either CipherError (B.ByteString, B.ByteString)
decryptPreservingNonce :: SymmetricAlgorithm
-> ByteString
-> ByteString
-> Either CipherError (ByteString, ByteString)
decryptPreservingNonce SymmetricAlgorithm
Plaintext ByteString
ciphertext ByteString
_ = (ByteString, ByteString)
-> Either CipherError (ByteString, ByteString)
forall a. a -> Either CipherError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
forall a. Monoid a => a
mempty, ByteString
ciphertext)
decryptPreservingNonce SymmetricAlgorithm
sa ByteString
ciphertext ByteString
keydata =
    SymmetricAlgorithm
-> ByteString
-> HOCipher (ByteString, ByteString)
-> Either CipherError (ByteString, ByteString)
forall a.
SymmetricAlgorithm
-> ByteString -> HOCipher a -> Either CipherError a
withSymmetricCipher SymmetricAlgorithm
sa ByteString
keydata (HOCipher (ByteString, ByteString)
 -> Either CipherError (ByteString, ByteString))
-> HOCipher (ByteString, ByteString)
-> Either CipherError (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \cipher
bc -> do
        let bs :: Int
bs = cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
bc
        decrypted <- cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbDecrypt cipher
bc (Int -> Word8 -> ByteString
B.replicate Int
bs Word8
0) ByteString
ciphertext
        let (nonce, cleartext) = B.splitAt (bs + 2) decrypted
        if nonceCheck bc nonce
            then return (nonce, cleartext)
            else Left "Session key quickcheck failed"

decryptNoNonce
    :: SymmetricAlgorithm
    -> IV
    -> B.ByteString
    -> B.ByteString
    -> Either CipherError B.ByteString
decryptNoNonce :: SymmetricAlgorithm
-> IV -> ByteString -> ByteString -> Either CipherError ByteString
decryptNoNonce SymmetricAlgorithm
Plaintext IV
_ ByteString
ciphertext ByteString
_ = ByteString -> Either CipherError ByteString
forall a. a -> Either CipherError a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ciphertext
decryptNoNonce SymmetricAlgorithm
sa IV
iv ByteString
ciphertext ByteString
keydata =
    SymmetricAlgorithm
-> ByteString
-> HOCipher ByteString
-> Either CipherError ByteString
forall a.
SymmetricAlgorithm
-> ByteString -> HOCipher a -> Either CipherError a
withSymmetricCipher SymmetricAlgorithm
sa ByteString
keydata (ByteString -> cipher -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
decrypt' ByteString
ciphertext)
  where
    decrypt'
        :: HOBlockCipher cipher
        => B.ByteString
        -> cipher
        -> Either String B.ByteString
    decrypt' :: forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
decrypt' ByteString
ct cipher
cipher = cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbDecrypt cipher
cipher (IV -> ByteString
unIV IV
iv) ByteString
ct

nonceCheck
    :: HOBlockCipher cipher => cipher -> B.ByteString -> Bool
nonceCheck :: forall cipher. HOBlockCipher cipher => cipher -> ByteString -> Bool
nonceCheck cipher
bc =
    ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==)
        (ByteString -> ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> ByteString -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ByteString -> ByteString
B.take Int
2 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
bc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        (ByteString -> ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall a b.
(ByteString -> a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ByteString -> ByteString
B.drop (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
bc)

encryptNoNonce
    :: SymmetricAlgorithm
    -> S2K
    -> IV
    -> B.ByteString
    -> B.ByteString
    -> Either CipherError B.ByteString
encryptNoNonce :: SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> ByteString
-> Either CipherError ByteString
encryptNoNonce SymmetricAlgorithm
Plaintext S2K
_ IV
_ ByteString
payload ByteString
_ = ByteString -> Either CipherError ByteString
forall a. a -> Either CipherError a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
payload
encryptNoNonce SymmetricAlgorithm
sa S2K
_s2k IV
iv ByteString
payload ByteString
keydata =
    SymmetricAlgorithm
-> ByteString
-> HOCipher ByteString
-> Either CipherError ByteString
forall a.
SymmetricAlgorithm
-> ByteString -> HOCipher a -> Either CipherError a
withSymmetricCipher SymmetricAlgorithm
sa ByteString
keydata (ByteString -> cipher -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
encrypt' ByteString
payload)
  where
    encrypt'
        :: HOBlockCipher cipher
        => B.ByteString
        -> cipher
        -> Either String B.ByteString
    encrypt' :: forall cipher.
HOBlockCipher cipher =>
ByteString -> cipher -> Either String ByteString
encrypt' ByteString
ct cipher
cipher = cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbEncrypt cipher
cipher (IV -> ByteString
unIV IV
iv) ByteString
ct

encryptOpenPGPCfbRaw
    :: OpenPGPCFBModeW mode
    -> SymmetricAlgorithm
    -> IV
    -> B.ByteString
    -- ^ plaintext (with MDC trailer already appended)
    -> B.ByteString
    -- ^ raw session key bytes
    -> Either CipherError B.ByteString
encryptOpenPGPCfbRaw :: forall (mode :: OpenPGPCFBMode).
OpenPGPCFBModeW mode
-> SymmetricAlgorithm
-> IV
-> ByteString
-> ByteString
-> Either CipherError ByteString
encryptOpenPGPCfbRaw OpenPGPCFBModeW mode
_ SymmetricAlgorithm
Plaintext IV
_ ByteString
cleartext ByteString
_ = ByteString -> Either CipherError ByteString
forall a b. b -> Either a b
Right ByteString
cleartext
encryptOpenPGPCfbRaw OpenPGPCFBModeW mode
mode SymmetricAlgorithm
sa IV
iv ByteString
cleartext ByteString
keydata =
    SymmetricAlgorithm
-> ByteString
-> HOCipher ByteString
-> Either CipherError ByteString
forall a.
SymmetricAlgorithm
-> ByteString -> HOCipher a -> Either CipherError a
withSymmetricCipher SymmetricAlgorithm
sa ByteString
keydata (HOCipher ByteString -> Either CipherError ByteString)
-> HOCipher ByteString -> Either CipherError ByteString
forall a b. (a -> b) -> a -> b
$ \cipher
cipher -> do
        let initialVector :: ByteString
initialVector = IV -> ByteString
unIV IV
iv
            bs :: Int
bs = cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
cipher
        if ByteString -> Int
B.length ByteString
initialVector Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bs
            then
                String -> Either String ByteString
forall a b. a -> Either a b
Left
                    ( String
"IV length mismatch for "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": expected "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bs
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", got "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
initialVector)
                    )
            else do
                let prefix :: ByteString
prefix = ByteString
initialVector ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
B.drop (Int
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ByteString
initialVector
                case OpenPGPCFBModeW mode
mode of
                    OpenPGPCFBModeW mode
OpenPGPCFBResyncW -> do
                        nonceAndCheck <-
                            cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbEncrypt cipher
cipher (Int -> Word8 -> ByteString
B.replicate Int
bs Word8
0) ByteString
prefix
                        encryptedPayload <-
                            paddedCfbEncrypt
                                cipher
                                (B.take bs (B.drop 2 nonceAndCheck))
                                cleartext
                        return (nonceAndCheck <> encryptedPayload)
                    OpenPGPCFBModeW mode
OpenPGPCFBNoResyncW ->
                        cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbEncrypt cipher
cipher (Int -> Word8 -> ByteString
B.replicate Int
bs Word8
0) (ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cleartext)