Adam Wick
d459850c54
In general, it's a straight translation of the Google code, which in turn is "mostly taken from the ref10 version of Ed25519 in SUPERCOP 10241124.", except that it's been hand translated to rust with some test case generators. Future versions should clean this up to be more normally rust-y.
44 lines
1.6 KiB
Haskell
44 lines
1.6 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE PackageImports #-}
|
|
import Control.Concurrent(forkIO)
|
|
import Control.Concurrent.Chan(Chan,newChan,readChan,writeChan)
|
|
import Control.Concurrent.MVar(MVar,newMVar,modifyMVar)
|
|
import Control.Exception(SomeException,catch)
|
|
import Control.Monad(replicateM_,void)
|
|
import "crypto-api" Crypto.Random(CryptoRandomGen(..),SystemRandom)
|
|
import DSA(dsaTasks)
|
|
import ECDSATesting(ecdsaTasks)
|
|
import ED25519(ed25519Tasks)
|
|
import GHC.Conc(getNumCapabilities)
|
|
import RFC6979(rfcTasks)
|
|
import RSA(rsaTasks)
|
|
import System.Console.AsciiProgress
|
|
import Task(Task, runTask)
|
|
|
|
taskExecutor :: MVar [Task] -> Chan () -> SystemRandom -> IO SystemRandom
|
|
taskExecutor taskList done gen =
|
|
do mnext <- modifyMVar taskList (\case
|
|
[] -> return ([], Nothing)
|
|
(x:xs) -> return (xs, Just x))
|
|
case mnext of
|
|
Nothing -> do writeChan done ()
|
|
return gen
|
|
Just x -> do gen' <- runTask gen x
|
|
taskExecutor taskList done gen'
|
|
|
|
spawnExecutor :: MVar [Task] -> Chan () -> IO ()
|
|
spawnExecutor tasks done =
|
|
do gen <- newGenIO
|
|
void (forkIO (catch (void (taskExecutor tasks done gen)) handler))
|
|
where
|
|
handler :: SomeException -> IO ()
|
|
handler e = putStrLn ("ERROR: " ++ show e)
|
|
|
|
main :: IO ()
|
|
main = displayConsoleRegions $
|
|
do
|
|
executors <- getNumCapabilities
|
|
done <- newChan
|
|
tasks <- newMVar (dsaTasks ++ ecdsaTasks ++ rfcTasks ++ rsaTasks ++ ed25519Tasks)
|
|
replicateM_ executors (spawnExecutor tasks done)
|
|
replicateM_ executors (void $ readChan done) |