module Crypto.RLWE.Challenges.Common where
import Crypto.RLWE.Challenges.Beacon
import Crypto.Lol.Cyclotomic.Tensor.CPP
import Crypto.Lol.Types hiding (RRq)
import qualified Crypto.Lol.Types as RRq
import Crypto.Proto.RLWE.Challenges.Challenge
import Crypto.Proto.RLWE.Challenges.InstanceCont
import Crypto.Proto.RLWE.Challenges.InstanceDisc
import Crypto.Proto.RLWE.Challenges.InstanceRLWR
import Crypto.Proto.RLWE.Challenges.Secret
import Crypto.Random.DRBG
import Control.Monad.Except
import Data.ByteString.Lazy (unpack)
import Data.Int
import Data.Maybe
import Net.Beacon
import System.Console.ANSI
import System.Directory (doesDirectoryExist, doesFileExist,
getDirectoryContents)
import System.FilePath ((</>))
import Text.Printf
type ChallengeID = Int32
type InstanceID = Int32
type InstDRBG = GenBuffered CtrDRBG
type T = CT
data ChallengeU = CU !Challenge ![InstanceU]
data InstanceU = IC {secret :: !Secret, instc :: !InstanceCont}
| ID {secret :: !Secret, instd :: !InstanceDisc}
| IR {secret :: !Secret, instr :: !InstanceRLWR}
type Zq q = ZqBasic q Int64
type RRq q = RRq.RRq q Double
challengeList :: (MonadIO m) => FilePath -> m [String]
challengeList path = liftIO $ do
challDirExists <- doesDirectoryExist path
unless challDirExists $ error $ "Could not find " ++ path
names <- filterM (doesDirectoryExist . (path </>)) =<<
filter (("chall" ==) . take 5) <$> getDirectoryContents path
when (null names) $ error "No challenges found."
return names
checkFileExists :: (MonadIO m, MonadError String m) => FilePath -> m ()
checkFileExists file = do
fileExists <- liftIO $ doesFileExist file
throwErrorUnless fileExists $
"Error reading " ++ file ++ ": file does not exist."
parseBeaconAddr :: (MonadError String m) => Challenge -> m BeaconAddr
parseBeaconAddr Challenge{..} = do
let ba = BA beaconEpoch beaconOffset
throwErrorUnless (validBeaconAddr ba) $ "Invalid beacon address: " ++ show ba
return ba
suppressedSecretID :: InstanceID -> Record -> Int32 -> InstanceID
suppressedSecretID numInstances record byteOffset =
let output = outputValue record
byte = unpack output !! fromIntegral byteOffset
in fromIntegral byte `mod` numInstances
challengeFilesDir :: FilePath -> String -> FilePath
challengeFilesDir path name = path </> name
challFilePath :: FilePath -> String -> FilePath
challFilePath path name = challengeFilesDir path name </> name ++ ".challenge"
instFilePath :: FilePath -> String -> InstanceID -> FilePath
instFilePath path name instID = challengeFilesDir path name </> name ++ "-" ++
instIDString instID ++ ".instance"
secretFilePath :: FilePath -> String -> InstanceID -> FilePath
secretFilePath path name instID = challengeFilesDir path name </> name ++ "-" ++
instIDString instID ++ ".secret"
beaconFilePath :: FilePath -> BeaconEpoch -> FilePath
beaconFilePath path t = path </> "epoch-" ++ show t ++ ".xml"
certFilePath :: FilePath -> FilePath
certFilePath path = path </> "beacon.cer"
instIDString :: InstanceID -> String
instIDString = printf "%02X"
throwErrorIf :: (MonadError String m) => Bool -> String -> m ()
throwErrorIf b = when b . throwError
throwErrorUnless :: (MonadError String m) => Bool -> String -> m ()
throwErrorUnless b = unless b . throwError
maybeThrowError :: (MonadError String m) => Maybe a -> String -> m a
maybeThrowError m str = do
throwErrorIf (isNothing m) str
return $ fromJust m
printPassFailGeneric :: (MonadIO m)
=> Color
-> String
-> String
-> ExceptT String m a
-> m (Maybe a)
printPassFailGeneric failColor str pass e = do
liftIO $ putStr str
res <- runExceptT e
case res of
(Left st) -> do printANSI failColor st
return Nothing
(Right a) -> do printANSI Green pass
return $ Just a
printPassFail, printPassWarn :: (MonadIO m)
=> String -> String -> ExceptT String m a -> m (Maybe a)
printPassFail = printPassFailGeneric Red
printPassWarn = printPassFailGeneric Yellow
printANSI :: (MonadIO m) => Color -> String -> m ()
printANSI sgr str = liftIO $ do
setSGR [SetColor Foreground Vivid sgr]
putStrLn str
setSGR [Reset]