vestigia

Detect where execution depends on secrets.
git clone git://git.ppad.tech/vestigia.git
Log | Files | Refs | README | LICENSE

Harness.hs (3575B)

      1 {-# LANGUAGE BangPatterns #-}
      2 {-# LANGUAGE ForeignFunctionInterface #-}
      3 
      4 -- | ppad-secp256k1 under vestigia: each run draws a fresh secret key
      5 --   (and Schnorr auxiliary randomness), marked secret, and runs the
      6 --   library's secret-key roots on fixed public messages: public key
      7 --   derivation, Schnorr and ECDSA signing (with and without a
      8 --   precomputed context), and ECDH against a fixed public peer.
      9 --
     10 --   usage: harness [RUNS [SEED]]
     11 --
     12 --   SEED (hex) seeds the secrets alone, so runs that differ in SEED
     13 --   differ only in their secrets.
     14 
     15 module Main (
     16     main
     17   ) where
     18 
     19 import Control.Monad (forM_)
     20 import qualified Crypto.Curve.Secp256k1 as S
     21 import Data.Bits (shiftR, xor, (.&.))
     22 import qualified Data.ByteString as BS
     23 import qualified Data.ByteString.Unsafe as BU
     24 import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)
     25 import Data.Word (Word64)
     26 import Foreign.C.Types (CSize(..))
     27 import Foreign.Ptr (Ptr, castPtr)
     28 import Numeric (readHex)
     29 import System.Environment (getArgs)
     30 
     31 foreign import ccall unsafe "vestigia_secret"
     32   c_secret :: Ptr () -> CSize -> IO ()
     33 
     34 foreign import ccall unsafe "vestigia_public"
     35   c_public :: Ptr () -> CSize -> IO ()
     36 
     37 mark :: (Ptr () -> CSize -> IO ()) -> BS.ByteString -> IO ()
     38 mark f bs =
     39   BU.unsafeUseAsCStringLen bs (\(p, n) -> f (castPtr p) (fromIntegral n))
     40 
     41 splitmix :: Word64 -> (Word64, Word64)
     42 splitmix s0 =
     43   let s = s0 + 0x9e3779b97f4a7c15
     44       z1 = (s `xor` (s `shiftR` 30)) * 0xbf58476d1ce4e5b9
     45       z2 = (z1 `xor` (z1 `shiftR` 27)) * 0x94d049bb133111eb
     46   in (z2 `xor` (z2 `shiftR` 31), s)
     47 
     48 bytes :: Int -> Word64 -> (BS.ByteString, Word64)
     49 bytes n s0 = go n s0 []
     50   where
     51     go 0 s acc = (BS.pack (reverse acc), s)
     52     go k s acc =
     53       let (x, s') = splitmix s in go (k - 1) s' (fromIntegral x : acc)
     54 
     55 -- a key below the group order: random bytes with the top bit clear
     56 key :: Word64 -> (BS.ByteString, Word64)
     57 key s =
     58   let (b, s') = bytes 32 s
     59   in case BS.uncons b of
     60        Just (h, t) -> (BS.cons (h .&. 0x7f) t, s')
     61        Nothing -> (b, s')
     62 
     63 -- a result's bytes, made public again: a signature is meant to be
     64 -- revealed
     65 reveal :: Maybe BS.ByteString -> IO Int
     66 reveal r = case r of
     67   Just b -> mark c_public b >> pure (BS.length b)
     68   Nothing -> pure 0
     69 
     70 -- a result forced, and nothing of it revealed
     71 forced :: Maybe a -> IO Int
     72 forced r = case r of
     73   Just !_ -> pure 1
     74   Nothing -> pure 0
     75 
     76 main :: IO ()
     77 main = do
     78   args <- getArgs
     79   let runs = case args of
     80         (r : _) | [ (n, "") ] <- reads r -> n
     81         _ -> 2 :: Int
     82       seed = case args of
     83         (_ : s : _) | [ (n, "") ] <- readHex s -> n
     84         _ -> 1
     85       (msg, p1) = bytes 32 0x0123456789abcdef
     86       (peerKey, _) = key p1
     87       !tex = S.precompute
     88   peer <- case S.parse_int256 peerKey >>= S.derive_pub of
     89     Just p -> pure p
     90     Nothing -> fail "no peer key"
     91   secrets <- newIORef seed
     92   total <- newIORef (0 :: Int)
     93   forM_ [ 1 .. runs ] $ \_ -> do
     94     s <- readIORef secrets
     95     let (skBytes, s1) = key s
     96         (aux, s2) = bytes 32 s1
     97     writeIORef secrets s2
     98     mark c_secret skBytes
     99     mark c_secret aux
    100     case S.parse_int256 skBytes of
    101       Nothing -> pure ()
    102       Just sk -> do
    103         n1 <- forced (S.derive_pub sk)
    104         n2 <- reveal (S.sign_schnorr sk msg aux)
    105         n3 <- reveal (S.sign_schnorr' tex sk msg aux)
    106         n4 <- forced (S.sign_ecdsa sk msg)
    107         n5 <- forced (S.sign_ecdsa' tex sk msg)
    108         n6 <- forced (S.ecdh peer sk)
    109         modifyIORef' total (+ (n1 + n2 + n3 + n4 + n5 + n6))
    110   n <- readIORef total
    111   putStrLn (show runs <> " run(s), " <> show n <> " result(s)")