import Data.Maybe (Maybe(..), maybe)
import Data.Monoid (class Monoid, mempty, (<>))
import Data.Newtype (class Newtype, wrap, unwrap)
-import Data.Ord (class Ord, (<))
+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 Effect.Exception.Unsafe (unsafeThrow)
import Type.Proxy (Proxy(..))
-- * Type 'Natural'
nat :: a -> Natural
instance toNaturalBigInt :: ToNatural Natural where
nat = identity
+instance toNaturalInt :: ToNatural Int where
+ nat x | 0 <= x = wrap (BigInt.fromInt x)
+ | otherwise = unsafeThrow "nat: given Int is negative"
-- * Class 'Additive'
import Control.Applicative (pure, (<*>))
import Control.Monad (bind, join)
import Control.Monad.Trans.Class (lift)
-import Control.Monad.Except.Trans (ExceptT)
+import Control.Monad.Except.Trans (ExceptT, throwError)
import Data.Argonaut.Core as JSON
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:))
import Data.Argonaut.Encode (class EncodeJson, encodeJson, (:=), (:=?), (~>), (~>?))
import Partial.Unsafe (unsafePartial)
import Type.Proxy (Proxy(..))
+import Voting.Protocol.Utils
import Voting.Protocol.Arithmetic
import Voting.Protocol.Version
let proofs = prevFakeProofs <> (genuineProof : nextFakeProofs)
pure (DisjProof proofs)
-{-
verifyEncryption ::
forall crypto v c.
Reifies v Version =>
List (Disjunction crypto c) -> Tuple (Encryption crypto v c) (DisjProof crypto v c) ->
ExceptT ErrorVerifyEncryption Effect Boolean
verifyEncryption elecPubKey voterZKP disjs (Tuple enc (DisjProof proofs)) =
- case isoZipWith (encryptionCommitments elecPubKEy enc) disjs proofs of
+ case isoZipWith (encryptionCommitments elecPubKey enc) disjs proofs of
Nothing ->
- throwE $ ErrorVerifyEncryption_InvalidProofLength
- (fromIntegral $ List.length proofs)
- (fromIntegral $ List.length disjs)
+ throwError $ ErrorVerifyEncryption_InvalidProofLength
+ (nat $ List.length proofs)
+ (nat $ List.length disjs)
Just commitments -> do
h <- lift $ hash (encryptionStatement voterZKP enc) (join commitments)
pure (challengeSum == h)
where
challengeSum = sum ((\(Proof p) -> p.proof_challenge) <$> proofs)
--}
-- ** Hashing
encryptionStatement ::
-- the number of 'Disjunction's.
-- deriving (Eq,Show)
-{-
-- * Type 'Signature'
-- | Schnorr-like signature.
--
-- using his/her 'Credential',
-- in order to avoid ballot stuffing.
data Signature crypto v c = Signature
- { signature_publicKey :: !(PublicKey crypto c)
+ { signature_publicKey :: PublicKey crypto c
-- ^ Verification key.
- , signature_proof :: !(Proof crypto v c)
- } deriving (Generic)
-deriving instance (NFData crypto, NFData (G crypto c)) => NFData (Signature crypto v c)
-instance
+ , signature_proof :: Proof crypto v c
+ }
+instance encodeJsonSignature ::
( Reifies v Version
, CryptoParams crypto c
- ) => ToJSON (Signature crypto v c) where
- toJSON (Signature pubKey Proof{..}) =
- JSON.object
- [ "public_key" .= pubKey
- , "challenge" .= proof_challenge
- , "response" .= proof_response
- ]
- toEncoding (Signature pubKey Proof{..}) =
- JSON.pairs
- ( "public_key" .= pubKey
- <> "challenge" .= proof_challenge
- <> "response" .= proof_response
- )
-instance
+ ) => EncodeJson (Signature crypto v c) where
+ encodeJson (Signature{signature_publicKey:pubKey, signature_proof:Proof p}) =
+ "public_key" := pubKey ~>
+ "challenge" := p.proof_challenge ~>
+ "response" := p.proof_response ~>
+ JSON.jsonEmptyObject
+instance decodeJsonSignature ::
( Reifies v Version
, CryptoParams crypto c
- ) => FromJSON (Signature crypto v c) where
- parseJSON = JSON.withObject "Signature" $ \o -> do
- signature_publicKey <- o .: "public_key"
- proof_challenge <- o .: "challenge"
- proof_response <- o .: "response"
- let signature_proof = Proof{..}
- pure Signature{..}
--}
+ ) => DecodeJson (Signature crypto v c) where
+ decodeJson json = do
+ obj <- decodeJson json
+ signature_publicKey <- obj .: "public_key"
+ proof_challenge <- obj .: "challenge"
+ proof_response <- obj .: "response"
+ let signature_proof = Proof{proof_challenge, proof_response}
+ pure $ Signature{signature_publicKey, signature_proof}
--- /dev/null
+module Voting.Protocol.Utils where
+
+import Control.Applicative (class Applicative, (<$))
+import Data.Boolean (otherwise)
+import Data.Eq (class Eq, (==), (/=))
+import Data.Function (($))
+import Data.List (List, (:))
+import Data.List as List
+import Data.List.Lazy as LL
+import Data.Maybe (Maybe(..), maybe)
+import Data.Traversable (sequence)
+import Data.Unit (Unit)
+
+-- | The 'zipWith3' function takes a function which combines three
+-- elements, as well as three lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith3 :: forall a b c d. (a->b->c->d) -> List a->List b->List c->List d
+zipWith3 z = go
+ where
+ go (a:as) (b:bs) (c:cs) = z a b c : go as bs cs
+ go _ _ _ = List.Nil
+
+-- | NOTE: check the lengths before applying @f@.
+isoZipWith :: forall a b c. (a->b->c) -> List a->List b->Maybe (List c)
+isoZipWith f as bs
+ | List.length as /= List.length bs = Nothing
+ | otherwise = Just (List.zipWith f as bs)
+
+-- | NOTE: check the lengths before applying @f@.
+isoZipWith3 :: forall a b c d. (a->b->c->d) -> List a->List b->List c->Maybe (List d)
+isoZipWith3 f as bs cs
+ | List.length as /= List.length bs = Nothing
+ | List.length as /= List.length cs = Nothing
+ | otherwise = Just (zipWith3 f as bs cs)
+
+isoZipWithM :: forall f a b c.
+ Applicative f =>
+ f Unit -> (a->b->f c) -> List a->List b->f (List c)
+isoZipWithM err f as bs =
+ maybe (List.Nil <$ err) sequence $
+ isoZipWith f as bs
sourcephile / git / majurity.git / commitdiff