-- 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
    ( decryptPrivateKey
    , reinterpretUnknownSKeyForPKPayload
    , mkUnencryptedSKAddendum
    , encryptPrivateKeyWithPolicyAndSaltAndIV
    , encryptPrivateKey
    , changePrivateKeyPassphrase
    , changePrivateKeyPassphraseRandom
    , reencryptSecretKeyRandomEither
    , reencryptPrivateKeyTyped
    , SecretKeyError (..)
    , SecretKeyEncryptOptions (..)
    , decryptSecretKey
    , decryptSecretKeyAddendum
    , encryptSecretKey
    , encryptSecretKeyWithPolicy
    , reencryptSecretKey
    , reencryptSecretKeyRandom
    , changeSecretKeyPassphrase
    ) where

import Control.Monad (when)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
    ( ExceptT
    , 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
    ( 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.List (nub)
import Data.Word (Word16, Word8)
import qualified "crypton" Crypto.Cipher.Types as CCT

import Codec.Encryption.OpenPGP.BlockCipher
    ( keySize
    , renderCipherError
    )
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
    ( renderS2KError
    , skesk2Key
    , string2Key
    )
import Codec.Encryption.OpenPGP.Serialize
    ( getSecretKey
    , putSKeyForPKPayload
    )
import Codec.Encryption.OpenPGP.Types
import Codec.Encryption.OpenPGP.Types.Internal.Base
    ( Passphrase (..)
    )

data SecretKeyError
    = SecretKeyDecryptError String
    | SecretKeyEncryptError String
    | SecretKeyPolicyError String
    | SecretKeyUnsupportedLegacyProtection
    deriving (SecretKeyError -> SecretKeyError -> Bool
(SecretKeyError -> SecretKeyError -> Bool)
-> (SecretKeyError -> SecretKeyError -> Bool) -> Eq SecretKeyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKeyError -> SecretKeyError -> Bool
== :: SecretKeyError -> SecretKeyError -> Bool
$c/= :: SecretKeyError -> SecretKeyError -> Bool
/= :: SecretKeyError -> SecretKeyError -> Bool
Eq, Int -> SecretKeyError -> ShowS
[SecretKeyError] -> ShowS
SecretKeyError -> String
(Int -> SecretKeyError -> ShowS)
-> (SecretKeyError -> String)
-> ([SecretKeyError] -> ShowS)
-> Show SecretKeyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKeyError -> ShowS
showsPrec :: Int -> SecretKeyError -> ShowS
$cshow :: SecretKeyError -> String
show :: SecretKeyError -> String
$cshowList :: [SecretKeyError] -> ShowS
showList :: [SecretKeyError] -> ShowS
Show)

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

decryptPrivateKey
    :: (SomePKPayload, SKAddendum)
    -> BL.ByteString
    -> Either String SKAddendum
decryptPrivateKey :: (SomePKPayload, SKAddendum)
-> LazyByteString -> Either String SKAddendum
decryptPrivateKey (SomePKPayload
pkp, SKAddendum
ska) LazyByteString
pp =
    SomePKPayload -> SKAddendum -> Either String SomeSKAddendumV
fromSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
ska Either String SomeSKAddendumV
-> (SomeSKAddendumV -> Either String SKAddendum)
-> Either String SKAddendum
forall a b.
Either String a -> (a -> Either String b) -> Either String 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 String (SKAddendumV v) -> Either String SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload
-> SKAddendumV v -> LazyByteString -> Either String (SKAddendumV v)
forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v -> LazyByteString -> Either String (SKAddendumV v)
decryptPrivateKeyTyped SomePKPayload
pkp SKAddendumV v
skaV LazyByteString
pp

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)
-> LazyByteString -> Either String SKAddendum
decryptPrivateKey (SomePKPayload
pkp, SKAddendum
ska) (Passphrase -> LazyByteString
unPassphrase Passphrase
pp) of
        Left String
err -> SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. a -> Either a b
Left (SecretKeyError -> Either SecretKeyError (SKey, SKAddendum))
-> SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. (a -> b) -> a -> b
$ String -> SecretKeyError
SecretKeyDecryptError String
err
        Right SKAddendum
decrypted ->
            case SKAddendum
decrypted of
                SUUnencrypted SKey
skey Word16
_ -> (SKey, SKAddendum) -> Either SecretKeyError (SKey, SKAddendum)
forall a b. b -> Either a b
Right (SKey
skey, SKAddendum
decrypted)
                SKAddendum
_ ->
                    SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. a -> Either a b
Left (SecretKeyError -> Either SecretKeyError (SKey, SKAddendum))
-> SecretKeyError -> Either SecretKeyError (SKey, SKAddendum)
forall a b. (a -> b) -> a -> b
$
                        String -> SecretKeyError
SecretKeyDecryptError
                            String
"decrypted secret key material was not in unencrypted form"

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 String (Salt, IV))
-> ExceptT SecretKeyError m (Either String (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 String (Salt, IV))
 -> ExceptT SecretKeyError m (Either String (Salt, IV)))
-> m (Either String (Salt, IV))
-> ExceptT SecretKeyError m (Either String (Salt, IV))
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
generateSecretKeyProtectionMaterial (SecretKeyEncryptOptions -> OpenPGPPolicy
skeoPolicy SecretKeyEncryptOptions
opts) SomePKPayload
pkp
                    except $ first SecretKeyPolicyError 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 -> ExceptT SecretKeyError m (Salt, IV))
-> SecretKeyError -> ExceptT SecretKeyError m (Salt, IV)
forall a b. (a -> b) -> a -> b
$
                            String -> SecretKeyError
SecretKeyEncryptError
                                String
"skeoGenerateSaltAndIV is False but skeoSalt or skeoIV are Nothing"
        ska <-
            except
                (first SecretKeyEncryptError $ mkUnencryptedSKAddendum pkp skey)
        except
            ( first SecretKeyEncryptError $
                encryptPrivateKeyWithPolicyAndSaltAndIV
                    (skeoPolicy opts)
                    pkp
                    salt
                    iv
                    ska
                    (unPassphrase 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
        decrypted <-
            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
$
                (String -> SecretKeyError)
-> Either String SKAddendum -> Either SecretKeyError SKAddendum
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
SecretKeyDecryptError (Either String SKAddendum -> Either SecretKeyError SKAddendum)
-> Either String SKAddendum -> Either SecretKeyError SKAddendum
forall a b. (a -> b) -> a -> b
$
                    (SomePKPayload, SKAddendum)
-> LazyByteString -> Either String SKAddendum
decryptPrivateKey (SomePKPayload
pkp, SKAddendum
originalSka) (Passphrase -> LazyByteString
unPassphrase Passphrase
oldPassphrase)
        case decrypted of
            SUUnencrypted SKey
skey Word16
_ -> do
                let pp :: LazyByteString
pp = Passphrase -> LazyByteString
unPassphrase Passphrase
newPassphrase
                (salt, iv) <-
                    if SecretKeyEncryptOptions -> Bool
skeoGenerateSaltAndIV SecretKeyEncryptOptions
opts
                        then do
                            nextMaterial <-
                                m (Either String (Salt, IV))
-> ExceptT SecretKeyError m (Either String (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 String (Salt, IV))
 -> ExceptT SecretKeyError m (Either String (Salt, IV)))
-> m (Either String (Salt, IV))
-> ExceptT SecretKeyError m (Either String (Salt, IV))
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
generateSecretKeyProtectionMaterial (SecretKeyEncryptOptions -> OpenPGPPolicy
skeoPolicy SecretKeyEncryptOptions
opts) SomePKPayload
pkp
                            except $ first SecretKeyPolicyError 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 -> ExceptT SecretKeyError m (Salt, IV))
-> SecretKeyError -> ExceptT SecretKeyError m (Salt, IV)
forall a b. (a -> b) -> a -> b
$
                                    String -> SecretKeyError
SecretKeyEncryptError
                                        String
"skeoGenerateSaltAndIV is False but skeoSalt or skeoIV are Nothing"
                newSka <-
                    except $
                        reencryptWithPolicyAndSaltAndIV
                            pkp
                            originalSka
                            salt
                            iv
                            skey
                            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 -> ExceptT SecretKeyError m SecretKey)
