-- |
-- Module      : Crypto.PubKey.MLDSA
-- License     : BSD-style
-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
-- Stability   : experimental
-- Portability : unknown
--
-- ML-DSA, the Module-Lattice-Based Digital Signature Algorithm of
-- <https://csrc.nist.gov/pubs/fips/204/final FIPS 204>, in all three
-- parameter sets.
--
-- > (vk, sk) <- generateKeyPair MLDSA65
-- > sig      <- sign sk emptyContext message
-- > verify vk emptyContext message sig
--
-- What 'generateKeyPair' and 'sign' draw their randomness from is the
-- 'Crypto.Random.MonadRandom' instance in use.  Its documentation says what
-- an instance of your own has to be.
--
-- The parameter set is a type, so an ML-DSA-65 key cannot be passed where
-- an ML-DSA-87 one is expected.  The three are fixed by FIPS 204 and the
-- class has no other instances.
--
-- This is pure ML-DSA: the message goes in whole.  The pre-hash variant
-- (HashML-DSA) is a different algorithm with a different domain separator
-- and is not offered here.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Crypto.PubKey.MLDSA (
    -- * Parameter sets
    MLDSA44 (..),
    MLDSA65 (..),
    MLDSA87 (..),
    MLDSA (verificationKeySize, signingKeySize, signatureSize),

    -- * Keys and signatures
    VerificationKey,
    SigningKey,
    Signature,

    -- * Smart constructors
    verificationKey,
    signingKey,
    signature,

    -- * Generating a key pair
    generateKeyPair,
    generateKeyPairAndSeed,
    keyPairFromSeed,
    toPublic,

    -- * The context string
    Context,
    context,
    emptyContext,

    -- * The message representative
    Mu,
    mu,
    messageRepresentative,

    -- ** A message that does not arrive in one piece
    MuContext,
    muInit,
    muUpdate,
    muUpdates,
    muFinalize,

    -- * Signing and verifying
    sign,
    signWith,
    signDeterministic,
    verify,

    -- * Signing and verifying a message representative
    signExternalMu,
    signExternalMuWith,
    signExternalMuDeterministic,
    verifyExternalMu,

    -- * Sizes
    seedSize,
    signingRandomnessSize,
    maxContextLength,
    muSize,
) where

import Data.Proxy (Proxy (..))
import Foreign.C.Types (CInt (..), CSize (..))
import Foreign.Ptr (Ptr, nullPtr)

import Crypto.Debug (DebugShow (..), debugShowBytes)
import Crypto.Hash (Digest, hash, hashFinalize, hashInit, hashUpdate, hashUpdates)
import qualified Crypto.Hash as Hash (Context)
import Crypto.Hash.Algorithms (SHAKE256 (..))
import Crypto.Error
import Crypto.Internal.ByteArray (
    ByteArrayAccess,
    Bytes,
    ScrubbedBytes,
    withByteArray,
 )
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat (unsafeDoIO)
import Crypto.Internal.Imports
import Crypto.Random (MonadRandom, getRandomBytes)

-- | ML-DSA-44.
data MLDSA44 = MLDSA44 deriving (Int -> MLDSA44 -> ShowS
[MLDSA44] -> ShowS
MLDSA44 -> String
(Int -> MLDSA44 -> ShowS)
-> (MLDSA44 -> String) -> ([MLDSA44] -> ShowS) -> Show MLDSA44
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLDSA44 -> ShowS
showsPrec :: Int -> MLDSA44 -> ShowS
$cshow :: MLDSA44 -> String
show :: MLDSA44 -> String
$cshowList :: [MLDSA44] -> ShowS
showList :: [MLDSA44] -> ShowS
Show, MLDSA44 -> MLDSA44 -> Bool
(MLDSA44 -> MLDSA44 -> Bool)
-> (MLDSA44 -> MLDSA44 -> Bool) -> Eq MLDSA44
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLDSA44 -> MLDSA44 -> Bool
== :: MLDSA44 -> MLDSA44 -> Bool
$c/= :: MLDSA44 -> MLDSA44 -> Bool
/= :: MLDSA44 -> MLDSA44 -> Bool
Eq)

-- | ML-DSA-65.
data MLDSA65 = MLDSA65 deriving (Int -> MLDSA65 -> ShowS
[MLDSA65] -> ShowS
MLDSA65 -> String
(Int -> MLDSA65 -> ShowS)
-> (MLDSA65 -> String) -> ([MLDSA65] -> ShowS) -> Show MLDSA65
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLDSA65 -> ShowS
showsPrec :: Int -> MLDSA65 -> ShowS
$cshow :: MLDSA65 -> String
show :: MLDSA65 -> String
$cshowList :: [MLDSA65] -> ShowS
showList :: [MLDSA65] -> ShowS
Show, MLDSA65 -> MLDSA65 -> Bool
(MLDSA65 -> MLDSA65 -> Bool)
-> (MLDSA65 -> MLDSA65 -> Bool) -> Eq MLDSA65
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLDSA65 -> MLDSA65 -> Bool
== :: MLDSA65 -> MLDSA65 -> Bool
$c/= :: MLDSA65 -> MLDSA65 -> Bool
/= :: MLDSA65 -> MLDSA65 -> Bool
Eq)

-- | ML-DSA-87.
data MLDSA87 = MLDSA87 deriving (Int -> MLDSA87 -> ShowS
[MLDSA87] -> ShowS
MLDSA87 -> String
(Int -> MLDSA87 -> ShowS)
-> (MLDSA87 -> String) -> ([MLDSA87] -> ShowS) -> Show MLDSA87
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLDSA87 -> ShowS
showsPrec :: Int -> MLDSA87 -> ShowS
$cshow :: MLDSA87 -> String
show :: MLDSA87 -> String
$cshowList :: [MLDSA87] -> ShowS
showList :: [MLDSA87] -> ShowS
Show, MLDSA87 -> MLDSA87 -> Bool
(MLDSA87 -> MLDSA87 -> Bool)
-> (MLDSA87 -> MLDSA87 -> Bool) -> Eq MLDSA87
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLDSA87 -> MLDSA87 -> Bool
== :: MLDSA87 -> MLDSA87 -> Bool
$c/= :: MLDSA87 -> MLDSA87 -> Bool
/= :: MLDSA87 -> MLDSA87 -> Bool
Eq)

-- | The three parameter sets of FIPS 204.
--
-- Named for the algorithm rather than \"DSA\", which is a different one that
-- crypton also has, in "Crypto.PubKey.DSA".  It is the three sets FIPS 204
-- defines, closed, carrying their sizes and the calls into the
-- implementation; only the sizes are exported.
class MLDSA p where
    -- | Size in bytes of a 'VerificationKey' of this parameter set.
    verificationKeySize :: proxy p -> Int

    -- | Size in bytes of a 'SigningKey' of this parameter set.
    signingKeySize :: proxy p -> Int

    -- | Size in bytes of a 'Signature' of this parameter set.
    signatureSize :: proxy p -> Int

    c_keypair :: proxy p -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
    c_sign
        :: proxy p
        -> Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> Ptr Word8 -> CInt -> IO CInt
    c_verify
        :: proxy p
        -> Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> CInt -> IO CInt
    c_pkFromSk :: proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt

-- | A public verification key.
newtype VerificationKey p = VerificationKey Bytes
    deriving (Int -> VerificationKey p -> ShowS
[VerificationKey p] -> ShowS
VerificationKey p -> String
(Int -> VerificationKey p -> ShowS)
-> (VerificationKey p -> String)
-> ([VerificationKey p] -> ShowS)
-> Show (VerificationKey p)
forall p. Int -> VerificationKey p -> ShowS
forall p. [VerificationKey p] -> ShowS
forall p. VerificationKey p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Int -> VerificationKey p -> ShowS
showsPrec :: Int -> VerificationKey p -> ShowS
$cshow :: forall p. VerificationKey p -> String
show :: VerificationKey p -> String
$cshowList :: forall p. [VerificationKey p] -> ShowS
showList :: [VerificationKey p] -> ShowS
Show, VerificationKey p -> VerificationKey p -> Bool
(VerificationKey p -> VerificationKey p -> Bool)
-> (VerificationKey p -> VerificationKey p -> Bool)
-> Eq (VerificationKey p)
forall p. VerificationKey p -> VerificationKey p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. VerificationKey p -> VerificationKey p -> Bool
== :: VerificationKey p -> VerificationKey p -> Bool
$c/= :: forall p. VerificationKey p -> VerificationKey p -> Bool
/= :: VerificationKey p -> VerificationKey p -> Bool
Eq, VerificationKey p -> Int
(VerificationKey p -> Int)
-> (forall p a. VerificationKey p -> (Ptr p -> IO a) -> IO a)
-> (forall p. VerificationKey p -> Ptr p -> IO ())
-> ByteArrayAccess (VerificationKey p)
forall p. VerificationKey p -> Int
forall p. VerificationKey p -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p p. VerificationKey p -> Ptr p -> IO ()
forall p a. VerificationKey p -> (Ptr p -> IO a) -> IO a
forall p p a. VerificationKey p -> (Ptr p -> IO a) -> IO a
$clength :: forall p. VerificationKey p -> Int
length :: VerificationKey p -> Int
$cwithByteArray :: forall p p a. VerificationKey p -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. VerificationKey p -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p p. VerificationKey p -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. VerificationKey p -> Ptr p -> IO ()
ByteArrayAccess, VerificationKey p -> ()
(VerificationKey p -> ()) -> NFData (VerificationKey p)
forall p. VerificationKey p -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall p. VerificationKey p -> ()
rnf :: VerificationKey p -> ()
NFData)

-- | A private signing key.
newtype SigningKey p = SigningKey ScrubbedBytes
    deriving (SigningKey p -> SigningKey p -> Bool
(SigningKey p -> SigningKey p -> Bool)
-> (SigningKey p -> SigningKey p -> Bool) -> Eq (SigningKey p)
forall p. SigningKey p -> SigningKey p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. SigningKey p -> SigningKey p -> Bool
== :: SigningKey p -> SigningKey p -> Bool
$c/= :: forall p. SigningKey p -> SigningKey p -> Bool
/= :: SigningKey p -> SigningKey p -> Bool
Eq, SigningKey p -> Int
(SigningKey p -> Int)
-> (forall p a. SigningKey p -> (Ptr p -> IO a) -> IO a)
-> (forall p. SigningKey p -> Ptr p -> IO ())
-> ByteArrayAccess (SigningKey p)
forall p. SigningKey p -> Int
forall p. SigningKey p -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p p. SigningKey p -> Ptr p -> IO ()
forall p a. SigningKey p -> (Ptr p -> IO a) -> IO a
forall p p a. SigningKey p -> (Ptr p -> IO a) -> IO a
$clength :: forall p. SigningKey p -> Int
length :: SigningKey p -> Int
$cwithByteArray :: forall p p a. SigningKey p -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. SigningKey p -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p p. SigningKey p -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. SigningKey p -> Ptr p -> IO ()
ByteArrayAccess, SigningKey p -> ()
(SigningKey p -> ()) -> NFData (SigningKey p)
forall p. SigningKey p -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall p. SigningKey p -> ()
rnf :: SigningKey p -> ()
NFData)

instance Show (SigningKey p) where
    show :: SigningKey p -> String
show SigningKey p
_ = String
"SigningKey <redacted>"

instance DebugShow (SigningKey p) where
    debugShow :: SigningKey p -> String
debugShow = String -> SigningKey p -> String
forall ba. ByteArrayAccess ba => String -> ba -> String
debugShowBytes String
"SigningKey"

-- | A signature.
newtype Signature p = Signature Bytes
    deriving (Int -> Signature p -> ShowS
[Signature p] -> ShowS
Signature p -> String
(Int -> Signature p -> ShowS)
-> (Signature p -> String)
-> ([Signature p] -> ShowS)
-> Show (Signature p)
forall p. Int -> Signature p -> ShowS
forall p. [Signature p] -> ShowS
forall p. Signature p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Int -> Signature p -> ShowS
showsPrec :: Int -> Signature p -> ShowS
$cshow :: forall p. Signature p -> String
show :: Signature p -> String
$cshowList :: forall p. [Signature p] -> ShowS
showList :: [Signature p] -> ShowS
Show, Signature p -> Signature p -> Bool
(Signature p -> Signature p -> Bool)
-> (Signature p -> Signature p -> Bool) -> Eq (Signature p)
forall p. Signature p -> Signature p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. Signature p -> Signature p -> Bool
== :: Signature p -> Signature p -> Bool
$c/= :: forall p. Signature p -> Signature p -> Bool
/= :: Signature p -> Signature p -> Bool
Eq, Signature p -> Int
(Signature p -> Int)
-> (forall p a. Signature p -> (Ptr p -> IO a) -> IO a)
-> (forall p. Signature p -> Ptr p -> IO ())
-> ByteArrayAccess (Signature p)
forall p. Signature p -> Int
forall p. Signature p -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p p. Signature p -> Ptr p -> IO ()
forall p a. Signature p -> (Ptr p -> IO a) -> IO a
forall p p a. Signature p -> (Ptr p -> IO a) -> IO a
$clength :: forall p. Signature p -> Int
length :: Signature p -> Int
$cwithByteArray :: forall p p a. Signature p -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Signature p -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p p. Signature p -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Signature p -> Ptr p -> IO ()
ByteArrayAccess, Signature p -> ()
(Signature p -> ()) -> NFData (Signature p)
forall p. Signature p -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall p. Signature p -> ()
rnf :: Signature p -> ()
NFData)

-- | The context string a signature is bound to, at most
-- 'maxContextLength' bytes.
--
-- FIPS 204 mixes it into what is signed, so a signature made under one
-- context does not verify under another.  Two uses of one key that don't
-- agree on a context string cannot be made to accept each other's
-- signatures.  Use 'emptyContext' where there is nothing to separate -- TLS,
-- for one, signs with an empty context.
newtype Context = Context Bytes
    deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show, Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq, Context -> Int
(Context -> Int)
-> (forall p a. Context -> (Ptr p -> IO a) -> IO a)
-> (forall p. Context -> Ptr p -> IO ())
-> ByteArrayAccess Context
forall p. Context -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Context -> (Ptr p -> IO a) -> IO a
$clength :: Context -> Int
length :: Context -> Int
$cwithByteArray :: forall p a. Context -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Context -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. Context -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Context -> Ptr p -> IO ()
ByteArrayAccess, Context -> ()
(Context -> ()) -> NFData Context
forall a. (a -> ()) -> NFData a
$crnf :: Context -> ()
rnf :: Context -> ()
NFData)

