-- CryptoCipherTypes.hs: shim for crypto-cipher-types stuff (current nettle)
-- Copyright © 2016  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE UndecidableInstances #-}

module Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes
  ( HOWrappedOldCCT(..)
  ) where

import Control.Error.Util (note)
import qualified "crypto-cipher-types" Crypto.Cipher.Types as OldCCT
import qualified "cryptonite" Crypto.Cipher.Types as CCT
import qualified Data.ByteString as B

import Codec.Encryption.OpenPGP.Internal.HOBlockCipher

newtype HOWrappedOldCCT a =
  HWOCCT a

instance OldCCT.BlockCipher cipher =>
         HOBlockCipher (HOWrappedOldCCT cipher) where
  cipherInit =
    fmap HWOCCT .
    either (const (Left "nettle invalid key")) (Right . OldCCT.cipherInit) .
    OldCCT.makeKey
  cipherName (HWOCCT c) = OldCCT.cipherName c
  cipherKeySize (HWOCCT c) = convertKSS . OldCCT.cipherKeySize $ c
  blockSize (HWOCCT c) = OldCCT.blockSize c
  cfbEncrypt (HWOCCT c) iv bs =
    hammerIV iv >>= \i -> return (OldCCT.cfbEncrypt c i bs)
  cfbDecrypt (HWOCCT c) iv bs =
    hammerIV iv >>= \i -> return (OldCCT.cfbDecrypt c i bs)
  paddedCfbEncrypt _ _ _ =
    Left "padding for nettle-encryption not implemented yet"
  paddedCfbDecrypt (HWOCCT cipher) iv ciphertext =
    hammerIV iv >>= \i ->
      return (B.take (B.length ciphertext) (OldCCT.cfbDecrypt cipher i padded))
    where
      padded =
        ciphertext `B.append`
        B.pack
          (replicate
             (OldCCT.blockSize cipher -
              (B.length ciphertext `mod` OldCCT.blockSize cipher))
             0)

convertKSS :: OldCCT.KeySizeSpecifier -> CCT.KeySizeSpecifier
convertKSS (OldCCT.KeySizeRange a b) = CCT.KeySizeRange a b
convertKSS (OldCCT.KeySizeEnum as) = CCT.KeySizeEnum as
convertKSS (OldCCT.KeySizeFixed a) = CCT.KeySizeFixed a

hammerIV ::
     OldCCT.BlockCipher cipher
  => B.ByteString
  -> Either String (OldCCT.IV cipher)
hammerIV = note "nettle bad IV" . OldCCT.makeIV