-- SecretKey.hs: OpenPGP (RFC9580) secret key encryption/decryption
-- Copyright © 2013-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}

module Codec.Encryption.OpenPGP.SecretKey
    ( SecretKeyEncryptOptions (..)
    , decryptSecretKey
    , decryptSecretKeyAddendum
    , encryptSecretKey
    , encryptSecretKeyWithPolicy
    , mkUnencryptedSKAddendum
    , reencryptSecretKey
    , reencryptSecretKeyRandom
    ) where

import Control.Error.Util (note)
import Control.Monad (when)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
    ( except
    , runExceptT
    , throwE
    )
import qualified Crypto.Error as CE
import qualified Crypto.Hash as CH
import qualified Crypto.Hash.Algorithms as CHA
import Crypto.KDF.HKDF (expand, extract)
import Crypto.Number.ModArithmetic (inverse)
import Crypto.Number.Serialize (os2ip)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.RSA as R
import Crypto.Random.Types (MonadRandom, getRandomBytes)
import Data.Bifunctor (bimap, first)
import Data.Binary (put)
import Data.Binary.Get
    ( getRemainingLazyByteString
    , getWord16be
    , runGetOrFail
    )
import Data.Binary.Put
    ( putByteString
    , putLazyByteString
    , putWord16be
    , runPut
    )
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Data.Containers.ListUtils (nubOrd)
import Data.Word (Word16, Word8)
import qualified "crypton" Crypto.Cipher.Types as CCT

import Codec.Encryption.OpenPGP.BlockCipher
    ( keySize
    )
import Codec.Encryption.OpenPGP.CFB
    ( decryptNoNonce
    , encryptNoNonce
    )
import Codec.Encryption.OpenPGP.Internal.CryptoAES
    ( withAESCipher
    )
import Codec.Encryption.OpenPGP.Internal.RFC7253OCB
    ( decryptWithOCBRFC7253With
    , encryptWithOCBRFC7253
    )
import Codec.Encryption.OpenPGP.Policy
    ( OpenPGPPolicy (..)
    , OpenPGPRFC (..)
    , SecretKeyProtectionPolicy
    , defaultPolicy
    , legacySecretKeyProtectionErrorMessage
    , secretKeyAEADNonceOctets
    , secretKeyDefaultAEADAlgorithm
    , secretKeyDefaultS2KForSalt
    , secretKeyDefaultSymmetricAlgorithm
    , secretKeyProtectionPolicyForKeyVersion
    , secretKeyS2KSaltOctets
    )
import Codec.Encryption.OpenPGP.S2K
    ( skesk2Key
    , string2Key
    )
import Codec.Encryption.OpenPGP.Serialize
    ( getSecretKey
    , putSKeyForPKPayload
    )
import Codec.Encryption.OpenPGP.Types

data SecretKeyEncryptOptions = SecretKeyEncryptOptions
    { SecretKeyEncryptOptions -> OpenPGPPolicy
skeoPolicy :: OpenPGPPolicy
    , SecretKeyEncryptOptions -> Bool
skeoGenerateSaltAndIV :: Bool
    , SecretKeyEncryptOptions -> Maybe Salt
skeoSalt :: Maybe Salt
    , SecretKeyEncryptOptions -> Maybe IV
skeoIV :: Maybe IV
    }

decryptSecretKey
    :: SecretKey
    -> Passphrase
    -> Either SecretKeyError SKey
decryptSecretKey :: SecretKey -> Passphrase -> Either SecretKeyError SKey
decryptSecretKey SecretKey
sk Passphrase
pp =
    SomePKPayload
-> SKAddendum
-> Passphrase
-> Either SecretKeyError (SKey, SKAddendum)
decryptSecretKeyAddendum
        (SecretKey -> SomePKPayload
_secretKeyPKPayload SecretKey
sk)
        (SecretKey -> SKAddendum
_secretKeySKAddendum SecretKey
sk)
        Passphrase
pp
        Either SecretKeyError (SKey, SKAddendum)
-> ((SKey, SKAddendum) -> Either SecretKeyError SKey)
-> Either SecretKeyError SKey
forall a b.
Either SecretKeyError a
-> (a -> Either SecretKeyError b) -> Either SecretKeyError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(SKey
skey, SKAddendum
_) ->
            SKey -> Either SecretKeyError SKey
forall a b. b -> Either a b
Right SKey
skey

decryptSecretKeyAddendum
    :: SomePKPayload
    -> SKAddendum
    -> Passphrase
    -> Either SecretKeyError (SKey, SKAddendum)
decryptSecretKeyAddendum :: SomePKPayload
-> SKAddendum
-> Passphrase
-> Either SecretKeyError (SKey, SKAddendum)
decryptSecretKeyAddendum SomePKPayload
pkp SKAddendum
ska Passphrase
pp =
    case SomePKPayload
-> SKAddendum -> Either SKAddendumKeyVersionError SomeSKAddendumV
fromSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
ska of
        Left SKAddendumKeyVersionError
err -> SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. a -> Either a b
Left (SKAddendumKeyVersionError -> SecretKeyError
SecretKeyDecryptAddendumError SKAddendumKeyVersionError
err)
        Right (SomeSKAddendumV SKAddendumV v
skaV) ->
            case SomePKPayload
-> SKAddendumV v
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
decryptPrivateKeyTyped SomePKPayload
pkp SKAddendumV v
skaV Passphrase
pp of
                Left SecretKeyError
err -> SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. a -> Either a b
Left SecretKeyError
err
                Right SKAddendumV v
decryptedV ->
                    case SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum SKAddendumV v
decryptedV of
                        SUSUnprotected SKey
skey Word16
_ -> (SKey, SKAddendum) -> Either SecretKeyError (SKey, SKAddendum)
forall a b. b -> Either a b
Right (SKey
skey, SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum SKAddendumV v
decryptedV)
                        SKAddendum
_ -> SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. a -> Either a b
Left SecretKeyError
SecretKeyDecryptNotUnencrypted

encryptSecretKey
    :: MonadRandom m
    => SomePKPayload
    -> SKey
    -> Passphrase
    -> SecretKeyEncryptOptions
    -> m (Either SecretKeyError SKAddendum)
encryptSecretKey :: forall (m :: * -> *).
MonadRandom m =>
SomePKPayload
-> SKey
-> Passphrase
-> SecretKeyEncryptOptions
-> m (Either SecretKeyError SKAddendum)
encryptSecretKey SomePKPayload
pkp SKey
skey Passphrase
newPassphrase SecretKeyEncryptOptions
opts = do
    result <- ExceptT SecretKeyError m SKAddendum
-> m (Either SecretKeyError SKAddendum)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SecretKeyError m SKAddendum
 -> m (Either SecretKeyError SKAddendum))
-> ExceptT SecretKeyError m SKAddendum
-> m (Either SecretKeyError SKAddendum)
forall a b. (a -> b) -> a -> b
$ do
        (salt, iv) <-
            if SecretKeyEncryptOptions -> Bool
skeoGenerateSaltAndIV SecretKeyEncryptOptions
opts
                then do
                    nextMaterial <-
                        m (Either SecretKeyError (Salt, IV))
-> ExceptT SecretKeyError m (Either SecretKeyError (Salt, IV))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT SecretKeyError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either SecretKeyError (Salt, IV))
 -> ExceptT SecretKeyError m (Either SecretKeyError (Salt, IV)))
-> m (Either SecretKeyError (Salt, IV))
-> ExceptT SecretKeyError m (Either SecretKeyError (Salt, IV))
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy
-> SomePKPayload -> m (Either SecretKeyError (Salt, IV))
forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy
-> SomePKPayload -> m (Either SecretKeyError (Salt, IV))
generateSecretKeyProtectionMaterial (SecretKeyEncryptOptions -> OpenPGPPolicy
skeoPolicy SecretKeyEncryptOptions
opts) SomePKPayload
pkp
                    except nextMaterial
                else case (SecretKeyEncryptOptions -> Maybe Salt
skeoSalt SecretKeyEncryptOptions
opts, SecretKeyEncryptOptions -> Maybe IV
skeoIV SecretKeyEncryptOptions
opts) of
                    (Just Salt
salt, Just IV
iv) -> (Salt, IV) -> ExceptT SecretKeyError m (Salt, IV)
forall a. a -> ExceptT SecretKeyError m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Salt
salt, IV
iv)
                    (Maybe Salt, Maybe IV)
_ -> SecretKeyError -> ExceptT SecretKeyError m (Salt, IV)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE SecretKeyError
SecretKeyEncryptOptionsInconsistent
        ska <-
            except
                (mkUnencryptedSKAddendum pkp skey)
        except
            ( encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV
                (skeoPolicy opts)
                pkp
                salt
                iv
                skey
                newPassphrase
            )
    return result

encryptSecretKeyWithPolicy
    :: MonadRandom m
    => OpenPGPPolicy
    -> SomePKPayload
    -> SKey
    -> Passphrase
    -> m (Either SecretKeyError SKAddendum)
encryptSecretKeyWithPolicy :: forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy
-> SomePKPayload
-> SKey
-> Passphrase
-> m (Either SecretKeyError SKAddendum)
encryptSecretKeyWithPolicy OpenPGPPolicy
policy SomePKPayload
pkp SKey
skey Passphrase
pp = do
    SomePKPayload
-> SKey
-> Passphrase
-> SecretKeyEncryptOptions
-> m (Either SecretKeyError SKAddendum)
forall (m :: * -> *).
MonadRandom m =>
SomePKPayload
-> SKey
-> Passphrase
-> SecretKeyEncryptOptions
-> m (Either SecretKeyError SKAddendum)
encryptSecretKey
        SomePKPayload
pkp
        SKey
skey
        Passphrase
