module Voting.Protocol.Cryptography where import Effect (Effect) import Control.Applicative (pure) import Control.Monad (bind) import Data.Argonaut.Core as JSON import Data.Argonaut.Decode (class DecodeJson, decodeJson) import Data.Argonaut.Encode (class EncodeJson, encodeJson) import Data.Argonaut.Parser as JSON import Data.BigInt (BigInt) import Data.BigInt as BigInt import Data.Boolean (otherwise) import Data.Bounded (class Bounded, top) import Data.Either (Either(..)) import Data.Eq (class Eq, (==), (/=)) import Data.EuclideanRing (class EuclideanRing, (/), mod) import Data.Foldable (intercalate) import Data.Function (($), identity, (<<<), flip) import Data.Functor ((<$>)) import Data.HeytingAlgebra ((&&)) import Data.List (List, (:)) import Data.Maybe (Maybe(..), maybe, fromJust) import Data.Monoid (class Monoid, mempty, (<>)) import Data.Newtype (class Newtype, wrap, unwrap) import Data.Ord (class Ord, (>=)) import Data.Reflection (class Reifies, reflect) import Data.Ring (class Ring, (-), negate) import Data.Semiring (class Semiring, zero, (+), one, (*)) import Data.Show (class Show, show) import Data.String.CodeUnits as String import Node.Crypto as Crypto import Node.Crypto.Hash as Crypto import Effect.Random (randomInt) import Partial.Unsafe (unsafePartial) import Type.Proxy (Proxy(..)) import Voting.Protocol.Arithmetic -- * Type 'Hash' newtype Hash crypto c = Hash (E crypto c) derive newtype instance eqHash :: Eq (Hash crypto c) derive newtype instance ordHash :: Ord (Hash crypto c) derive newtype instance showHash :: Show (Hash crypto c) {- -- | @('hash' bs gs)@ returns as a number in 'G' -- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs' -- prefixing the decimal representation of given subgroup elements 'gs', -- with a comma (",") intercalated between them. -- -- NOTE: to avoid any collision when the 'hash' function is used in different contexts, -- a message 'gs' is actually prefixed by a 'bs' indicating the context. -- -- Used by 'proveEncryption' and 'verifyEncryption', -- where the 'bs' usually contains the 'statement' to be proven, -- and the 'gs' contains the 'commitments'. -} hash :: forall crypto c. CryptoParams crypto c => String -> List (G crypto c) -> Effect (E crypto c) hash bs gs = do let s = bs <> intercalate "," (bytesNat <$> gs) h <- Crypto.hex Crypto.SHA256 s pure $ fromNatural $ Natural $ unsafePartial $ fromJust $ BigInt.fromBase 16 h -- | `('bytesNat' x)` returns the serialization of `x`. bytesNat :: forall n. ToNatural n => n -> String bytesNat = show <<< nat -- | `'randomBigInt' low high` returns a random 'BigInt' within `low` and `high`. -- -- NOTE: adapted from GHC's 'randomIvalInteger' randomBigInt :: BigInt -> BigInt -> Effect BigInt randomBigInt l h = do v <- f one zero pure (l + v `mod` k) where srcLow = one :: Int srcHigh = top :: Int -- | source interval b = BigInt.fromInt srcHigh - BigInt.fromInt srcLow + one -- | target interval k = h - l + one -- Probabilities of the most likely and least likely result -- will differ at most by a factor of (1 +- 1/q). -- Assuming the 'random' is uniform, of course. -- On average, log q / log b more random values will be generated -- than the minimum q = BigInt.fromInt 1000 targetMagnitude = k * q -- generate random values until we exceed the target magnitude f mag acc | mag >= targetMagnitude = pure acc | otherwise = do r <- randomInt srcLow srcHigh f (mag * b) (acc * b + (BigInt.fromInt r - BigInt.fromInt srcLow)) randomE :: forall crypto c. CryptoParams crypto c => Effect (E crypto c) randomE = E <<< Natural <$> randomBigInt zero (unwrap (nat (top::E crypto c)))