]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/src/Voting/Protocol/FFC.hs
cli: admin: directly use election_hash
[majurity.git] / hjugement-protocol / src / Voting / Protocol / FFC.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DeriveAnyClass #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE DerivingStrategies #-}
5 {-# LANGUAGE OverloadedStrings #-}
6 {-# LANGUAGE InstanceSigs #-}
7 {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances
8 {-# OPTIONS_GHC -fno-warn-orphans #-}
9 -- | Finite Field Cryptography (FFC)
10 -- is a method of implementing discrete logarithm cryptography
11 -- using finite field mathematics.
12 module Voting.Protocol.FFC where
13
14 import Control.Arrow (first)
15 import Control.DeepSeq (NFData)
16 import Control.Monad (Monad(..), unless)
17 import Data.Aeson (ToJSON(..), FromJSON(..), (.:), (.:?), (.=))
18 import Data.Bool
19 import Data.Either (Either(..))
20 import Data.Eq (Eq(..))
21 import Data.Function (($), (.))
22 import Data.Functor ((<$>))
23 import Data.Maybe (Maybe(..), fromMaybe, fromJust)
24 import Data.Monoid (Monoid(..))
25 import Data.Ord (Ord(..))
26 import Data.Proxy (Proxy(..))
27 import Data.Reflection (Reifies(..), reify)
28 import Data.Semigroup (Semigroup(..))
29 import Data.Text (Text)
30 import GHC.Generics (Generic)
31 import GHC.Natural (minusNaturalMaybe)
32 import Numeric.Natural (Natural)
33 import Prelude (Integral(..), fromIntegral)
34 import Text.Read (readMaybe, readEither)
35 import Text.Show (Show(..))
36 import qualified Crypto.KDF.PBKDF2 as Crypto
37 import qualified Data.Aeson as JSON
38 import qualified Data.Aeson.Types as JSON
39 import qualified Data.Char as Char
40 import qualified Data.Text as Text
41 import qualified Data.Text.Encoding as Text
42 import qualified System.Random as Random
43
44 import Voting.Protocol.Arithmetic
45 import Voting.Protocol.Cryptography
46 import Voting.Protocol.Credential
47
48 -- * Type 'FFC'
49 -- | Mutiplicative subgroup of a Finite Prime Field.
50 --
51 -- NOTE: an 'FFC' term-value is brought into the context of many functions
52 -- through a type-variable @c@ whose 'Reifies' constraint enables to 'reflect'
53 -- that 'FFC' at the term-level (a surprising technique but a very useful one).
54 -- Doing like this is simpler than working in a 'Monad' (like a 'Reader'),
55 -- and enables that 'FFC' term to be used simply in instances' methods
56 -- not supporting an inner 'Monad', like 'parseJSON', 'randomR', 'fromEnum' or 'arbitrary'.
57 -- Aside from that, the sharing of 'FFC' amongst several types
58 -- is encoded at the type-level by including @c@
59 -- as a phantom type of 'F', 'G' and 'E'.
60 data FFC = FFC
61 { ffc_name :: !Text
62 , ffc_fieldCharac :: !Natural
63 -- ^ The prime number characteristic of a Finite Prime Field.
64 --
65 -- ElGamal's hardness to decrypt requires a large prime number
66 -- to form the multiplicative subgroup.
67 , ffc_groupGen :: !Natural
68 -- ^ A generator of the multiplicative subgroup of the Finite Prime Field.
69 --
70 -- NOTE: since 'ffc_fieldCharac' is prime,
71 -- the multiplicative subgroup is cyclic,
72 -- and there are phi('fieldCharac'-1) many choices for the generator of the group,
73 -- where phi is the Euler totient function.
74 , ffc_groupOrder :: !Natural
75 -- ^ The order of the subgroup.
76 --
77 -- WARNING: 'ffc_groupOrder' MUST be a prime number dividing @('ffc_fieldCharac'-1)@
78 -- to ensure that ElGamal is secure in terms of the DDH assumption.
79 } deriving (Eq,Show,Generic,NFData)
80 instance ToJSON FFC where
81 toJSON FFC{..} =
82 JSON.object $
83 (if Text.null ffc_name then [] else ["name" .= ffc_name] ) <>
84 [ "p" .= show ffc_fieldCharac
85 , "g" .= show ffc_groupGen
86 , "q" .= show ffc_groupOrder
87 ]
88 toEncoding FFC{..} =
89 JSON.pairs $
90 (if Text.null ffc_name then mempty else "name" .= ffc_name) <>
91 "p" .= show ffc_fieldCharac <>
92 "g" .= show ffc_groupGen <>
93 "q" .= show ffc_groupOrder
94 instance FromJSON FFC where
95 parseJSON = JSON.withObject "FFC" $ \o -> do
96 ffc_name <- fromMaybe "" <$> (o .:? "name")
97 p <- o .: "p"
98 g <- o .: "g"
99 q <- o .: "q"
100 -- TODO: check p is probable prime
101 -- TODO: check q is probable prime
102 ffc_fieldCharac <- case readEither (Text.unpack p) of
103 Left err -> JSON.typeMismatch ("FFC: fieldCharac: "<>err) (JSON.String p)
104 Right a -> return a
105 ffc_groupGen <- case readEither (Text.unpack g) of
106 Left err -> JSON.typeMismatch ("FFC: groupGen: "<>err) (JSON.String g)
107 Right a -> return a
108 ffc_groupOrder <- case readEither (Text.unpack q) of
109 Left err -> JSON.typeMismatch ("FFC: groupOrder: "<>err) (JSON.String q)
110 Right a -> return a
111 unless (nat ffc_groupGen < ffc_fieldCharac) $
112 JSON.typeMismatch "FFC: groupGen is not lower than fieldCharac" (JSON.Object o)
113 unless (ffc_groupOrder < ffc_fieldCharac) $
114 JSON.typeMismatch "FFC: groupOrder is not lower than fieldCharac" (JSON.Object o)
115 unless (nat ffc_groupGen > 1) $
116 JSON.typeMismatch "FFC: groupGen is not greater than 1" (JSON.Object o)
117 unless (fromJust (ffc_fieldCharac`minusNaturalMaybe`one) `rem` ffc_groupOrder == 0) $
118 JSON.typeMismatch "FFC: groupOrder does not divide fieldCharac-1" (JSON.Object o)
119 return FFC{..}
120 instance Reifies c FFC => CryptoParams FFC c where
121 groupGen = G $ ffc_groupGen $ reflect (Proxy::Proxy c)
122 groupOrder c = ffc_groupOrder $ reflect c
123 instance ReifyCrypto FFC where
124 reifyCrypto = reify
125 instance Key FFC where
126 cryptoType _ = "FFC"
127 cryptoName = ffc_name
128 randomSecretKey = random
129 credentialSecretKey (UUID uuid) (Credential cred) =
130 fromNatural $ decodeBigEndian $
131 Crypto.fastPBKDF2_SHA256
132 Crypto.Parameters
133 { Crypto.iterCounts = 1000
134 , Crypto.outputLength = 32 -- bytes, ie. 256 bits
135 }
136 (Text.encodeUtf8 cred)
137 (Text.encodeUtf8 uuid)
138 publicKey = (groupGen @FFC ^)
139
140 fieldCharac :: forall c. Reifies c FFC => Natural
141 fieldCharac = ffc_fieldCharac $ reflect (Proxy::Proxy c)
142
143 -- ** Examples
144 -- | Weak parameters for debugging purposes only.
145 weakFFC :: FFC
146 weakFFC = FFC
147 { ffc_name = "weakFFC"
148 , ffc_fieldCharac = 263
149 , ffc_groupGen = 2
150 , ffc_groupOrder = 131
151 }
152
153 -- | Parameters used in Belenios.
154 -- A 2048-bit 'fieldCharac' of a Finite Prime Field,
155 -- with a 256-bit 'groupOrder' for a multiplicative subgroup
156 -- generated by 'groupGen'.
157 beleniosFFC :: FFC
158 beleniosFFC = FFC
159 { ffc_name = "beleniosFFC"
160 , ffc_fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
161 , ffc_groupGen = 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627
162 , ffc_groupOrder = 78571733251071885079927659812671450121821421258408794611510081919805623223441
163 }
164
165 -- | The type of the elements of a Finite Prime Field.
166 --
167 -- A field must satisfy the following properties:
168 --
169 -- * @(f, ('+'), 'zero')@ forms an abelian group,
170 -- called the additive group of 'f'.
171 --
172 -- * @('NonNull' f, ('*'), 'one')@ forms an abelian group,
173 -- called the multiplicative group of 'f'.
174 --
175 -- * ('*') is associative:
176 -- @(a'*'b)'*'c == a'*'(b'*'c)@ and
177 -- @a'*'(b'*'c) == (a'*'b)'*'c@.
178 --
179 -- * ('*') and ('+') are both commutative:
180 -- @a'*'b == b'*'a@ and
181 -- @a'+'b == b'+'a@
182 --
183 -- * ('*') and ('+') are both left and right distributive:
184 -- @a'*'(b'+'c) == (a'*'b) '+' (a'*'c)@ and
185 -- @(a'+'b)'*'c == (a'*'c) '+' (b'*'c)@
186 --
187 -- The 'Natural' is always within @[0..'fieldCharac'-1]@.
188 type instance FieldElement FFC = Natural
189 deriving newtype instance Eq (G FFC c)
190 deriving newtype instance Ord (G FFC c)
191 deriving newtype instance NFData (G FFC c)
192 deriving newtype instance Show (G FFC c)
193 instance Reifies c FFC => FromJSON (G FFC c) where
194 parseJSON (JSON.String s)
195 | Just (c0,_) <- Text.uncons s
196 , c0 /= '0'
197 , Text.all Char.isDigit s
198 , Just x <- readMaybe (Text.unpack s)
199 , x < fieldCharac @c
200 , r <- G x
201 , r ^ E (groupOrder @FFC (Proxy @c)) == one
202 = return r
203 parseJSON json = JSON.typeMismatch "GroupElement" json
204 instance ToJSON (G FFC c) where
205 toJSON (G x) = JSON.toJSON (show x)
206 instance Reifies c FFC => FromNatural (G FFC c) where
207 fromNatural i = G $ abs $ i `mod` fieldCharac @c
208 where
209 abs x | x < 0 = x + fieldCharac @c
210 | otherwise = x
211 instance ToNatural (G FFC c) where
212 nat = unG
213 instance Reifies c FFC => Additive (G FFC c) where
214 zero = G 0
215 G x + G y = G $ (x + y) `mod` fieldCharac @c
216 instance Reifies c FFC => Semiring (G FFC c) where
217 one = G 1
218 G x * G y = G $ (x * y) `mod` fieldCharac @c
219 instance Reifies c FFC => Ring (G FFC c) where
220 negate (G x)
221 | x == 0 = zero
222 | otherwise = G $ fromJust $ nat (fieldCharac @c)`minusNaturalMaybe`x
223 instance Reifies c FFC => EuclideanRing (G FFC c) where
224 -- | NOTE: add 'groupOrder' so the exponent given to (^) is positive.
225 inverse = (^ E (fromJust $ groupOrder @FFC (Proxy @c)`minusNaturalMaybe`1))
226 instance Reifies c FFC => Random.Random (G FFC c) where
227 randomR (G lo, G hi) =
228 first (G . fromIntegral) .
229 Random.randomR
230 ( 0`max`toInteger lo
231 , toInteger hi`min`(toInteger (fieldCharac @c) - 1) )
232 random =
233 first (G . fromIntegral) .
234 Random.randomR (0, toInteger (fieldCharac @c) - 1)