pp
        SecretKeyEncryptOptions
            { skeoPolicy :: OpenPGPPolicy
skeoPolicy = OpenPGPPolicy
policy
            , skeoGenerateSaltAndIV :: Bool
skeoGenerateSaltAndIV = Bool
True
            , skeoSalt :: Maybe Salt
skeoSalt = Maybe Salt
forall a. Maybe a
Nothing
            , skeoIV :: Maybe IV
skeoIV = Maybe IV
forall a. Maybe a
Nothing
            }

reencryptSecretKey
    :: MonadRandom m
    => SecretKey
    -> Passphrase
    -> Passphrase
    -> SecretKeyEncryptOptions
    -> m (Either SecretKeyError SecretKey)
reencryptSecretKey :: forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> Passphrase
-> Passphrase
-> SecretKeyEncryptOptions
-> m (Either SecretKeyError SecretKey)
reencryptSecretKey SecretKey
sk Passphrase
oldPassphrase Passphrase
newPassphrase SecretKeyEncryptOptions
opts = do
    result <- ExceptT SecretKeyError m SecretKey
-> m (Either SecretKeyError SecretKey)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SecretKeyError m SecretKey
 -> m (Either SecretKeyError SecretKey))
-> ExceptT SecretKeyError m SecretKey
-> m (Either SecretKeyError SecretKey)
forall a b. (a -> b) -> a -> b
$ do
        let pkp :: SomePKPayload
pkp = SecretKey -> SomePKPayload
_secretKeyPKPayload SecretKey
sk
            originalSka :: SKAddendum
originalSka = SecretKey -> SKAddendum
_secretKeySKAddendum SecretKey
sk
        decryptedSKA <-
            Either SecretKeyError SKAddendum
-> ExceptT SecretKeyError m SKAddendum
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either SecretKeyError SKAddendum
 -> ExceptT SecretKeyError m SKAddendum)
-> Either SecretKeyError SKAddendum
-> ExceptT SecretKeyError m SKAddendum
forall a b. (a -> b) -> a -> b
$ case SomePKPayload
-> SKAddendum -> Either SKAddendumKeyVersionError SomeSKAddendumV
fromSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
originalSka of
                Left SKAddendumKeyVersionError
err -> SecretKeyError -> Either SecretKeyError SKAddendum
forall a b. a -> Either a b
Left (SKAddendumKeyVersionError -> SecretKeyError
SecretKeyDecryptAddendumError SKAddendumKeyVersionError
err)
                Right (SomeSKAddendumV SKAddendumV v
skaV) ->
                    case SomePKPayload
-> SKAddendumV v
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
decryptPrivateKeyTyped SomePKPayload
pkp SKAddendumV v
skaV Passphrase
oldPassphrase of
                        Left SecretKeyError
err -> SecretKeyError -> Either SecretKeyError SKAddendum
forall a b. a -> Either a b
Left SecretKeyError
err
                        Right SKAddendumV v
decryptedV -> SKAddendum -> Either SecretKeyError SKAddendum
forall a b. b -> Either a b
Right (SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum SKAddendumV v
decryptedV)
        case decryptedSKA of
            SUSUnprotected SKey
skey Word16
_ -> do
                let pp :: StrictByteString
pp = Passphrase -> StrictByteString
unPassphrase Passphrase
newPassphrase
                (salt, iv) <-
                    if SecretKeyEncryptOptions -> Bool
skeoGenerateSaltAndIV SecretKeyEncryptOptions
opts
                        then do
                            nextMaterial <-
                                m (Either SecretKeyError (Salt, IV))
-> ExceptT SecretKeyError m (Either SecretKeyError (Salt, IV))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT SecretKeyError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either SecretKeyError (Salt, IV))
 -> ExceptT SecretKeyError m (Either SecretKeyError (Salt, IV)))
-> m (Either SecretKeyError (Salt, IV))
-> ExceptT SecretKeyError m (Either SecretKeyError (Salt, IV))
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy
-> SomePKPayload -> m (Either SecretKeyError (Salt, IV))
forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy
-> SomePKPayload -> m (Either SecretKeyError (Salt, IV))
generateSecretKeyProtectionMaterial (SecretKeyEncryptOptions -> OpenPGPPolicy
skeoPolicy SecretKeyEncryptOptions
opts) SomePKPayload
pkp
                            except nextMaterial
                        else case (SecretKeyEncryptOptions -> Maybe Salt
skeoSalt SecretKeyEncryptOptions
opts, SecretKeyEncryptOptions -> Maybe IV
skeoIV SecretKeyEncryptOptions
opts) of
                            (Just Salt
salt, Just IV
iv) -> (Salt, IV) -> ExceptT SecretKeyError m (Salt, IV)
forall a. a -> ExceptT SecretKeyError m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Salt
salt, IV
iv)
                            (Maybe Salt, Maybe IV)
_ -> SecretKeyError -> ExceptT SecretKeyError m (Salt, IV)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE SecretKeyError
SecretKeyEncryptOptionsInconsistent
                newSka <-
                    except $
                        reencryptWithPolicyAndSaltAndIV
                            pkp
                            originalSka
                            salt
                            iv
                            skey
                            (Passphrase pp)
                            (skeoPolicy opts)
                return $ sk {_secretKeySKAddendum = newSka}
            SKAddendum
_ -> SecretKeyError -> ExceptT SecretKeyError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE SecretKeyError
SecretKeyDecryptNotUnencrypted
    return result

reencryptWithPolicyAndSaltAndIV
    :: SomePKPayload
    -> SKAddendum
    -> Salt
    -> IV
    -> SKey
    -> Passphrase
    -> OpenPGPPolicy
    -> Either SecretKeyError SKAddendum
reencryptWithPolicyAndSaltAndIV :: SomePKPayload
-> SKAddendum
-> Salt
-> IV
-> SKey
-> Passphrase
-> OpenPGPPolicy
-> Either SecretKeyError SKAddendum
reencryptWithPolicyAndSaltAndIV SomePKPayload
pkp SKAddendum
originalSka Salt
salt IV
iv SKey
skey (Passphrase StrictByteString
pp) OpenPGPPolicy
policy =
    (SKAddendumKeyVersionError -> SecretKeyError)
-> Either SKAddendumKeyVersionError SomeSKAddendumV
-> Either SecretKeyError SomeSKAddendumV
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
        SKAddendumKeyVersionError -> SecretKeyError
SecretKeyEncryptAddendumError
        (SomePKPayload
-> SKAddendum -> Either SKAddendumKeyVersionError SomeSKAddendumV
fromSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
originalSka)
        Either SecretKeyError SomeSKAddendumV
-> (SomeSKAddendumV -> Either SecretKeyError SKAddendum)
-> Either SecretKeyError SKAddendum
forall a b.
Either SecretKeyError a
-> (a -> Either SecretKeyError b) -> Either SecretKeyError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            SomeSKAddendumV SKAddendumV v
skaV ->
                SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum
                    (SKAddendumV v -> SKAddendum)
-> Either SecretKeyError (SKAddendumV v)
-> Either SecretKeyError SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
forall (v :: KeyVersion).
OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
reencryptWithPolicyAndSaltAndIVTyped
                        OpenPGPPolicy
policy
                        SomePKPayload
pkp
                        SKAddendumV v
skaV
                        Salt
salt
                        IV
iv
                        SKey
skey
                        (StrictByteString -> Passphrase
Passphrase StrictByteString
pp)

reencryptSecretKeyRandom
    :: MonadRandom m
    => SecretKey
    -> Passphrase
    -> Passphrase
    -> OpenPGPPolicy
    -> m (Either SecretKeyError SecretKey)
reencryptSecretKeyRandom :: forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> Passphrase
-> Passphrase
-> OpenPGPPolicy
-> m (Either SecretKeyError SecretKey)
reencryptSecretKeyRandom SecretKey
sk Passphrase
oldPassphrase Passphrase
newPassphrase OpenPGPPolicy
policy = do
    SecretKey
-> Passphrase
-> Passphrase
-> SecretKeyEncryptOptions
-> m (Either SecretKeyError SecretKey)
forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> Passphrase
-> Passphrase
-> SecretKeyEncryptOptions
-> m (Either SecretKeyError SecretKey)
reencryptSecretKey
        SecretKey
sk
        Passphrase
oldPassphrase
        Passphrase
newPassphrase
        SecretKeyEncryptOptions
            { skeoPolicy :: OpenPGPPolicy
skeoPolicy = OpenPGPPolicy
policy
            , skeoGenerateSaltAndIV :: Bool
skeoGenerateSaltAndIV = Bool
True
            , skeoSalt :: Maybe Salt
skeoSalt = Maybe Salt
forall a. Maybe a
Nothing
            , skeoIV :: Maybe IV
skeoIV = Maybe IV
forall a. Maybe a
Nothing
            }

decryptPrivateKeyTyped
    :: SomePKPayload
    -> SKAddendumV v
    -> Passphrase
    -> Either SecretKeyError (SKAddendumV v)
decryptPrivateKeyTyped :: forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
decryptPrivateKeyTyped SomePKPayload
pkp (SKAMalleableCFB SymmetricAlgorithm
sa S2K
s2k IV
iv ByteString
payload) Passphrase
pp = do
    (sk, cksum) <-
        SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> Passphrase
-> (SomePKPayload
    -> StrictByteString -> Either SecretKeyError (SKey, Word16))
-> Either SecretKeyError (SKey, Word16)
decryptS2KProtectedPayload
            SomePKPayload
pkp
            SymmetricAlgorithm
sa
            S2K
s2k
            IV
iv
            ByteString
payload
            Passphrase
pp
            SomePKPayload
-> StrictByteString -> Either SecretKeyError (SKey, Word16)
parse16BitProtectedSecretKey
    pure (SKAUnprotectedLegacy sk cksum)
decryptPrivateKeyTyped SomePKPayload
pkp (SKACFBLegacy SymmetricAlgorithm
sa S2K
s2k IV
iv ByteString
payload) Passphrase
pp = do
    (sk, cksum) <-
        SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> Passphrase
-> (SomePKPayload
    -> StrictByteString -> Either SecretKeyError (SKey, Word16))
-> Either SecretKeyError (SKey, Word16)
decryptS2KProtectedPayload
            SomePKPayload
pkp
            SymmetricAlgorithm
sa
            S2K
s2k
            IV
iv
            ByteString
payload
            Passphrase
pp
            SomePKPayload
-> StrictByteString -> Either SecretKeyError (SKey, Word16)
parseSHA1ProtectedSecretKey
    pure (SKAUnprotectedLegacy sk cksum)
decryptPrivateKeyTyped SomePKPayload
pkp (SKACFBV6 SymmetricAlgorithm
sa S2K
s2k IV
iv ByteString
payload) Passphrase
pp = do
    (sk, _) <-
        SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> Passphrase
-> (SomePKPayload
    -> StrictByteString -> Either SecretKeyError (SKey, Word16))
-> Either SecretKeyError (SKey, Word16)
decryptS2KProtectedPayload
            SomePKPayload
pkp
            SymmetricAlgorithm
sa
            S2K
s2k
            IV
iv
            ByteString
payload
            Passphrase
pp
            SomePKPayload
-> StrictByteString -> Either SecretKeyError (SKey, Word16)
parseSHA1ProtectedSecretKey
    pure (SKAUnprotectedV6 sk)
decryptPrivateKeyTyped SomePKPayload
pkp (SKAAEADV6 SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv ByteString
payload) Passphrase
pp = do
    sk <-
        SomePKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> StrictByteString
-> Passphrase
-> Either SecretKeyError SKey
decryptAEADPayloadCore SomePKPayload
pkp SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv (ByteString -> StrictByteString
BL.toStrict ByteString
payload) Passphrase
pp
    pure (SKAUnprotectedV6 sk)
decryptPrivateKeyTyped SomePKPayload
pkp (SKAAEADLegacy SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv ByteString
payload) Passphrase
pp = do
    sk <-
        SomePKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> StrictByteString
-> Passphrase
-> Either SecretKeyError SKey
decryptAEADPayloadCore SomePKPayload
pkp SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv (ByteString -> StrictByteString
BL.toStrict ByteString
payload) Passphrase
pp
    pure (SKAUnprotectedLegacy sk 0)
decryptPrivateKeyTyped SomePKPayload
pkp (SKALegacyCFBLegacy SymmetricAlgorithm
sa IV
iv ByteString
payload) Passphrase
pp = do
    keyLen <-
        (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    dek <-
        first
            SecretKeyInvalidS2KMode
            (string2Key (Simple DeprecatedMD5) keyLen (unPassphrase pp))
    p <-
        first
            SecretKeyDecryptCipherError
            (decryptNoNonce sa iv (BL.toStrict payload) dek)
    (sk, cksum) <- parse16BitProtectedSecretKey pkp p
    pure (SKAUnprotectedLegacy sk cksum)
decryptPrivateKeyTyped SomePKPayload
pkp (SKALegacyCFBV6 SymmetricAlgorithm
sa IV
iv ByteString
payload) Passphrase
pp = do
    keyLen <-
        (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    dek <-
        first
            SecretKeyInvalidS2KMode
            (string2Key (Simple DeprecatedMD5) keyLen (unPassphrase pp))
    p <-
        first
            SecretKeyDecryptCipherError
            (decryptNoNonce sa iv (BL.toStrict payload) dek)
    (sk, _) <- parse16BitProtectedSecretKey pkp p
    pure (SKAUnprotectedV6 sk)
decryptPrivateKeyTyped SomePKPayload
_ ska :: SKAddendumV v
ska@(SKAUnprotectedLegacy {}) Passphrase
_ = SKAddendumV v -> Either SecretKeyError (SKAddendumV v)
forall a b. b -> Either a b
Right SKAddendumV v
ska
decryptPrivateKeyTyped SomePKPayload
_ ska :: SKAddendumV v
ska@(SKAUnprotectedV6 {}) Passphrase
_ = SKAddendumV v -> Either SecretKeyError (SKAddendumV v)
forall a b. b -> Either a b
Right SKAddendumV v
ska

mkUnencryptedSKAddendum
    :: SomePKPayload -> SKey -> Either SecretKeyError SKAddendum
mkUnencryptedSKAddendum :: SomePKPayload -> SKey -> Either SecretKeyError SKAddendum
mkUnencryptedSKAddendum SomePKPayload
pkp SKey
skey = do
    payload <- SomePKPayload -> SKey -> Either SecretKeyError ByteString
legacySecretKeyPayload SomePKPayload
pkp SKey
skey
    let checksum =
            case SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp of
                KeyVersion
V6 -> Word16
0
                KeyVersion
_ -> StrictByteString -> Word16
checksum16 (ByteString -> StrictByteString
BL.toStrict ByteString
payload)
    pure (SUSUnprotected skey checksum)

decryptS2KProtectedPayload
    :: SomePKPayload
    -> SymmetricAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> Passphrase
    -> ( SomePKPayload
         -> B.ByteString
         -> Either SecretKeyError (SKey, Word16)
       )
    -> Either SecretKeyError (SKey, Word16)
decryptS2KProtectedPayload :: SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> Passphrase
-> (SomePKPayload
    -> StrictByteString -> Either SecretKeyError (SKey, Word16))
-> Either SecretKeyError (SKey, Word16)
decryptS2KProtectedPayload SomePKPayload
pkp SymmetricAlgorithm
sa S2K
s2k IV
iv ByteString
payload (Passphrase StrictByteString
pp) SomePKPayload
-> StrictByteString -> Either SecretKeyError (SKey, Word16)
parser = do
    dek <-
        (S2KError -> SecretKeyError)
-> Either S2KError StrictByteString
-> Either SecretKeyError StrictByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
            S2KError -> SecretKeyError
SecretKeyInvalidS2KMode
            (SKESK 'SKESKV4
-> StrictByteString -> Either S2KError StrictByteString
skesk2Key (SymmetricAlgorithm
-> S2K -> Maybe StrictByteString -> SKESK 'SKESKV4
SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe StrictByteString
forall a. Maybe a
Nothing) StrictByteString
pp)
    decrypted <-
        first
            SecretKeyDecryptCipherError
            (decryptNoNonce sa iv (BL.toStrict payload) dek)
    parser pkp decrypted
parse16BitProtectedSecretKey
    :: SomePKPayload
    -> B.ByteString
    -> Either SecretKeyError (SKey, Word16)
parse16BitProtectedSecretKey :: SomePKPayload
-> StrictByteString -> Either SecretKeyError (SKey, Word16)
parse16BitProtectedSecretKey SomePKPayload
pkp StrictByteString
p
    | StrictByteString -> Int
B.length StrictByteString
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 =
        SecretKeyError -> Either SecretKeyError (SKey, Word16)
forall a b. a -> Either a b
Left
            ( String -> SecretKeyError
SecretKeyPayloadTooShort
                String
"secret key payload is too short for a 16-bit checksum"
            )
    | Bool
otherwise = do
        let (StrictByteString
skeyPayload, StrictByteString
checksumPayload) = Int -> StrictByteString -> (StrictByteString, StrictByteString)
B.splitAt (StrictByteString -> Int
B.length StrictByteString
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) StrictByteString
p
        sk <- SomePKPayload -> StrictByteString -> Either SecretKeyError SKey
decodeSecretKey SomePKPayload
pkp StrictByteString
skeyPayload
        cksum <- decodeChecksum checksumPayload
        let expected = StrictByteString -> Word16
checksum16 StrictByteString
skeyPayload
        if cksum == expected
            then Right (sk, cksum)
            else
                Left
                    ( SecretKeyChecksumError
                        ( "16-bit secret key checksum mismatch (expected "
                            ++ show expected
                            ++ ", got "
                            ++ show cksum
                            ++ ")"
                        )
                    )

parseSHA1ProtectedSecretKey
    :: SomePKPayload
    -> B.ByteString
    -> Either SecretKeyError (SKey, Word16)
parseSHA1ProtectedSecretKey :: SomePKPayload
-> StrictByteString -> Either SecretKeyError (SKey, Word16)
parseSHA1ProtectedSecretKey SomePKPayload
pkp StrictByteString
p
    | StrictByteString -> Int
B.length StrictByteString
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20 =
        SecretKeyError -> Either SecretKeyError (SKey, Word16)
forall a b. a -> Either a b
Left
            ( String -> SecretKeyError
SecretKeyPayloadTooShort
                String
"secret key payload is too short for a SHA1 checksum"
            )
    | Bool
otherwise = do
        let (StrictByteString
skeyPayload, StrictByteString
hashPayload) = Int -> StrictByteString -> (StrictByteString, StrictByteString)
B.splitAt (StrictByteString -> Int
B.length StrictByteString
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
20) StrictByteString
p
            expected :: StrictByteString
expected = Digest SHA1 -> StrictByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (StrictByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash StrictByteString
skeyPayload :: CH.Digest CH.SHA1)
        sk <- SomePKPayload -> StrictByteString -> Either SecretKeyError SKey
decodeSecretKey SomePKPayload
pkp StrictByteString
skeyPayload
        if hashPayload == expected
            then Right (sk, checksum16 skeyPayload)
            else
                Left (SecretKeyChecksumError "SHA1 secret key checksum mismatch")

decodeSecretKey
    :: SomePKPayload -> B.ByteString -> Either SecretKeyError SKey
decodeSecretKey :: SomePKPayload -> StrictByteString -> Either SecretKeyError SKey
decodeSecretKey SomePKPayload
pkp StrictByteString
payloadBytes =
    (String -> SecretKeyError)
-> Either String SKey -> Either SecretKeyError SKey
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
        String -> SecretKeyError
SecretKeyDecodeError
        ( ((ByteString, ByteOffset, String) -> String)
-> ((ByteString, ByteOffset, SKey) -> SKey)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, SKey)
-> Either String SKey
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
            (\(ByteString
_, ByteOffset
_, String
x) -> String
x)
            (\(ByteString
_, ByteOffset
_, SKey
x) -> SKey
x)
            (Get SKey
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, SKey)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (SomePKPayload -> Get SKey
getSecretKey SomePKPayload
pkp) (StrictByteString -> ByteString
BL.fromStrict StrictByteString
payloadBytes))
        )

