protocol: fix election_hash

diff --git a/hjugement-protocol/benchmarks/Election.hs b/hjugement-protocol/benchmarks/Election.hs
index c51b40d84b48162b6efbe96036b22d8552a372cb..10dc7bcdb447f2e9a8475ece957c63f5876d4c64 100644 (file)
--- a/hjugement-protocol/benchmarks/Election.hs
+++ b/hjugement-protocol/benchmarks/Election.hs
@@ -9,22 +9,25 @@ import Voting.Protocol
 import Utils
 
 makeElection :: forall c. Reifies c FFC => Int -> Int -> Election c
-makeElection nQuests nChoices = hashElection $ Election
- { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices
- , election_description = "benchmarkable election"
- , election_uuid
- , election_crypto = ElectionCrypto_FFC (reflect (Proxy::Proxy c)) $
-       let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in
-       publicKey secKey
- , election_hash = Hash ""
- , election_questions =
-       (<$> [1..nQuests]) $ \quest -> Question
-        { question_text = Text.pack $ "quest"<>show quest
-        , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice
-        , question_mini = one
-        , question_maxi = one -- sum $ List.replicate nChoices one
+makeElection nQuests nChoices = elec
+       where
+       election_uuid = UUID "xLcs7ev6Jy6FHH"
+       elec = Election
+        { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices
+        , election_description = "benchmarkable election"
+        , election_uuid
+        , election_crypto = ElectionCrypto_FFC (reflect (Proxy::Proxy c)) $
+               let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in
+               publicKey secKey
+        , election_hash = hashElection elec
+        , election_questions =
+               (<$> [1..nQuests]) $ \quest -> Question
+                { question_text = Text.pack $ "quest"<>show quest
+                , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice
+                , question_mini = one
+                , question_maxi = one -- sum $ List.replicate nChoices one
+                }
         }
- } where election_uuid = UUID "xLcs7ev6Jy6FHH"
 
 makeVotes :: Election c -> [[Bool]]
 makeVotes Election{..} =

diff --git a/hjugement-protocol/src/Voting/Protocol/Election.hs b/hjugement-protocol/src/Voting/Protocol/Election.hs
index 39ad1607a5a1a291afabea7b3eec4631a999dfe3..1dc16db1f4208c35fa83488becc69e362abfe64c 100644 (file)
--- a/hjugement-protocol/src/Voting/Protocol/Election.hs
+++ b/hjugement-protocol/src/Voting/Protocol/Election.hs
@@ -10,7 +10,7 @@ import Control.Applicative (Applicative(..))
 import Control.DeepSeq (NFData)
 import Control.Monad (Monad(..), join, mapM, replicateM, zipWithM)
 import Control.Monad.Trans.Class (MonadTrans(..))
-import Control.Monad.Trans.Except (ExceptT, runExcept, throwE, withExceptT)
+import Control.Monad.Trans.Except (ExceptT(..), runExcept, throwE, withExceptT)
 import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=))
 import Data.Bool
 import Data.Either (either)
@@ -23,6 +23,7 @@ import Data.Maybe (Maybe(..), maybe, fromJust)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
+import Data.String (String)
 import Data.Text (Text)
 import Data.Traversable (Traversable(..))
 import Data.Tuple (fst, snd)
@@ -30,11 +31,11 @@ import GHC.Generics (Generic)
 import GHC.Natural (minusNaturalMaybe)
 import Numeric.Natural (Natural)
 import Prelude (fromIntegral)
+import System.IO (IO, FilePath)
 import Text.Show (Show(..))
 import qualified Control.Monad.Trans.State.Strict as S
 import qualified Data.Aeson as JSON
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base64.Lazy as BSL64
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.List as List
 
@@ -548,7 +549,18 @@ instance FromJSON (Election ()) where
         <*> o .: "public_key"
         <*> o .: "questions"
         <*> o .: "uuid"
