hjugement-web/src/Voting/Protocol/Cryptography.purs

   1 module Voting.Protocol.Cryptography where
   2
   3 import Effect (Effect)
   4 import Control.Applicative (pure)
   5 import Control.Monad (bind)
   6 import Data.Argonaut.Core as JSON
   7 import Data.Argonaut.Decode (class DecodeJson, decodeJson)
   8 import Data.Argonaut.Encode (class EncodeJson, encodeJson)
   9 import Data.Argonaut.Parser as JSON
  10 import Data.BigInt (BigInt)
  11 import Data.BigInt as BigInt
  12 import Data.Boolean (otherwise)
  13 import Data.Bounded (class Bounded, top)
  14 import Data.Either (Either(..))
  15 import Data.Eq (class Eq, (==), (/=))
  16 import Data.EuclideanRing (class EuclideanRing, (/), mod)
  17 import Data.Foldable (intercalate)
  18 import Data.Function (($), identity, (<<<), flip)
  19 import Data.Functor ((<$>))
  20 import Data.HeytingAlgebra ((&&))
  21 import Data.List (List, (:))
  22 import Data.Maybe (Maybe(..), maybe, fromJust)
  23 import Data.Monoid (class Monoid, mempty, (<>))
  24 import Data.Newtype (class Newtype, wrap, unwrap)
  25 import Data.Ord (class Ord, (>=))
  26 import Data.Reflection (class Reifies, reflect)
  27 import Data.Ring (class Ring, (-), negate)
  28 import Data.Semiring (class Semiring, zero, (+), one, (*))
  29 import Data.Show (class Show, show)
  30 import Data.String.CodeUnits as String
  31 import Node.Crypto as Crypto
  32 import Node.Crypto.Hash as Crypto
  33 import Effect.Random (randomInt)
  34 import Partial.Unsafe (unsafePartial)
  35 import Type.Proxy (Proxy(..))
  36
  37 import Voting.Protocol.Arithmetic
  38
  39 -- * Type 'Hash'
  40 newtype Hash crypto c = Hash (E crypto c)
  41 derive newtype instance eqHash   :: Eq   (Hash crypto c)
  42 derive newtype instance ordHash  :: Ord  (Hash crypto c)
  43 derive newtype instance showHash :: Show (Hash crypto c)
  44
  45 {-
  46 -- | @('hash' bs gs)@ returns as a number in 'G'
  47 -- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs'
  48 -- prefixing the decimal representation of given subgroup elements 'gs',
  49 -- with a comma (",") intercalated between them.
  50 --
  51 -- NOTE: to avoid any collision when the 'hash' function is used in different contexts,
  52 -- a message 'gs' is actually prefixed by a 'bs' indicating the context.
  53 --
  54 -- Used by 'proveEncryption' and 'verifyEncryption',
  55 -- where the 'bs' usually contains the 'statement' to be proven,
  56 -- and the 'gs' contains the 'commitments'.
  57 -}
  58 hash ::
  59  forall crypto c.
  60  CryptoParams crypto c =>
  61  String -> List (G crypto c) ->
  62  Effect (E crypto c)
  63 hash bs gs = do
  64   let s = bs <> intercalate "," (bytesNat <$> gs)
  65   h <- Crypto.hex Crypto.SHA256 s
  66   pure $ fromNatural $ Natural $
  67     unsafePartial $ fromJust $
  68     BigInt.fromBase 16 h
  69
  70 -- | `('bytesNat' x)` returns the serialization of `x`.
  71 bytesNat :: forall n. ToNatural n => n -> String
  72 bytesNat = show <<< nat
  73
  74 -- | `'randomBigInt' low high` returns a random 'BigInt' within `low` and `high`.
  75 --
  76 -- NOTE: adapted from GHC's 'randomIvalInteger'
  77 randomBigInt :: BigInt -> BigInt -> Effect BigInt
  78 randomBigInt l h = do
  79   v <- f one zero
  80   pure (l + v `mod` k)
  81   where
  82   srcLow  = one :: Int
  83   srcHigh = top :: Int
  84   -- | source interval
  85   b = BigInt.fromInt srcHigh - BigInt.fromInt srcLow + one
  86   -- | target interval
  87   k = h - l + one
  88   -- Probabilities of the most likely and least likely result
  89   -- will differ at most by a factor of (1 +- 1/q).
  90   -- Assuming the 'random' is uniform, of course.
  91   -- On average, log q / log b more random values will be generated
  92   -- than the minimum
  93   q = BigInt.fromInt 1000
  94   targetMagnitude = k * q
  95   -- generate random values until we exceed the target magnitude
  96   f mag acc
  97    | mag >= targetMagnitude = pure acc
  98    | otherwise = do
  99      r <- randomInt srcLow srcHigh
 100      f (mag * b)
 101        (acc * b + (BigInt.fromInt r - BigInt.fromInt srcLow))
 102
 103 randomE ::
 104  forall crypto c.
 105  CryptoParams crypto c =>
 106  Effect (E crypto c)
 107 randomE = E <<< Natural <$> randomBigInt zero (unwrap (nat (top::E crypto c)))