decodeChecksum :: B.ByteString -> Either SecretKeyError Word16
decodeChecksum :: StrictByteString -> Either SecretKeyError Word16
decodeChecksum StrictByteString
checksumBytes =
    (String -> SecretKeyError)
-> Either String Word16 -> Either SecretKeyError Word16
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
        String -> SecretKeyError
SecretKeyDecodeError
        ( ((ByteString, ByteOffset, String) -> String)
-> ((ByteString, ByteOffset, Word16) -> Word16)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16)
-> Either String Word16
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
            (\(ByteString
_, ByteOffset
_, String
x) -> String
x)
            (\(ByteString
_, ByteOffset
_, Word16
x) -> Word16
x)
            (Get Word16
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Word16
getWord16be (StrictByteString -> ByteString
BL.fromStrict StrictByteString
checksumBytes))
        )
decryptAEADPayloadCore
    :: SomePKPayload
    -> SymmetricAlgorithm
    -> AEADAlgorithm
    -> S2K
    -> IV
    -> B.ByteString
    -> Passphrase
    -> Either SecretKeyError SKey
decryptAEADPayloadCore :: SomePKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> StrictByteString
-> Passphrase
-> Either SecretKeyError SKey
decryptAEADPayloadCore SomePKPayload
pkp SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv StrictByteString
payload (Passphrase StrictByteString
pp) = do
    keyLen <-
        (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    keyMaterial <-
        first
            SecretKeyInvalidS2KMode
            (string2Key s2k keyLen pp)
    let keyCandidates = [StrictByteString
keyMaterial]
        tagCandidates = [Word8
0xC5, Word8
0xC7, Word8
0x94, Word8
0x95, Word8
0x96, Word8
0x97, Word8
0x9C, Word8
0x9D, Word8
0x9E, Word8
0x9F]
        infoCandidates =
            [StrictByteString] -> [StrictByteString]
forall a. Ord a => [a] -> [a]
nubOrd
                [ [Word8] -> StrictByteString
B.pack
                    [ Word8
tag
                    , Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KeyVersion -> Int
forall a. Enum a => a -> Int
fromEnum (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp))
                    , SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
sa
                    , AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aa
                    ]
                | Word8
tag <- [Word8]
tagCandidates
                ]
        pkpBytes = ByteString -> StrictByteString
BL.toStrict (Put -> ByteString
runPut (SomePKPayload -> Put
forall t. Binary t => t -> Put
put SomePKPayload
pkp))
        adCandidates =
            [StrictByteString] -> [StrictByteString]
forall a. Ord a => [a] -> [a]
nubOrd
                [Word8 -> StrictByteString -> StrictByteString
B.cons Word8
tagByte StrictByteString
pkpBytes | Word8
tagByte <- [Word8]
tagCandidates]
        aaCandidates = [AEADAlgorithm
aa]
        nonce = IV -> StrictByteString
unIV IV
iv
        payloadStrict = StrictByteString
payload
        tagLen = Int
16
        tryDecrypt StrictByteString
candidateKeyMaterial StrictByteString
info StrictByteString
ad AEADAlgorithm
aaTry = do
            Bool -> Either SecretKeyError () -> Either SecretKeyError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictByteString -> Int
B.length StrictByteString
payloadStrict Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tagLen) (Either SecretKeyError () -> Either SecretKeyError ())
-> Either SecretKeyError () -> Either SecretKeyError ()
forall a b. (a -> b) -> a -> b
$
                SecretKeyError -> Either SecretKeyError ()
forall a b. a -> Either a b
Left
                    (String -> SecretKeyError
SecretKeyPayloadTooShort String
"v6 AEAD secret key payload too short")
            let (StrictByteString
ciphertext, StrictByteString
tagBytes) = Int -> StrictByteString -> (StrictByteString, StrictByteString)
B.splitAt (StrictByteString -> Int
B.length StrictByteString
payloadStrict Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tagLen) StrictByteString
payloadStrict
                authTag :: AuthTag
authTag = Bytes -> AuthTag
CCT.AuthTag (StrictByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert StrictByteString
tagBytes)
                prk :: PRK SHA256
prk = forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
extract @CHA.SHA256 StrictByteString
B.empty StrictByteString
candidateKeyMaterial
                kekCandidates :: [StrictByteString]
kekCandidates =
                    [StrictByteString] -> [StrictByteString]
forall a. Ord a => [a] -> [a]
nubOrd
                        [ Int -> StrictByteString -> StrictByteString
B.take Int
keyLen StrictByteString
candidateKeyMaterial
                        , (forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
expand @CHA.SHA256 PRK SHA256
prk StrictByteString
info Int
keyLen :: B.ByteString)
                        , (forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
expand @CHA.SHA256 PRK SHA256
prk StrictByteString
B.empty Int
keyLen :: B.ByteString)
                        ]
                tryKeks :: [StrictByteString] -> Either SecretKeyError StrictByteString
tryKeks = Maybe SecretKeyError
-> [StrictByteString] -> Either SecretKeyError StrictByteString
go Maybe SecretKeyError
forall a. Maybe a
Nothing
                  where
                    go :: Maybe SecretKeyError
-> [StrictByteString] -> Either SecretKeyError StrictByteString
go Maybe SecretKeyError
merr [] =
                        SecretKeyError -> Either SecretKeyError StrictByteString
forall a b. a -> Either a b
Left (SecretKeyError -> Either SecretKeyError StrictByteString)
-> SecretKeyError -> Either SecretKeyError StrictByteString
forall a b. (a -> b) -> a -> b
$
                            String -> SecretKeyError
SecretKeyAEADError
                                ( String
"could not decrypt using any KEK candidate"
                                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> (SecretKeyError -> String) -> Maybe SecretKeyError -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                        String
""
                                        (\SecretKeyError
e -> String
" (last error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SecretKeyError -> String
renderSecretKeyError SecretKeyError
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
                                        Maybe SecretKeyError
merr
                                )
                    go Maybe SecretKeyError
merr (StrictByteString
kek : [StrictByteString]
ks) =
                        case SymmetricAlgorithm
-> AEADAlgorithm
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either SecretKeyError StrictByteString
decryptWithKey SymmetricAlgorithm
sa AEADAlgorithm
aaTry StrictByteString
kek StrictByteString
ad StrictByteString
nonce StrictByteString
ciphertext AuthTag
authTag of
                            Right StrictByteString
cleartext -> StrictByteString -> Either SecretKeyError StrictByteString
forall a b. b -> Either a b
Right StrictByteString
cleartext
                            Left SecretKeyError
err -> Maybe SecretKeyError
-> [StrictByteString] -> Either SecretKeyError StrictByteString
go (SecretKeyError -> Maybe SecretKeyError
forall a. a -> Maybe a
Just SecretKeyError
err) [StrictByteString]
ks
            [StrictByteString] -> Either SecretKeyError StrictByteString
tryKeks [StrictByteString]
kekCandidates
        tryAll = Maybe SecretKeyError
-> [(StrictByteString, StrictByteString, StrictByteString,
     AEADAlgorithm)]
-> Either SecretKeyError StrictByteString
go Maybe SecretKeyError
forall a. Maybe a
Nothing
          where
            go :: Maybe SecretKeyError
-> [(StrictByteString, StrictByteString, StrictByteString,
     AEADAlgorithm)]
-> Either SecretKeyError StrictByteString
go Maybe SecretKeyError
merr [] =
                SecretKeyError -> Either SecretKeyError StrictByteString
forall a b. a -> Either a b
Left (SecretKeyError -> Either SecretKeyError StrictByteString)
-> SecretKeyError -> Either SecretKeyError StrictByteString
forall a b. (a -> b) -> a -> b
$
                    String -> SecretKeyError
SecretKeyAEADError
                        ( String
"could not decrypt v6 AEAD secret key payload"
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> (SecretKeyError -> String) -> Maybe SecretKeyError -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                String
""
                                (\SecretKeyError
e -> String
" (last error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SecretKeyError -> String
renderSecretKeyError SecretKeyError
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
                                Maybe SecretKeyError
merr
                        )
            go Maybe SecretKeyError
merr ((StrictByteString
keyMaterialCandidate, StrictByteString
info, StrictByteString
ad, AEADAlgorithm
aaTry) : [(StrictByteString, StrictByteString, StrictByteString,
  AEADAlgorithm)]
xs) =
                case StrictByteString
-> StrictByteString
-> StrictByteString
-> AEADAlgorithm
-> Either SecretKeyError StrictByteString
tryDecrypt StrictByteString
keyMaterialCandidate StrictByteString
info StrictByteString
ad AEADAlgorithm
aaTry of
                    Right StrictByteString
cleartext -> StrictByteString -> Either SecretKeyError StrictByteString
forall a b. b -> Either a b
Right StrictByteString
cleartext
                    Left SecretKeyError
err -> Maybe SecretKeyError
-> [(StrictByteString, StrictByteString, StrictByteString,
     AEADAlgorithm)]
-> Either SecretKeyError StrictByteString
go (SecretKeyError -> Maybe SecretKeyError
forall a. a -> Maybe a
Just SecretKeyError
err) [(StrictByteString, StrictByteString, StrictByteString,
  AEADAlgorithm)]
xs
    cleartext <-
        tryAll
            [ (k, i, a, m)
            | k <- keyCandidates
            , i <- infoCandidates
            , a <- adCandidates
            , m <- aaCandidates
            ]
    parseSecretKeyExact pkp cleartext

checksum16 :: B.ByteString -> Word16
checksum16 :: StrictByteString -> Word16
checksum16 =
    Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        (Integer -> Word16)
-> (StrictByteString -> Integer) -> StrictByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word8 -> Integer)
-> Integer -> StrictByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> StrictByteString -> a
B.foldl'
            (\Integer
acc Word8
octet -> (Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
octet) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
65536 :: Integer))
            Integer
