]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/Protocol/Arithmetic.hs
protocol: polish comments
[majurity.git] / hjugement-protocol / Protocol / Arithmetic.hs
1 {-# OPTIONS_GHC -fno-warn-orphans #-}
2 module Protocol.Arithmetic where
3
4 import Control.Arrow (first)
5 import Control.Monad (Monad(..))
6 import Data.Bits
7 import Data.Bool
8 import Data.Eq (Eq(..))
9 import Data.Foldable (Foldable, foldl', foldMap)
10 import Data.Function (($), (.))
11 import Data.Int (Int)
12 import Data.Maybe (Maybe(..))
13 import Data.Ord (Ord(..))
14 import Data.Semigroup (Semigroup(..))
15 import Data.String (IsString(..))
16 import Numeric.Natural (Natural)
17 import Prelude (Integer, Integral(..), fromIntegral, Enum(..))
18 import Text.Show (Show(..))
19 import qualified Control.Monad.Trans.State.Strict as S
20 import qualified Crypto.Hash as Crypto
21 import qualified Data.ByteArray as ByteArray
22 import qualified Data.ByteString as BS
23 import qualified Data.List as List
24 import qualified Prelude as N
25 import qualified System.Random as Random
26
27 -- * Type 'F'
28 -- | The type of the elements of a 'PrimeField'.
29 --
30 -- A field must satisfy the following properties:
31 --
32 -- * @(f, ('+'), 'zero')@ forms an abelian group,
33 -- called the 'Additive' group of 'f'.
34 --
35 -- * @('NonNull' f, ('*'), 'one')@ forms an abelian group,
36 -- called the 'Multiplicative' group of 'f'.
37 --
38 -- * ('*') is associative:
39 -- @(a'*'b)'*'c == a'*'(b'*'c)@ and
40 -- @a'*'(b'*'c) == (a'*'b)'*'c@.
41 --
42 -- * ('*') and ('+') are both commutative:
43 -- @a'*'b == b'*'a@ and
44 -- @a'+'b == b'+'a@
45 --
46 -- * ('*') and ('+') are both left and right distributive:
47 -- @a'*'(b'+'c) == (a'*'b) '+' (a'*'c)@ and
48 -- @(a'+'b)'*'c == (a'*'c) '+' (b'*'c)@
49 --
50 -- The 'Natural' is always within @[0..'fieldCharac'-1]@.
51 newtype F p = F { unF :: Natural }
52 deriving (Eq,Ord,Show)
53
54 inF :: forall p i. PrimeField p => Integral i => i -> F p
55 inF i = F (abs (fromIntegral i `mod` fieldCharac @p))
56 where abs x | x < 0 = x + fieldCharac @p
57 | otherwise = x
58
59 instance PrimeField p => Additive (F p) where
60 zero = F 0
61 F x + F y = F ((x + y) `mod` fieldCharac @p)
62 instance PrimeField p => Negable (F p) where
63 neg (F x) | x == 0 = zero
64 | otherwise = F (fromIntegral (N.negate (toInteger x) + toInteger (fieldCharac @p)))
65 instance PrimeField p => Multiplicative (F p) where
66 one = F 1
67 -- | Because 'fieldCharac' is prime,
68 -- all elements of the field are invertible modulo 'fieldCharac'.
69 F x * F y = F ((x * y) `mod` fieldCharac @p)
70 instance PrimeField p => Random.Random (F p) where
71 randomR (F lo, F hi) =
72 first (F . fromIntegral) .
73 Random.randomR
74 ( 0`max`toInteger lo
75 , toInteger hi`min`(toInteger (fieldCharac @p) - 1))
76 random = first (F . fromIntegral) . Random.randomR (0, toInteger (fieldCharac @p) - 1)
77
78 -- ** Class 'PrimeField'
79 -- | Parameter for a prime field.
80 class PrimeField p where
81 -- | The prime number characteristic of a 'PrimeField'.
82 --
83 -- ElGamal's hardness to decrypt requires a large prime number
84 -- to form the 'Multiplicative' 'SubGroup'.
85 fieldCharac :: Natural
86
87 -- ** Class 'Additive'
88 class Additive a where
89 zero :: a
90 (+) :: a -> a -> a; infixl 6 +
91 sum :: Foldable f => f a -> a
92 sum = foldl' (+) zero
93 instance Additive Natural where
94 zero = 0
95 (+) = (N.+)
96 instance Additive Integer where
97 zero = 0
98 (+) = (N.+)
99 instance Additive Int where
100 zero = 0
101 (+) = (N.+)
102
103 -- *** Class 'Negable'
104 class Additive a => Negable a where
105 neg :: a -> a
106 (-) :: a -> a -> a; infixl 6 -
107 x-y = x + neg y
108 instance Negable Integer where
109 neg = N.negate
110 instance Negable Int where
111 neg = N.negate
112
113 -- ** Class 'Multiplicative'
114 class Multiplicative a where
115 one :: a
116 (*) :: a -> a -> a; infixl 7 *
117 instance Multiplicative Natural where
118 one = 1
119 (*) = (N.*)
120 instance Multiplicative Integer where
121 one = 1
122 (*) = (N.*)
123 instance Multiplicative Int where
124 one = 1
125 (*) = (N.*)
126
127 -- ** Class 'Invertible'
128 class Multiplicative a => Invertible a where
129 inv :: a -> a
130 (/) :: a -> a -> a; infixl 7 /
131 x/y = x * inv y
132
133 -- * Type 'G'
134 -- | The type of the elements of a 'Multiplicative' 'SubGroup' of a 'PrimeField'.
135 newtype G q = G { unG :: F (P q) }
136 deriving (Eq,Ord,Show)
137
138 -- | @('natG' g)@ returns the element of the 'SubGroup' 'g'
139 -- as an 'Natural' within @[0..'fieldCharac'-1]@.
140 natG :: SubGroup q => G q -> Natural
141 natG = unF . unG
142
143 instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (G q) where
144 one = G one
145 G x * G y = G (x * y)
146 instance (SubGroup q, Multiplicative (F (P q))) => Invertible (G q) where
147 -- | NOTE: add 'groupOrder' so the exponent given to (^) is positive.
148 inv = (^ E (neg one + groupOrder @q))
149
150 -- ** Class 'SubGroupOfPrimeField'
151 -- | A 'SubGroup' of a 'PrimeField'.
152 -- Used for signing (Schnorr) and encrypting (ElGamal).
153 class
154 ( PrimeField (P q)
155 , Multiplicative (F (P q))
156 ) => SubGroup q where
157 -- | Setting 'q' determines 'p', equals to @'P' q@.
158 type P q :: *
159 -- | A generator of the 'SubGroup'.
160 -- NOTE: since @F p@ is a 'PrimeField',
161 -- the 'Multiplicative' 'SubGroup' is cyclic,
162 -- and there are phi('fieldCharac'-1) many choices for the generator of the group,
163 -- where phi is the Euler totient function.
164 groupGen :: G q
165 -- | The order of the 'SubGroup'.
166 --
167 -- WARNING: 'groupOrder' MUST be a prime number dividing @('fieldCharac'-1)@
168 -- to ensure that ensures that ElGamal is secure in terms
169 -- of the DDH assumption.
170 groupOrder :: F (P q)
171
172 -- | 'groupGenInverses' returns the infinite list
173 -- of 'inv'erse powers of 'groupGen':
174 -- @['groupGen' '^' 'neg' i | i <- [0..]]@,
175 -- but by computing each value from the previous one.
176 --
177 -- NOTE: 'groupGenInverses' is in the 'SubGroup' class in order to keep
178 -- computed terms in memory accross calls to 'groupGenInverses'.
179 --
180 -- Used by 'validableEncryption'.
181 groupGenInverses :: [G q]
182 groupGenInverses = go one
183 where
184 go g = g : go (g * invGen)
185 invGen = inv groupGen
186
187 -- | @('hash' prefix gs)@ returns as a number in @('F' p)@
188 -- the SHA256 of the given 'prefix' prefixing the decimal representation
189 -- of given 'SubGroup' elements 'gs', each one postfixed with a comma (",").
190 --
191 -- Used by 'proveEncryption' and 'validateEncryption',
192 -- where the 'prefix' contains the 'statement' to be proven,
193 -- and the 'gs' contains the 'commitments'.
194 hash ::
195 SubGroup q =>
196 BS.ByteString -> [G q] -> E q
197 hash prefix gs =
198 let s = prefix <> foldMap (\(G (F i)) -> fromString (show i) <> fromString ",") gs in
199 let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in
200 inE (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Natural) h)
201
202 -- * Type 'E'
203 -- | An exponent of a (necessarily cyclic) 'SubGroup' of a 'PrimeField'.
204 -- The value is always in @[0..'groupOrder'-1]@.
205 newtype E q = E { unE :: F (P q) }
206 deriving (Eq,Ord,Show)
207
208 inE :: forall q i. SubGroup q => Integral i => i -> E q
209 inE i = E (F (abs (fromIntegral i `mod` unF (groupOrder @q))))
210 where abs x | x < 0 = x + unF (groupOrder @q)
211 | otherwise = x
212
213 natE :: forall q. SubGroup q => E q -> Natural
214 natE = unF . unE
215
216 instance (SubGroup q, Additive (F (P q))) => Additive (E q) where
217 zero = E zero
218 E (F x) + E (F y) = E (F ((x + y) `mod` unF (groupOrder @q)))
219 instance (SubGroup q, Negable (F (P q))) => Negable (E q) where
220 neg (E (F x)) | x == 0 = zero
221 | otherwise = E (F (fromIntegral ( neg (toInteger x)
222 + toInteger (unF (groupOrder @q)) )))
223 instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (E q) where
224 one = E one
225 E (F x) * E (F y) = E (F ((x * y) `mod` unF (groupOrder @q)))
226 instance SubGroup q => Random.Random (E q) where
227 randomR (E (F lo), E (F hi)) =
228 first (E . F . fromIntegral) .
229 Random.randomR
230 ( 0`max`toInteger lo
231 , toInteger hi`min`(toInteger (unF (groupOrder @q)) - 1) )
232 random =
233 first (E . F . fromIntegral) .
234 Random.randomR (0, toInteger (unF (groupOrder @q)) - 1)
235 instance SubGroup q => Enum (E q) where
236 toEnum = inE
237 fromEnum = fromIntegral . natE
238 enumFromTo lo hi = List.unfoldr
239 (\i -> if i<=hi then Just (i, i+one) else Nothing) lo
240
241 infixr 8 ^
242 -- | @(b '^' e)@ returns the modular exponentiation of base 'b' by exponent 'e'.
243 (^) :: SubGroup q => G q -> E q -> G q
244 (^) b (E (F e))
245 | e == zero = one
246 | otherwise = t * (b*b) ^ E (F (e`shiftR`1))
247 where
248 t | testBit e 0 = b
249 | otherwise = one
250
251 -- * Type 'RandomGen'
252 type RandomGen = Random.RandomGen
253
254 -- | @('randomR' i)@ returns a random integer in @[0..i-1]@.
255 randomR ::
256 Monad m =>
257 RandomGen r =>
258 Random.Random i =>
259 Negable i =>
260 Multiplicative i =>
261 i -> S.StateT r m i
262 randomR i = S.StateT $ return . Random.randomR (zero, i-one)
263
264 -- | @('random')@ returns a random integer
265 -- in the range determined by its type.
266 random ::
267 Monad m =>
268 RandomGen r =>
269 Random.Random i =>
270 Negable i =>
271 Multiplicative i =>
272 S.StateT r m i
273 random = S.StateT $ return . Random.random
274
275 instance Random.Random Natural where
276 randomR (mini,maxi) =
277 first (fromIntegral::Integer -> Natural) .
278 Random.randomR (fromIntegral mini, fromIntegral maxi)
279 random = first (fromIntegral::Integer -> Natural) . Random.random
280
281 -- * Groups
282
283 -- ** Type 'WeakParams'
284 -- | Weak parameters for debugging purposes only.
285 data WeakParams
286 instance PrimeField WeakParams where
287 fieldCharac = 263
288 instance SubGroup WeakParams where
289 type P WeakParams = WeakParams
290 groupGen = G (F 2)
291 groupOrder = F 131
292
293 -- ** Type 'BeleniosParams'
294 -- | Parameters used in Belenios.
295 -- A 2048-bit 'fieldCharac' of a 'PrimeField',
296 -- with a 256-bit 'groupOrder' for a 'Multiplicative' 'SubGroup'
297 -- generated by 'groupGen',
298 data BeleniosParams
299 instance PrimeField BeleniosParams where
300 fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
301 instance SubGroup BeleniosParams where
302 type P BeleniosParams = BeleniosParams
303 groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627)
304 groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441