{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
module Codec.Encryption.OpenPGP.CFB
( decrypt
, decryptPreservingNonce
, decryptNoNonce
, decryptOpenPGPCfb
, decryptOpenPGPCfbWithNonce
, OpenPGPCFBMode(..)
, OpenPGPCFBModeW(..)
, encryptNoNonce
, encryptOpenPGPCfbRaw
, mdcTrailerForSEIPDv1
, seipdv1NonceFromIV
, validateSEIPD1MDC
, calculateMDC
) where
import Codec.Encryption.OpenPGP.BlockCipher (CipherError(..), withSymmetricCipher)
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher
import Codec.Encryption.OpenPGP.Types
import qualified Crypto.Hash as CH
import qualified Crypto.Hash.Algorithms as CHA
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Control.Monad (when)
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)
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
-> B.ByteString
-> 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)
mdcTrailerForSEIPDv1 :: IV -> B.ByteString -> B.ByteString
mdcTrailerForSEIPDv1 :: IV -> ByteString -> ByteString
mdcTrailerForSEIPDv1 IV
iv ByteString
plaintext = ByteString
mdcHeader ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
digest
where
mdcHeader :: ByteString
mdcHeader = [Word8] -> ByteString
B.pack [Word8
0xd3, Word8
0x14]
nonce :: ByteString
nonce = IV -> ByteString
seipdv1NonceFromIV IV
iv
digest :: ByteString
digest = Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash (ByteString
nonce ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
plaintext ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
mdcHeader) :: CH.Digest CHA.SHA1)
seipdv1NonceFromIV :: IV -> B.ByteString
seipdv1NonceFromIV :: IV -> ByteString
seipdv1NonceFromIV (IV ByteString
ivBytes) = ByteString
ivBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
ivBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ByteString
ivBytes
calculateMDC :: B.ByteString -> B.ByteString -> Maybe BL.ByteString
calculateMDC :: ByteString -> ByteString -> Maybe ByteString
calculateMDC ByteString
nonce ByteString
garbage
| ByteString -> Int
B.length ByteString
garbage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
23 = Maybe ByteString
forall a. Maybe a
Nothing
| Bool
otherwise =
let digest :: Digest SHA1
digest = ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash (ByteString
nonce ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
garbage Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
22) ByteString
garbage ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
B.pack [Word8
211, Word8
20]) :: CH.Digest CHA.SHA1
in ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
BL.fromStrict (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA1
digest :: B.ByteString))
validateSEIPD1MDC :: B.ByteString -> B.ByteString -> Either String B.ByteString
validateSEIPD1MDC :: ByteString -> ByteString -> Either String ByteString
validateSEIPD1MDC ByteString
nonce ByteString
decrypted = do
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
decrypted Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
22) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD1 cleartext too short to contain MDC trailer"
let (ByteString
payload, ByteString
trailer) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
decrypted Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
22) ByteString
decrypted
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> ByteString -> ByteString
B.take Int
2 ByteString
trailer ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> ByteString
B.pack [Word8
211, Word8
20]) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD1 cleartext missing MDC packet trailer (tag 19)"
expectedMdc <-
case ByteString -> ByteString -> Maybe ByteString
calculateMDC ByteString
nonce ByteString
decrypted of
Maybe ByteString
Nothing -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"SEIPD1 cleartext too short for MDC calculation"
Just ByteString
x -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
x
let actualMdc = ByteString -> ByteString
BL.fromStrict (Int -> ByteString -> ByteString
B.drop Int
2 ByteString
trailer)
when (expectedMdc /= actualMdc) $
Left "MDC indicates tampering"
Right payload