0

decryptWithKey
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> CCT.AuthTag
    -> Either SecretKeyError B.ByteString
decryptWithKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either SecretKeyError StrictByteString
decryptWithKey SymmetricAlgorithm
sa AEADAlgorithm
aa StrictByteString
kek StrictByteString
ad StrictByteString
nonce StrictByteString
ciphertext AuthTag
authTag = do
    let toHex :: StrictByteString -> String
toHex = StrictByteString -> String
BC.unpack (StrictByteString -> String)
-> (StrictByteString -> StrictByteString)
-> StrictByteString
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> StrictByteString
B16.encode
        authFailure :: StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> SecretKeyError
authFailure StrictByteString
expectedTag StrictByteString
computedTag StrictByteString
n StrictByteString
a StrictByteString
hashAd StrictByteString
plaintext =
            String -> SecretKeyError
SecretKeyAuthError
                ( String
"failed to authenticate v6 AEAD secret key payload (expected tag="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
expectedTag
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", computed tag="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
computedTag
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", nonce="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
n
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", ad="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
a
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", hashAd="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
hashAd
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", plaintext="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
plaintext
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                )
        unsupportedSecretKeyAEADError :: SecretKeyError
unsupportedSecretKeyAEADError =
            SymmetricAlgorithm -> SecretKeyError
SecretKeyAEADModeUnsupportedCipher SymmetricAlgorithm
sa
    case AEADAlgorithm
aa of
        AEADAlgorithm
OCB ->
            (CryptoError -> SecretKeyError)
-> SecretKeyError
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher.
    BlockCipher cipher =>
    cipher -> Either SecretKeyError StrictByteString)
-> Either SecretKeyError StrictByteString
forall e a.
(CryptoError -> e)
-> e
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher. BlockCipher cipher => cipher -> Either e a)
-> Either e a
withAESCipher
                CryptoError -> SecretKeyError
SecretKeyAEADModeCrypto
                SecretKeyError
unsupportedSecretKeyAEADError
                SymmetricAlgorithm
sa
                StrictByteString
kek
                ( \cipher
cipher ->
                    (StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> SecretKeyError)
-> cipher
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either SecretKeyError StrictByteString
forall c e.
BlockCipher c =>
(StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> e)
-> c
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either e StrictByteString
decryptWithOCBRFC7253With
                        StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> SecretKeyError
authFailure
                        cipher
cipher
                        StrictByteString
nonce
                        StrictByteString
ad
                        StrictByteString
ciphertext
                        AuthTag
authTag
                )
        AEADAlgorithm
_ -> do
            mode <- AEADAlgorithm -> Either SecretKeyError AEADMode
aeadMode AEADAlgorithm
aa
            expectedNonceLen <- aeadNonceSize aa
            when (B.length nonce /= expectedNonceLen) $
                Left
                    ( SecretKeyInvalidNonceSize
                        "invalid nonce size for v6 AEAD secret key payload"
                    )
            withAESCipher
                SecretKeyAEADModeCrypto
                unsupportedSecretKeyAEADError
                sa
                kek
                $ \cipher
cipher ->
                    (CryptoError -> SecretKeyError)
-> Either CryptoError (AEAD cipher)
-> Either SecretKeyError (AEAD cipher)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
                        CryptoError -> SecretKeyError
SecretKeyAEADModeCrypto
                        (CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (AEADMode
-> cipher -> StrictByteString -> 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
cipher StrictByteString
nonce))
                        Either SecretKeyError (AEAD cipher)
-> (AEAD cipher -> Either SecretKeyError StrictByteString)
-> Either SecretKeyError StrictByteString
forall a b.
Either SecretKeyError a
-> (a -> Either SecretKeyError b) -> Either SecretKeyError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AEAD cipher
aead ->
                            SecretKeyError
-> Maybe StrictByteString -> Either SecretKeyError StrictByteString
forall a b. a -> Maybe b -> Either a b
note
                                ( String -> SecretKeyError
SecretKeyAuthError
                                    String
"failed to authenticate v6 AEAD secret key payload"
                                )
                                (AEAD cipher
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Maybe StrictByteString
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
CCT.aeadSimpleDecrypt AEAD cipher
aead StrictByteString
ad StrictByteString
ciphertext AuthTag
authTag)

aeadMode :: AEADAlgorithm -> Either SecretKeyError CCT.AEADMode
aeadMode :: AEADAlgorithm -> Either SecretKeyError AEADMode
aeadMode AEADAlgorithm
EAX = AEADMode -> Either SecretKeyError AEADMode
forall a b. b -> Either a b
Right AEADMode
CCT.AEAD_EAX
aeadMode AEADAlgorithm
OCB = AEADMode -> Either SecretKeyError AEADMode
forall a b. b -> Either a b
Right AEADMode
CCT.AEAD_OCB
aeadMode AEADAlgorithm
GCM = AEADMode -> Either SecretKeyError AEADMode
forall a b. b -> Either a b
Right AEADMode
CCT.AEAD_GCM
aeadMode aa :: AEADAlgorithm
aa@(OtherAEADAlgo Word8
_) = SecretKeyError -> Either SecretKeyError AEADMode
forall a b. a -> Either a b
Left (AEADAlgorithm -> SecretKeyError
SecretKeyAEADModeUnsupportedAlgo AEADAlgorithm
aa)

aeadNonceSize :: AEADAlgorithm -> Either SecretKeyError Int
aeadNonceSize :: AEADAlgorithm -> Either SecretKeyError Int
aeadNonceSize AEADAlgorithm
EAX = Int -> Either SecretKeyError Int
forall a b. b -> Either a b
Right Int
16
aeadNonceSize AEADAlgorithm
OCB = Int -> Either SecretKeyError Int
forall a b. b -> Either a b
Right Int
15
aeadNonceSize AEADAlgorithm
GCM = Int -> Either SecretKeyError Int
forall a b. b -> Either a b
Right Int
12
aeadNonceSize (OtherAEADAlgo Word8
_) = SecretKeyError -> Either SecretKeyError Int
forall a b. a -> Either a b
Left (String -> SecretKeyError
SecretKeyInvalidNonceSize String
"unknown AEAD nonce size")

parseSecretKeyExact
    :: SomePKPayload -> B.ByteString -> Either SecretKeyError SKey