-        <*> pure (hashJSON (JSON.Object o))
+        <*> pure (Base64SHA256 "")
+            -- NOTE: set in 'readElection'.
+
+readElection :: FilePath -> ExceptT String IO (Election ())
+readElection filePath = do
+       fileData <- lift $ BS.readFile filePath
+       ExceptT $ return $
+               (\e -> e{election_hash=base64SHA256 fileData})
+                <$> JSON.eitherDecodeStrict' fileData
+
+hashElection :: Election c -> Base64SHA256
+hashElection = base64SHA256 . BSL.toStrict . JSON.encode
 
 -- ** Type 'ElectionCrypto'
 data ElectionCrypto c =
@@ -581,25 +593,12 @@ instance FromJSON (ElectionCrypto ()) where
                pubKey <- reify ffc $ \(_::Proxy s) -> nat <$> ((.:) @(PublicKey s) o "y")
                return $ ElectionCrypto_FFC ffc (G (F pubKey))
 
-
--- ** Type 'Hash'
-newtype Hash = Hash Text
- deriving (Eq,Ord,Show,Generic)
- deriving anyclass (ToJSON,FromJSON)
- deriving newtype NFData
-
-hashJSON :: ToJSON a => a -> Hash
-hashJSON = Hash . hexHash . BSL.toStrict . BSL64.encode . JSON.encode
-
-hashElection :: Election c -> Election c
-hashElection elec = elec{election_hash=hashJSON elec}
-
 -- * Type 'Ballot'
 data Ballot c = Ballot
  { ballot_answers       :: ![Answer c]
  , ballot_signature     :: !(Maybe (Signature c))
  , ballot_election_uuid :: !UUID
- , ballot_election_hash :: !Hash
+ , ballot_election_hash :: !Base64SHA256
  } deriving (Generic,NFData)
 instance Reifies c FFC => ToJSON (Ballot c) where
        toJSON Ballot{..} =

diff --git a/hjugement-protocol/src/Voting/Protocol/FFC.hs b/hjugement-protocol/src/Voting/Protocol/FFC.hs
index bb00fb362e173de2618debc8b72d66f9e3199b79..d9982f83f003fcff792f59d7ac1aeae2f75a42a3 100644 (file)
--- a/hjugement-protocol/src/Voting/Protocol/FFC.hs
+++ b/hjugement-protocol/src/Voting/Protocol/FFC.hs
@@ -47,9 +47,11 @@ import qualified Data.Aeson as JSON
 import qualified Data.Aeson.Types as JSON
 import qualified Data.ByteArray as ByteArray
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as BS64
 import qualified Data.Char as Char
 import qualified Data.List as List
 import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TLB
 import qualified Data.Text.Lazy.Builder.Int as TLB
@@ -316,6 +318,11 @@ groupGenPowers :: forall c. Reifies c FFC => [G c]
 groupGenPowers = go one
        where go g = g : go (g * groupGen @c)
 
+-- ** Type 'Hash'
+newtype Hash c = Hash (E c)
+ deriving (Eq,Ord,Show)
+ deriving newtype NFData
+
 -- | @('hash' bs gs)@ returns as a number in 'E'
 -- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs'
 -- prefixing the decimal representation of given subgroup elements 'gs',
@@ -334,14 +341,44 @@ hash bs gs = do
        fromNatural $
                decodeBigEndian $ ByteArray.convert h
 