-> SecretKeyError -> ExceptT SecretKeyError m SecretKey
forall a b. (a -> b) -> a -> b
$
                    String -> SecretKeyError
SecretKeyDecryptError
                        String
"decrypted secret key material was not in unencrypted form"
    return result

reencryptWithPolicyAndSaltAndIV
    :: SomePKPayload
    -> SKAddendum
    -> Salt
    -> IV
    -> SKey
    -> BL.ByteString
    -> OpenPGPPolicy
    -> Either SecretKeyError SKAddendum
reencryptWithPolicyAndSaltAndIV :: SomePKPayload
-> SKAddendum
-> Salt
-> IV
-> SKey
-> LazyByteString
-> OpenPGPPolicy
-> Either SecretKeyError SKAddendum
reencryptWithPolicyAndSaltAndIV SomePKPayload
pkp SKAddendum
originalSka Salt
salt IV
iv SKey
skey LazyByteString
pp OpenPGPPolicy
policy =
    (String -> SecretKeyError)
-> Either String 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
        String -> SecretKeyError
SecretKeyEncryptError
        (SomePKPayload -> SKAddendum -> Either String 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 ->
            (String -> SecretKeyError)
-> Either String SKAddendum -> Either SecretKeyError SKAddendum
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
SecretKeyEncryptError (Either String SKAddendum -> Either SecretKeyError SKAddendum)
-> Either String SKAddendum -> Either SecretKeyError SKAddendum
forall a b. (a -> b) -> a -> b
$
                SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum
                    (SKAddendumV v -> SKAddendum)
-> Either String (SKAddendumV v) -> Either String SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
forall (v :: KeyVersion).
OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
reencryptPrivateKeyTypedWithPolicy
                        OpenPGPPolicy
policy
                        SomePKPayload
pkp
                        SKAddendumV v
skaV
                        Salt
salt
                        IV
iv
                        SKey
skey
                        LazyByteString
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
            }

