Crypton.hs

-- Crypton.hs: shim for crypton
-- Copyright © 2016-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE UndecidableInstances #-}

module Codec.Encryption.OpenPGP.Internal.Crypton
    ( HOWrappedCCT (..)
    ) where

import Control.Error.Util (note)
import qualified Crypto.Error as CE
import Data.Bifunctor (bimap)
import qualified Data.ByteString as B
import qualified "crypton" Crypto.Cipher.Types as CCT

import Codec.Encryption.OpenPGP.Internal.HOBlockCipher
import Codec.Encryption.OpenPGP.Types.Internal.Errors
    ( CipherError (..)
    )

newtype HOWrappedCCT a
    = HWCCT a

instance CCT.BlockCipher cipher => HOBlockCipher (HOWrappedCCT cipher) where
    cipherInit =
        bimap CipherOperationFailed HWCCT
            . CE.eitherCryptoError
            . CCT.cipherInit
    cipherName (HWCCT c) = CCT.cipherName c
    cipherKeySize (HWCCT c) = CCT.cipherKeySize c
    blockSize (HWCCT c) = CCT.blockSize c
    ecbEncrypt (HWCCT c) bs = Right (CCT.ecbEncrypt c bs)
    ecbDecrypt (HWCCT c) bs = Right (CCT.ecbDecrypt c bs)
    cfbEncrypt (HWCCT c) iv bs =
        hammerIV iv >>= \i -> return (CCT.cfbEncrypt c i bs)
    cfbDecrypt (HWCCT c) iv bs =
        hammerIV iv >>= \i -> return (CCT.cfbDecrypt c i bs)
    paddedCfbDecrypt (HWCCT cipher) iv ciphertext =
        hammerIV iv >>= \i ->
            return
                (B.take (B.length ciphertext) (CCT.cfbDecrypt cipher i padded))
      where
        padded =
            ciphertext
                `B.append` B.pack
                    ( replicate
                        ( CCT.blockSize cipher
                            - (B.length ciphertext `mod` CCT.blockSize cipher)
                        )
                        0
                    )
    aeadInit mode (HWCCT c) iv =
        fmap
            (\(CCT.AEAD impl st) -> CCT.AEAD impl st)
            ( bimap
                CipherOperationFailed
                id
                (CE.eitherCryptoError (CCT.aeadInit mode c iv))
            )
    aeadSimpleEncrypt aead aad pt plen =
        CCT.aeadSimpleEncrypt aead aad pt plen
    aeadSimpleDecrypt aead aad ct tag =
        CCT.aeadSimpleDecrypt aead aad ct tag

hammerIV
    :: CCT.BlockCipher cipher
    => B.ByteString -> Either CipherError (CCT.IV cipher)
hammerIV = note (CipherBadIV "crypton") . CCT.makeIV