packages feed

mldsa-0.1.0.0: tests/SigGen.hs

-- |
-- Module      : SigVer
-- License     : BSD-3-Clause
-- Copyright   : (c) 2026 Olivier Chéron
--
-- Types that are specific to signature-generation test vectors
--
{-# LANGUAGE OverloadedStrings #-}
module SigGen
    ( TestGroup(..), Test(..), TestGroupPayload(..)
    ) where

import Data.Aeson
import Data.Aeson.Types
import Data.ByteString (ByteString)

import SigExt
import Util

data TestGroup = TestGroup
    { tgId :: Int
    , testType :: String
    , parameterSet :: String
    , deterministic :: Bool
    , signatureInterface :: String
    , preHash :: String
    , externalMu :: Bool
    , cornerCase :: String
    , payload :: TestGroupPayload
    } deriving Show

data TestGroupPayload
    = ModePure [Test PureExt]
    | ModePreHash [Test PreHashExt]
    | ModeExternalMu [Test ExternalMuExt]
    | ModeInternal [Test InternalExt]
    deriving Show

parsePayload :: Object -> Parser TestGroupPayload
parsePayload o = do
    si <- o .: "signatureInterface"
    ph <- o .: "preHash"
    em <- o .: "externalMu"
    case (si :: String, ph :: String, em) of
        ("external", "pure", False) -> ModePure <$> (o .: "tests")
        ("external", "preHash", False) -> ModePreHash <$> (o .: "tests")
        ("internal", "none", True) -> ModeExternalMu <$> (o .: "tests")
        ("internal", "none", False) -> ModeInternal <$> (o .: "tests")
        unknown -> fail ("parsePayload: unknown mode " ++ show unknown)

instance FromJSON TestGroup where
    parseJSON = withObject "TestGroup" $ \o -> TestGroup
        <$> o .: "tgId"
        <*> o .: "testType"
        <*> o .: "parameterSet"
        <*> o .: "deterministic"
        <*> o .: "signatureInterface"
        <*> o .: "preHash"
        <*> o .: "externalMu"
        <*> o .: "cornerCase"
        <*> parsePayload o

data Test ext = Test
    { tcId :: Int
    , deferred :: Bool
    , pkEnc :: ByteString
    , skEnc :: ByteString
    , sigEnc :: ByteString
    , rndEnc :: Maybe ByteString
    , tcExt :: ext
    } deriving Show

instance TestExt ext => FromJSON (Test ext) where
    parseJSON = withObject "Test" $ \o -> Test
        <$> o .:   "tcId"
        <*> o .:   "deferred"
        <*> o .::  "pk"
        <*> o .::  "sk"
        <*> o .::  "signature"
        <*> o .::? "rnd"
        <*> parseExt o