From 924eb9eca84d3f26182227d8d4b4fd309bdf9005 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Thu, 27 Feb 2020 15:04:21 +0100 Subject: [PATCH] web: impl: continue to transcode Voting.Protocol.Cryptography --- .../src/Voting/Protocol/Arithmetic.purs | 6 +- .../src/Voting/Protocol/Cryptography.purs | 60 ++++++++----------- hjugement-web/src/Voting/Protocol/Utils.purs | 41 +++++++++++++ 3 files changed, 71 insertions(+), 36 deletions(-) create mode 100644 hjugement-web/src/Voting/Protocol/Utils.purs diff --git a/hjugement-web/src/Voting/Protocol/Arithmetic.purs b/hjugement-web/src/Voting/Protocol/Arithmetic.purs index 83209e6..ec5414c 100644 --- a/hjugement-web/src/Voting/Protocol/Arithmetic.purs +++ b/hjugement-web/src/Voting/Protocol/Arithmetic.purs @@ -21,12 +21,13 @@ import Data.List.Lazy as LL 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' @@ -49,6 +50,9 @@ class ToNatural a where 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' diff --git a/hjugement-web/src/Voting/Protocol/Cryptography.purs b/hjugement-web/src/Voting/Protocol/Cryptography.purs index d9b9e90..530a16e 100644 --- a/hjugement-web/src/Voting/Protocol/Cryptography.purs +++ b/hjugement-web/src/Voting/Protocol/Cryptography.purs @@ -3,7 +3,7 @@ module Voting.Protocol.Cryptography where 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, (:=), (:=?), (~>), (~>?)) @@ -42,6 +42,7 @@ import Node.Crypto.Hash as Crypto import Partial.Unsafe (unsafePartial) import Type.Proxy (Proxy(..)) +import Voting.Protocol.Utils import Voting.Protocol.Arithmetic import Voting.Protocol.Version @@ -477,7 +478,6 @@ proveEncryption elecPubKey voterZKP (Tuple prevDisjs nextDisjs) (Tuple encNonce let proofs = prevFakeProofs <> (genuineProof : nextFakeProofs) pure (DisjProof proofs) -{- verifyEncryption :: forall crypto v c. Reifies v Version => @@ -486,17 +486,16 @@ verifyEncryption :: 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 :: @@ -537,7 +536,6 @@ data ErrorVerifyEncryption -- the number of 'Disjunction's. -- deriving (Eq,Show) -{- -- * Type 'Signature' -- | Schnorr-like signature. -- @@ -545,35 +543,27 @@ data ErrorVerifyEncryption -- 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} diff --git a/hjugement-web/src/Voting/Protocol/Utils.purs b/hjugement-web/src/Voting/Protocol/Utils.purs new file mode 100644 index 0000000..3b220be --- /dev/null +++ b/hjugement-web/src/Voting/Protocol/Utils.purs @@ -0,0 +1,41 @@ +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 -- 2.44.1