CryptoCipherTypes.hs

-- CryptoCipherTypes.hs: shim for crypto-cipher-types stuff (current nettle)
-- Copyright © 2016-2024  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 Data.ByteString as B
import qualified "crypto-cipher-types" Crypto.Cipher.Types as OldCCT
import qualified "crypton" Crypto.Cipher.Types as CCT

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