{-# DEPRECATED
    changeSecretKeyPassphrase
    "Use reencryptSecretKey or reencryptSecretKeyRandom instead"
    #-}
changeSecretKeyPassphrase
    :: MonadRandom m
    => SecretKey
    -> Passphrase
    -> Passphrase
    -> m (Either SecretKeyError SecretKey)
changeSecretKeyPassphrase :: forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> Passphrase -> Passphrase -> m (Either SecretKeyError SecretKey)
changeSecretKeyPassphrase SecretKey
sk Passphrase
oldPassphrase Passphrase
newPassphrase =
    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
defaultPolicy
            , 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
    -> BL.ByteString
    -> Either String (SKAddendumV v)
decryptPrivateKeyTyped :: forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v -> LazyByteString -> Either String (SKAddendumV v)
decryptPrivateKeyTyped SomePKPayload
pkp (SKA16bit SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
payload) LazyByteString
pp = do
    (sk, cksum) <-
        SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> (SomePKPayload
    -> StrictByteString -> Either String (SKey, Word16))
-> Either String (SKey, Word16)
decryptS2KProtectedPayload
            SomePKPayload
pkp
            SymmetricAlgorithm
sa
            S2K
s2k
            IV
iv
            LazyByteString
payload
            LazyByteString
pp
            SomePKPayload -> StrictByteString -> Either String (SKey, Word16)
parse16BitProtectedSecretKey
    pure (SKAUnencryptedLegacy sk cksum)
decryptPrivateKeyTyped SomePKPayload
pkp (SKASHA1Legacy SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
payload) LazyByteString
pp = do
    (sk, cksum) <-
        SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> (SomePKPayload
    -> StrictByteString -> Either String (SKey, Word16))
-> Either String (SKey, Word16)
decryptS2KProtectedPayload
            SomePKPayload
pkp
            SymmetricAlgorithm
sa
            S2K
s2k
            IV
iv
            LazyByteString
payload
            LazyByteString
pp
            SomePKPayload -> StrictByteString -> Either String (SKey, Word16)
parseSHA1ProtectedSecretKey
    pure (SKAUnencryptedLegacy sk cksum)
decryptPrivateKeyTyped SomePKPayload
pkp (SKASHA1V6 SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
payload) LazyByteString
pp = do
    (sk, _) <-
        SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> (SomePKPayload
    -> StrictByteString -> Either String (SKey, Word16))
-> Either String (SKey, Word16)
decryptS2KProtectedPayload
            SomePKPayload
pkp
            SymmetricAlgorithm
sa
            S2K
s2k
            IV
iv
            LazyByteString
payload
            LazyByteString
pp
            SomePKPayload -> StrictByteString -> Either String (SKey, Word16)
parseSHA1ProtectedSecretKey
    pure (SKAUnencryptedV6 sk)
decryptPrivateKeyTyped SomePKPayload
pkp (SKAAEADV6 SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv LazyByteString
payload) LazyByteString
pp = do
    sk <- SomePKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> Either String SKey
decryptAEADPayloadCore SomePKPayload
pkp SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv LazyByteString
payload LazyByteString
pp
    pure (SKAUnencryptedV6 sk)
decryptPrivateKeyTyped SomePKPayload
pkp (SKAAEADLegacy SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv LazyByteString
payload) LazyByteString
pp = do
    sk <- SomePKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> Either String SKey
decryptAEADPayloadCore SomePKPayload
pkp SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv LazyByteString
payload LazyByteString
pp
    pure (SKAUnencryptedLegacy sk 0)
decryptPrivateKeyTyped SomePKPayload
pkp (SKASymLegacy SymmetricAlgorithm
sa IV
iv LazyByteString
payload) LazyByteString
pp = do
    keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    dek <-
        first
            renderS2KError
            (string2Key (Simple DeprecatedMD5) keyLen pp)
    p <-
        first
            renderCipherError
            (decryptNoNonce sa iv (BL.toStrict payload) dek)
    (sk, cksum) <- parse16BitProtectedSecretKey pkp p
    pure (SKAUnencryptedLegacy sk cksum)
decryptPrivateKeyTyped SomePKPayload
pkp (SKASymV6 SymmetricAlgorithm
sa IV
iv LazyByteString
payload) LazyByteString
pp = do
    keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    dek <-
        first
            renderS2KError
            (string2Key (Simple DeprecatedMD5) keyLen pp)
    p <-
        first
            renderCipherError
            (decryptNoNonce sa iv (BL.toStrict payload) dek)
    (sk, _) <- parse16BitProtectedSecretKey pkp p
    pure (SKAUnencryptedV6 sk)
decryptPrivateKeyTyped SomePKPayload
_ ska :: SKAddendumV v
ska@(SKAUnencryptedLegacy {}) LazyByteString
_ = SKAddendumV v -> Either String (SKAddendumV v)
forall a b. b -> Either a b
Right SKAddendumV v
ska
decryptPrivateKeyTyped SomePKPayload
_ ska :: SKAddendumV v
ska@(SKAUnencryptedV6 {}) LazyByteString
_ = SKAddendumV v -> Either String (SKAddendumV v)
forall a b. b -> Either a b
Right SKAddendumV v
ska

reinterpretUnknownSKeyForPKPayload
    :: SomePKPayload -> SKey -> Either String SKey
reinterpretUnknownSKeyForPKPayload :: SomePKPayload -> SKey -> Either String SKey
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@RSAPrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@DSAPrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@ElGamalPrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@ECDHPrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@ECDSAPrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@EdDSAPrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@X25519PrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
_ sk :: SKey
sk@X448PrivateKey {} = SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
sk
reinterpretUnknownSKeyForPKPayload SomePKPayload
pkp (UnknownSKey LazyByteString
payload) =
    case Get (SKey, LazyByteString)
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, (SKey, LazyByteString))
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, a)
runGetOrFail
        ((,) (SKey -> LazyByteString -> (SKey, LazyByteString))
-> Get SKey -> Get (LazyByteString -> (SKey, LazyByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload -> Get SKey
getSecretKey SomePKPayload
pkp Get (LazyByteString -> (SKey, LazyByteString))
-> Get LazyByteString -> Get (SKey, LazyByteString)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get LazyByteString
getRemainingLazyByteString)
        LazyByteString
payload of
        Left (LazyByteString
_, ByteOffset
_, String
err) -> String -> Either String SKey
forall a b. a -> Either a b
Left String
err
        Right (LazyByteString
_, ByteOffset
_, (SKey
skey, LazyByteString
trailing))
            | LazyByteString -> Bool
BL.null LazyByteString
trailing -> SKey -> Either String SKey
forall a b. b -> Either a b
Right SKey
skey
            | Bool
otherwise ->
                String -> Either String SKey
forall a b. a -> Either a b
Left String
"decoded secret key material has trailing bytes"

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

decryptS2KProtectedPayload
    :: SomePKPayload
    -> SymmetricAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> BL.ByteString
    -> (SomePKPayload -> B.ByteString -> Either String (SKey, Word16))
    -> Either String (SKey, Word16)
decryptS2KProtectedPayload :: SomePKPayload
-> SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> (SomePKPayload
    -> StrictByteString -> Either String (SKey, Word16))
-> Either String (SKey, Word16)
decryptS2KProtectedPayload SomePKPayload
pkp SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
payload LazyByteString
pp SomePKPayload -> StrictByteString -> Either String (SKey, Word16)
parser = do
    dek <-
        (S2KError -> String)
-> Either S2KError StrictByteString
-> Either String 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 -> String
renderS2KError (SKESK 'SKESKV4
-> LazyByteString -> Either S2KError StrictByteString
skesk2Key (SymmetricAlgorithm -> S2K -> Maybe LazyByteString -> SKESK 'SKESKV4
SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe LazyByteString
forall a. Maybe a
Nothing) LazyByteString
pp)
    decrypted <-
        first
            renderCipherError
            (decryptNoNonce sa iv (BL.toStrict payload) dek)
    parser pkp decrypted
parse16BitProtectedSecretKey
    :: SomePKPayload -> B.ByteString -> Either String (SKey, Word16)
parse16BitProtectedSecretKey :: SomePKPayload -> StrictByteString -> Either String (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 =
        String -> Either String (SKey, Word16)
forall a b. a -> Either a b
Left 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 String 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
                    ( "16-bit secret key checksum mismatch (expected "
                        ++ show expected
                        ++ ", got "
                        ++ show cksum
                        ++ ")"
                    )

parseSHA1ProtectedSecretKey
    :: SomePKPayload -> B.ByteString -> Either String (SKey, Word16)
parseSHA1ProtectedSecretKey :: SomePKPayload -> StrictByteString -> Either String (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 =
        String -> Either String (SKey, Word16)
forall a b. a -> Either a b
Left 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 String SKey
decodeSecretKey SomePKPayload
pkp StrictByteString
skeyPayload
        if hashPayload == expected
            then Right (sk, checksum16 skeyPayload)
            else Left "SHA1 secret key checksum mismatch"

decodeSecretKey
    :: SomePKPayload -> B.ByteString -> Either String SKey
decodeSecretKey :: SomePKPayload -> StrictByteString -> Either String SKey
decodeSecretKey SomePKPayload
pkp StrictByteString
payloadBytes =
    ((LazyByteString, ByteOffset, String) -> String)
-> ((LazyByteString, ByteOffset, SKey) -> SKey)
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, 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
        (\(LazyByteString
_, ByteOffset
_, String
x) -> String
x)
        (\(LazyByteString
_, ByteOffset
_, SKey
x) -> SKey
x)
        (Get SKey
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, SKey)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, a)
runGetOrFail (SomePKPayload -> Get SKey
getSecretKey SomePKPayload
pkp) (StrictByteString -> LazyByteString
BL.fromStrict StrictByteString
payloadBytes))

decodeChecksum :: B.ByteString -> Either String Word16
decodeChecksum :: StrictByteString -> Either String Word16
decodeChecksum StrictByteString
checksumBytes =
    ((LazyByteString, ByteOffset, String) -> String)
-> ((LazyByteString, ByteOffset, Word16) -> Word16)
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, 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
        (\(LazyByteString
_, ByteOffset
_, String
x) -> String
x)
        (\(LazyByteString
_, ByteOffset
_, Word16
x) -> Word16
x)
        (Get Word16
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, Word16)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, a)
runGetOrFail Get Word16
getWord16be (StrictByteString -> LazyByteString
BL.fromStrict StrictByteString
checksumBytes))
decryptAEADPayloadCore
    :: SomePKPayload
    -> SymmetricAlgorithm
    -> AEADAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> BL.ByteString
    -> Either String SKey
