From 9ff2f4dbe493f9db0800ef5c9fb9d9893013c9df Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+hjugement@autogeree.net>
Date: Fri, 19 Apr 2019 00:40:21 +0000
Subject: [PATCH] protocol: Add Credential
---
hjugement-protocol/Protocol/Credential.hs | 99 ++++++++++++++++++
hjugement-protocol/hjugement-protocol.cabal | 110 +++++++++++++++++---
hjugement-protocol/test/HUnit.hs | 11 ++
hjugement-protocol/test/HUnit/Credential.hs | 43 ++++++++
hjugement-protocol/test/HUnit/Utils.hs | 37 +++++++
5 files changed, 284 insertions(+), 16 deletions(-)
create mode 100644 hjugement-protocol/Protocol/Credential.hs
create mode 100644 hjugement-protocol/test/HUnit.hs
create mode 100644 hjugement-protocol/test/HUnit/Credential.hs
create mode 100644 hjugement-protocol/test/HUnit/Utils.hs
diff --git a/hjugement-protocol/Protocol/Credential.hs b/hjugement-protocol/Protocol/Credential.hs
new file mode 100644
index 0000000..9e7222e
--- /dev/null
+++ b/hjugement-protocol/Protocol/Credential.hs
@@ -0,0 +1,99 @@
+module Protocol.Credential where
+
+import Control.Monad (Monad(..), replicateM)
+import Data.Bool
+import Data.Eq (Eq(..))
+import Data.Either (Either(..))
+import Data.Function (($), (.))
+import Data.Functor ((<$>))
+import Data.Int (Int)
+import Data.Ord (Ord(..))
+import Data.Text (Text)
+import Prelude (Integral(..), fromIntegral)
+import Text.Show (Show)
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified System.Random as Random
+
+import Protocol.Arith
+
+-- * Type 'Credential'
+-- | A 'Credential' is a word of 15-characters from the alphabet:
+-- "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz".
+-- The last character is a checksum.
+-- The entropy is: @(14 * log (9+26+26) / log 2) ~ 83.03 bits@.
+newtype Credential p = Credential Text
+ deriving (Eq, Show)
+
+tokenBase :: F p
+tokenBase = F (9+26+26)
+tokenLength ::Int
+tokenLength = 14
+
+random ::
+ Monad m =>
+ Random.RandomGen r =>
+ Random.Random i =>
+ Negable i =>
+ Multiplicative i =>
+ i -> S.StateT r m i
+random i = S.StateT $ return . Random.randomR (zero, i-one)
+
+-- | @'randomCredential'@ generates a random credential.
+randomCredential ::
+ forall m p r.
+ Monad m =>
+ PrimeField p =>
+ Random.RandomGen r =>
+ S.StateT r m (Credential p)
+randomCredential = do
+ rs <- replicateM tokenLength (random (fromIntegral (unF tokenBase)))
+ let (tot, cs) = List.foldl' (\(acc,ds) d ->
+ ( acc * tokenBase + F (fromIntegral d)
+ , charOfDigit d : ds
+ )
+ ) (zero::F p, []) rs
+ let checksum = 53 - fromIntegral (unF tot `mod` 53)
+ return $ Credential $ Text.reverse $ Text.pack (charOfDigit checksum:cs)
+ where
+ charOfDigit d
+ | d < 9 = Char.chr (Char.ord '1'+d)
+ | d < (9+26) = Char.chr (Char.ord 'A'+d-9)
+ | otherwise = Char.chr (Char.ord 'a'+d-9-26)
+
+-- | @'readCredential'@ reads and check the well-formedness of a 'Credential'
+-- from raw 'Text'.
+readCredential ::
+ forall p.
+ PrimeField p =>
+ Text -> Either CredentialError (Credential p)
+readCredential s
+ | Text.length s /= tokenLength + 1 = Left CredentialError_Length
+ | otherwise = do
+ tot <- Text.foldl'
+ (\acc c -> acc >>= \a -> ((a * tokenBase) +) <$> digitOfChar c)
+ (Right (zero::F p))
+ (Text.init s)
+ checksum <- digitOfChar (Text.last s)
+ if unF (tot + checksum) `mod` 53 == 0
+ then Right (Credential s)
+ else Left CredentialError_Checksum
+ where
+ digitOfChar c
+ | c < '1' = err
+ | c <= '9' = Right (primeField $ Char.ord c - Char.ord '1')
+ | c < 'A' = err
+ | c <= 'Z' = Right (primeField $ Char.ord c - Char.ord 'A' + 9)
+ | c < 'a' = err
+ | c <= 'z' = Right (primeField $ Char.ord c - Char.ord 'a' + 9 + 26)
+ | otherwise = err
+ where err = Left $ CredentialError_BadChar c
+
+-- ** Type 'CredentialError'
+data CredentialError
+ = CredentialError_BadChar Char.Char
+ | CredentialError_Checksum
+ | CredentialError_Length
+ deriving (Eq, Show)
diff --git a/hjugement-protocol/hjugement-protocol.cabal b/hjugement-protocol/hjugement-protocol.cabal
index 331fc97..4b4295f 100644
--- a/hjugement-protocol/hjugement-protocol.cabal
+++ b/hjugement-protocol/hjugement-protocol.cabal
@@ -1,13 +1,14 @@
-name: hjugement-heliosc
+name: hjugement-protocol
-- PVP: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
version: 0.0.0.20190415
category: Politic
-synopsis: Helios-C fully distributed threshold cryptosystem for the Majority Judgment.
+synopsis: A fully distributed threshold cryptosystem for the Majority Judgment.
description:
- <https://eprint.iacr.org/2013/177.pdf Helios-C> (Helios with Credentials)
- is a variant of Helios that is:
+ This library implements an online voting protocol
+ known as <https://eprint.iacr.org/2013/177.pdf Helios-C> (Helios with Credentials)
+ which is:
.
* /fully correct/: the published result are proven to correspond
to the (sum of) intended votes of the voters,
@@ -34,18 +35,40 @@ description:
This allows a testing of duplicates which depends only on the size of the number of voters,
and thus enables Helios-C to scale for larger elections while attaining correctness.
.
- Helios-C uses:
+ In this protocol :
.
- * A 256-bit multiplicative subgroup of a 2048-bit finite prime field,
- for signing with a Schnorr-like NIZK proof,
- and encrypting with an ElGamal-like scheme.
+ * Ballots are encrypted using public-key cryptography
+ secured by the /Discrete Logarithm problem/:
+ finding @x@ in @g^x `mod` p@, where @p@ is a large prime
+ and @g@ a generator of @Gq@, the multiplicative subgroup of @Fp@
+ (the finite prime field whose characteristic is @p@) of order @q@.
+ Here, @p@ is 2048-bit and @q@ is 256-bit.
+ The signing (Schnorr-like), the encrypting (ElGamal-like)
+ and the /Decisional Diffe Hellman/ (DDH) assumption,
+ all rely on the hardness of that problem.
+ * Ballots are added without being decrypted
+ because adding ciphertexts then decrypting
+ is like decrypting then adding plaintexts (/additive homomorphism/).
+ This uses an /ElGamal encryption scheme/ with
+ a transformation so that from being a /multiplicative homomorphism/
+ it becomes an /additive homomorphism/.
+ Which requires to solve the /Discrete Logarithm Problem/
+ for numbers in the order of the number of voters,
+ which is not hard for small numbers (with a lookup table as here,
+ or with Pollardâs rho algorithm for logarithms).
* A Pedersen's /distributed key generation/ (DKG) protocol
- coupled with ElGamal under the Decision Diffie-Hellman (DDH) assumption,
- to have a fully distributed semantically secure (IND-CPA) encryption.
- * An ad-hoc Fiat-Shamir transform proving the well-formedness of ciphertexts,
- applied to a Disjunctive Chaum-Pedersen NIZK proof
- asserting that two given ciphertexts belonging to different voters
- with public credentials are encryptions of 0 or 1.
+ coupled with ElGamal keys (under the DDH assumption),
+ is used to have a fully distributed semantically secure encryption.
+ * The /Schnorr protocol/ is used to prove that a voter has knowledge
+ of the secret key used to encrypt their votes.
+ * The /Chaum-Pedersen protocol/ (proving that equality of discrete logarithms)
+ is used to prove that two given ciphertexts
+ belonging to two voters with different public credentials,
+ are well-formed (encrypting a 0 or a 1) without decrypting them.
+ Which is known as a /Disjunctive Chaum-Pedersen/ proof of partial knowledge.
+ * A /Fiat-Shamir transformation/ is used
+ to transform the /interactive zero-knowledge/ (IZK) /Chaum-Pedersen protocol/
+ into a /non-interactive zero-knowledge/ (NIZK) proof, using a SHA256 hash.
extra-doc-files:
license: GPL-3
license-file: COPYING
@@ -68,17 +91,24 @@ Source-Repository head
Library
exposed-modules:
- Heliosc.Arith
- Heliosc.Crypto
+ Protocol.Arith
+ Protocol.Credential
default-language: Haskell2010
default-extensions:
+ AllowAmbiguousTypes
DefaultSignatures
FlexibleContexts
FlexibleInstances
+ GeneralizedNewtypeDeriving
MonoLocalBinds
+ MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude
+ NoMonomorphismRestriction
ScopedTypeVariables
+ TypeApplications
+ TypeFamilies
+ UndecidableInstances
ghc-options:
-Wall
-Wincomplete-uni-patterns
@@ -93,5 +123,53 @@ Library
, hashable >= 1.2.6
, memory >= 0.14
, random >= 1.1
+ , reflection >= 2.1
+ , transformers >= 0.5
+ , unordered-containers >= 0.2.8
+
+Test-Suite hjugement-protocol-test
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ other-modules:
+ HUnit
+ HUnit.Arith
+ HUnit.Credential
+ HUnit.Utils
+ -- QuickCheck
+ default-language: Haskell2010
+ default-extensions:
+ AllowAmbiguousTypes
+ DefaultSignatures
+ FlexibleContexts
+ FlexibleInstances
+ GeneralizedNewtypeDeriving
+ MonoLocalBinds
+ MultiParamTypeClasses
+ NamedFieldPuns
+ NoImplicitPrelude
+ NoMonomorphismRestriction
+ ScopedTypeVariables
+ TypeApplications
+ TypeFamilies
+ UndecidableInstances
+ ghc-options:
+ -Wall
+ -Wincomplete-uni-patterns
+ -Wincomplete-record-updates
+ -fno-warn-tabs
+ -- -fhide-source-paths
+ build-depends:
+ hjugement-protocol
+ , base >= 4.6 && < 5
+ , containers >= 0.5
+ , hashable >= 1.2.6
+ , QuickCheck >= 2.0
+ , random >= 1.1
+ , reflection >= 2.1
+ , tasty >= 0.11
+ , tasty-hunit >= 0.9
+ , tasty-quickcheck
+ , text >= 1.2
, transformers >= 0.5
, unordered-containers >= 0.2.8
diff --git a/hjugement-protocol/test/HUnit.hs b/hjugement-protocol/test/HUnit.hs
new file mode 100644
index 0000000..a03204d
--- /dev/null
+++ b/hjugement-protocol/test/HUnit.hs
@@ -0,0 +1,11 @@
+module HUnit where
+import Test.Tasty
+import qualified HUnit.Arith
+import qualified HUnit.Credential
+
+hunits :: TestTree
+hunits =
+ testGroup "HUnit"
+ [ HUnit.Arith.hunit
+ , HUnit.Credential.hunit
+ ]
diff --git a/hjugement-protocol/test/HUnit/Credential.hs b/hjugement-protocol/test/HUnit/Credential.hs
new file mode 100644
index 0000000..d680189
--- /dev/null
+++ b/hjugement-protocol/test/HUnit/Credential.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+module HUnit.Credential where
+
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified System.Random as Random
+
+import Protocol.Arith
+import Protocol.Credential
+import HUnit.Utils
+
+hunit :: TestTree
+hunit = testGroup "Credential"
+ [ testGroup "randomCredential"
+ [ testCase "WeakParams" $
+ S.evalState randomCredential (Random.mkStdGen 0) @?=
+ Credential @WeakParams "RDfIgdmiCkU46pK"
+ , testCase "BeleniosParams" $
+ S.evalState randomCredential (Random.mkStdGen 0) @?=
+ Credential @BeleniosParams "RDfIgdmiCkU46pr"
+ ]
+ , testGroup "readCredential"
+ [ testGroup "WeakParams" $
+ let (==>) inp (exp::Either CredentialError (Credential WeakParams)) =
+ testCase (show inp) $ readCredential inp @?= exp in
+ [ "" ==> Left CredentialError_Length
+ , "RDfIgdmiCkU46_K" ==> Left (CredentialError_BadChar '_')
+ , "RDfIgdmiCkU462" ==> Left CredentialError_Length
+ , "RDfIgdmiCkU46pKE" ==> Left CredentialError_Length
+ , "RDfIgdmiCkU46pJ" ==> Left CredentialError_Checksum
+ , "RDfIgdmiCkU46pK" ==> Right (Credential "RDfIgdmiCkU46pK")
+ ]
+ , testGroup "BeleniosParams" $
+ let (==>) inp (exp::Either CredentialError (Credential BeleniosParams)) =
+ testCase (show inp) $ readCredential inp @?= exp in
+ [ "RDfIgdmiCkU46R" ==> Left CredentialError_Length
+ , "RDfIgdmiCkU46pKR" ==> Left CredentialError_Length
+ , "RDfIgdmiCkU46ps" ==> Left CredentialError_Checksum
+ , "RDfIgdmiCkU46pr" ==> Right (Credential "RDfIgdmiCkU46pr")
+ ]
+ ]
+ ]
diff --git a/hjugement-protocol/test/HUnit/Utils.hs b/hjugement-protocol/test/HUnit/Utils.hs
new file mode 100644
index 0000000..ae9fa89
--- /dev/null
+++ b/hjugement-protocol/test/HUnit/Utils.hs
@@ -0,0 +1,37 @@
+module HUnit.Utils
+ ( module Test.Tasty
+ , module Test.Tasty.HUnit
+ , Monad(..), replicateM, when
+ , module Data.Bool
+ , Eq(..)
+ , Either(..)
+ , ($), (.)
+ , (<$>)
+ , Int
+ , Maybe(..)
+ , Monoid(..)
+ , Ord(..)
+ , String
+ , Text
+ , Word8
+ , Num, Fractional(..), Integral(..), Integer, undefined, fromIntegral
+ , Show(..)
+ ) where
+
+import Control.Monad (Monad(..), replicateM, when)
+import Data.Bool
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Function (($), (.))
+import Data.Functor ((<$>))
+import Data.Int (Int)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.String (String)
+import Data.Text (Text)
+import Data.Word (Word8)
+import Prelude (Num, Fractional(..), Integral(..), Integer, undefined, fromIntegral)
+import Test.Tasty
+import Test.Tasty.HUnit
+import Text.Show (Show(..))
--
2.47.2