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

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

import Control.Error.Util (note)
import Data.Bifunctor (bimap)
import qualified Data.ByteArray as BA
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
import Codec.Encryption.OpenPGP.Types.Internal.Errors
    ( CipherError (..)
    )

newtype HOWrappedOldCCT a
    = HWOCCT a

instance
    OldCCT.BlockCipher cipher
    => HOBlockCipher (HOWrappedOldCCT cipher)
    where
    cipherInit :: forall key.
ByteArray key =>
key -> Either CipherError (HOWrappedOldCCT cipher)
cipherInit key
key =
        let keyBS :: ByteString
keyBS = key -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert key
key :: B.ByteString
         in (KeyError -> CipherError)
-> (Key cipher -> HOWrappedOldCCT cipher)
-> Either KeyError (Key cipher)
-> Either CipherError (HOWrappedOldCCT 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
                (CipherError -> KeyError -> CipherError
forall a b. a -> b -> a
const (String -> CipherError
CipherOldInitFailed String
"nettle invalid key"))
                (cipher -> HOWrappedOldCCT cipher
forall a. a -> HOWrappedOldCCT a
HWOCCT (cipher -> HOWrappedOldCCT cipher)
-> (Key cipher -> cipher) -> Key cipher -> HOWrappedOldCCT cipher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
OldCCT.cipherInit)
                (ByteString -> Either KeyError (Key cipher)
forall b c.
(ToSecureMem b, Cipher c) =>
b -> Either KeyError (Key c)
OldCCT.makeKey ByteString
keyBS)
    cipherName :: HOWrappedOldCCT cipher -> String
cipherName (HWOCCT cipher
c) = cipher -> String
forall cipher. Cipher cipher => cipher -> String
OldCCT.cipherName cipher
c
    cipherKeySize :: HOWrappedOldCCT cipher -> KeySizeSpecifier
cipherKeySize (HWOCCT cipher
c) = KeySizeSpecifier -> KeySizeSpecifier
convertKSS (KeySizeSpecifier -> KeySizeSpecifier)
-> (cipher -> KeySizeSpecifier) -> cipher -> KeySizeSpecifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. cipher -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
OldCCT.cipherKeySize (cipher -> KeySizeSpecifier) -> cipher -> KeySizeSpecifier
forall a b. (a -> b) -> a -> b
$ cipher
c
    blockSize :: HOWrappedOldCCT cipher -> Int
blockSize (HWOCCT cipher
c) = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
OldCCT.blockSize cipher
c
    ecbEncrypt :: HOWrappedOldCCT cipher
-> ByteString -> Either CipherError ByteString
ecbEncrypt (HWOCCT cipher
c) ByteString
bs = ByteString -> Either CipherError ByteString
forall a b. b -> Either a b
Right (cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
OldCCT.ecbEncrypt cipher
c ByteString
bs)
    ecbDecrypt :: HOWrappedOldCCT cipher
-> ByteString -> Either CipherError ByteString
ecbDecrypt (HWOCCT cipher
c) ByteString
bs = ByteString -> Either CipherError ByteString
forall a b. b -> Either a b
Right (cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
OldCCT.ecbDecrypt cipher
c ByteString
bs)
    cfbEncrypt :: HOWrappedOldCCT cipher
-> ByteString -> ByteString -> Either CipherError ByteString
cfbEncrypt (HWOCCT 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.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
OldCCT.cfbEncrypt cipher
c IV cipher
i ByteString
bs)
    cfbDecrypt :: HOWrappedOldCCT cipher
-> ByteString -> ByteString -> Either CipherError ByteString
cfbDecrypt (HWOCCT 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.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
OldCCT.cfbDecrypt cipher
c IV cipher
i ByteString
bs)
    paddedCfbEncrypt :: HOWrappedOldCCT cipher
-> ByteString -> ByteString -> Either CipherError ByteString
paddedCfbEncrypt HOWrappedOldCCT cipher
_ ByteString
_ ByteString
_ =
        CipherError -> Either CipherError ByteString
forall a b. a -> Either a b
Left CipherError
CipherPaddingUnsupported
    paddedCfbDecrypt :: HOWrappedOldCCT cipher
-> ByteString -> ByteString -> Either CipherError ByteString
paddedCfbDecrypt (HWOCCT cipher
cipher) ByteString
iv ByteString
ciphertext =
        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
                (Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
ciphertext) (cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
OldCCT.cfbDecrypt cipher
cipher IV cipher
i ByteString
padded))
      where
        padded :: ByteString
padded =
            ByteString
ciphertext
                ByteString -> ByteString -> ByteString
`B.append` [Word8] -> ByteString
B.pack
                    ( Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate
                        ( cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
OldCCT.blockSize cipher
cipher
                            Int -> Int -> Int
forall a. Num a => a -> a -> a
- (ByteString -> Int
B.length ByteString
ciphertext Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
OldCCT.blockSize cipher
cipher)
                        )
                        Word8
0
                    )
    aeadInit :: AEADMode
-> HOWrappedOldCCT cipher
-> ByteString
-> Either CipherError (AEAD (HOWrappedOldCCT cipher))
aeadInit AEADMode
mode (HWOCCT cipher
c) ByteString
iv =
        case AEADMode -> cipher -> ByteString -> Maybe (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, Byteable iv) =>
AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
forall iv.
Byteable iv =>
AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
OldCCT.aeadInit (AEADMode -> AEADMode
convertMode AEADMode
mode) cipher
c ByteString
iv of
            Maybe (AEAD cipher)
Nothing -> CipherError -> Either CipherError (AEAD (HOWrappedOldCCT cipher))
forall a b. a -> Either a b
Left CipherError
CipherAEADModeUnsupported
            Just (OldCCT.AEAD cipher
_ (OldCCT.AEADState st
st)) ->
                AEAD (HOWrappedOldCCT cipher)
-> Either CipherError (AEAD (HOWrappedOldCCT cipher))
forall a b. b -> Either a b
Right (AEADModeImpl st -> st -> AEAD (HOWrappedOldCCT cipher)
forall cipher st. AEADModeImpl st -> st -> AEAD cipher
CCT.AEAD (cipher -> AEADModeImpl st
forall cipher st.
AEADModeImpl cipher st =>
cipher -> AEADModeImpl st
bridgeImpl cipher
c) st
st)
    aeadSimpleEncrypt :: forall pt aad.
(ByteArray pt, ByteArrayAccess aad) =>
AEAD (HOWrappedOldCCT cipher) -> aad -> pt -> Int -> (AuthTag, pt)
aeadSimpleEncrypt AEAD (HOWrappedOldCCT cipher)
aead aad
aad pt
pt Int
plen =
        AEAD (HOWrappedOldCCT cipher) -> aad -> pt -> Int -> (AuthTag, pt)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
CCT.aeadSimpleEncrypt AEAD (HOWrappedOldCCT cipher)
aead aad
aad pt
pt Int
plen
    aeadSimpleDecrypt :: forall ct aad.
(ByteArray ct, ByteArrayAccess aad) =>
AEAD (HOWrappedOldCCT cipher) -> aad -> ct -> AuthTag -> Maybe ct
aeadSimpleDecrypt AEAD (HOWrappedOldCCT cipher)
aead aad
aad ct
ct AuthTag
tag =
        AEAD (HOWrappedOldCCT cipher) -> aad -> ct -> AuthTag -> Maybe ct
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
CCT.aeadSimpleDecrypt AEAD (HOWrappedOldCCT cipher)
aead aad
aad ct
ct AuthTag
tag

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

convertMode :: CCT.AEADMode -> OldCCT.AEADMode
convertMode :: AEADMode -> AEADMode
convertMode AEADMode
CCT.AEAD_GCM = AEADMode
OldCCT.AEAD_GCM
convertMode (CCT.AEAD_CCM Int
0 CCM_M
CCT.CCM_M16 CCM_L
CCT.CCM_L2) = AEADMode
OldCCT.AEAD_CCM
convertMode AEADMode
_ = AEADMode
OldCCT.AEAD_GCM

bridgeImpl
    :: OldCCT.AEADModeImpl cipher st => cipher -> CCT.AEADModeImpl st
bridgeImpl :: forall cipher st.
AEADModeImpl cipher st =>
cipher -> AEADModeImpl st
bridgeImpl cipher
c =
    CCT.AEADModeImpl
        { aeadImplAppendHeader :: forall ba. ByteArrayAccess ba => st -> ba -> st
CCT.aeadImplAppendHeader = \st
st' ba
ba -> cipher -> st -> ByteString -> st
forall cipher state.
AEADModeImpl cipher state =>
cipher -> state -> ByteString -> state
OldCCT.aeadStateAppendHeader cipher
c st
st' (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba)
        , aeadImplEncrypt :: forall ba. ByteArray ba => st -> ba -> (ba, st)
CCT.aeadImplEncrypt = \st
st' ba
ba ->
            let (ByteString
ct, st
st'') = cipher -> st -> ByteString -> (ByteString, st)
forall cipher state.
AEADModeImpl cipher state =>
cipher -> state -> ByteString -> (ByteString, state)
OldCCT.aeadStateEncrypt cipher
c st
st' (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba)
             in (ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
ct, st
st'')
        , aeadImplDecrypt :: forall ba. ByteArray ba => st -> ba -> (ba, st)
CCT.aeadImplDecrypt = \st
st' ba
ba ->
            let (ByteString
pt, st
st'') = cipher -> st -> ByteString -> (ByteString, st)
forall cipher state.
AEADModeImpl cipher state =>
cipher -> state -> ByteString -> (ByteString, state)
OldCCT.aeadStateDecrypt cipher
c st
st' (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba)
             in (ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
pt, st
st'')
        , aeadImplFinalize :: st -> Int -> AuthTag
CCT.aeadImplFinalize = \st
st' Int
plen ->
            let OldCCT.AuthTag ByteString
bs = cipher -> st -> Int -> AuthTag
forall cipher state.
AEADModeImpl cipher state =>
cipher -> state -> Int -> AuthTag
OldCCT.aeadStateFinalize cipher
c st
st' Int
plen
             in Bytes -> AuthTag
CCT.AuthTag (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
bs)
        }

hammerIV
    :: OldCCT.BlockCipher cipher
    => B.ByteString -> Either CipherError (OldCCT.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
"nettle") (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. (Byteable b, BlockCipher c) => b -> Maybe (IV c)
OldCCT.makeIV