-- 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 :: forall key.
ByteArray key =>
key -> Either CipherError (HOWrappedCCT cipher)
cipherInit =
        (CryptoError -> CipherError)
-> (cipher -> HOWrappedCCT cipher)
-> Either CryptoError cipher
-> Either CipherError (HOWrappedCCT cipher)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CryptoError -> CipherError
CipherOperationFailed cipher -> HOWrappedCCT cipher
forall a. a -> HOWrappedCCT a
HWCCT
            (Either CryptoError cipher
 -> Either CipherError (HOWrappedCCT cipher))
-> (key -> Either CryptoError cipher)
-> key
-> Either CipherError (HOWrappedCCT cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable cipher -> Either CryptoError cipher
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError
            (CryptoFailable cipher -> Either CryptoError cipher)
-> (key -> CryptoFailable cipher)
-> key
-> Either CryptoError cipher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> CryptoFailable cipher
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
forall key. ByteArray key => key -> CryptoFailable cipher
CCT.cipherInit
    cipherName :: HOWrappedCCT cipher -> String
cipherName (HWCCT cipher
c) = cipher -> String
forall cipher. Cipher cipher => cipher -> String
CCT.cipherName cipher
c
    cipherKeySize :: HOWrappedCCT cipher -> KeySizeSpecifier
cipherKeySize (HWCCT cipher
c) = cipher -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
CCT.cipherKeySize cipher
c
    blockSize :: HOWrappedCCT cipher -> Int
blockSize (HWCCT cipher
c) = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
CCT.blockSize cipher
c
    ecbEncrypt :: HOWrappedCCT cipher -> ByteString -> Either CipherError ByteString
ecbEncrypt (HWCCT cipher
c) ByteString
bs = ByteString -> Either CipherError ByteString
forall a b. b -> Either a b
Right (cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> ba -> ba
CCT.ecbEncrypt cipher
c ByteString
bs)
    ecbDecrypt :: HOWrappedCCT cipher -> ByteString -> Either CipherError ByteString
ecbDecrypt (HWCCT cipher
c) ByteString
bs = ByteString -> Either CipherError ByteString
forall a b. b -> Either a b
Right (cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> ba -> ba
CCT.ecbDecrypt cipher
c ByteString
bs)
    cfbEncrypt :: HOWrappedCCT cipher
-> ByteString -> ByteString -> Either CipherError ByteString
cfbEncrypt (HWCCT cipher
c) ByteString
iv ByteString
bs =
        ByteString -> Either CipherError (IV cipher)
forall cipher.
BlockCipher cipher =>
ByteString -> Either CipherError (IV cipher)
hammerIV ByteString
iv Either CipherError (IV cipher)
-> (IV cipher -> Either CipherError ByteString)
-> Either CipherError ByteString
forall a b.
Either CipherError a
-> (a -> Either CipherError b) -> Either CipherError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \IV cipher
i -> ByteString -> Either CipherError ByteString
forall a. a -> Either CipherError a
forall (m :: * -> *) a. Monad m => a -> m a
return (cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> IV cipher -> ba -> ba
CCT.cfbEncrypt cipher
c IV cipher
i ByteString
bs)
    cfbDecrypt :: HOWrappedCCT cipher
-> ByteString -> ByteString -> Either CipherError ByteString
cfbDecrypt (HWCCT cipher
c) ByteString
iv ByteString
bs =
        ByteString -> Either CipherError (IV cipher)
forall cipher.
BlockCipher cipher =>
ByteString -> Either CipherError (IV cipher)
hammerIV ByteString
iv Either CipherError (IV cipher)
-> (IV cipher -> Either CipherError ByteString)
-> Either CipherError ByteString
forall a b.
Either CipherError a
-> (a -> Either CipherError b) -> Either CipherError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \IV cipher
i -> ByteString -> Either CipherError ByteString
forall a. a -> Either CipherError a
forall (m :: * -> *) a. Monad m => a -> m a
return (cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> IV cipher -> ba -> ba
CCT.cfbDecrypt cipher
c IV cipher
i ByteString
bs)
    aeadInit :: AEADMode
-> HOWrappedCCT cipher
-> ByteString
-> Either CipherError (AEAD (HOWrappedCCT cipher))
aeadInit AEADMode
mode (HWCCT cipher
c) ByteString
iv =
        (AEAD cipher -> AEAD (HOWrappedCCT cipher))
-> Either CipherError (AEAD cipher)
-> Either CipherError (AEAD (HOWrappedCCT cipher))
forall a b.
(a -> b) -> Either CipherError a -> Either CipherError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\(CCT.AEAD AEADModeImpl st
impl st
st) -> AEADModeImpl st -> st -> AEAD (HOWrappedCCT cipher)
forall cipher st. AEADModeImpl st -> st -> AEAD cipher
CCT.AEAD AEADModeImpl st
impl st
st)
            ( (CryptoError -> CipherError)
-> (AEAD cipher -> AEAD cipher)
-> Either CryptoError (AEAD cipher)
-> Either CipherError (AEAD cipher)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
                CryptoError -> CipherError
CipherOperationFailed
                AEAD cipher -> AEAD cipher
forall a. a -> a
id
                (CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (AEADMode -> cipher -> ByteString -> CryptoFailable (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
forall iv.
ByteArrayAccess iv =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
CCT.aeadInit AEADMode
mode cipher
c ByteString
iv))
            )
    aeadSimpleEncrypt :: forall pt aad.
(ByteArray pt, ByteArrayAccess aad) =>
AEAD (HOWrappedCCT cipher) -> aad -> pt -> Int -> (AuthTag, pt)
aeadSimpleEncrypt AEAD (HOWrappedCCT cipher)
aead aad
aad pt
pt Int
plen =
        AEAD (HOWrappedCCT cipher) -> aad -> pt -> Int -> (AuthTag, pt)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
CCT.aeadSimpleEncrypt AEAD (HOWrappedCCT cipher)
aead aad
aad pt
pt Int
plen
    aeadSimpleDecrypt :: forall ct aad.
(ByteArray ct, ByteArrayAccess aad) =>
AEAD (HOWrappedCCT cipher) -> aad -> ct -> AuthTag -> Maybe ct
aeadSimpleDecrypt AEAD (HOWrappedCCT cipher)
aead aad
aad ct
ct AuthTag
tag =
        AEAD (HOWrappedCCT cipher) -> aad -> ct -> AuthTag -> Maybe ct
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
CCT.aeadSimpleDecrypt AEAD (HOWrappedCCT cipher)
aead aad
aad ct
ct AuthTag
tag

hammerIV
    :: CCT.BlockCipher cipher
    => B.ByteString -> Either CipherError (CCT.IV cipher)
hammerIV :: forall cipher.
BlockCipher cipher =>
ByteString -> Either CipherError (IV cipher)
hammerIV = CipherError -> Maybe (IV cipher) -> Either CipherError (IV cipher)
forall a b. a -> Maybe b -> Either a b
note (String -> CipherError
CipherBadIV String
"crypton") (Maybe (IV cipher) -> Either CipherError (IV cipher))
-> (ByteString -> Maybe (IV cipher))
-> ByteString
-> Either CipherError (IV cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (IV cipher)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
CCT.makeIV