decryptAEADPayloadCore :: SomePKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> LazyByteString
-> LazyByteString
-> Either String SKey
decryptAEADPayloadCore SomePKPayload
pkp SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv LazyByteString
payload LazyByteString
pp = do
    keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    keyMaterial <- first renderS2KError (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. Eq a => [a] -> [a]
nub
                [ [Word8] -> StrictByteString
B.pack
                    [Word8
tag, KeyVersion -> Word8
keyVersionByte (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 = LazyByteString -> StrictByteString
BL.toStrict (Put -> LazyByteString
runPut (SomePKPayload -> Put
forall t. Binary t => t -> Put
put SomePKPayload
pkp))
        adCandidates =
            [StrictByteString] -> [StrictByteString]
forall a. Eq a => [a] -> [a]
nub
                [Word8 -> StrictByteString -> StrictByteString
B.cons Word8
tagByte StrictByteString
pkpBytes | Word8
tagByte <- [Word8]
tagCandidates]
        aaCandidates = [AEADAlgorithm
aa]
        nonce = IV -> StrictByteString
unIV IV
iv
        payloadStrict = LazyByteString -> StrictByteString
BL.toStrict LazyByteString
payload
        tagLen = Int
16
        tryDecrypt StrictByteString
candidateKeyMaterial StrictByteString
info StrictByteString
ad AEADAlgorithm
aaTry = do
            Bool -> Either String () -> Either String ()
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 String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
                String -> Either String ()
forall a b. a -> Either a b
Left 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. Eq a => [a] -> [a]
nub
                        [ 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 String StrictByteString
tryKeks = Maybe String
-> [StrictByteString] -> Either String StrictByteString
go Maybe String
forall a. Maybe a
Nothing
                  where
                    go :: Maybe String
-> [StrictByteString] -> Either String StrictByteString
go Maybe String
merr [] =
                        String -> Either String StrictByteString
forall a b. a -> Either a b
Left (String -> Either String StrictByteString)
-> String -> Either String StrictByteString
forall a b. (a -> b) -> a -> b
$
                            String
"could not decrypt using any KEK candidate"
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
e -> String
" (last error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") Maybe String
merr
                    go Maybe String
merr (StrictByteString
kek : [StrictByteString]
ks) =
                        case SymmetricAlgorithm
-> AEADAlgorithm
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either String StrictByteString
decryptWithKey SymmetricAlgorithm
sa AEADAlgorithm
aaTry StrictByteString
kek StrictByteString
ad StrictByteString
nonce StrictByteString
ciphertext AuthTag
authTag of
                            Right StrictByteString
cleartext -> StrictByteString -> Either String StrictByteString
forall a b. b -> Either a b
Right StrictByteString
cleartext
                            Left String
err -> Maybe String
-> [StrictByteString] -> Either String StrictByteString
go (String -> Maybe String
forall a. a -> Maybe a
Just (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
err ShowS
forall a. a -> a
id Maybe String
merr)) [StrictByteString]
ks
            [StrictByteString] -> Either String StrictByteString
tryKeks [StrictByteString]
kekCandidates
        tryAll = Maybe String
-> [(StrictByteString, StrictByteString, StrictByteString,
     AEADAlgorithm)]
-> Either String StrictByteString
go Maybe String
forall a. Maybe a
Nothing
          where
            go :: Maybe String
-> [(StrictByteString, StrictByteString, StrictByteString,
     AEADAlgorithm)]
-> Either String StrictByteString
go Maybe String
merr [] =
                String -> Either String StrictByteString
forall a b. a -> Either a b
Left (String -> Either String StrictByteString)
-> String -> Either String StrictByteString
forall a b. (a -> b) -> a -> b
$
                    String
"could not decrypt v6 AEAD secret key payload"
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
e -> String
" (last error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") Maybe String
merr
            go Maybe String
merr ((StrictByteString
keyMaterialCandidate, StrictByteString
info, StrictByteString
ad, AEADAlgorithm
aaTry) : [(StrictByteString, StrictByteString, StrictByteString,
  AEADAlgorithm)]
xs) =
                case StrictByteString
-> StrictByteString
-> StrictByteString
-> AEADAlgorithm
-> Either String StrictByteString
tryDecrypt StrictByteString
keyMaterialCandidate StrictByteString
info StrictByteString
ad AEADAlgorithm
aaTry of
                    Right StrictByteString
cleartext -> StrictByteString -> Either String StrictByteString
forall a b. b -> Either a b
Right StrictByteString
cleartext
                    Left String
err -> Maybe String
-> [(StrictByteString, StrictByteString, StrictByteString,
     AEADAlgorithm)]
-> Either String StrictByteString
go (String -> Maybe String
forall a. a -> Maybe a
Just (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
err ShowS
forall a. a -> a
id Maybe String
merr)) [(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 String B.ByteString
decryptWithKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either String 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
-> String
authFailure StrictByteString
expectedTag StrictByteString
computedTag StrictByteString
n StrictByteString
a StrictByteString
hashAd StrictByteString
plaintext =
            String
"failed to authenticate v6 AEAD secret key payload (expected tag="
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
expectedTag
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", computed tag="
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
computedTag
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", nonce="
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
n
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ad="
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
a
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", hashAd="
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
hashAd
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", plaintext="
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictByteString -> String
toHex StrictByteString
plaintext
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        unsupportedSecretKeyAEADError :: String
unsupportedSecretKeyAEADError = String
"unsupported secret-key AEAD symmetric algorithm"
    case AEADAlgorithm
aa of
        AEADAlgorithm
OCB ->
            String
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher.
    BlockCipher cipher =>
    cipher -> Either String StrictByteString)
-> Either String StrictByteString
forall a.
String
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher. BlockCipher cipher => cipher -> Either String a)
-> Either String a
withAESCipher
                String
unsupportedSecretKeyAEADError
                SymmetricAlgorithm
sa
                StrictByteString
kek
                ( \cipher
cipher ->
                    (StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> String)
-> cipher
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either String StrictByteString
forall c.
BlockCipher c =>
(StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> StrictByteString
 -> String)
-> c
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> AuthTag
-> Either String StrictByteString
decryptWithOCBRFC7253With
                        StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> String
authFailure
                        cipher
cipher
                        StrictByteString
nonce
                        StrictByteString
ad
                        StrictByteString
ciphertext
                        AuthTag
authTag
                )
        AEADAlgorithm
_ -> do
            mode <- AEADAlgorithm -> Either String AEADMode
aeadMode AEADAlgorithm
aa
            expectedNonceLen <- aeadNonceSize aa
            when (B.length nonce /= expectedNonceLen) $
                Left "invalid nonce size for v6 AEAD secret key payload"
            withAESCipher unsupportedSecretKeyAEADError sa kek $ \cipher
cipher ->
                (CryptoError -> String)
-> Either CryptoError (AEAD cipher) -> Either String (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 -> String
forall a. Show a => a -> String
show
                    (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 String (AEAD cipher)
-> (AEAD cipher -> Either String StrictByteString)
-> Either String StrictByteString
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AEAD cipher
aead ->
                    Either String StrictByteString
-> (StrictByteString -> Either String StrictByteString)
-> Maybe StrictByteString
-> Either String StrictByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        (String -> Either String StrictByteString
forall a b. a -> Either a b
Left String
"failed to authenticate v6 AEAD secret key payload")
                        StrictByteString -> Either String StrictByteString
forall a b. b -> Either a b
Right
                        (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 String CCT.AEADMode
aeadMode :: AEADAlgorithm -> Either String AEADMode
aeadMode AEADAlgorithm
EAX = AEADMode -> Either String AEADMode
forall a b. b -> Either a b
Right AEADMode
CCT.AEAD_EAX
aeadMode AEADAlgorithm
OCB = AEADMode -> Either String AEADMode
forall a b. b -> Either a b
Right AEADMode
CCT.AEAD_OCB
aeadMode AEADAlgorithm
GCM = AEADMode -> Either String AEADMode
forall a b. b -> Either a b
Right AEADMode
CCT.AEAD_GCM
aeadMode (OtherAEADAlgo Word8
_) = String -> Either String AEADMode
forall a b. a -> Either a b
Left String
"unknown AEAD mode"

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

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

keyVersionByte :: KeyVersion -> Word8
keyVersionByte :: KeyVersion -> Word8
keyVersionByte KeyVersion
DeprecatedV3 = Word8
3
keyVersionByte KeyVersion
V4 = Word8
4
keyVersionByte KeyVersion
V6 = Word8
6

{-# DEPRECATED encryptPrivateKey "Use encryptSecretKeyWithPolicy instead" #-}

-- | generates pseudo-random salt and IV
encryptPrivateKey
    :: MonadRandom m
    => OpenPGPPolicy
    -> SomePKPayload
    -> SKAddendum
    -> BL.ByteString
    -> m (Either String SKAddendum)
encryptPrivateKey :: forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy
-> SomePKPayload
-> SKAddendum
-> LazyByteString
-> m (Either String SKAddendum)
encryptPrivateKey OpenPGPPolicy
policy SomePKPayload
pkp SKAddendum
ska LazyByteString
pp = do
    nextMaterial <- OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
generateSecretKeyProtectionMaterial OpenPGPPolicy
policy SomePKPayload
pkp
    case nextMaterial of
        Left String
err -> Either String SKAddendum -> m (Either String SKAddendum)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SKAddendum -> m (Either String SKAddendum))
-> Either String SKAddendum -> m (Either String SKAddendum)
forall a b. (a -> b) -> a -> b
$ String -> Either String SKAddendum
forall a b. a -> Either a b
Left String
err
        Right (Salt
salt, IV
iv) ->
            Either String SKAddendum -> m (Either String SKAddendum)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SKAddendum -> m (Either String SKAddendum))
-> Either String SKAddendum -> m (Either String SKAddendum)
forall a b. (a -> b) -> a -> b
$
                OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> SKAddendum
-> LazyByteString
-> Either String SKAddendum
encryptPrivateKeyWithPolicyAndSaltAndIV OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv SKAddendum
ska LazyByteString
pp

encryptPrivateKeyWithPolicyAndSaltAndIV
    :: OpenPGPPolicy
    -> SomePKPayload
    -> Salt
    -> IV
    -> SKAddendum
    -> BL.ByteString
    -> Either String SKAddendum
encryptPrivateKeyWithPolicyAndSaltAndIV :: OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> SKAddendum
-> LazyByteString
-> Either String SKAddendum
encryptPrivateKeyWithPolicyAndSaltAndIV OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv SKAddendum
ska LazyByteString
pp =
    case SKAddendum
ska of
        SUUnencrypted SKey
skey Word16
_ ->
            OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String SKAddendum
encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV
                OpenPGPPolicy
policy
                SomePKPayload
pkp
                Salt
salt
                IV
iv
                SKey
skey
                LazyByteString
pp
        SKAddendum
_ -> SKAddendum -> Either String SKAddendum
forall a b. b -> Either a b
Right SKAddendum
ska

encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV
    :: OpenPGPPolicy
    -> SomePKPayload
    -> Salt
    -> IV
    -> SKey
    -> BL.ByteString
    -> Either String SKAddendum
encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV :: OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String SKAddendum
encryptUnencryptedPrivateSKeyWithPolicyAndSaltAndIV OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv SKey
skey LazyByteString
pp = do
    (sa, aa, s2k) <- OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either String (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults OpenPGPPolicy
policy SomePKPayload
pkp Salt
salt IV
iv
    (\StrictByteString
payload -> SymmetricAlgorithm
-> AEADAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendum
SUSAEAD SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv (StrictByteString -> LazyByteString
BL.fromStrict StrictByteString
payload))
        <$> encryptV6SKey pkp skey sa aa s2k iv pp

{-# DEPRECATED changePrivateKeyPassphrase "Use reencryptSecretKey instead" #-}
changePrivateKeyPassphrase
    :: (SomePKPayload, SKAddendum)
    -> BL.ByteString
    -> Salt
    -> IV
    -> BL.ByteString
    -> Either String SKAddendum
changePrivateKeyPassphrase :: (SomePKPayload, SKAddendum)
-> LazyByteString
-> Salt
-> IV
-> LazyByteString
-> Either String SKAddendum
changePrivateKeyPassphrase (SomePKPayload
pkp, SKAddendum
ska) LazyByteString
oldPassphrase Salt
salt IV
iv LazyByteString
newPassphrase = do
    decrypted <- (SomePKPayload, SKAddendum)
-> LazyByteString -> Either String SKAddendum
decryptPrivateKey (SomePKPayload
pkp, SKAddendum
ska) LazyByteString
oldPassphrase
    case decrypted of
        SUUnencrypted SKey
skey Word16
_ ->
            SomePKPayload
-> SKAddendum
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String SKAddendum
reencryptPrivateKeyWithSaltAndIV
                SomePKPayload
pkp
                SKAddendum
ska
                Salt
salt
                IV
iv
                SKey
skey
                LazyByteString
newPassphrase
        SKAddendum
_ ->
            String -> Either String SKAddendum
forall a b. a -> Either a b
Left
                String
"Unexpected codepath: decrypted private key material was not in unencrypted form"

{-# DEPRECATED
    changePrivateKeyPassphraseRandom
    "Use reencryptSecretKeyRandom instead"
    #-}
changePrivateKeyPassphraseRandom
    :: MonadRandom m
    => (SomePKPayload, SKAddendum)
    -> BL.ByteString
    -> BL.ByteString
    -> m (Either String SKAddendum)
changePrivateKeyPassphraseRandom :: forall (m :: * -> *).
MonadRandom m =>
(SomePKPayload, SKAddendum)
-> LazyByteString -> LazyByteString -> m (Either String SKAddendum)
changePrivateKeyPassphraseRandom (SomePKPayload
pkp, SKAddendum
ska) LazyByteString
oldPassphrase LazyByteString
newPassphrase = do
    nextMaterial <-
        OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
generateSecretKeyProtectionMaterial OpenPGPPolicy
defaultPolicy SomePKPayload
pkp
    case nextMaterial of
        Left String
err -> Either String SKAddendum -> m (Either String SKAddendum)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SKAddendum -> m (Either String SKAddendum))
-> Either String SKAddendum -> m (Either String SKAddendum)
forall a b. (a -> b) -> a -> b
$ String -> Either String SKAddendum
forall a b. a -> Either a b
Left String
err
        Right (Salt
salt, IV
iv) ->
            Either String SKAddendum -> m (Either String SKAddendum)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SKAddendum -> m (Either String SKAddendum))
-> Either String SKAddendum -> m (Either String SKAddendum)
forall a b. (a -> b) -> a -> b
$
                (SomePKPayload, SKAddendum)
-> LazyByteString
-> Salt
-> IV
-> LazyByteString
-> Either String SKAddendum
changePrivateKeyPassphrase
                    (SomePKPayload
pkp, SKAddendum
ska)
                    LazyByteString
oldPassphrase
                    Salt
salt
                    IV
iv
                    LazyByteString
newPassphrase

encodeSKeyMaterial :: SKey -> Either String BL.ByteString
encodeSKeyMaterial :: SKey -> Either String LazyByteString
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 ->
                    String -> Either String LazyByteString
forall a b. a -> Either a b
Left
                        String
"could not derive RSA multiplicative inverse while encrypting secret key"
                Just Integer
u ->
                    LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right
                        (Put -> LazyByteString
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)) ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
x)))
        ElGamalPrivateKey Integer
x ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
x)))
        ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey Curve