parseSecretKeyExact :: SomePKPayload -> StrictByteString -> Either SecretKeyError SKey
parseSecretKeyExact SomePKPayload
pkp StrictByteString
cleartext =
    case Get (SKey, ByteString)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, (SKey, ByteString))
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail
        ((,) (SKey -> ByteString -> (SKey, ByteString))
-> Get SKey -> Get (ByteString -> (SKey, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload -> Get SKey
getSecretKey SomePKPayload
pkp Get (ByteString -> (SKey, ByteString))
-> Get ByteString -> Get (SKey, ByteString)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getRemainingLazyByteString)
        (StrictByteString -> ByteString
BL.fromStrict StrictByteString
cleartext) of
        Left (ByteString
_, ByteOffset
_, String
err) -> SecretKeyError -> Either SecretKeyError SKey
forall a b. a -> Either a b
Left (String -> SecretKeyError
SecretKeyDecodeError String
err)
        Right (ByteString
_, ByteOffset
_, (SKey
sk, ByteString
trailing))
            | ByteString -> Bool
BL.null ByteString
trailing -> SKey -> Either SecretKeyError SKey
forall a b. b -> Either a b
Right SKey
sk
            | Bool
otherwise ->
                SecretKeyError -> Either SecretKeyError SKey
forall a b. a -> Either a b
Left
                    ( String -> SecretKeyError
SecretKeyTrailingBytes
                        String
"v6 AEAD secret key cleartext has trailing bytes"
                    )

encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV
    :: OpenPGPPolicy
    -> SomePKPayload
    -> Salt
    -> IV
    -> SKey
    -> Passphrase
    -> Either SecretKeyError SKAddendum
encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV :: OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> Either SecretKeyError SKAddendum
encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv SKey
skey (Passphrase StrictByteString
pp) = do
    (sa, _aa, s2k) <- OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either SecretKeyError (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv
    let retargetedS2K = Salt -> S2K -> S2K
retargetS2K Salt
salt S2K
s2k
    case _keyVersion pkp of
        KeyVersion
V6 ->
            (\StrictByteString
payload -> SymmetricAlgorithm
-> AEADAlgorithm -> S2K -> IV -> ByteString -> SKAddendum
SUSAEAD SymmetricAlgorithm
sa AEADAlgorithm
_aa S2K
s2k IV
iv (StrictByteString -> ByteString
BL.fromStrict StrictByteString
payload))
                (StrictByteString -> SKAddendum)
-> Either SecretKeyError StrictByteString
-> Either SecretKeyError SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload
-> SKey
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> Passphrase
-> Either SecretKeyError StrictByteString
encryptV6SKey SomePKPayload
pkp SKey
skey SymmetricAlgorithm
sa AEADAlgorithm
_aa S2K
s2k IV
iv (StrictByteString -> Passphrase
Passphrase StrictByteString
pp)
        KeyVersion
V4 ->
            if OpenPGPPolicy -> OpenPGPRFC
policyRFC OpenPGPPolicy
policy OpenPGPRFC -> OpenPGPRFC -> Bool
forall a. Eq a => a -> a -> Bool
== OpenPGPRFC
RFC9580
                then
                    (\StrictByteString
payload -> SymmetricAlgorithm
-> AEADAlgorithm -> S2K -> IV -> ByteString -> SKAddendum
SUSAEAD SymmetricAlgorithm
sa AEADAlgorithm
_aa S2K
s2k IV
iv (StrictByteString -> ByteString
BL.fromStrict StrictByteString
payload))
                        (StrictByteString -> SKAddendum)
-> Either SecretKeyError StrictByteString
-> Either SecretKeyError SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload
-> SKey
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> Passphrase
-> Either SecretKeyError StrictByteString
encryptV6SKey SomePKPayload
pkp SKey
skey SymmetricAlgorithm
sa AEADAlgorithm
_aa S2K
s2k IV
iv (StrictByteString -> Passphrase
Passphrase StrictByteString
pp)
                else do
                    keyLen <-
                        (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
                    keyMaterial <-
                        first
                            SecretKeyInvalidS2KMode
                            (string2Key retargetedS2K keyLen pp)
                    cleartext <- legacySecretKeyPayload pkp skey
                    let clearWithSHA1 =
                            ByteString -> StrictByteString
BL.toStrict ByteString
cleartext
                                StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> Digest SHA1 -> StrictByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
                                    ( StrictByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash
                                        (ByteString -> StrictByteString
BL.toStrict ByteString
cleartext)
                                        :: CH.Digest CH.SHA1
                                    )
                    encrypted <-
                        first
                            SecretKeyEncryptCipherError
                            (encryptNoNonce sa retargetedS2K iv clearWithSHA1 keyMaterial)
                    pure (SUSCFB sa retargetedS2K iv (BL.fromStrict encrypted))
        KeyVersion
DeprecatedV3 ->
            SecretKeyError -> Either SecretKeyError SKAddendum
forall a b. a -> Either a b
Left SecretKeyError
SecretKeyUnsupportedLegacyProtection

encodeSKeyMaterial :: SKey -> Either SecretKeyError BL.ByteString
encodeSKeyMaterial :: SKey -> Either SecretKeyError ByteString
encodeSKeyMaterial SKey
keyMaterial =
    case SKey
keyMaterial of
        RSAPrivateKey (RSA_PrivateKey (R.PrivateKey PublicKey
_ Integer
d Integer
p Integer
q Integer
_ Integer
_ Integer
_)) ->
            case Integer -> Integer -> Maybe Integer
inverse Integer
p Integer
q of
                Maybe Integer
Nothing ->
                    SecretKeyError -> Either SecretKeyError ByteString
forall a b. a -> Either a b
Left SecretKeyError
SecretKeyRSAInverseError
                Just Integer
u ->
                    ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right
                        (Put -> ByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
p) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
q) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
u)))
        DSAPrivateKey (DSA_PrivateKey (DSA.PrivateKey Params
_ Integer
x)) ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
x)))
        ElGamalPrivateKey Integer
x ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
x)))
        ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey Curve
_ Integer
d)) ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d)))
        ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey Curve
_ Integer
d)) ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d)))
        EdDSAPrivateKey EdSigningCurve
_ StrictByteString
bs ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI (StrictByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip StrictByteString
bs))))
        Ed25519PrivateKey StrictByteString
bs ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (StrictByteString -> Put
putByteString StrictByteString
bs))
        Ed448PrivateKey StrictByteString
bs ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (StrictByteString -> Put
putByteString StrictByteString
bs))
        X25519PrivateKey StrictByteString
bs ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (StrictByteString -> Put
putByteString StrictByteString
bs))
        X448PrivateKey StrictByteString
bs ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (StrictByteString -> Put
putByteString StrictByteString
bs))
        UnknownSKey ByteString
bs ->
            ByteString -> Either SecretKeyError ByteString
forall a b. b -> Either a b
Right (Put -> ByteString
runPut (ByteString -> Put
putLazyByteString ByteString
bs))

encryptV6SKey
    :: SomePKPayload
    -> SKey
    -> SymmetricAlgorithm
    -> AEADAlgorithm
    -> S2K
    -> IV
    -> Passphrase
    -> Either SecretKeyError B.ByteString
encryptV6SKey :: SomePKPayload
-> SKey
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> Passphrase
-> Either SecretKeyError StrictByteString
encryptV6SKey SomePKPayload
pkp SKey
skey SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv (Passphrase StrictByteString
pp) = do
    keyLen <-
        (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    keyMaterial <-
        first
            SecretKeyInvalidS2KMode
            (string2Key s2k keyLen pp)
    payload <- encodeSKeyMaterial skey
    let info =
            [Word8] -> StrictByteString
B.pack
                [ Word8
0xC5
                , Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KeyVersion -> Int
forall a. Enum a => a -> Int
fromEnum (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp))
                , SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
sa
                , AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aa
                ]
        ad = Word8 -> StrictByteString -> StrictByteString
B.cons Word8
0xC5 (ByteString -> StrictByteString
BL.toStrict (Put -> ByteString
runPut (SomePKPayload -> Put
forall t. Binary t => t -> Put
put SomePKPayload
pkp)))
        prk = forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
extract @CHA.SHA256 StrictByteString
B.empty StrictByteString
keyMaterial
        kek = forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
expand @CHA.SHA256 PRK SHA256
prk StrictByteString
info Int
keyLen :: B.ByteString
    (tag, ciphertext) <-
        encryptWithKey sa aa kek ad (unIV iv) (BL.toStrict payload)
    pure (ciphertext <> BA.convert (CCT.unAuthTag tag))

secretKeyProtectionMaterialLengths
    :: OpenPGPPolicy
    -> SomePKPayload
    -> Either SecretKeyError (Int, Int)
secretKeyProtectionMaterialLengths :: OpenPGPPolicy -> SomePKPayload -> Either SecretKeyError (Int, Int)
secretKeyProtectionMaterialLengths OpenPGPPolicy
policy SomePKPayload
pkp =
    case OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForEncryption OpenPGPPolicy
policy (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp) of
        Just SecretKeyProtectionPolicy
skPolicy ->
            let saltLen :: Int
saltLen = case SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp of
                    KeyVersion
V4 -> Int
8
                    KeyVersion
_ -> SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets SecretKeyProtectionPolicy
skPolicy
             in (Int, Int) -> Either SecretKeyError (Int, Int)
forall a b. b -> Either a b
Right (Int
saltLen, SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
skPolicy)
        Maybe SecretKeyProtectionPolicy
Nothing -> SecretKeyError -> Either SecretKeyError (Int, Int)
forall a b. a -> Either a b
Left SecretKeyError
SecretKeyUnsupportedLegacyProtection

generateSecretKeyProtectionMaterial
    :: MonadRandom m
    => OpenPGPPolicy
    -> SomePKPayload
    -> m (Either SecretKeyError (Salt, IV))
generateSecretKeyProtectionMaterial :: forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy
-> SomePKPayload -> m (Either SecretKeyError (Salt, IV))
generateSecretKeyProtectionMaterial OpenPGPPolicy
policy SomePKPayload
pkp =
    case OpenPGPPolicy -> SomePKPayload -> Either SecretKeyError (Int, Int)
secretKeyProtectionMaterialLengths OpenPGPPolicy
policy SomePKPayload
pkp of
        Left SecretKeyError
err -> Either SecretKeyError (Salt, IV)
-> m (Either SecretKeyError (Salt, IV))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecretKeyError -> Either SecretKeyError (Salt, IV)
forall a b. a -> Either a b
Left SecretKeyError
err)
        Right (Int
saltLen, Int
nonceLen) -> do
            entropy <- Int -> m StrictByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (Int
saltLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nonceLen)
            let (saltBytes, ivBytes) = B.splitAt saltLen entropy
            pure (Right (Salt saltBytes, IV ivBytes))

