-- 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 PackageImports #-}
{-# LANGUAGE TypeApplications #-}

module Codec.Encryption.OpenPGP.SecretKey
  ( decryptPrivateKey
  , reinterpretUnknownSKeyForPKPayload
  , mkUnencryptedSKAddendum
  , encryptPrivateKeyWithPolicyAndSaltAndIV
  , encryptPrivateKey
  , changePrivateKeyPassphrase
  , changePrivateKeyPassphraseRandom
  , changeSecretKeyPassphrase
  , changeSecretKeyPassphraseRandom
  , reencryptSecretKeyRandomEither
  , reencryptPrivateKeyTyped
  ) where

import Codec.Encryption.OpenPGP.BlockCipher (renderCipherError, keySize)
import Codec.Encryption.OpenPGP.CFB (decryptNoNonce, encryptNoNonce)
import Codec.Encryption.OpenPGP.Internal.RFC7253OCB
  ( decryptWithOCBRFC7253With
  , encryptWithOCBRFC7253
  )
import Codec.Encryption.OpenPGP.Internal.CryptoAES (withAESCipher)
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 qualified "crypton" Crypto.Cipher.Types as CCT
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 Control.Monad (when)
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.Base16 as B16
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Data.List (nub)
import Data.Word (Word8, Word16)

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

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 -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
e -> String
" (last error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
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 -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
err String -> String
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 -> String -> String
forall a. [a] -> [a] -> [a]
++
            String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
e -> String
" (last error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
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 -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
err String -> String
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 -> String -> String
forall a. [a] -> [a] -> [a]
++
        StrictByteString -> String
toHex StrictByteString
expectedTag String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
", computed tag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++
        StrictByteString -> String
toHex StrictByteString
computedTag String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
", nonce=" String -> String -> String
forall a. [a] -> [a] -> [a]
++
        StrictByteString -> String
toHex StrictByteString
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
", ad=" String -> String -> String
forall a. [a] -> [a] -> [a]
++
        StrictByteString -> String
toHex StrictByteString
a String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
", hashAd=" String -> String -> String
forall a. [a] -> [a] -> [a]
++
        StrictByteString -> String
toHex StrictByteString
hashAd String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
", plaintext=" String -> String -> String
forall a. [a] -> [a] -> [a]
++
        StrictByteString -> String
toHex StrictByteString
plaintext String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
")"
      unsupportedSecretKeyAEADError :: 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

-- |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
  pure $ do
    (salt, iv) <- nextMaterial
    encryptPrivateKeyWithPolicyAndSaltAndIV policy pkp salt iv ska 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

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"

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
  pure $ do
    (salt, iv) <- nextMaterial
    changePrivateKeyPassphrase
      (pkp, ska)
      oldPassphrase
      salt
      iv
      newPassphrase

changeSecretKeyPassphrase ::
     SecretKey
  -> BL.ByteString
  -> Salt
  -> IV
  -> BL.ByteString
  -> Either String SecretKey
changeSecretKeyPassphrase :: SecretKey
-> LazyByteString
-> Salt
-> IV
-> LazyByteString
-> Either String SecretKey
changeSecretKeyPassphrase SecretKey
sk LazyByteString
oldPassphrase Salt
salt IV
iv LazyByteString
newPassphrase = do
  ska <-
    (SomePKPayload, SKAddendum)
-> LazyByteString
-> Salt
-> IV
-> LazyByteString
-> Either String SKAddendum
changePrivateKeyPassphrase
      (SecretKey -> SomePKPayload
_secretKeyPKPayload SecretKey
sk, SecretKey -> SKAddendum
_secretKeySKAddendum SecretKey
sk)
      LazyByteString
oldPassphrase
      Salt
salt
      IV
iv
      LazyByteString
newPassphrase
  return sk {_secretKeySKAddendum = ska}

changeSecretKeyPassphraseRandom ::
     MonadRandom m
  => SecretKey
  -> BL.ByteString
  -> BL.ByteString
  -> m (Either String SecretKey)
changeSecretKeyPassphraseRandom :: forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> LazyByteString -> LazyByteString -> m (Either String SecretKey)
changeSecretKeyPassphraseRandom SecretKey
sk LazyByteString
oldPassphrase LazyByteString
newPassphrase = do
  nextSKA <-
    (SomePKPayload, SKAddendum)
-> LazyByteString -> LazyByteString -> m (Either String SKAddendum)
forall (m :: * -> *).
MonadRandom m =>
(SomePKPayload, SKAddendum)
-> LazyByteString -> LazyByteString -> m (Either String SKAddendum)
changePrivateKeyPassphraseRandom
      (SecretKey -> SomePKPayload
_secretKeyPKPayload SecretKey
sk, SecretKey -> SKAddendum
_secretKeySKAddendum SecretKey
sk)
      LazyByteString
oldPassphrase
      LazyByteString
newPassphrase
  pure ((\SKAddendum
ska -> SecretKey
sk {_secretKeySKAddendum = ska}) <$> nextSKA)

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 -> String -> String
forall a. [a] -> [a] -> [a]
++
           Int -> String
forall a. Show a => a -> String
show (SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets SecretKeyProtectionPolicy
policy) String -> String -> String
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 -> String -> String
forall a. [a] -> [a] -> [a]
++
           Int -> String
forall a. Show a => a -> String
show (SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets SecretKeyProtectionPolicy
policy) String -> String -> String
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)

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
-> LazyByteString -> LazyByteString -> m (Either String SecretKey)
forall (m :: * -> *).
MonadRandom m =>
SecretKey
-> LazyByteString -> LazyByteString -> m (Either String SecretKey)
changeSecretKeyPassphraseRandom SecretKey
sk LazyByteString
pp LazyByteString
pp

-- | 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 SomePKPayload
pkp SKAddendumV v
skaV Salt
salt IV
iv SKey
skey LazyByteString
pp =
  case SKAddendumV v
skaV of
    SKAAEADV6 {}        -> Either String (SKAddendumV v)
Either String (SKAddendumV 'V6)
reencryptV6
    SKASHA1V6 {}        -> Either String (SKAddendumV v)
Either String (SKAddendumV 'V6)
reencryptV6
    SKASymV6 {}         -> Either String (SKAddendumV v)
Either String (SKAddendumV 'V6)
reencryptV6
    SKAUnencryptedV6 {} -> Either String (SKAddendumV v)
Either String (SKAddendumV 'V6)
reencryptV6
    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 :: Either String (SKAddendumV 'V6)
reencryptV6 = do
      (sa, aa, s2k) <- OpenPGPPolicy
-> SomePKPayload
-> Salt
-> IV
-> Either String (SymmetricAlgorithm, AEADAlgorithm, S2K)
secretKeyProtectionDefaults OpenPGPPolicy
defaultPolicy 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