]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/Protocol/Arithmetic.hs
protocol: polish randomUUID
[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 'SubGroup'
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 ElGamal is secure in terms of the DDH assumption.
169 groupOrder :: F (P q)
170
171 -- | 'groupGenInverses' returns the infinite list
172 -- of 'inv'erse powers of 'groupGen':
173 -- @['groupGen' '^' 'neg' i | i <- [0..]]@,
174 -- but by computing each value from the previous one.
175 --
176 -- NOTE: 'groupGenInverses' is in the 'SubGroup' class in order to keep
177 -- computed terms in memory across calls to 'groupGenInverses'.
178 --
179 -- Used by 'intervalDisjunctions'.
180 groupGenInverses :: [G q]
181 groupGenInverses = go one
182 where
183 go g = g : go (g * invGen)
184 invGen = inv groupGen
185
186 -- | @('hash' prefix gs)@ returns as a number in @('F' p)@
187 -- the SHA256 of the given 'prefix' prefixing the decimal representation
188 -- of given 'SubGroup' elements 'gs', each one postfixed with a comma (",").
189 --
190 -- Used by 'proveEncryption' and 'verifyEncryption',
191 -- where the 'prefix' contains the 'statement' to be proven,
192 -- and the 'gs' contains the 'commitments'.
193 hash ::
194 SubGroup q =>
195 BS.ByteString -> [G q] -> E q
196 hash prefix gs =
197 let s = prefix <> foldMap (\(G (F i)) -> fromString (show i) <> fromString ",") gs in
198 let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in
199 inE (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Natural) h)
200
201 -- * Type 'E'
202 -- | An exponent of a (necessarily cyclic) 'SubGroup' of a 'PrimeField'.
203 -- The value is always in @[0..'groupOrder'-1]@.
204 newtype E q = E { unE :: F (P q) }
205 deriving (Eq,Ord,Show)
206
207 inE :: forall q i. SubGroup q => Integral i => i -> E q
208 inE i = E (F (abs (fromIntegral i `mod` unF (groupOrder @q))))
209 where abs x | x < 0 = x + unF (groupOrder @q)
210 | otherwise = x
211
212 natE :: forall q. SubGroup q => E q -> Natural
213 natE = unF . unE
214
215 instance (SubGroup q, Additive (F (P q))) => Additive (E q) where
216 zero = E zero
217 E (F x) + E (F y) = E (F ((x + y) `mod` unF (groupOrder @q)))
218 instance (SubGroup q, Negable (F (P q))) => Negable (E q) where
219 neg (E (F x)) | x == 0 = zero
220 | otherwise = E (F (fromIntegral ( neg (toInteger x)
221 + toInteger (unF (groupOrder @q)) )))
222 instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (E q) where
223 one = E one
224 E (F x) * E (F y) = E (F ((x * y) `mod` unF (groupOrder @q)))
225 instance SubGroup q => Random.Random (E q) where
226 randomR (E (F lo), E (F hi)) =
227 first (E . F . fromIntegral) .
228 Random.randomR
229 ( 0`max`toInteger lo
230 , toInteger hi`min`(toInteger (unF (groupOrder @q)) - 1) )
231 random =
232 first (E . F . fromIntegral) .
233 Random.randomR (0, toInteger (unF (groupOrder @q)) - 1)
234 instance SubGroup q => Enum (E q) where
235 toEnum = inE
236 fromEnum = fromIntegral . natE
237 enumFromTo lo hi = List.unfoldr
238 (\i -> if i<=hi then Just (i, i+one) else Nothing) lo
239
240 infixr 8 ^
241 -- | @(b '^' e)@ returns the modular exponentiation of base 'b' by exponent 'e'.
242 (^) :: SubGroup q => G q -> E q -> G q
243 (^) b (E (F e))
244 | e == zero = one
245 | otherwise = t * (b*b) ^ E (F (e`shiftR`1))
246 where
247 t | testBit e 0 = b
248 | otherwise = one
249
250 -- * Type 'RandomGen'
251 type RandomGen = Random.RandomGen
252
253 -- | @('randomR' i)@ returns a random integer in @[0..i-1]@.
254 randomR ::
255 Monad m =>
256 RandomGen r =>
257 Random.Random i =>
258 Negable i =>
259 Multiplicative i =>
260 i -> S.StateT r m i
261 randomR i = S.StateT $ return . Random.randomR (zero, i-one)
262
263 -- | @('random')@ returns a random integer
264 -- in the range determined by its type.
265 random ::
266 Monad m =>
267 RandomGen r =>
268 Random.Random i =>
269 Negable i =>
270 Multiplicative i =>
271 S.StateT r m i
272 random = S.StateT $ return . Random.random
273
274 instance Random.Random Natural where
275 randomR (mini,maxi) =
276 first (fromIntegral::Integer -> Natural) .
277 Random.randomR (fromIntegral mini, fromIntegral maxi)
278 random = first (fromIntegral::Integer -> Natural) . Random.random
279
280 -- * Groups
281
282 -- ** Type 'WeakParams'
283 -- | Weak parameters for debugging purposes only.
284 data WeakParams
285 instance PrimeField WeakParams where
286 fieldCharac = 263
287 instance SubGroup WeakParams where
288 type P WeakParams = WeakParams
289 groupGen = G (F 2)
290 groupOrder = F 131
291
292 -- ** Type 'BeleniosParams'
293 -- | Parameters used in Belenios.
294 -- A 2048-bit 'fieldCharac' of a 'PrimeField',
295 -- with a 256-bit 'groupOrder' for a 'Multiplicative' 'SubGroup'
296 -- generated by 'groupGen'.
297 data BeleniosParams
298 instance PrimeField BeleniosParams where
299 fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
300 instance SubGroup BeleniosParams where
301 type P BeleniosParams = BeleniosParams
302 groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627)
303 groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441