-- CFB.hs: OpenPGP (RFC4880) CFB mode
-- Copyright © 2013 Daniel Kahn Gillmor and Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE ExistentialQuantification #-}

module Codec.Encryption.OpenPGP.CFB (
   decrypt
 , decryptOpenPGPCfb
) where

import Codec.Encryption.OpenPGP.Types
import Crypto.Cipher.Types (makeKey, nullIV, BlockCipher(..), Cipher(..))
import qualified Crypto.Cipher as CC
import qualified Crypto.Nettle.Ciphers as CNC
import qualified Data.ByteString as B
import Data.Maybe (fromJust)
import Data.SecureMem (ToSecureMem)

data BCipher = forall a. (BlockCipher a) => BCipher a

decryptOpenPGPCfb :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString
decryptOpenPGPCfb Plaintext ciphertext _ = return ciphertext
decryptOpenPGPCfb sa ciphertext keydata = do
    bc <- mkBCipher sa keydata
    return $ B.drop (bsize bc + 2) (decrypt1 ciphertext bc `B.append` decrypt2 ciphertext bc) -- FIXME: verify the code
    where
        decrypt1 :: B.ByteString -> BCipher -> B.ByteString
        decrypt1 ct (BCipher cipher) = cdecrypt sa cipher nullIV (B.take (blockSize cipher + 2) ct)
        decrypt2 :: B.ByteString -> BCipher -> B.ByteString
        decrypt2 ct (BCipher cipher) = cdecrypt sa cipher (fromJust (CC.makeIV (B.take (blockSize cipher) (B.drop 2 ct)))) (B.drop (blockSize cipher + 2) ct)

decrypt :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString
decrypt Plaintext ciphertext _ = return ciphertext
decrypt sa ciphertext keydata = do
    bc <- mkBCipher sa keydata
    return $ B.drop (bsize bc + 2) (decrypt' ciphertext bc)  -- FIXME: verify the code
    where
        decrypt' :: B.ByteString -> BCipher -> B.ByteString
        decrypt' ct (BCipher cipher) = cdecrypt sa cipher nullIV ct

bsize :: BCipher -> Int
bsize (BCipher bc) = blockSize bc

cdecrypt :: BlockCipher cipher => SymmetricAlgorithm -> cipher -> CC.IV cipher -> B.ByteString -> B.ByteString
cdecrypt sa
    | sa `elem` [CAST5, Twofish] = paddedCfbDecrypt
    | otherwise = cfbDecrypt

paddedCfbDecrypt :: BlockCipher cipher => cipher -> CC.IV cipher -> B.ByteString -> B.ByteString
paddedCfbDecrypt cipher iv ciphertext = B.take (B.length ciphertext) (cfbDecrypt cipher iv padded)
    where
        padded = ciphertext `B.append` B.pack (replicate (blockSize cipher - (B.length ciphertext `mod` blockSize cipher)) 0)

mkBCipher :: ToSecureMem b => SymmetricAlgorithm -> b -> Either String BCipher
mkBCipher Plaintext = const (fail "this shouldn't have happened") -- FIXME: orphan instance?
mkBCipher IDEA = const (fail "IDEA not yet implemented") -- FIXME: IDEA
mkBCipher ReservedSAFER = const (fail "SAFER not implemented") -- FIXME: or not?
mkBCipher ReservedDES = const (fail "DES not implemented") -- FIXME: or not?
mkBCipher (OtherSA _) = const (fail "Unknown, unimplemented symmetric algorithm")
mkBCipher CAST5 = return . BCipher . (ciph :: ToSecureMem b => b -> CNC.CAST128)
mkBCipher Twofish = return . BCipher . (ciph :: ToSecureMem b => b -> CNC.TWOFISH)
mkBCipher TripleDES = return . BCipher . (ciph :: ToSecureMem b => b -> CC.DES_EDE3)
mkBCipher Blowfish = return . BCipher . (ciph :: ToSecureMem b => b -> CC.Blowfish128)
mkBCipher AES128 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES128)
mkBCipher AES192 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES192)
mkBCipher AES256 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES256)

ciph :: (CC.BlockCipher cipher, ToSecureMem b) => b -> cipher -- FIXME: return an Either String cipher ?
ciph keydata = cipherInit ekey
    where
        ekey = case makeKey keydata of
          Left _ -> error "bad cipher parameters"
          Right key -> key