KeyGeneration.hs

-- KeyGeneration.hs: hOpenPGP key generation tests
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Tests.KeyGeneration (keyGenerationTests) where

import Control.Monad.Trans.Except (runExceptT)
import Crypto.Random.Types (getRandomBytes)
import Data.Binary.Get (Get, runGetOrFail)
import Data.Binary.Put (runPut)
import qualified Data.ByteString.Lazy as BL
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
    ( Assertion
    , assertEqual
    , assertFailure
    , testCase
    )

import Codec.Encryption.OpenPGP.KeyGeneration
    ( KeyGenSpec (..)
    , generateSecretKey
    )
import Codec.Encryption.OpenPGP.Serialize
    ( getSecretKey
    , putSKeyForPKPayload
    )
import Codec.Encryption.OpenPGP.Types

keyGenerationTests :: TestTree
keyGenerationTests =
    testGroup
        "Key generation"
        [ testGroup
            "RSA"
            [ testCase "V4 RSA 1024-bit round-trip" testRSAV4RoundTrip
            , testCase "V6 RSA 1024-bit round-trip" testRSAV6RoundTrip
            , testCase "RSA key size must be multiple of 8" testRSAMultipleOf8
            ]
        , testGroup
            "Ed25519"
            [ testCase "V6 Ed25519 round-trip" testEd25519V6RoundTrip
            ]
        , testGroup
            "Ed448"
            [ testCase "V6 Ed448 round-trip" testEd448V6RoundTrip
            ]
        , testGroup
            "X25519"
            [ testCase "V6 X25519 round-trip" testX25519V6RoundTrip
            ]
        , testGroup
            "X448"
            [ testCase "V6 X448 round-trip" testX448V6RoundTrip
            ]
        ]

roundTripAssertion
    :: String
    -> SomePKPayload
    -> SKey
    -> Assertion
roundTripAssertion label pkp skey = do
    put <-
        either
            (assertFailure . ("serialize failed: " ++))
            pure
            (putSKeyForPKPayload pkp skey)
    let bs = runPut put
    case runGetOrFail (getSecretKey pkp) bs of
        Left (_, _, err) -> assertFailure ("getSecretKey failed: " ++ err)
        Right (_, _, parsedSkey) ->
            assertEqual (label ++ " secret key round-trip") skey parsedSkey

testRSAV4RoundTrip :: Assertion
testRSAV4RoundTrip = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenRSA @V4 (ThirtyTwoBitTimeStamp 0) 1024)
    case result of
        Left err -> assertFailure ("generateSecretKey failed: " ++ err)
        Right (pkp, skey) -> roundTripAssertion "RSA V4" pkp skey

testRSAV6RoundTrip :: Assertion
testRSAV6RoundTrip = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenRSA @V6 (ThirtyTwoBitTimeStamp 0) 1024)
    case result of
        Left err -> assertFailure ("generateSecretKey failed: " ++ err)
        Right (pkp, skey) -> roundTripAssertion "RSA V6" pkp skey

testRSAMultipleOf8 :: Assertion
testRSAMultipleOf8 = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenRSA @V4 (ThirtyTwoBitTimeStamp 0) 1023)
    case result of
        Left _ -> pure ()
        Right _ ->
            assertFailure
                "expected failure for non-multiple-of-8 RSA key size"

testEd25519V6RoundTrip :: Assertion
testEd25519V6RoundTrip = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenEd25519 (ThirtyTwoBitTimeStamp 0))
    case result of
        Left err -> assertFailure ("generateSecretKey failed: " ++ err)
        Right (pkp, skey) -> roundTripAssertion "Ed25519 V6" pkp skey

testEd448V6RoundTrip :: Assertion
testEd448V6RoundTrip = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenEd448 (ThirtyTwoBitTimeStamp 0))
    case result of
        Left err -> assertFailure ("generateSecretKey failed: " ++ err)
        Right (pkp, skey) -> roundTripAssertion "Ed448 V6" pkp skey

testX25519V6RoundTrip :: Assertion
testX25519V6RoundTrip = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenX25519 (ThirtyTwoBitTimeStamp 0))
    case result of
        Left err -> assertFailure ("generateSecretKey failed: " ++ err)
        Right (pkp, skey) -> roundTripAssertion "X25519 V6" pkp skey

testX448V6RoundTrip :: Assertion
testX448V6RoundTrip = do
    result <-
        runExceptT $
            generateSecretKey (KeyGenX448 (ThirtyTwoBitTimeStamp 0))
    case result of
        Left err -> assertFailure ("generateSecretKey failed: " ++ err)
        Right (pkp, skey) -> roundTripAssertion "X448 V6" pkp skey