_ Integer
d)) ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d)))
        ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey Curve
_ Integer
d)) ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d)))
        EdDSAPrivateKey EdSigningCurve
_ StrictByteString
bs ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI (StrictByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip StrictByteString
bs))))
        X25519PrivateKey StrictByteString
bs ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (StrictByteString -> Put
putByteString StrictByteString
bs))
        X448PrivateKey StrictByteString
bs ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (StrictByteString -> Put
putByteString StrictByteString
bs))
        UnknownSKey LazyByteString
bs ->
            LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (Put -> LazyByteString
runPut (LazyByteString -> Put
putLazyByteString LazyByteString
bs))

encryptV6SKey
    :: SomePKPayload
    -> SKey
    -> SymmetricAlgorithm
    -> AEADAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> Either String B.ByteString
encryptV6SKey :: SomePKPayload
-> SKey
-> SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> IV
-> LazyByteString
-> Either String StrictByteString
encryptV6SKey SomePKPayload
pkp SKey
skey SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv LazyByteString
pp = do
    keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    keyMaterial <- first renderS2KError (string2Key s2k keyLen pp)
    payload <- encodeSKeyMaterial skey
    let info =
            [Word8] -> StrictByteString
B.pack
                [ Word8
0xC5
                , KeyVersion -> Word8
keyVersionByte (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 (LazyByteString -> StrictByteString
BL.toStrict (Put -> LazyByteString
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 String (Int, Int)
secretKeyProtectionMaterialLengths :: OpenPGPPolicy -> SomePKPayload -> Either String (Int, Int)
secretKeyProtectionMaterialLengths OpenPGPPolicy
policy SomePKPayload
pkp =
    case OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForEncryption OpenPGPPolicy
policy (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp) of
        Just SecretKeyProtectionPolicy
policy ->
            (Int, Int) -> Either String (Int, Int)
forall a b. b -> Either a b
Right
                (SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets SecretKeyProtectionPolicy
policy, SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
policy)
        Maybe SecretKeyProtectionPolicy
Nothing -> String -> Either String (Int, Int)
forall a b. a -> Either a b
Left String
legacySecretKeyProtectionErrorMessage

generateSecretKeyProtectionMaterial
    :: MonadRandom m
    => OpenPGPPolicy
    -> SomePKPayload
    -> m (Either String (Salt, IV))
generateSecretKeyProtectionMaterial :: forall (m :: * -> *).
MonadRandom m =>
OpenPGPPolicy -> SomePKPayload -> m (Either String (Salt, IV))
generateSecretKeyProtectionMaterial OpenPGPPolicy
policy SomePKPayload
pkp =
    case OpenPGPPolicy -> SomePKPayload -> Either String (Int, Int)
secretKeyProtectionMaterialLengths OpenPGPPolicy
policy SomePKPayload
pkp of
        Left String
err -> Either String (Salt, IV) -> m (Either String (Salt, IV))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (Salt, IV)
forall a b. a -> Either a b
Left String
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 String (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults :: OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either String (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
policy -> do
            Bool -> Either String () -> Either String ()
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
/= SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets SecretKeyProtectionPolicy
policy) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
                String -> Either String ()
forall a b. a -> Either a b
Left
                    ( String
"v6 secret key S2K salt must be "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets SecretKeyProtectionPolicy
policy)
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" octets"
                    )
            Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictByteString -> Int
B.length (IV -> StrictByteString
unIV IV
iv) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
policy) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
                String -> Either String ()
forall a b. a -> Either a b
Left
                    ( String
"v6 secret key AEAD nonce must be "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
policy)
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" octets"
                    )
            (SymmetricAlgorithm, AEADAlgorithm, S2K)
-> Either String (SymmetricAlgorithm, AEADAlgorithm, S2K)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( SecretKeyProtectionPolicy -> SymmetricAlgorithm
secretKeyDefaultSymmetricAlgorithm SecretKeyProtectionPolicy
policy
                , SecretKeyProtectionPolicy -> AEADAlgorithm
secretKeyDefaultAEADAlgorithm SecretKeyProtectionPolicy
policy
                , SecretKeyProtectionPolicy -> Salt -> S2K
secretKeyDefaultS2KForSalt SecretKeyProtectionPolicy
policy Salt
salt
                )
        Maybe SecretKeyProtectionPolicy
Nothing -> String -> Either String (SymmetricAlgorithm, AEADAlgorithm, S2K)
forall a b. a -> Either a b
Left String
legacySecretKeyProtectionErrorMessage

secretKeyProtectionPolicyForEncryption
    :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForEncryption :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
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 String (CCT.AuthTag, B.ByteString)
encryptWithKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> Either String (AuthTag, StrictByteString)
encryptWithKey SymmetricAlgorithm
sa AEADAlgorithm
aa StrictByteString
kek StrictByteString
ad StrictByteString
nonce StrictByteString
plaintext = do
    expectedNonceLen <- AEADAlgorithm -> Either String Int
aeadNonceSize AEADAlgorithm
aa
    when (B.length nonce /= expectedNonceLen) $
        Left "invalid nonce size for v6 AEAD secret key payload"
    let unsupportedSecretKeyAEADError = String
"unsupported secret-key AEAD symmetric algorithm"
    case aa of
        AEADAlgorithm
OCB ->
            String
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher.
    BlockCipher cipher =>
    cipher -> Either String (AuthTag, StrictByteString))
-> Either String (AuthTag, StrictByteString)
forall a.
String
-> SymmetricAlgorithm
-> StrictByteString
-> (forall cipher. BlockCipher cipher => cipher -> Either String a)
-> Either String a
withAESCipher
                String
unsupportedSecretKeyAEADError
                SymmetricAlgorithm
sa
                StrictByteString
kek
                (\cipher
cipher -> cipher
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> Either String (AuthTag, StrictByteString)
forall c.
BlockCipher c =>
c
-> StrictByteString
-> StrictByteString
-> StrictByteString
-> Either String (AuthTag, StrictByteString)
encryptWithOCBRFC7253 cipher
cipher StrictByteString
nonce StrictByteString
ad StrictByteString
plaintext)
        AEADAlgorithm
_ -> do
            mode <- AEADAlgorithm -> Either String AEADMode
aeadMode AEADAlgorithm
aa
            withAESCipher unsupportedSecretKeyAEADError sa kek $ \cipher
cipher ->
                (CryptoError -> String)
-> Either CryptoError (AEAD cipher) -> Either String (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 -> String
forall a. Show a => a -> String
show
                    (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 String (AEAD cipher)
-> (AEAD cipher -> Either String (AuthTag, StrictByteString))
-> Either String (AuthTag, StrictByteString)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AEAD cipher
aead ->
                    (AuthTag, StrictByteString)
-> Either String (AuthTag, StrictByteString)
forall a. a -> Either String 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)

{-# DEPRECATED
    reencryptSecretKeyRandomEither
    "Use changeSecretKeyPassphrase or reencryptSecretKeyRandom instead"
    #-}
reencryptSecretKeyRandomEither
    :: MonadRandom m
    => SecretKey -> BL.ByteString -> m (Either String SecretKey)
reencryptSecretKeyRandomEither :: forall (m :: * -> *).
MonadRandom m =>
SecretKey -> LazyByteString -> m (Either String SecretKey)
reencryptSecretKeyRandomEither SecretKey
sk LazyByteString
pp =
    SecretKey
-> Passphrase
-> Passphrase
-> OpenPGPPolicy
-> m (Either SecretKeyError SecretKey)
forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> Passphrase
-> Passphrase
-> OpenPGPPolicy
-> m (Either SecretKeyError SecretKey)
reencryptSecretKeyRandom
        SecretKey
sk
        (LazyByteString -> Passphrase
Passphrase LazyByteString
pp)
        (LazyByteString -> Passphrase
Passphrase LazyByteString
pp)
        OpenPGPPolicy
defaultPolicy
        m (Either SecretKeyError SecretKey)
-> (Either SecretKeyError SecretKey -> m (Either String SecretKey))
-> m (Either String SecretKey)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left SecretKeyError
err -> Either String SecretKey -> m (Either String SecretKey)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SecretKey -> m (Either String SecretKey))
-> Either String SecretKey -> m (Either String SecretKey)
forall a b. (a -> b) -> a -> b
$ String -> Either String SecretKey
forall a b. a -> Either a b
Left (String -> Either String SecretKey)
-> String -> Either String SecretKey
forall a b. (a -> b) -> a -> b
$ SecretKeyError -> String
forall a. Show a => a -> String
show SecretKeyError
err
            Right SecretKey
sk' -> Either String SecretKey -> m (Either String SecretKey)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SecretKey -> m (Either String SecretKey))
-> Either String SecretKey -> m (Either String SecretKey)
forall a b. (a -> b) -> a -> b
$ SecretKey -> Either String SecretKey
forall a b. b -> Either a b
Right SecretKey
sk'

{- | Version-preserving re-encryption of a typed secret-key addendum.

Each constructor family is re-encrypted in kind:
  * V6 variants (AEAD, SHA1, Sym, Unencrypted) → SKAAEADV6 (default v6 policy)
  * SKA16bit / SKASHA1Legacy → same S2K family with updated salt
  * SKAAEADLegacy → re-protected as SKASHA1Legacy (standard v3\/v4 S2K)
  * SKASymLegacy → legacy CFB re-encryption as SKASymLegacy
  * SKAUnencryptedLegacy → Left (cannot re-encrypt unencrypted legacy keys)
-}
reencryptPrivateKeyTyped
    :: SomePKPayload
    -> SKAddendumV v
    -> Salt
    -> IV
    -> SKey
    -> BL.ByteString
    -> Either String (SKAddendumV v)
reencryptPrivateKeyTyped :: forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
reencryptPrivateKeyTyped = OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
forall (v :: KeyVersion).
OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
reencryptPrivateKeyTypedWithPolicy OpenPGPPolicy
defaultPolicy

reencryptPrivateKeyTypedWithPolicy
    :: OpenPGPPolicy
    -> SomePKPayload
    -> SKAddendumV v
    -> Salt
    -> IV
    -> SKey
    -> BL.ByteString
    -> Either String (SKAddendumV v)
reencryptPrivateKeyTypedWithPolicy :: forall (v :: KeyVersion).
OpenPGPPolicy
-> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
reencryptPrivateKeyTypedWithPolicy OpenPGPPolicy
policy SomePKPayload
pkp SKAddendumV v
skaV Salt
salt IV
iv SKey
skey LazyByteString
pp =
    case SKAddendumV v
skaV of
        SKAAEADV6 {} -> OpenPGPPolicy -> Either String (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKASHA1V6 {} -> OpenPGPPolicy -> Either String (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKASymV6 {} -> OpenPGPPolicy -> Either String (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKAUnencryptedV6 {} -> OpenPGPPolicy -> Either String (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
policy
        SKA16bit SymmetricAlgorithm
sa S2K
s2k IV
_ LazyByteString
_ ->
            SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String (SKAddendumV v))
-> Either String (SKAddendumV v)
forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String r)
-> Either String r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey LazyByteString
pp SymmetricAlgorithm
sa S2K
s2k ((SymmetricAlgorithm
  -> S2K
  -> IV
  -> LazyByteString
  -> StrictByteString
  -> Either String (SKAddendumV v))
 -> Either String (SKAddendumV v))
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String (SKAddendumV v))
-> Either String (SKAddendumV v)
forall a b. (a -> b) -> a -> b
$ \SymmetricAlgorithm
sa' S2K
s2k' IV
iv' LazyByteString
ct StrictByteString
km ->
                SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> SKAddendumV v)
-> Either String (SKAddendumV v)
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> r)
-> Either String r
encryptProtectedSecretKey
                    SymmetricAlgorithm
sa'
                    S2K
s2k'
                    IV
iv'
                    LazyByteString
ct
                    StrictByteString
km
                    LazyByteString -> LazyByteString
checksum16Trailer
                    (SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV v
SKA16bit SymmetricAlgorithm
sa' S2K
s2k' IV
iv')
        SKASHA1Legacy SymmetricAlgorithm
sa S2K
s2k IV
_ LazyByteString
_ ->
            SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String (SKAddendumV v))
-> Either String (SKAddendumV v)
forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String r)
-> Either String r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey LazyByteString
pp SymmetricAlgorithm
sa S2K
s2k ((SymmetricAlgorithm
  -> S2K
  -> IV
  -> LazyByteString
  -> StrictByteString
  -> Either String (SKAddendumV v))
 -> Either String (SKAddendumV v))
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String (SKAddendumV v))
-> Either String (SKAddendumV v)
forall a b. (a -> b) -> a -> b
$ \SymmetricAlgorithm
sa' S2K
s2k' IV
iv' LazyByteString
ct StrictByteString
km ->
                SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> SKAddendumV v)
-> Either String (SKAddendumV v)
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> r)
-> Either String r
encryptProtectedSecretKey
                    SymmetricAlgorithm
sa'
                    S2K
s2k'
                    IV
iv'
                    LazyByteString
ct
                    StrictByteString
km
                    LazyByteString -> LazyByteString
sha1Trailer
                    (SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV v
SKASHA1Legacy SymmetricAlgorithm
sa' S2K
s2k' IV
iv')
        SKAAEADLegacy SymmetricAlgorithm
sa AEADAlgorithm
_aa S2K
s2k IV
_ LazyByteString
_ ->
            SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String (SKAddendumV v))
-> Either String (SKAddendumV v)
forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String r)
-> Either String r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey LazyByteString
pp SymmetricAlgorithm
sa S2K
s2k ((SymmetricAlgorithm
  -> S2K
  -> IV
  -> LazyByteString
  -> StrictByteString
  -> Either String (SKAddendumV v))
 -> Either String (SKAddendumV v))
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String (SKAddendumV v))
-> Either String (SKAddendumV v)
forall a b. (a -> b) -> a -> b
$ \SymmetricAlgorithm
sa' S2K
s2k' IV
iv' LazyByteString
ct StrictByteString
km ->
                SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> SKAddendumV v)
-> Either String (SKAddendumV v)
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> r)
-> Either String r
encryptProtectedSecretKey
                    SymmetricAlgorithm
