-- CryptoSEIPDv2.hs: OpenPGP (RFC9580) SEIPD-v2 and SKESK-v6 crypto helpers
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}

module Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2
  ( aeadModeAndNonceSizeForSEIPDv2
  , seipdv2SymmetricKeySize
  , deriveSKESK6KEK
  , encryptSKESK6SessionKey
  , decryptSKESK6SessionKey
  ) where

import Codec.Encryption.OpenPGP.Internal.CryptoAES (withAESCipher)
import Codec.Encryption.OpenPGP.Internal.RFC7253OCB
  ( decryptWithOCBRFC7253With
  , encryptWithOCBRFC7253
  )
import Codec.Encryption.OpenPGP.Types
import qualified "crypton" Crypto.Cipher.Types as CCT
import qualified Crypto.Error as CE
import qualified Crypto.Hash.Algorithms as CHA
import Crypto.KDF.HKDF (expand, extract)
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B

aeadModeAndNonceSizeForSEIPDv2 ::
     String -> AEADAlgorithm -> Either String (CCT.AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2 :: String -> AEADAlgorithm -> Either String (AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2 String
otherAeadError AEADAlgorithm
EAX =
  String -> Either String (AEADMode, Int)
forall a b. a -> Either a b
Left String
"EAX is currently unsupported by the crypton AEAD backend"
aeadModeAndNonceSizeForSEIPDv2 String
otherAeadError AEADAlgorithm
OCB = (AEADMode, Int) -> Either String (AEADMode, Int)
forall a b. b -> Either a b
Right (AEADMode
CCT.AEAD_OCB, Int
15)
aeadModeAndNonceSizeForSEIPDv2 String
otherAeadError AEADAlgorithm
GCM = (AEADMode, Int) -> Either String (AEADMode, Int)
forall a b. b -> Either a b
Right (AEADMode
CCT.AEAD_GCM, Int
12)
aeadModeAndNonceSizeForSEIPDv2 String
otherAeadError (OtherAEADAlgo Word8
_) = String -> Either String (AEADMode, Int)
forall a b. a -> Either a b
Left String
otherAeadError

seipdv2SymmetricKeySize :: String -> SymmetricAlgorithm -> Either String Int
seipdv2SymmetricKeySize :: String -> SymmetricAlgorithm -> Either String Int
seipdv2SymmetricKeySize String
unsupportedSymmetricError SymmetricAlgorithm
symalgo =
  case SymmetricAlgorithm
symalgo of
    SymmetricAlgorithm
AES128 -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
    SymmetricAlgorithm
AES192 -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
24
    SymmetricAlgorithm
AES256 -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
32
    SymmetricAlgorithm
_ -> String -> Either String Int
forall a b. a -> Either a b
Left String
unsupportedSymmetricError

skeskV6Info :: SymmetricAlgorithm -> AEADAlgorithm -> B.ByteString
skeskV6Info :: SymmetricAlgorithm -> AEADAlgorithm -> ByteString
skeskV6Info SymmetricAlgorithm
symalgo AEADAlgorithm
aead = [Word8] -> ByteString
B.pack [Word8
0xc3, Word8
6, SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
symalgo, AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aead]

deriveSKESK6KEK ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> B.ByteString
  -> Either String B.ByteString
deriveSKESK6KEK :: SymmetricAlgorithm
-> AEADAlgorithm -> ByteString -> Either String ByteString
deriveSKESK6KEK SymmetricAlgorithm
symalgo AEADAlgorithm
aead ByteString
ikm = do
  keyLen <-
    String -> SymmetricAlgorithm -> Either String Int
seipdv2SymmetricKeySize
      String
"SKESK v6 currently supports AES-128/192/256 only"
      SymmetricAlgorithm
symalgo
  let prk = forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
extract @CHA.SHA256 ByteString
B.empty ByteString
ikm
  pure (expand @CHA.SHA256 prk (skeskV6Info symalgo aead) keyLen)

encryptSKESK6SessionKey ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> B.ByteString
  -> B.ByteString
  -> B.ByteString
  -> Either String (B.ByteString, B.ByteString)
encryptSKESK6SessionKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> ByteString
-> ByteString
-> ByteString
-> Either String (ByteString, ByteString)
encryptSKESK6SessionKey SymmetricAlgorithm
symalgo AEADAlgorithm
aead ByteString
kek ByteString
iv ByteString
sessionKey = do
  (mode, nonceSize) <-
    String -> AEADAlgorithm -> Either String (AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2
      String
"unsupported AEAD algorithm for SKESK v6 encrypt"
      AEADAlgorithm
aead
  if B.length iv /= nonceSize
    then Left "SKESK v6 IV length does not match AEAD algorithm"
    else
      withAESCipher
        "SKESK v6 encrypt currently supports AES-128/192/256 only"
        symalgo
        kek
        (\cipher
cipher ->
           if AEADMode
mode AEADMode -> AEADMode -> Bool
forall a. Eq a => a -> a -> Bool
== AEADMode
CCT.AEAD_OCB
             then do
               (tag, ciphertext) <-
                 cipher
-> ByteString
-> ByteString
-> ByteString
-> Either String (AuthTag, ByteString)
forall c.
BlockCipher c =>
c
-> ByteString
-> ByteString
-> ByteString
-> Either String (AuthTag, ByteString)
encryptWithOCBRFC7253 cipher
cipher ByteString
iv (SymmetricAlgorithm -> AEADAlgorithm -> ByteString
skeskV6Info SymmetricAlgorithm
symalgo AEADAlgorithm
aead) ByteString
sessionKey
               pure (ciphertext, authTagToBS tag)
             else do
               aeadCtx <- (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 (Either CryptoError (AEAD cipher) -> Either String (AEAD cipher))
-> (CryptoFailable (AEAD cipher)
    -> Either CryptoError (AEAD cipher))
-> CryptoFailable (AEAD cipher)
-> Either String (AEAD cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (CryptoFailable (AEAD cipher) -> Either String (AEAD cipher))
-> CryptoFailable (AEAD cipher) -> Either String (AEAD cipher)
forall a b. (a -> b) -> a -> b
$ AEADMode -> cipher -> ByteString -> CryptoFailable (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
forall iv.
ByteArrayAccess iv =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
CCT.aeadInit AEADMode
mode cipher
cipher ByteString
iv
               let (tag, ciphertext) =
                     CCT.aeadSimpleEncrypt aeadCtx (skeskV6Info symalgo aead) sessionKey 16
               pure (ciphertext, authTagToBS tag))

decryptSKESK6SessionKey ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> B.ByteString
  -> B.ByteString
  -> B.ByteString
  -> B.ByteString
  -> Either String B.ByteString
decryptSKESK6SessionKey :: SymmetricAlgorithm
-> AEADAlgorithm
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Either String ByteString
decryptSKESK6SessionKey SymmetricAlgorithm
symalgo AEADAlgorithm
aead ByteString
kek ByteString
iv ByteString
ciphertext ByteString
tag = do
  (mode, nonceSize) <-
    String -> AEADAlgorithm -> Either String (AEADMode, Int)
aeadModeAndNonceSizeForSEIPDv2
      String
"unsupported AEAD algorithm for SKESK v6 decrypt"
      AEADAlgorithm
aead
  if B.length iv /= nonceSize
    then Left "SKESK v6 IV length does not match AEAD algorithm"
    else
      withAESCipher
        "SKESK v6 decrypt currently supports AES-128/192/256 only"
        symalgo
        kek
        (\cipher
cipher ->
           if AEADMode
mode AEADMode -> AEADMode -> Bool
forall a. Eq a => a -> a -> Bool
== AEADMode
CCT.AEAD_OCB
             then
               (ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> String)
-> cipher
-> ByteString
-> ByteString
-> ByteString
-> AuthTag
-> Either String ByteString
forall c.
BlockCipher c =>
(ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> String)
-> c
-> ByteString
-> ByteString
-> ByteString
-> AuthTag
-> Either String ByteString
decryptWithOCBRFC7253With
                 (\ByteString
_ ByteString
_ ByteString
_ ByteString
_ ByteString
_ ByteString
_ -> String
"SKESK v6 authentication failed")
                 cipher
cipher
                 ByteString
iv
                 (SymmetricAlgorithm -> AEADAlgorithm -> ByteString
skeskV6Info SymmetricAlgorithm
symalgo AEADAlgorithm
aead)
                 ByteString
ciphertext
                 (ByteString -> AuthTag
mkAuthTag ByteString
tag)
             else do
               aeadCtx <- (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 (Either CryptoError (AEAD cipher) -> Either String (AEAD cipher))
-> (CryptoFailable (AEAD cipher)
    -> Either CryptoError (AEAD cipher))
-> CryptoFailable (AEAD cipher)
-> Either String (AEAD cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (AEAD cipher) -> Either CryptoError (AEAD cipher)
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (CryptoFailable (AEAD cipher) -> Either String (AEAD cipher))
-> CryptoFailable (AEAD cipher) -> Either String (AEAD cipher)
forall a b. (a -> b) -> a -> b
$ AEADMode -> cipher -> ByteString -> CryptoFailable (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
forall iv.
ByteArrayAccess iv =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
CCT.aeadInit AEADMode
mode cipher
cipher ByteString
iv
               case CCT.aeadSimpleDecrypt aeadCtx (skeskV6Info symalgo aead) ciphertext (mkAuthTag tag) of
                 Maybe ByteString
Nothing -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"SKESK v6 authentication failed"
                 Just ByteString
plain -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
plain)

authTagToBS :: CCT.AuthTag -> B.ByteString
authTagToBS :: AuthTag -> ByteString
authTagToBS = Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Bytes -> ByteString)
-> (AuthTag -> Bytes) -> AuthTag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthTag -> Bytes
CCT.unAuthTag

mkAuthTag :: B.ByteString -> CCT.AuthTag
mkAuthTag :: ByteString -> AuthTag
mkAuthTag = Bytes -> AuthTag
CCT.AuthTag (Bytes -> AuthTag)
-> (ByteString -> Bytes) -> ByteString -> AuthTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert