sd-jwt-0.1.0.0: test/TestKeys.hs

{-# LANGUAGE OverloadedStrings #-}
-- | Test key generation utilities for SD-JWT tests.
--
-- This module provides functions to load test RSA and EC keys
-- from a JSON file for use in unit tests. Keys are cached
-- to avoid regenerating them on every test run.
module TestKeys
  ( generateTestRSAKeyPair
  , generateTestRSAKeyPair2
  , generateTestECKeyPair
  , generateTestEd25519KeyPair
  , TestKeyPair(..)
  ) where

import qualified Data.Aeson as Aeson
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BSL
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Key as Key

-- | A test key pair containing both private and public keys in JWK JSON format.
data TestKeyPair = TestKeyPair
  { privateKeyJWK :: T.Text  -- ^ Private key JWK (JSON format)
  , publicKeyJWK :: T.Text   -- ^ Public key JWK (JSON format)
  }

-- | Path to the test keys JSON file (relative to test directory)
testKeysPath :: FilePath
testKeysPath = "test/test-keys.json"

-- | Load test keys from JSON file (cached)
loadTestKeys :: IO Aeson.Value
loadTestKeys = do
  contents <- BSL.readFile testKeysPath
  case Aeson.eitherDecode contents of
    Left err -> error $ "Failed to parse test-keys.json: " ++ err ++ "\nRun 'stack runghc generate-test-keys.hs' to generate keys."
    Right val -> return val

-- | Cached test keys (loaded once)
{-# NOINLINE cachedTestKeys #-}
cachedTestKeys :: Aeson.Value
cachedTestKeys = unsafePerformIO loadTestKeys

-- | Extract a key from the cached test keys
extractKey :: T.Text -> T.Text -> T.Text
extractKey keyType keyKind =
  case cachedTestKeys of
    Aeson.Object obj -> case KeyMap.lookup (Key.fromText keyType) obj of
      Just (Aeson.Object keyObj) -> case KeyMap.lookup (Key.fromText keyKind) keyObj of
        Just (Aeson.String keyText) -> keyText
        _ -> error $ "Missing " ++ T.unpack keyKind ++ " key for " ++ T.unpack keyType
      _ -> error $ "Missing " ++ T.unpack keyType ++ " key section"
    _ -> error "test-keys.json is not an object"

-- | Generate a test RSA key pair.
--
-- Returns cached 2048-bit RSA key pair from test-keys.json.
-- This is fast since keys are pre-generated and cached.
-- Keys are generated using 'stack runghc generate-test-keys.hs'.
generateTestRSAKeyPair :: IO TestKeyPair
generateTestRSAKeyPair = return $ TestKeyPair
  { privateKeyJWK = extractKey "rsa" "private"
  , publicKeyJWK = extractKey "rsa" "public"
  }

-- | Generate a second test RSA key pair (for testing signature verification with wrong key).
--
-- Returns cached 2048-bit RSA key pair from test-keys.json.
-- This is a different key pair from generateTestRSAKeyPair, used for testing
-- that signature verification properly rejects JWTs signed with wrong keys.
generateTestRSAKeyPair2 :: IO TestKeyPair
generateTestRSAKeyPair2 = return $ TestKeyPair
  { privateKeyJWK = extractKey "rsa2" "private"
  , publicKeyJWK = extractKey "rsa2" "public"
  }

-- | Generate a test EC key pair (P-256).
--
-- Returns cached EC key pair from test-keys.json.
-- This is fast since keys are pre-generated and cached.
-- Keys are generated using 'stack runghc generate-test-keys.hs'.
generateTestECKeyPair :: IO TestKeyPair
generateTestECKeyPair = return $ TestKeyPair
  { privateKeyJWK = extractKey "ec" "private"
  , publicKeyJWK = extractKey "ec" "public"
  }

-- | Generate a test Ed25519 key pair.
--
-- Returns cached Ed25519 key pair from test-keys.json.
-- This is fast since keys are pre-generated and cached.
-- Keys are generated using 'stack runghc generate-test-keys.hs'.
generateTestEd25519KeyPair :: IO TestKeyPair
generateTestEd25519KeyPair = return $ TestKeyPair
  { privateKeyJWK = extractKey "ed25519" "private"
  , publicKeyJWK = extractKey "ed25519" "public"
  }