secretKeyProtectionDefaults
    :: OpenPGPPolicy
    -> SomePKPayload
    -> Salt
    -> IV
    -> Either SecretKeyError (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults :: OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either SecretKeyError (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv =
    case OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForEncryption OpenPGPPolicy
policy (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp) of
        Just SecretKeyProtectionPolicy
skPolicy -> do
            let expectedSaltLen :: Int
expectedSaltLen = case SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp of
                    KeyVersion
V4 -> Int
8
                    KeyVersion
_ -> SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets SecretKeyProtectionPolicy
skPolicy
            Bool -> Either SecretKeyError () -> Either SecretKeyError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictByteString -> Int
B.length (Salt -> StrictByteString
unSalt Salt
salt) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedSaltLen) (Either SecretKeyError () -> Either SecretKeyError ())
-> Either SecretKeyError () -> Either SecretKeyError ()
forall a b. (a -> b) -> a -> b
$
                SecretKeyError -> Either SecretKeyError ()
forall a b. a -> Either a b
Left
                    ( Int -> Int -> SecretKeyError
SecretKeyPolicySaltLengthMismatch
                        Int
expectedSaltLen
                        (StrictByteString -> Int
B.length (Salt -> StrictByteString
unSalt Salt
salt))
                    )
            Bool -> Either SecretKeyError () -> Either SecretKeyError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
                ( SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
                    Bool -> Bool -> Bool
&& StrictByteString -> Int
B.length (IV -> StrictByteString
unIV IV
iv) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
skPolicy
                )
                (Either SecretKeyError () -> Either SecretKeyError ())
-> Either SecretKeyError () -> Either SecretKeyError ()
forall a b. (a -> b) -> a -> b
$ SecretKeyError -> Either SecretKeyError ()
forall a b. a -> Either a b
Left
                    ( Int -> Int -> SecretKeyError
SecretKeyPolicyNonceLengthMismatch
                        (SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
skPolicy)
                        (StrictByteString -> Int
B.length (IV -> StrictByteString
unIV IV
iv))
                    )
            let defaultS2K :: S2K
defaultS2K = SecretKeyProtectionPolicy -> Salt -> S2K
secretKeyDefaultS2KForSalt SecretKeyProtectionPolicy
skPolicy Salt
salt
                s2k :: S2K
s2k = case SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp of
                    KeyVersion
V4 ->
                        case S2K
defaultS2K of
                            Argon2 {} ->
                                HashAlgorithm -> Salt8 -> IterationCount -> S2K
IteratedSalted
                                    HashAlgorithm
SHA512
                                    (StrictByteString -> Salt8
Salt8 (Int -> StrictByteString -> StrictByteString
B.take Int
8 (Salt -> StrictByteString
unSalt Salt
salt)))
                                    IterationCount
1024
                            S2K
_ -> S2K
defaultS2K
                    KeyVersion
_ -> S2K
defaultS2K
            let sa :: SymmetricAlgorithm
sa = SecretKeyProtectionPolicy -> SymmetricAlgorithm
secretKeyDefaultSymmetricAlgorithm SecretKeyProtectionPolicy
skPolicy
                aa :: AEADAlgorithm
aa = SecretKeyProtectionPolicy -> AEADAlgorithm
secretKeyDefaultAEADAlgorithm SecretKeyProtectionPolicy
skPolicy
            (SymmetricAlgorithm, AEADAlgorithm, S2K)
-> Either SecretKeyError (SymmetricAlgorithm, AEADAlgorithm, S2K)
forall a. a -> Either SecretKeyError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm
sa, AEADAlgorithm
aa, S2K
s2k)
        Maybe SecretKeyProtectionPolicy
Nothing -> SecretKeyError
-> Either SecretKeyError (SymmetricAlgorithm, AEADAlgorithm, S2K)
forall a b. a -> Either a b
Left SecretKeyError
SecretKeyUnsupportedLegacyProtection

secretKeyProtectionPolicyForEncryption
    :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForEncryption :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForEncryption OpenPGPPolicy
policy KeyVersion
V4 =
    OpenPGPPolicy -> Maybe SecretKeyProtectionPolicy
policySecretKeyProtection OpenPGPPolicy
policy
secretKeyProtectionPolicyForEncryption OpenPGPPolicy
policy KeyVersion
V6 =
    OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForKeyVersion OpenPGPPolicy
policy KeyVersion
V6
secretKeyProtectionPolicyForEncryption OpenPGPPolicy
policy KeyVersion
_
    | OpenPGPPolicy -> OpenPGPRFC
policyRFC OpenPGPPolicy
policy OpenPGPRFC -> OpenPGPRFC -> Bool
forall a. Eq a => a -> a -> Bool
== OpenPGPRFC
RFC9580 = Maybe SecretKeyProtectionPolicy
forall a. Maybe a
Nothing
    | Bool
otherwise = OpenPGPPolicy -> Maybe SecretKeyProtectionPolicy
policySecretKeyProtection OpenPGPPolicy
policy

encryptWithKey
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> B.ByteString
    -> Either SecretKeyError (CCT.AuthTag, B.ByteString)
encryptWithKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> Either SecretKeyError (AuthTag, StrictByteString)
encryptWithKey SymmetricAlgorithm
sa AEADAlgorithm
aa StrictByteString
kek StrictByteString
ad StrictByteString
nonce StrictByteString
plaintext = do
    expectedNonceLen <- AEADAlgorithm -> Either SecretKeyError Int
aeadNonceSize AEADAlgorithm
aa
    when (B.length nonce /= expectedNonceLen) $
        Left
            ( SecretKeyInvalidNonceSize
                "invalid nonce size for v6 AEAD secret key payload"
            )
    let unsupportedSecretKeyAEADError =
            SymmetricAlgorithm -> SecretKeyError
SecretKeyAEADModeUnsupportedCipher SymmetricAlgorithm
sa
    case aa of
        AEADAlgorithm
OCB ->
            (CryptoError -> SecretKeyError)
-> SecretKeyError
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher.
    BlockCipher cipher =>
    cipher -> Either SecretKeyError (AuthTag, StrictByteString))
-> Either SecretKeyError (AuthTag, StrictByteString)
forall e a.
(CryptoError -> e)
-> e
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher. BlockCipher cipher => cipher -> Either e a)
-> Either e a
withAESCipher
                CryptoError -> SecretKeyError
SecretKeyAEADModeCrypto
                SecretKeyError
unsupportedSecretKeyAEADError
                SymmetricAlgorithm
sa
                StrictByteString
kek
                (\cipher
cipher -> cipher
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> Either SecretKeyError (AuthTag, StrictByteString)
forall c e.
BlockCipher c =>
c
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> Either e (AuthTag, StrictByteString)
encryptWithOCBRFC7253 cipher
cipher StrictByteString
nonce StrictByteString
ad StrictByteString
plaintext)
        AEADAlgorithm
_ -> do
            mode <- AEADAlgorithm -> Either SecretKeyError AEADMode
aeadMode AEADAlgorithm
aa
            withAESCipher
                SecretKeyAEADModeCrypto
                unsupportedSecretKeyAEADError
                sa
                kek
                $ \cipher
cipher ->
                    (CryptoError -> SecretKeyError)
-> Either CryptoError (AEAD cipher)
-> Either SecretKeyError (AEAD cipher)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
                        CryptoError -> SecretKeyError
SecretKeyAEADModeCrypto
                        (CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (AEADMode
-> cipher -> StrictByteString -> 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
cipher StrictByteString
nonce))
                        Either SecretKeyError (AEAD cipher)
-> (AEAD cipher
    -> Either SecretKeyError (AuthTag, StrictByteString))
-> Either SecretKeyError (AuthTag, StrictByteString)
forall a b.
Either SecretKeyError a
-> (a -> Either SecretKeyError b) -> Either SecretKeyError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AEAD cipher
aead ->
                            (AuthTag, StrictByteString)
-> Either SecretKeyError (AuthTag, StrictByteString)
forall a. a -> Either SecretKeyError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AEAD cipher
-> StrictByteString
-> StrictByteString
-> Int
-> (AuthTag, StrictByteString)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
CCT.aeadSimpleEncrypt AEAD cipher
aead StrictByteString
ad StrictByteString
plaintext Int
16)

reencryptWithPolicyAndSaltAndIVTyped
    :: OpenPGPPolicy
    -> SomePKPayload
    -> SKAddendumV v
    -> Salt
    -> IV
    -> SKey
    -> Passphrase
    -> Either SecretKeyError (SKAddendumV v)
reencryptWithPolicyAndSaltAndIVTyped :: forall (v :: KeyVersion).
OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> Passphrase
-> Either SecretKeyError (SKAddendumV v)
reencryptWithPolicyAndSaltAndIVTyped OpenPGPPolicy
policy SomePKPayload
pkp SKAddendumV v
skaV Salt
salt IV
iv SKey
skey Passphrase
pp =
    case SKAddendumV v
skaV of
        SKAAEADV6 {} -> OpenPGPPolicy -> Either SecretKeyError (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKACFBV6 {} -> OpenPGPPolicy -> Either SecretKeyError (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKALegacyCFBV6 {} -> OpenPGPPolicy -> Either SecretKeyError (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKAUnprotectedV6 {} -> OpenPGPPolicy -> Either SecretKeyError (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKAMalleableCFB SymmetricAlgorithm
sa S2K
s2k IV
_ ByteString
_ ->
            SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError (SKAddendumV v))
-> Either SecretKeyError (SKAddendumV v)
forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError r)
-> Either SecretKeyError r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey Passphrase
pp SymmetricAlgorithm
sa S2K
s2k ((SymmetricAlgorithm
  -> S2K
  -> IV
  -> ByteString
  -> StrictByteString
  -> Either SecretKeyError (SKAddendumV v))
 -> Either SecretKeyError (SKAddendumV v))
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError (SKAddendumV v))
-> Either SecretKeyError (SKAddendumV v)
forall a b. (a -> b) -> a -> b
$ \SymmetricAlgorithm
sa' S2K
s2k' IV
iv' ByteString
ct StrictByteString
km ->
                SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> SKAddendumV v)
-> Either SecretKeyError (SKAddendumV v)
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> r)
-> Either SecretKeyError r
encryptProtectedSecretKey
                    SymmetricAlgorithm
sa'
                    S2K
s2k'
                    IV
iv'
                    ByteString
ct
                    StrictByteString
km
                    ByteString -> ByteString
checksum16Trailer
                    (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKAMalleableCFB SymmetricAlgorithm
sa' S2K
s2k' IV
iv')
        SKACFBLegacy SymmetricAlgorithm
sa S2K
s2k IV
_ ByteString
_ ->
            SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError (SKAddendumV v))
-> Either SecretKeyError (SKAddendumV v)
forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError r)
-> Either SecretKeyError r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey Passphrase
pp SymmetricAlgorithm
sa S2K
s2k ((SymmetricAlgorithm
  -> S2K
  -> IV
  -> ByteString
  -> StrictByteString
  -> Either SecretKeyError (SKAddendumV v))
 -> Either SecretKeyError (SKAddendumV v))
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError (SKAddendumV v))
-> Either SecretKeyError (SKAddendumV v)
forall a b. (a -> b) -> a -> b
$ \SymmetricAlgorithm
sa' S2K
s2k' IV
iv' ByteString
ct StrictByteString
km ->
                SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> SKAddendumV v)
-> Either SecretKeyError (SKAddendumV v)
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> r)
-> Either SecretKeyError r
encryptProtectedSecretKey
                    SymmetricAlgorithm
sa'
                    S2K
s2k'
                    IV
iv'
                    ByteString
ct
                    StrictByteString
km
                    ByteString -> ByteString
sha1Trailer
                    (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKACFBLegacy SymmetricAlgorithm
sa' S2K
s2k' IV
iv')
        SKAAEADLegacy SymmetricAlgorithm
sa AEADAlgorithm
_aa S2K
s2k IV
_ ByteString
_ ->
            SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError (SKAddendumV v))
-> Either SecretKeyError (SKAddendumV v)
forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError r)
-> Either SecretKeyError r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey Passphrase
pp SymmetricAlgorithm
sa S2K
s2k ((SymmetricAlgorithm
  -> S2K
  -> IV
  -> ByteString
  -> StrictByteString
  -> Either SecretKeyError (SKAddendumV v))
 -> Either SecretKeyError (SKAddendumV v))
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError (SKAddendumV v))
-> Either SecretKeyError (SKAddendumV v)
forall a b. (a -> b) -> a -> b
$ \SymmetricAlgorithm
sa' S2K
s2k' IV
iv' ByteString
ct StrictByteString
km ->
                SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> SKAddendumV v)
-> Either SecretKeyError (SKAddendumV v)
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> r)
-> Either SecretKeyError r
encryptProtectedSecretKey
                    SymmetricAlgorithm
sa'
                    S2K
s2k'
                    IV
iv'
                    ByteString
ct
                    StrictByteString
km
                    ByteString -> ByteString
sha1Trailer
                    (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKACFBLegacy SymmetricAlgorithm
sa' S2K
s2k' IV
iv')
        SKALegacyCFBLegacy SymmetricAlgorithm
sa IV
_ ByteString
_ -> do
            keyLen <-
                (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
            keyMaterial <-
                first
                    SecretKeyInvalidS2KMode
                    (string2Key (Simple DeprecatedMD5) keyLen (unPassphrase pp))
            cleartext <- legacySecretKeyPayload pkp skey
            let clearWithChecksum =
                    ByteString -> StrictByteString
BL.toStrict
                        ( ByteString
cleartext
                            ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Put -> ByteString
runPut (Word16 -> Put
putWord16be (StrictByteString -> Word16
checksum16 (ByteString -> StrictByteString
BL.toStrict ByteString
cleartext)))
                        )
            (\StrictByteString
encrypted -> SymmetricAlgorithm -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> IV -> ByteString -> SKAddendumV v
SKALegacyCFBLegacy SymmetricAlgorithm
sa IV
iv (StrictByteString -> ByteString
BL.fromStrict StrictByteString
encrypted))
                <$> first
                    SecretKeyEncryptCipherError
                    ( encryptNoNonce
                        sa
                        (Simple DeprecatedMD5)
                        iv
                        clearWithChecksum
                        keyMaterial
                    )
        SKAUnprotectedLegacy SKey
_ Word16
_ -> SecretKeyError -> Either SecretKeyError (SKAddendumV v)
forall a b. a -> Either a b
Left SecretKeyError
SecretKeyUnsupportedLegacyProtection
  where
    reencryptV6 :: OpenPGPPolicy -> Either SecretKeyError (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
pol = do
        (sa, aa, s2k) <- OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either SecretKeyError (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults OpenPGPPolicy
pol SomePKPayload
pkp Salt
salt IV
iv
        (\StrictByteString
payload -> SymmetricAlgorithm
-> AEADAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV 'V6
SKAAEADV6 SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv (StrictByteString -> ByteString
BL.fromStrict StrictByteString
payload))
            <$> encryptV6SKey pkp skey sa aa s2k iv pp

reencryptS2KProtectedSecretKey
    :: SomePKPayload
    -> Salt
    -> IV
    -> SKey
    -> Passphrase
    -> SymmetricAlgorithm
    -> S2K
    -> ( SymmetricAlgorithm
         -> S2K
         -> IV
         -> BL.ByteString
         -> B.ByteString
         -> Either SecretKeyError r
       )
    -> Either SecretKeyError r
reencryptS2KProtectedSecretKey :: forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> Passphrase
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> ByteString
    -> StrictByteString
    -> Either SecretKeyError r)
-> Either SecretKeyError r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey (Passphrase StrictByteString
pp) SymmetricAlgorithm
sa S2K
s2k SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> Either SecretKeyError r
encryptFn = do
    keyLen <-
        (CipherError -> SecretKeyError)
-> Either CipherError Int -> Either SecretKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> SecretKeyError
SecretKeyPolicyCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    let retargetedS2K = Salt -> S2K -> S2K
retargetS2K Salt
salt S2K
s2k
    keyMaterial <-
        first
            SecretKeyInvalidS2KMode
            (string2Key retargetedS2K keyLen pp)
    cleartext <- legacySecretKeyPayload pkp skey
    encryptFn sa retargetedS2K iv cleartext keyMaterial

encryptProtectedSecretKey
    :: SymmetricAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> B.ByteString
    -> (BL.ByteString -> BL.ByteString)
    -> (BL.ByteString -> r)
    -> Either SecretKeyError r
encryptProtectedSecretKey :: forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> ByteString
-> StrictByteString
-> (ByteString -> ByteString)
-> (ByteString -> r)
-> Either SecretKeyError r
encryptProtectedSecretKey SymmetricAlgorithm
sa S2K
s2k IV
iv ByteString
cleartext StrictByteString
keyMaterial ByteString -> ByteString
checksumTrailer ByteString -> r
mkAddendum = do
    let clearWithChecksum :: StrictByteString
clearWithChecksum = ByteString -> StrictByteString
BL.toStrict (ByteString
cleartext ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
checksumTrailer ByteString
cleartext)
    encrypted <-
        (CipherError -> SecretKeyError)
-> Either CipherError StrictByteString
-> Either SecretKeyError StrictByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
            CipherError -> SecretKeyError
SecretKeyEncryptCipherError
            (SymmetricAlgorithm
-> S2K
-> IV
-> StrictByteString
-> StrictByteString
-> Either CipherError StrictByteString
encryptNoNonce SymmetricAlgorithm
sa S2K
s2k IV
iv StrictByteString
clearWithChecksum StrictByteString
keyMaterial)
    pure (mkAddendum (BL.fromStrict encrypted))

checksum16Trailer :: BL.ByteString -> BL.ByteString
checksum16Trailer :: ByteString -> ByteString
checksum16Trailer ByteString
cleartext =
    Put -> ByteString
runPut (Word16 -> Put
putWord16be (StrictByteString -> Word16
checksum16 (ByteString -> StrictByteString
BL.toStrict ByteString
cleartext)))

sha1Trailer :: BL.ByteString -> BL.ByteString
sha1Trailer :: ByteString -> ByteString
sha1Trailer ByteString
cleartext =
    StrictByteString -> ByteString
BL.fromStrict
        (Digest SHA1 -> StrictByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (StrictByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash (ByteString -> StrictByteString
BL.toStrict ByteString
cleartext) :: CH.Digest CH.SHA1))

legacySecretKeyPayload
    :: SomePKPayload -> SKey -> Either SecretKeyError BL.ByteString
legacySecretKeyPayload :: SomePKPayload -> SKey -> Either SecretKeyError ByteString
legacySecretKeyPayload SomePKPayload
pkp SKey
skey =
    (SerializeError -> SecretKeyError)
-> Either SerializeError ByteString
-> Either SecretKeyError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SerializeError -> SecretKeyError
SecretKeyEncodeError (Either SerializeError ByteString
 -> Either SecretKeyError ByteString)
-> Either SerializeError ByteString
-> Either SecretKeyError ByteString
forall a b. (a -> b) -> a -> b
$
        Put -> ByteString
runPut (Put -> ByteString)
-> Either SerializeError Put -> Either SerializeError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload -> SKey -> Either SerializeError Put
putSKeyForPKPayload SomePKPayload
pkp SKey
skey

retargetS2K :: Salt -> S2K -> S2K
retargetS2K :: Salt -> S2K -> S2K
retargetS2K Salt
salt (Salted HashAlgorithm
ha Salt8
oldSalt) =
    S2K -> (Salt8 -> S2K) -> Maybe Salt8 -> S2K
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HashAlgorithm -> Salt8 -> S2K
Salted HashAlgorithm
ha Salt8
oldSalt) (HashAlgorithm -> Salt8 -> S2K
Salted HashAlgorithm
ha) (Salt -> Maybe Salt8
salt8FromSalt Salt
salt)
retargetS2K Salt
salt (IteratedSalted HashAlgorithm
ha Salt8
oldSalt IterationCount
cnt) =
    S2K -> (Salt8 -> S2K) -> Maybe Salt8 -> S2K
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (HashAlgorithm -> Salt8 -> IterationCount -> S2K
IteratedSalted HashAlgorithm
ha Salt8
oldSalt IterationCount
cnt)
        (\Salt8
salt8 -> HashAlgorithm -> Salt8 -> IterationCount -> S2K
IteratedSalted HashAlgorithm
ha Salt8
salt8 IterationCount
cnt)
        (Salt -> Maybe Salt8
salt8FromSalt Salt
salt)
retargetS2K Salt
_ S2K
s2k = S2K
s2k