-- | The context string of length zero, which is what to sign under when
-- there is nothing to separate.
--
-- It is a context and not the absence of one: 'sign' always takes one, and
-- what this separates from is every non-empty context there is.
emptyContext :: Context
emptyContext :: Context
emptyContext = Bytes -> Context
Context Bytes
forall a. ByteArray a => a
B.empty

-- | Try to build a context string.
context :: ByteArrayAccess ba => ba -> CryptoFailable Context
context :: forall ba. ByteArrayAccess ba => ba -> CryptoFailable Context
context ba
bs
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxContextLength =
        Context -> CryptoFailable Context
forall a. a -> CryptoFailable a
CryptoPassed (Context -> CryptoFailable Context)
-> Context -> CryptoFailable Context
forall a b. (a -> b) -> a -> b
$ Bytes -> Context
Context (Bytes -> Context) -> Bytes -> Context
forall a b. (a -> b) -> a -> b
$ ba -> (Ptr Any -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ba
bs (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise = CryptoError -> CryptoFailable Context
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid

-- | The longest context string FIPS 204 allows, which is 255 bytes because
-- its length is encoded in one byte.
maxContextLength :: Int
maxContextLength :: Int
maxContextLength = Int
255

-- | The message representative, @mu@ in FIPS 204: a 64-byte commitment to
-- the verification key, the context string and the message, and the only
-- part of them that signing and verification actually read.
--
-- Signing it directly is the "external mu" interface.  It is for a caller
-- that has the representative without having the message in one piece: a
-- message arriving as a stream, or hashed on another machine, or by a
-- device that holds the key and is handed only this.  TLS does not need it.
newtype Mu = Mu Bytes
    deriving (Int -> Mu -> ShowS
[Mu] -> ShowS
Mu -> String
(Int -> Mu -> ShowS)
-> (Mu -> String) -> ([Mu] -> ShowS) -> Show Mu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mu -> ShowS
showsPrec :: Int -> Mu -> ShowS
$cshow :: Mu -> String
show :: Mu -> String
$cshowList :: [Mu] -> ShowS
showList :: [Mu] -> ShowS
Show, Mu -> Mu -> Bool
(Mu -> Mu -> Bool) -> (Mu -> Mu -> Bool) -> Eq Mu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mu -> Mu -> Bool
== :: Mu -> Mu -> Bool
$c/= :: Mu -> Mu -> Bool
/= :: Mu -> Mu -> Bool
Eq, Mu -> Int
(Mu -> Int)
-> (forall p a. Mu -> (Ptr p -> IO a) -> IO a)
-> (forall p. Mu -> Ptr p -> IO ())
-> ByteArrayAccess Mu
forall p. Mu -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Mu -> (Ptr p -> IO a) -> IO a
$clength :: Mu -> Int
length :: Mu -> Int
$cwithByteArray :: forall p a. Mu -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Mu -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. Mu -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Mu -> Ptr p -> IO ()
ByteArrayAccess, Mu -> ()
(Mu -> ()) -> NFData Mu
forall a. (a -> ()) -> NFData a
$crnf :: Mu -> ()
rnf :: Mu -> ()
NFData)

-- | Size in bytes of a 'Mu'.
muSize :: Int
muSize :: Int
muSize = Int
64

-- | Try to read a message representative.
mu :: ByteArrayAccess ba => ba -> CryptoFailable Mu
mu :: forall ba. ByteArrayAccess ba => ba -> CryptoFailable Mu
mu ba
bs
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
muSize = Mu -> CryptoFailable Mu
forall a. a -> CryptoFailable a
CryptoPassed (Mu -> CryptoFailable Mu) -> Mu -> CryptoFailable Mu
forall a b. (a -> b) -> a -> b
$ Bytes -> Mu
Mu (Bytes -> Mu) -> Bytes -> Mu
forall a b. (a -> b) -> a -> b
$ ba -> (Ptr Any -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ba
bs (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise = CryptoError -> CryptoFailable Mu
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid

-- | Compute the message representative, for a caller that wants to make it
-- here and sign it later, or sign it elsewhere.
--
-- @'signExternalMuDeterministic' sk ('messageRepresentative' ('toPublic' sk) ctx msg)@
-- and @'signDeterministic' sk ctx msg@ are the same signature.
messageRepresentative
    :: (MLDSA p, ByteArrayAccess msg)
    => VerificationKey p -> Context -> msg -> Mu
messageRepresentative :: forall p msg.
(MLDSA p, ByteArrayAccess msg) =>
VerificationKey p -> Context -> msg -> Mu
messageRepresentative VerificationKey p
vk Context
ctx msg
msg = MuContext -> Mu
muFinalize (MuContext -> msg -> MuContext
forall msg. ByteArrayAccess msg => MuContext -> msg -> MuContext
muUpdate (VerificationKey p -> Context -> MuContext
forall p. MLDSA p => VerificationKey p -> Context -> MuContext
muInit VerificationKey p
vk Context
ctx) msg
msg)

-- | A 'Mu' being computed, with the message going in a piece at a time.
--
-- The name is not 'Context': that is ML-DSA's context string, which this
-- is built from and is not.
newtype MuContext = MuContext (Hash.Context (SHAKE256 512))

-- | Begin a message representative.  The key and the context string are
-- what it is bound to, and they are all that is needed before the message.
--
-- > muFinalize (muUpdates (muInit vk ctx) chunks)
--
-- is 'messageRepresentative' of the chunks joined, so a message too large
-- to hold at once never has to be.
muInit :: MLDSA p => VerificationKey p -> Context -> MuContext
muInit :: forall p. MLDSA p => VerificationKey p -> Context -> MuContext
muInit VerificationKey p
vk Context
ctx =
    -- FIPS 204: tr <- H(pk, 64) at key generation, and mu <- H(tr || M', 64)
    -- when signing, with M' the domain-separated message.  Everything up to
    -- the message itself is absorbed here.
    Context (SHAKE256 512) -> MuContext
MuContext (Context (SHAKE256 512) -> MuContext)
-> Context (SHAKE256 512) -> MuContext
forall a b. (a -> b) -> a -> b
$ Context (SHAKE256 512) -> [Bytes] -> Context (SHAKE256 512)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates Context (SHAKE256 512)
forall a. HashAlgorithm a => Context a
hashInit [Bytes
tr, Context -> Bytes
domainPrefix Context
ctx]
  where
    tr :: Bytes
tr = Digest (SHAKE256 512) -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Bytes -> Digest (SHAKE256 512)
forall ba. ByteArrayAccess ba => ba -> Digest (SHAKE256 512)
shake64 (VerificationKey p -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert VerificationKey p
vk :: Bytes)) :: Bytes

-- | Absorb a piece of the message.
muUpdate :: ByteArrayAccess msg => MuContext -> msg -> MuContext
muUpdate :: forall msg. ByteArrayAccess msg => MuContext -> msg -> MuContext
muUpdate (MuContext Context (SHAKE256 512)
c) msg
msg = Context (SHAKE256 512) -> MuContext
MuContext (Context (SHAKE256 512) -> msg -> Context (SHAKE256 512)
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context (SHAKE256 512)
c msg
msg)

-- | Absorb several pieces, which is 'muUpdate' one after the other.
muUpdates :: ByteArrayAccess msg => MuContext -> [msg] -> MuContext
muUpdates :: forall msg. ByteArrayAccess msg => MuContext -> [msg] -> MuContext
muUpdates (MuContext Context (SHAKE256 512)
c) [msg]
msgs = Context (SHAKE256 512) -> MuContext
MuContext (Context (SHAKE256 512) -> [msg] -> Context (SHAKE256 512)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates Context (SHAKE256 512)
c [msg]
msgs)

-- | The message representative of everything absorbed so far.
muFinalize :: MuContext -> Mu
muFinalize :: MuContext -> Mu
muFinalize (MuContext Context (SHAKE256 512)
c) = Bytes -> Mu
Mu (Digest (SHAKE256 512) -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Context (SHAKE256 512) -> Digest (SHAKE256 512)
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize Context (SHAKE256 512)
c :: Digest (SHAKE256 512)))

shake64 :: ByteArrayAccess ba => ba -> Digest (SHAKE256 512)
shake64 :: forall ba. ByteArrayAccess ba => ba -> Digest (SHAKE256 512)
shake64 = ba -> Digest (SHAKE256 512)
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash

-- | Size in bytes of the seed 'keyPairFromSeed' takes, @xi@ in FIPS 204.
seedSize :: Int
seedSize :: Int
seedSize = Int
32

-- | Size in bytes of the randomness 'signWith' takes.
signingRandomnessSize :: Int
signingRandomnessSize :: Int
signingRandomnessSize = Int
32

-- | Try to read a verification key.  Only the length is checked: a
-- verification key is a packed encoding with no redundancy to test, and one
-- that is not a real key simply verifies nothing.
verificationKey
    :: forall p ba
     . (MLDSA p, ByteArrayAccess ba)
    => ba -> CryptoFailable (VerificationKey p)
verificationKey :: forall p ba.
(MLDSA p, ByteArrayAccess ba) =>
ba -> CryptoFailable (VerificationKey p)
verificationKey ba
bs
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
verificationKeySize (Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p) =
        VerificationKey p -> CryptoFailable (VerificationKey p)
forall a. a -> CryptoFailable a
CryptoPassed (VerificationKey p -> CryptoFailable (VerificationKey p))
-> VerificationKey p -> CryptoFailable (VerificationKey p)
forall a b. (a -> b) -> a -> b
$ Bytes -> VerificationKey p
forall p. Bytes -> VerificationKey p
VerificationKey (Bytes -> VerificationKey p) -> Bytes -> VerificationKey p
forall a b. (a -> b) -> a -> b
$ ba -> (Ptr Any -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ba
bs (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise = CryptoError -> CryptoFailable (VerificationKey p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_PublicKeySizeInvalid

-- | Try to read a signing key.
--
-- Beyond the length this runs the validity checks of the implementation:
-- the secret polynomials must have coefficients in range, and the
-- commitment and the public-key hash the key carries must match what is
-- recomputed from the rest of it.  A key that fails has been damaged or was
-- never a key, and signing with it would produce signatures nothing
-- verifies.
signingKey
    :: forall p ba
     . (MLDSA p, ByteArrayAccess ba)
    => ba -> CryptoFailable (SigningKey p)
signingKey :: forall p ba.
(MLDSA p, ByteArrayAccess ba) =>
ba -> CryptoFailable (SigningKey p)
signingKey ba
bs
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signingKeySize Proxy p
p = CryptoError -> CryptoFailable (SigningKey p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeySizeInvalid
    | Bool
otherwise = IO (CryptoFailable (SigningKey p)) -> CryptoFailable (SigningKey p)
forall a. IO a -> a
unsafeDoIO (IO (CryptoFailable (SigningKey p))
 -> CryptoFailable (SigningKey p))
-> IO (CryptoFailable (SigningKey p))
-> CryptoFailable (SigningKey p)
forall a b. (a -> b) -> a -> b
$ do
        (CInt
r, Bytes
_ :: Bytes) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
B.allocRet (Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
verificationKeySize Proxy p
p) ((Ptr Word8 -> IO CInt) -> IO (CInt, Bytes))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ppk ->
            ba -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
withByteArray ba
bs ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psk -> Proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall (proxy :: * -> *).
proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_pkFromSk Proxy p
p Ptr Word8
ppk Ptr Word8
psk
        CryptoFailable (SigningKey p) -> IO (CryptoFailable (SigningKey p))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoFailable (SigningKey p)
 -> IO (CryptoFailable (SigningKey p)))
-> CryptoFailable (SigningKey p)
-> IO (CryptoFailable (SigningKey p))
forall a b. (a -> b) -> a -> b
$
            if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                then SigningKey p -> CryptoFailable (SigningKey p)
forall a. a -> CryptoFailable a
CryptoPassed (SigningKey p -> CryptoFailable (SigningKey p))
-> SigningKey p -> CryptoFailable (SigningKey p)
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> SigningKey p
forall p. ScrubbedBytes -> SigningKey p
SigningKey (ScrubbedBytes -> SigningKey p) -> ScrubbedBytes -> SigningKey p
forall a b. (a -> b) -> a -> b
$ ba -> (Ptr Any -> IO ()) -> ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ba
bs (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                else CryptoError -> CryptoFailable (SigningKey p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
  where
    p :: Proxy p
p = Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p
{-# NOINLINE signingKey #-}

-- | Try to read a signature.  Only the length is checked; whether it is a
-- signature of anything is what 'verify' answers.
signature
    :: forall p ba
     . (MLDSA p, ByteArrayAccess ba)
    => ba -> CryptoFailable (Signature p)
signature :: forall p ba.
(MLDSA p, ByteArrayAccess ba) =>
ba -> CryptoFailable (Signature p)
signature ba
bs
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signatureSize (Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p) =
        Signature p -> CryptoFailable (Signature p)
forall a. a -> CryptoFailable a
CryptoPassed (Signature p -> CryptoFailable (Signature p))
-> Signature p -> CryptoFailable (Signature p)
forall a b. (a -> b) -> a -> b
$ Bytes -> Signature p
forall p. Bytes -> Signature p
Signature (Bytes -> Signature p) -> Bytes -> Signature p
forall a b. (a -> b) -> a -> b
$ ba -> (Ptr Any -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ba
bs (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise = CryptoError -> CryptoFailable (Signature p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid

-- | Recover the verification key a signing key was made with.
toPublic :: forall p. MLDSA p => SigningKey p -> VerificationKey p
toPublic :: forall p. MLDSA p => SigningKey p -> VerificationKey p
toPublic SigningKey p
sk = Bytes -> VerificationKey p
forall p. Bytes -> VerificationKey p
VerificationKey (Bytes -> VerificationKey p) -> Bytes -> VerificationKey p
forall a b. (a -> b) -> a -> b
$ IO Bytes -> Bytes
forall a. IO a -> a
unsafeDoIO (IO Bytes -> Bytes) -> IO Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ do
    (CInt
_ :: CInt, Bytes
pk) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
B.allocRet (Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
verificationKeySize Proxy p
p) ((Ptr Word8 -> IO CInt) -> IO (CInt, Bytes))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ppk ->
        SigningKey p -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. SigningKey p -> (Ptr p -> IO a) -> IO a
withByteArray SigningKey p
sk ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psk -> Proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall (proxy :: * -> *).
proxy p -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_pkFromSk Proxy p
p Ptr Word8
ppk Ptr Word8
psk
    Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
pk
  where
    p :: Proxy p
p = Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p
{-# NOINLINE toPublic #-}

-- | Generate a key pair.
--
-- The seed it is derived from is drawn here and thrown away.  Use
-- 'generateKeyPairAndSeed' where it has to be kept.
generateKeyPair
    :: forall p proxy m
     . (MLDSA p, MonadRandom m)
    => proxy p -> m (VerificationKey p, SigningKey p)
generateKeyPair :: forall p (proxy :: * -> *) (m :: * -> *).
(MLDSA p, MonadRandom m) =>
proxy p -> m (VerificationKey p, SigningKey p)
generateKeyPair proxy p
p = do
    (VerificationKey p
vk, SigningKey p
sk, ScrubbedBytes
_) <- proxy p -> m (VerificationKey p, SigningKey p, ScrubbedBytes)
forall p (proxy :: * -> *) (m :: * -> *).
(MLDSA p, MonadRandom m) =>
proxy p -> m (VerificationKey p, SigningKey p, ScrubbedBytes)
generateKeyPairAndSeed proxy p
p
    (VerificationKey p, SigningKey p)
-> m (VerificationKey p, SigningKey p)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey p
vk, SigningKey p
sk)

-- | Generate a key pair and hand back the seed it was derived from, @xi@
-- in FIPS 204.
--
-- A 'SigningKey' is the expanded key and nothing else, so the seed cannot
-- be recovered from a pair afterwards.  An application that has to write
-- the key out in a form that keeps the seed -- RFC 9881 lets an ML-DSA
-- private key be the seed, the expanded key, or both -- has to generate it
-- here:
--
-- > (vk, sk, seed) <- generateKeyPairAndSeed MLDSA65
--
-- The seed is as secret as the signing key: 'keyPairFromSeed' turns it
-- back into the same pair.
generateKeyPairAndSeed
    :: forall p proxy m
     . (MLDSA p, MonadRandom m)
    => proxy p -> m (VerificationKey p, SigningKey p, ScrubbedBytes)
generateKeyPairAndSeed :: forall p (proxy :: * -> *) (m :: * -> *).
(MLDSA p, MonadRandom m) =>
proxy p -> m (VerificationKey p, SigningKey p, ScrubbedBytes)
generateKeyPairAndSeed proxy p
p = do
    ScrubbedBytes
seed <- Int -> m ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
seedSize :: m ScrubbedBytes
    case proxy p
-> ScrubbedBytes
-> CryptoFailable (VerificationKey p, SigningKey p)
forall p (proxy :: * -> *) ba.
(MLDSA p, ByteArrayAccess ba) =>
proxy p -> ba -> CryptoFailable (VerificationKey p, SigningKey p)
keyPairFromSeed proxy p
p ScrubbedBytes
seed of
        CryptoPassed (VerificationKey p
vk, SigningKey p
sk) -> (VerificationKey p, SigningKey p, ScrubbedBytes)
-> m (VerificationKey p, SigningKey p, ScrubbedBytes)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey p
vk, SigningKey p
sk, ScrubbedBytes
seed)
        CryptoFailed CryptoError
e ->
            String -> m (VerificationKey p, SigningKey p, ScrubbedBytes)
forall a. HasCallStack => String -> a
error (String
"Crypto.PubKey.MLDSA.generateKeyPairAndSeed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

-- | Derive a key pair from a seed, @xi@ in FIPS 204, which must be
-- 'seedSize' bytes.
keyPairFromSeed
    :: forall p proxy ba
     . (MLDSA p, ByteArrayAccess ba)
    => proxy p -> ba -> CryptoFailable (VerificationKey p, SigningKey p)
keyPairFromSeed :: forall p (proxy :: * -> *) ba.
(MLDSA p, ByteArrayAccess ba) =>
proxy p -> ba -> CryptoFailable (VerificationKey p, SigningKey p)
keyPairFromSeed proxy p
p ba
seed
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
seed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
seedSize = CryptoError -> CryptoFailable (VerificationKey p, SigningKey p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SeedSizeInvalid
    | Bool
otherwise = IO (CryptoFailable (VerificationKey p, SigningKey p))
-> CryptoFailable (VerificationKey p, SigningKey p)
forall a. IO a -> a
unsafeDoIO (IO (CryptoFailable (VerificationKey p, SigningKey p))
 -> CryptoFailable (VerificationKey p, SigningKey p))
-> IO (CryptoFailable (VerificationKey p, SigningKey p))
-> CryptoFailable (VerificationKey p, SigningKey p)
forall a b. (a -> b) -> a -> b
$ do
        -- Not zeroed, and does not need to be: the C writes the whole
        -- buffer, and on a non-zero return the result is discarded without
        -- being read.  Anything that is *read* before being written has to
        -- use B.zero instead -- see signInternal in Crypto.PubKey.MLDSA.
        ScrubbedBytes
sk <- Int -> (Ptr Any -> IO ()) -> IO ScrubbedBytes
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc (proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signingKeySize proxy p
p) (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) :: IO ScrubbedBytes
        (CInt
r, Bytes
vk) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
B.allocRet (proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
verificationKeySize proxy p
p) ((Ptr Word8 -> IO CInt) -> IO (CInt, Bytes))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pvk ->
            ScrubbedBytes -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
sk ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psk ->
                ba -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
withByteArray ba
seed ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pseed ->
                    proxy p -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall (proxy :: * -> *).
proxy p -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_keypair proxy p
p Ptr Word8
pvk Ptr Word8
psk Ptr Word8
pseed
        CryptoFailable (VerificationKey p, SigningKey p)
-> IO (CryptoFailable (VerificationKey p, SigningKey p))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoFailable (VerificationKey p, SigningKey p)
 -> IO (CryptoFailable (VerificationKey p, SigningKey p)))
-> CryptoFailable (VerificationKey p, SigningKey p)
-> IO (CryptoFailable (VerificationKey p, SigningKey p))
forall a b. (a -> b) -> a -> b
$
            if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                then (VerificationKey p, SigningKey p)
-> CryptoFailable (VerificationKey p, SigningKey p)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> VerificationKey p
forall p. Bytes -> VerificationKey p
VerificationKey Bytes
vk, ScrubbedBytes -> SigningKey p
forall p. ScrubbedBytes -> SigningKey p
SigningKey ScrubbedBytes
sk)
                else CryptoError -> CryptoFailable (VerificationKey p, SigningKey p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
{-# NOINLINE keyPairFromSeed #-}

-- | Sign a message.
--
-- This is the hedged signing FIPS 204 recommends: fresh randomness goes in
-- alongside the key and the message, so two signatures of one message
-- differ and a fault in one reveals less.  Verification does not care which
-- of the three entry points made the signature.
sign
    :: forall p m msg
     . (MLDSA p, MonadRandom m, ByteArrayAccess msg)
    => SigningKey p -> Context -> msg -> m (Signature p)
sign :: forall p (m :: * -> *) msg.
(MLDSA p, MonadRandom m, ByteArrayAccess msg) =>
SigningKey p -> Context -> msg -> m (Signature p)
sign SigningKey p
sk Context
ctx msg
msg = do
    ScrubbedBytes
rnd <- Int -> m ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
signingRandomnessSize :: m ScrubbedBytes
    case SigningKey p
-> Context -> msg -> ScrubbedBytes -> CryptoFailable (Signature p)
forall p msg rnd.
(MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd) =>
SigningKey p
-> Context -> msg -> rnd -> CryptoFailable (Signature p)
signWith SigningKey p
sk Context
ctx msg
msg ScrubbedBytes
rnd of
        CryptoPassed Signature p
s -> Signature p -> m (Signature p)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Signature p
s
        CryptoFailed CryptoError
e -> String -> m (Signature p)
forall a. HasCallStack => String -> a
error (String
"Crypto.PubKey.MLDSA.sign: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

-- | Sign with the randomness supplied, which must be
-- 'signingRandomnessSize' bytes.
--
-- For test vectors, and for callers who draw their own randomness.  Ordinary
-- use wants 'sign'.
signWith
    :: forall p msg rnd
     . (MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd)
    => SigningKey p -> Context -> msg -> rnd -> CryptoFailable (Signature p)
signWith :: forall p msg rnd.
(MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd) =>
SigningKey p
-> Context -> msg -> rnd -> CryptoFailable (Signature p)
signWith SigningKey p
sk Context
ctx msg
msg rnd
rnd
    | rnd -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length rnd
rnd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
signingRandomnessSize = CryptoError -> CryptoFailable (Signature p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SeedSizeInvalid
    | Bool
otherwise = SigningKey p
-> Context -> msg -> Maybe rnd -> CryptoFailable (Signature p)
forall p msg rnd.
(MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd) =>
SigningKey p
-> Context -> msg -> Maybe rnd -> CryptoFailable (Signature p)
signInternal SigningKey p
sk Context
ctx msg
msg (rnd -> Maybe rnd
forall a. a -> Maybe a
Just rnd
rnd)

-- | Sign deterministically, as FIPS 204 section 3.4 allows: the randomness
-- is replaced by zeroes, so one key and one message always give one
-- signature.
--
-- This is what test vectors are written against, and what to use where the
-- signature must be reproducible.  It gives up what hedging buys, so where
-- there is a usable random source 'sign' is the better default.
signDeterministic
    :: forall p msg
     . (MLDSA p, ByteArrayAccess msg)
    => SigningKey p -> Context -> msg -> Signature p
signDeterministic :: forall p msg.
(MLDSA p, ByteArrayAccess msg) =>
SigningKey p -> Context -> msg -> Signature p
signDeterministic SigningKey p
sk Context
ctx msg
msg =
    case SigningKey p
-> Context -> msg -> Maybe Bytes -> CryptoFailable (Signature p)
forall p msg rnd.
(MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd) =>
SigningKey p
-> Context -> msg -> Maybe rnd -> CryptoFailable (Signature p)
signInternal SigningKey p
sk Context
ctx msg
msg (Maybe Bytes
forall a. Maybe a
Nothing :: Maybe Bytes) of
        CryptoPassed Signature p
s -> Signature p
s
        CryptoFailed CryptoError
e -> String -> Signature p
forall a. HasCallStack => String -> a
error (String
"Crypto.PubKey.MLDSA.signDeterministic: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

signInternal
    :: forall p msg rnd
     . (MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd)
    => SigningKey p -> Context -> msg -> Maybe rnd -> CryptoFailable (Signature p)
signInternal :: forall p msg rnd.
(MLDSA p, ByteArrayAccess msg, ByteArrayAccess rnd) =>
SigningKey p
-> Context -> msg -> Maybe rnd -> CryptoFailable (Signature p)
signInternal SigningKey p
sk Context
ctx msg
msg Maybe rnd
mrnd = IO (CryptoFailable (Signature p)) -> CryptoFailable (Signature p)
forall a. IO a -> a
unsafeDoIO (IO (CryptoFailable (Signature p)) -> CryptoFailable (Signature p))
-> IO (CryptoFailable (Signature p))
-> CryptoFailable (Signature p)
forall a b. (a -> b) -> a -> b
$ do
    -- B.zero, not B.alloc with an empty action: alloc hands back whatever
    -- was in the memory.  That made signDeterministic sign with the last
    -- caller's bytes and produce a different signature every time, which the
    -- ACVP vectors caught only once the whole suite ran and the allocator
    -- stopped handing out fresh zeroed pages.
    let zeroes :: ScrubbedBytes
zeroes = Int -> ScrubbedBytes
forall ba. ByteArray ba => Int -> ba
B.zero Int
signingRandomnessSize :: ScrubbedBytes
        withRnd :: (Ptr p -> IO a) -> IO a
withRnd Ptr p -> IO a
f = case Maybe rnd
mrnd of
            Just rnd
r -> rnd -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. rnd -> (Ptr p -> IO a) -> IO a
withByteArray rnd
r Ptr p -> IO a
f
            Maybe rnd
Nothing -> ScrubbedBytes -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
zeroes Ptr p -> IO a
f
    (CInt
r, Bytes
sig) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
B.allocRet (Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signatureSize Proxy p
p) ((Ptr Word8 -> IO CInt) -> IO (CInt, Bytes))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psig ->
        msg -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. msg -> (Ptr p -> IO a) -> IO a
withByteArray msg
msg ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pmsg ->
            Bytes -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withByteArray Bytes
pre ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ppre ->
                (Ptr Word8 -> IO CInt) -> IO CInt
forall {p} {a}. (Ptr p -> IO a) -> IO a
withRnd ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
prnd ->
                    SigningKey p -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. SigningKey p -> (Ptr p -> IO a) -> IO a
withByteArray SigningKey p
sk ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psk ->
                        Proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
forall (proxy :: * -> *).
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_sign
                            Proxy p
p
                            Ptr Word8
psig
                            Ptr Word8
pmsg
                            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (msg -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length msg
msg))
                            Ptr Word8
ppre
                            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
pre))
                            Ptr Word8
prnd
                            Ptr Word8
psk
                            CInt
0
    CryptoFailable (Signature p) -> IO (CryptoFailable (Signature p))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoFailable (Signature p) -> IO (CryptoFailable (Signature p)))
-> CryptoFailable (Signature p)
-> IO (CryptoFailable (Signature p))
forall a b. (a -> b) -> a -> b
$
        if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
            then Signature p -> CryptoFailable (Signature p)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> Signature p
forall p. Bytes -> Signature p
Signature Bytes
sig)
            else CryptoError -> CryptoFailable (Signature p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
  where
    p :: Proxy p
p = Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p
    pre :: Bytes
pre = Context -> Bytes
domainPrefix Context
ctx
{-# NOINLINE signInternal #-}

-- | Sign a message representative, drawing the randomness.
--
-- The context string is already inside the representative, which is why
-- this does not take one.
signExternalMu
    :: forall p m
     . (MLDSA p, MonadRandom m)
    => SigningKey p -> Mu -> m (Signature p)
signExternalMu :: forall p (m :: * -> *).
(MLDSA p, MonadRandom m) =>
SigningKey p -> Mu -> m (Signature p)
signExternalMu SigningKey p
sk Mu
m = do
    ScrubbedBytes
rnd <- Int -> m ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
signingRandomnessSize :: m ScrubbedBytes
    case SigningKey p -> Mu -> ScrubbedBytes -> CryptoFailable (Signature p)
forall p rnd.
(MLDSA p, ByteArrayAccess rnd) =>
SigningKey p -> Mu -> rnd -> CryptoFailable (Signature p)
signExternalMuWith SigningKey p
sk Mu
m ScrubbedBytes
rnd of
        CryptoPassed Signature p
s -> Signature p -> m (Signature p)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Signature p
s
        CryptoFailed CryptoError
e -> String -> m (Signature p)
forall a. HasCallStack => String -> a
error (String
"Crypto.PubKey.MLDSA.signExternalMu: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

-- | Sign a message representative with the randomness supplied.
signExternalMuWith
    :: (MLDSA p, ByteArrayAccess rnd)
    => SigningKey p -> Mu -> rnd -> CryptoFailable (Signature p)
signExternalMuWith :: forall p rnd.
(MLDSA p, ByteArrayAccess rnd) =>
SigningKey p -> Mu -> rnd -> CryptoFailable (Signature p)
signExternalMuWith SigningKey p
sk Mu
m rnd
rnd
    | rnd -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length rnd
rnd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
signingRandomnessSize = CryptoError -> CryptoFailable (Signature p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SeedSizeInvalid
    | Bool
otherwise = SigningKey p -> Mu -> Maybe rnd -> CryptoFailable (Signature p)
forall p rnd.
(MLDSA p, ByteArrayAccess rnd) =>
SigningKey p -> Mu -> Maybe rnd -> CryptoFailable (Signature p)
signMu SigningKey p
sk Mu
m (rnd -> Maybe rnd
forall a. a -> Maybe a
Just rnd
rnd)

-- | Sign a message representative deterministically.
signExternalMuDeterministic
    :: MLDSA p => SigningKey p -> Mu -> Signature p
signExternalMuDeterministic :: forall p. MLDSA p => SigningKey p -> Mu -> Signature p
signExternalMuDeterministic SigningKey p
sk Mu
m =
    case SigningKey p -> Mu -> Maybe Bytes -> CryptoFailable (Signature p)
forall p rnd.
(MLDSA p, ByteArrayAccess rnd) =>
SigningKey p -> Mu -> Maybe rnd -> CryptoFailable (Signature p)
signMu SigningKey p
sk Mu
m (Maybe Bytes
forall a. Maybe a
Nothing :: Maybe Bytes) of
        CryptoPassed Signature p
s -> Signature p
s
        CryptoFailed CryptoError
e ->
            String -> Signature p
forall a. HasCallStack => String -> a
error (String
"Crypto.PubKey.MLDSA.signExternalMuDeterministic: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

-- | Verify a signature of a message representative.
verifyExternalMu
    :: forall p. MLDSA p => VerificationKey p -> Mu -> Signature p -> Bool
verifyExternalMu :: forall p. MLDSA p => VerificationKey p -> Mu -> Signature p -> Bool
verifyExternalMu VerificationKey p
vk Mu
m Signature p
sig
    | Signature p -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Signature p
sig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signatureSize Proxy p
p = Bool
False
    | Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
unsafeDoIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        Signature p -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Signature p -> (Ptr p -> IO a) -> IO a
withByteArray Signature p
sig ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psig ->
            Mu -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Mu -> (Ptr p -> IO a) -> IO a
withByteArray Mu
m ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pmu ->
                VerificationKey p -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. VerificationKey p -> (Ptr p -> IO a) -> IO a
withByteArray VerificationKey p
vk ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pvk -> do
                    CInt
r <-
                        Proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
forall (proxy :: * -> *).
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_verify
                            Proxy p
p
                            Ptr Word8
psig
                            Ptr Word8
pmu
                            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
muSize)
                            Ptr Word8
forall a. Ptr a
nullPtr
                            CSize
0
                            Ptr Word8
pvk
                            CInt
1
                    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
  where
    p :: Proxy p
p = Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p
{-# NOINLINE verifyExternalMu #-}

-- The external-mu entry points are the ordinary ones with the last argument
-- set: the representative goes in where the message would, there is no
-- domain separation prefix to prepend because it is already inside, and the
-- implementation is told so.
signMu
    :: forall p rnd
     . (MLDSA p, ByteArrayAccess rnd)
    => SigningKey p -> Mu -> Maybe rnd -> CryptoFailable (Signature p)
signMu :: forall p rnd.
(MLDSA p, ByteArrayAccess rnd) =>
SigningKey p -> Mu -> Maybe rnd -> CryptoFailable (Signature p)
signMu SigningKey p
sk Mu
m Maybe rnd
mrnd = IO (CryptoFailable (Signature p)) -> CryptoFailable (Signature p)
forall a. IO a -> a
unsafeDoIO (IO (CryptoFailable (Signature p)) -> CryptoFailable (Signature p))
-> IO (CryptoFailable (Signature p))
-> CryptoFailable (Signature p)
forall a b. (a -> b) -> a -> b
$ do
    let zeroes :: ScrubbedBytes
zeroes = Int -> ScrubbedBytes
forall ba. ByteArray ba => Int -> ba
B.zero Int
signingRandomnessSize :: ScrubbedBytes
        withRnd :: (Ptr p -> IO a) -> IO a
withRnd Ptr p -> IO a
f = case Maybe rnd
mrnd of
            Just rnd
r -> rnd -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. rnd -> (Ptr p -> IO a) -> IO a
withByteArray rnd
r Ptr p -> IO a
f
            Maybe rnd
Nothing -> ScrubbedBytes -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
zeroes Ptr p -> IO a
f
    (CInt
r, Bytes
sig) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
B.allocRet (Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signatureSize Proxy p
p) ((Ptr Word8 -> IO CInt) -> IO (CInt, Bytes))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, Bytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psig ->
        Mu -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Mu -> (Ptr p -> IO a) -> IO a
withByteArray Mu
m ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pmu ->
            (Ptr Word8 -> IO CInt) -> IO CInt
forall {p} {a}. (Ptr p -> IO a) -> IO a
withRnd ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
prnd ->
                SigningKey p -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. SigningKey p -> (Ptr p -> IO a) -> IO a
withByteArray SigningKey p
sk ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psk ->
                    Proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
forall (proxy :: * -> *).
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_sign Proxy p
p Ptr Word8
psig Ptr Word8
pmu (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
muSize) Ptr Word8
forall a. Ptr a
nullPtr CSize
0 Ptr Word8
prnd Ptr Word8
psk CInt
1
    CryptoFailable (Signature p) -> IO (CryptoFailable (Signature p))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoFailable (Signature p) -> IO (CryptoFailable (Signature p)))
-> CryptoFailable (Signature p)
-> IO (CryptoFailable (Signature p))
forall a b. (a -> b) -> a -> b
$
        if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
            then Signature p -> CryptoFailable (Signature p)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> Signature p
forall p. Bytes -> Signature p
Signature Bytes
sig)
            else CryptoError -> CryptoFailable (Signature p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
  where
    p :: Proxy p
p = Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p
{-# NOINLINE signMu #-}

-- | Verify a signature.
--
-- The context must be the one it was signed under; anything else is a
-- rejection, which is what the context is for.
verify
    :: forall p msg
     . (MLDSA p, ByteArrayAccess msg)
    => VerificationKey p -> Context -> msg -> Signature p -> Bool
verify :: forall p msg.
(MLDSA p, ByteArrayAccess msg) =>
VerificationKey p -> Context -> msg -> Signature p -> Bool
verify VerificationKey p
vk Context
ctx msg
msg Signature p
sig
    | Signature p -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Signature p
sig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Proxy p -> Int
forall p (proxy :: * -> *). MLDSA p => proxy p -> Int
forall (proxy :: * -> *). proxy p -> Int
signatureSize Proxy p
p = Bool
False
    | Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
unsafeDoIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        Signature p -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Signature p -> (Ptr p -> IO a) -> IO a
withByteArray Signature p
sig ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psig ->
            msg -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. msg -> (Ptr p -> IO a) -> IO a
withByteArray msg
msg ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pmsg ->
                Bytes -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withByteArray Bytes
pre ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ppre ->
                    VerificationKey p -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. VerificationKey p -> (Ptr p -> IO a) -> IO a
withByteArray VerificationKey p
vk ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pvk -> do
                        CInt
r <-
                            Proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
forall (proxy :: * -> *).
proxy p
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_verify
                                Proxy p
p
                                Ptr Word8
psig
                                Ptr Word8
pmsg
                                (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (msg -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length msg
msg))
                                Ptr Word8
ppre
                                (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
pre))
                                Ptr Word8
pvk
                                CInt
0
                        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
  where
    p :: Proxy p
p = Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p
    pre :: Bytes
pre = Context -> Bytes
domainPrefix Context
ctx
{-# NOINLINE verify #-}

-- | The domain separation prefix of FIPS 204 for pure ML-DSA, which is a
-- zero byte, the context's length and the context itself.  It is built here
-- rather than taken from the implementation because it is three bytes of
-- concatenation and doing it here keeps one fewer foreign call.
domainPrefix :: Context -> Bytes
domainPrefix :: Context -> Bytes
domainPrefix (Context Bytes
ctx) =
    [Bytes] -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [[Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
B.pack [Word8
0, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
ctx)] :: Bytes, Bytes -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Bytes
ctx]

instance MLDSA MLDSA44 where
    verificationKeySize :: forall (proxy :: * -> *). proxy MLDSA44 -> Int
verificationKeySize proxy MLDSA44
_ = Int
1312
    signingKeySize :: forall (proxy :: * -> *). proxy MLDSA44 -> Int
signingKeySize proxy MLDSA44
_ = Int
2560
    signatureSize :: forall (proxy :: * -> *). proxy MLDSA44 -> Int
signatureSize proxy MLDSA44
_ = Int
2420
    c_keypair :: forall (proxy :: * -> *).
proxy MLDSA44 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_keypair proxy MLDSA44
_ = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_mldsa44_keypair
    c_sign :: forall (proxy :: * -> *).
proxy MLDSA44
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_sign proxy MLDSA44
_ = Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_mldsa44_sign
    c_verify :: forall (proxy :: * -> *).
proxy MLDSA44
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_verify proxy MLDSA44
_ = Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_mldsa44_verify
    c_pkFromSk :: forall (proxy :: * -> *).
proxy MLDSA44 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_pkFromSk proxy MLDSA44
_ = Ptr Word8 -> Ptr Word8 -> IO CInt
c_mldsa44_pk_from_sk

instance MLDSA MLDSA65 where
    verificationKeySize :: forall (proxy :: * -> *). proxy MLDSA65 -> Int
verificationKeySize proxy MLDSA65
_ = Int
1952
    signingKeySize :: forall (proxy :: * -> *). proxy MLDSA65 -> Int
signingKeySize proxy MLDSA65
_ = Int
4032
    signatureSize :: forall (proxy :: * -> *). proxy MLDSA65 -> Int
signatureSize proxy MLDSA65
_ = Int
3309
    c_keypair :: forall (proxy :: * -> *).
proxy MLDSA65 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_keypair proxy MLDSA65
_ = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_mldsa65_keypair
    c_sign :: forall (proxy :: * -> *).
proxy MLDSA65
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_sign proxy MLDSA65
_ = Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_mldsa65_sign
    c_verify :: forall (proxy :: * -> *).
proxy MLDSA65
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_verify proxy MLDSA65
_ = Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_mldsa65_verify
    c_pkFromSk :: forall (proxy :: * -> *).
proxy MLDSA65 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_pkFromSk proxy MLDSA65
_ = Ptr Word8 -> Ptr Word8 -> IO CInt
c_mldsa65_pk_from_sk

instance MLDSA MLDSA87 where
    verificationKeySize :: forall (proxy :: * -> *). proxy MLDSA87 -> Int
verificationKeySize proxy MLDSA87
_ = Int
2592
    signingKeySize :: forall (proxy :: * -> *). proxy MLDSA87 -> Int
signingKeySize proxy MLDSA87
_ = Int
4896
    signatureSize :: forall (proxy :: * -> *). proxy MLDSA87 -> Int
signatureSize proxy MLDSA87
_ = Int
4627
    c_keypair :: forall (proxy :: * -> *).
proxy MLDSA87 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_keypair proxy MLDSA87
_ = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_mldsa87_keypair
    c_sign :: forall (proxy :: * -> *).
proxy MLDSA87
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_sign proxy MLDSA87
_ = Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr Word8
-> CInt
-> IO CInt
c_mldsa87_sign
    c_verify :: forall (proxy :: * -> *).
proxy MLDSA87
-> Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_verify proxy MLDSA87
_ = Ptr Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CInt
-> IO CInt
c_mldsa87_verify
    c_pkFromSk :: forall (proxy :: * -> *).
proxy MLDSA87 -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_pkFromSk proxy MLDSA87
_ = Ptr Word8 -> Ptr Word8 -> IO CInt
c_mldsa87_pk_from_sk

foreign import ccall unsafe "crypton_mldsa44_keypair_internal"
    c_mldsa44_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
foreign import ccall unsafe "crypton_mldsa44_signature_internal"
    c_mldsa44_sign
        :: Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "crypton_mldsa44_verify_internal"
    c_mldsa44_verify
        :: Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "crypton_mldsa44_pk_from_sk"
    c_mldsa44_pk_from_sk :: Ptr Word8 -> Ptr Word8 -> IO CInt

foreign import ccall unsafe "crypton_mldsa65_keypair_internal"
    c_mldsa65_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
foreign import ccall unsafe "crypton_mldsa65_signature_internal"
    c_mldsa65_sign
        :: Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "crypton_mldsa65_verify_internal"
    c_mldsa65_verify
        :: Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "crypton_mldsa65_pk_from_sk"
    c_mldsa65_pk_from_sk :: Ptr Word8 -> Ptr Word8 -> IO CInt

foreign import ccall unsafe "crypton_mldsa87_keypair_internal"
    c_mldsa87_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
foreign import ccall unsafe "crypton_mldsa87_signature_internal"
    c_mldsa87_sign
        :: Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "crypton_mldsa87_verify_internal"
    c_mldsa87_verify
        :: Ptr Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> CSize
        -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "crypton_mldsa87_pk_from_sk"
    c_mldsa87_pk_from_sk :: Ptr Word8 -> Ptr Word8 -> IO CInt