sa'
                    S2K
s2k'
                    IV
iv'
                    LazyByteString
ct
                    StrictByteString
km
                    LazyByteString -> LazyByteString
sha1Trailer
                    (SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV v
SKASHA1Legacy SymmetricAlgorithm
sa' S2K
s2k' IV
iv')
        SKASymLegacy SymmetricAlgorithm
sa IV
_ LazyByteString
_ -> do
            keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
            keyMaterial <-
                first
                    renderS2KError
                    (string2Key (Simple DeprecatedMD5) keyLen pp)
            cleartext <- legacySecretKeyPayload pkp skey
            let clearWithChecksum =
                    LazyByteString -> StrictByteString
BL.toStrict
                        ( LazyByteString
cleartext
                            LazyByteString -> LazyByteString -> LazyByteString
forall a. Semigroup a => a -> a -> a
<> Put -> LazyByteString
runPut (Word16 -> Put
putWord16be (StrictByteString -> Word16
checksum16 (LazyByteString -> StrictByteString
BL.toStrict LazyByteString
cleartext)))
                        )
            (\StrictByteString
encrypted -> SymmetricAlgorithm -> IV -> LazyByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> IV -> LazyByteString -> SKAddendumV v
SKASymLegacy SymmetricAlgorithm
sa IV
iv (StrictByteString -> LazyByteString
BL.fromStrict StrictByteString
encrypted))
                <$> first
                    renderCipherError
                    ( encryptNoNonce
                        sa
                        (Simple DeprecatedMD5)
                        iv
                        clearWithChecksum
                        keyMaterial
                    )
        SKAUnencryptedLegacy SKey
_ Word16
_ -> String -> Either String (SKAddendumV v)
forall a b. a -> Either a b
Left String
legacySecretKeyProtectionErrorMessage
  where
    reencryptV6 :: OpenPGPPolicy -> Either String (SKAddendumV 'V6)
reencryptV6 OpenPGPPolicy
pol = do
        (sa, aa, s2k) <- OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either String (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults OpenPGPPolicy
pol SomePKPayload
pkp Salt
salt IV
iv
        (\StrictByteString
payload -> SymmetricAlgorithm
-> AEADAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendumV 'V6
SKAAEADV6 SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k IV
iv (StrictByteString -> LazyByteString
BL.fromStrict StrictByteString
payload))
            <$> encryptV6SKey pkp skey sa aa s2k iv pp

reencryptPrivateKeyWithSaltAndIV
    :: SomePKPayload
    -> SKAddendum
    -> Salt
    -> IV
    -> SKey
    -> BL.ByteString
    -> Either String SKAddendum
reencryptPrivateKeyWithSaltAndIV :: SomePKPayload
-> SKAddendum
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String SKAddendum
reencryptPrivateKeyWithSaltAndIV SomePKPayload
pkp SKAddendum
originalSka Salt
salt IV
iv SKey
skey LazyByteString
pp =
    case SomePKPayload -> SKAddendum -> Either String SomeSKAddendumV
fromSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
originalSka of
        Left String
err -> String -> Either String SKAddendum
forall a b. a -> Either a b
Left String
err
        Right (SomeSKAddendumV SKAddendumV v
skaV) ->
            SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum
                (SKAddendumV v -> SKAddendum)
-> Either String (SKAddendumV v) -> Either String SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
forall (v :: KeyVersion).
SomePKPayload
-> SKAddendumV v
-> Salt
-> IV
-> SKey
-> LazyByteString
-> Either String (SKAddendumV v)
reencryptPrivateKeyTyped SomePKPayload
pkp SKAddendumV v
skaV Salt
salt IV
iv SKey
skey LazyByteString
pp

reencryptS2KProtectedSecretKey
    :: SomePKPayload
    -> Salt
    -> IV
    -> SKey
    -> BL.ByteString
    -> SymmetricAlgorithm
    -> S2K
    -> ( SymmetricAlgorithm
         -> S2K
         -> IV
         -> BL.ByteString
         -> B.ByteString
         -> Either String r
       )
    -> Either String r
reencryptS2KProtectedSecretKey :: forall r.
SomePKPayload
-> Salt
-> IV
-> SKey
-> LazyByteString
-> SymmetricAlgorithm
-> S2K
-> (SymmetricAlgorithm
    -> S2K
    -> IV
    -> LazyByteString
    -> StrictByteString
    -> Either String r)
-> Either String r
reencryptS2KProtectedSecretKey SomePKPayload
pkp Salt
salt IV
iv SKey
skey LazyByteString
pp SymmetricAlgorithm
sa S2K
s2k SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> Either String r
encryptFn = do
    keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    let retargetedS2K = Salt -> S2K -> S2K
retargetS2K Salt
salt S2K
s2k
    keyMaterial <-
        first renderS2KError (string2Key retargetedS2K keyLen pp)
    cleartext <- legacySecretKeyPayload pkp skey
    encryptFn sa retargetedS2K iv cleartext keyMaterial

encryptLegacyCFBSecretKey
    :: SomePKPayload
    -> SymmetricAlgorithm
    -> IV
    -> SKey
    -> BL.ByteString
    -> Either String SKAddendum
encryptLegacyCFBSecretKey :: SomePKPayload
-> SymmetricAlgorithm
-> IV
-> SKey
-> LazyByteString
-> Either String SKAddendum
encryptLegacyCFBSecretKey SomePKPayload
pkp SymmetricAlgorithm
sa IV
iv SKey
skey LazyByteString
pp = do
    keyLen <- (CipherError -> String)
-> Either CipherError Int -> Either String 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 -> String
renderCipherError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
    keyMaterial <-
        first
            renderS2KError
            (string2Key (Simple DeprecatedMD5) keyLen pp)
    cleartext <- legacySecretKeyPayload pkp skey
    let clearWithChecksum =
            LazyByteString -> StrictByteString
BL.toStrict
                ( LazyByteString
cleartext
                    LazyByteString -> LazyByteString -> LazyByteString
forall a. Semigroup a => a -> a -> a
<> Put -> LazyByteString
runPut (Word16 -> Put
putWord16be (StrictByteString -> Word16
checksum16 (LazyByteString -> StrictByteString
BL.toStrict LazyByteString
cleartext)))
                )
    (\StrictByteString
encrypted -> SymmetricAlgorithm -> IV -> LazyByteString -> SKAddendum
SUSym SymmetricAlgorithm
sa IV
iv (StrictByteString -> LazyByteString
BL.fromStrict StrictByteString
encrypted))
        <$> first
            renderCipherError
            ( encryptNoNonce
                sa
                (Simple DeprecatedMD5)
                iv
                clearWithChecksum
                keyMaterial
            )

encrypt16BitProtectedSecretKey
    :: SymmetricAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> B.ByteString
    -> Either String SKAddendum
encrypt16BitProtectedSecretKey :: SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> Either String SKAddendum
encrypt16BitProtectedSecretKey SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
cleartext StrictByteString
keyMaterial =
    SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> SKAddendum)
-> Either String SKAddendum
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> r)
-> Either String r
encryptProtectedSecretKey
        SymmetricAlgorithm
sa
        S2K
s2k
        IV
iv
        LazyByteString
cleartext
        StrictByteString
keyMaterial
        LazyByteString -> LazyByteString
checksum16Trailer
        (\LazyByteString
payload -> SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendum
SUS16bit SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
payload)

encryptSHA1ProtectedSecretKey
    :: SymmetricAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> B.ByteString
    -> Either String SKAddendum
encryptSHA1ProtectedSecretKey :: SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> Either String SKAddendum
encryptSHA1ProtectedSecretKey SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
cleartext StrictByteString
keyMaterial =
    SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> SKAddendum)