--- | @('hexHash' bs)@ returns the 'Crypto.SHA256' hash
+-- | @('decodeBigEndian' bs)@ interpret @bs@ as big-endian number.
+decodeBigEndian :: BS.ByteString -> Natural
+decodeBigEndian =
+       BS.foldl'
+        (\acc b -> acc`shiftL`8 + fromIntegral b)
+        (0::Natural)
+
+-- ** Type 'Base64SHA256'
+newtype Base64SHA256 = Base64SHA256 Text
+ deriving (Eq,Ord,Show,Generic)
+ deriving anyclass (ToJSON,FromJSON)
+ deriving newtype NFData
+
+-- | @('base64SHA256' bs)@ returns the 'Crypto.SHA256' hash
+-- of the given 'BS.ByteString' 'bs',
+-- as a 'Text' escaped in @base64@ encoding
+-- (<https://tools.ietf.org/html/rfc4648 RFC 4648>).
+base64SHA256 :: BS.ByteString -> Base64SHA256
+base64SHA256 bs =
+       let h = Crypto.hashWith Crypto.SHA256 bs in
+       Base64SHA256 $
+               Text.takeWhile (/= '=') $
+               -- TODO: to be removed when Belenios will expect padding.
+               Text.decodeUtf8 $ BS64.encode $ ByteArray.convert h
+
+-- ** Type 'HexSHA256'
+newtype HexSHA256 = HexSHA256 Text
+ deriving (Eq,Ord,Show,Generic)
+ deriving anyclass (ToJSON,FromJSON)
+ deriving newtype NFData
+-- | @('hexSHA256' bs)@ returns the 'Crypto.SHA256' hash
 -- of the given 'BS.ByteString' 'bs', escaped in hexadecimal
 -- into a 'Text' of 32 lowercase characters.
 --
 -- Used (in retro-dependencies of this library) to hash
 -- the 'PublicKey' of a voter or a trustee.
-hexHash :: BS.ByteString -> Text
-hexHash bs =
+hexSHA256 :: BS.ByteString -> Text
+hexSHA256 bs =
        let h = Crypto.hashWith Crypto.SHA256 bs in
        let n = decodeBigEndian $ ByteArray.convert h in
        -- NOTE: always set the 256 bit then remove it
@@ -351,13 +388,6 @@ hexHash bs =
        TL.tail $ TLB.toLazyText $ TLB.hexadecimal $
        setBit n 256
 
--- | @('decodeBigEndian' bs)@ interpret @bs@ as big-endian number.
-decodeBigEndian :: BS.ByteString -> Natural
-decodeBigEndian =
-       BS.foldl'
-        (\acc b -> acc`shiftL`8 + fromIntegral b)
-        (0::Natural)
-
 -- * Type 'E'
 -- | An exponent of a (necessarily cyclic) subgroup of a Finite Prime Field.
 -- The value is always in @[0..'groupOrder'-1]@.

diff --git a/hjugement-protocol/tests/HUnit/Election.hs b/hjugement-protocol/tests/HUnit/Election.hs
index 5e193eb71c3d7719db7bae343f81350c6af0983e..a2f583b68bcf79d3f1283caee85cd099ee153106 100644 (file)
--- a/hjugement-protocol/tests/HUnit/Election.hs
+++ b/hjugement-protocol/tests/HUnit/Election.hs
@@ -4,7 +4,6 @@
 module HUnit.Election where
 
 import Test.Tasty.HUnit
-import qualified Data.Aeson as JSON
 import qualified Data.List as List
 import qualified Data.Text as Text
 import qualified System.Random as Random
@@ -94,7 +93,7 @@ testEncryptBallot ffc seed quests opins exp =
                                 , election_crypto      = ElectionCrypto_FFC ffc elecPubKey
                                 , election_questions   = quests
                                 , election_uuid        = uuid
-                                , election_hash        = hashJSON JSON.Null
+                                , election_hash        = hashElection elec
                                 }
                        verifyBallot elec
                         <$> encryptBallot elec (Just ballotSecKey) opins

diff --git a/hjugement-protocol/tests/QuickCheck/Election.hs b/hjugement-protocol/tests/QuickCheck/Election.hs
index 5bd09dff37308986c5d5d18fa73d7e62cfcbc3ea..bb7a43ea70a84fe736db741adf4b2921cc83c054 100644 (file)
--- a/hjugement-protocol/tests/QuickCheck/Election.hs
+++ b/hjugement-protocol/tests/QuickCheck/Election.hs
@@ -10,7 +10,6 @@ import Data.Ord (Ord(..))
 import GHC.Natural (minusNaturalMaybe)
 import Prelude (undefined)
 import Test.Tasty.QuickCheck
-import qualified Data.Aeson as JSON
 import qualified Data.List as List
 import qualified Data.Text as Text
 
@@ -86,8 +85,12 @@ instance Reifies c FFC => Arbitrary (Election c) where
                election_crypto <- arbitrary
                election_questions <- resize (fromIntegral maxArbitraryQuestions) $ listOf1 arbitrary
                election_uuid <- arbitrary
-               let election_hash = hashJSON JSON.Null
-               return Election{..}
+               let elec =
+                       Election
+                        { election_hash = hashElection elec
+                        , ..
+                        }
+               return elec
        shrink elec =
                [ elec{election_questions}
                | election_questions <- shrink $ election_questions elec