-> Either String SKAddendum
forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> r)
-> Either String r
encryptProtectedSecretKey
        SymmetricAlgorithm
sa
        S2K
s2k
        IV
iv
        LazyByteString
cleartext
        StrictByteString
keyMaterial
        LazyByteString -> LazyByteString
sha1Trailer
        (\LazyByteString
payload -> SymmetricAlgorithm -> S2K -> IV -> LazyByteString -> SKAddendum
SUSSHA1 SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
payload)

encryptProtectedSecretKey
    :: SymmetricAlgorithm
    -> S2K
    -> IV
    -> BL.ByteString
    -> B.ByteString
    -> (BL.ByteString -> BL.ByteString)
    -> (BL.ByteString -> r)
    -> Either String r
encryptProtectedSecretKey :: forall r.
SymmetricAlgorithm
-> S2K
-> IV
-> LazyByteString
-> StrictByteString
-> (LazyByteString -> LazyByteString)
-> (LazyByteString -> r)
-> Either String r
encryptProtectedSecretKey SymmetricAlgorithm
sa S2K
s2k IV
iv LazyByteString
cleartext StrictByteString
keyMaterial LazyByteString -> LazyByteString
checksumTrailer LazyByteString -> r
mkAddendum = do
    let clearWithChecksum :: StrictByteString
clearWithChecksum = LazyByteString -> StrictByteString
BL.toStrict (LazyByteString
cleartext LazyByteString -> LazyByteString -> LazyByteString
forall a. Semigroup a => a -> a -> a
<> LazyByteString -> LazyByteString
checksumTrailer LazyByteString
cleartext)
    encrypted <-
        (CipherError -> String)
-> Either CipherError StrictByteString
-> Either String 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 -> String
renderCipherError
            (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 :: LazyByteString -> LazyByteString
checksum16Trailer LazyByteString
cleartext =
    Put -> LazyByteString
runPut (Word16 -> Put
putWord16be (StrictByteString -> Word16
checksum16 (LazyByteString -> StrictByteString
BL.toStrict LazyByteString
cleartext)))

sha1Trailer :: BL.ByteString -> BL.ByteString
sha1Trailer :: LazyByteString -> LazyByteString
sha1Trailer LazyByteString
cleartext =
    StrictByteString -> LazyByteString
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 (LazyByteString -> StrictByteString
BL.toStrict LazyByteString
cleartext) :: CH.Digest CH.SHA1))

legacySecretKeyPayload
    :: SomePKPayload -> SKey -> Either String BL.ByteString
legacySecretKeyPayload :: SomePKPayload -> SKey -> Either String LazyByteString
legacySecretKeyPayload SomePKPayload
pkp SKey
skey =
    Put -> LazyByteString
runPut (Put -> LazyByteString)
-> Either String Put -> Either String LazyByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomePKPayload -> SKey -> Either String 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