]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/Protocol/Arith.hs
protocol: Add Credential
[majurity.git] / hjugement-protocol / Protocol / Arith.hs
1 module Protocol.Arith where
2
3 import Data.Bits
4 import Data.Bool
5 import Data.Eq (Eq(..))
6 import Data.Foldable (Foldable(..))
7 import Data.Function ((.), on)
8 import Data.Int (Int)
9 import Data.Ord (Ord(..), Ordering(..))
10 import Data.Semigroup (Semigroup(..))
11 import Data.String (IsString(..))
12 import Prelude (Integer, Integral(..), fromIntegral)
13 import Text.Show (Show(..))
14 import qualified Crypto.Hash as Crypto
15 import qualified Data.ByteArray as ByteArray
16 import qualified Data.ByteString as BS
17 import qualified Prelude as N
18
19 -- * Type 'F'
20 -- | The type of the elements of a 'PrimeField'.
21 --
22 -- A field must satisfy the following properties:
23 --
24 -- * @(f, ('+'), 'zero')@ forms an abelian group,
25 -- called the 'Additive' group of 'f'.
26 --
27 -- * @('NonNull' f, ('*'), 'one')@ forms an abelian group,
28 -- called the 'Multiplicative' group of 'f'.
29 --
30 -- * ('*') is associative:
31 -- @(a'*'b)'*'c == a'*'(b'*'c)@ and
32 -- @a'*'(b'*'c) == (a'*'b)'*'c@.
33 --
34 -- * ('*') and ('+') are both commutative:
35 -- @a'*'b == b'*'a@ and
36 -- @a'+'b == b'+'a@
37 --
38 -- * ('*') and ('+') are both left and right distributive:
39 -- @a'*'(b'+'c) == (a'*'b) '+' (a'*'c)@ and
40 -- @(a'+'b)'*'c == (a'*'c) '+' (b'*'c)@
41 --
42 -- WARNING: the underlying 'Integer' may be anything
43 -- (though most of the time 'mod'ulo 'fieldCharac' to keep it "small"),
44 -- use 'runF' to get a normalized value.
45 newtype F p = F { unF :: Integer }
46 deriving (Show)
47
48 -- | @('runF' f)@ returns the element of the 'PrimeField' 'f'
49 -- as an 'Integer' within @[0..'fieldCharac'-1]@.
50 runF :: forall p. PrimeField p => F p -> Integer
51 runF (F i) = abs (i `mod` fieldCharac @p)
52 where abs z | z < 0 = z + fieldCharac @p
53 | otherwise = z
54
55 primeField :: forall p i. PrimeField p => Integral i => i -> F p
56 primeField i = F (fromIntegral i `mod` fieldCharac @p)
57
58 instance PrimeField p => Eq (F p) where
59 (==) = (==) `on` runF @p
60 instance PrimeField p => Ord (F p) where
61 compare = compare `on` runF @p
62 instance PrimeField p => Additive (F p) where
63 zero = F 0
64 F x + F y = F ((x + y) `mod` fieldCharac @p)
65 instance PrimeField p => Negable (F p) where
66 neg (F x) = F (N.negate x)
67 instance PrimeField p => Multiplicative (F p) where
68 one = F 1
69 -- | Because 'fieldCharac' is prime,
70 -- all elements of the field are invertible modulo 'fieldCharac'.
71 F x * F y = F ((x * y) `mod` fieldCharac @p)
72
73 infixr 8 ^
74 -- | @(b ^ e)@ returns the modular exponentiation of base 'b' by exponent 'e'.
75 (^) ::
76 PrimeField p =>
77 SubGroup q =>
78 P q ~ p =>
79 G q (F p) -> F p -> G q (F p)
80 (^) b e =
81 case e`compare`zero of
82 LT -> inv b ^ e
83 EQ -> one
84 GT -> t * (b*b) ^ F (unF e`shiftR`1)
85 where
86 t | testBit (unF e) 0 = G (F (runG b))
87 | otherwise = one
88
89 -- ** Class 'PrimeField'
90 -- | Parameter for a prime field.
91 class PrimeField p where
92 -- | The prime number characteristic of a 'PrimeField'.
93 --
94 -- ElGamal's hardness to decrypt
95 -- requires a large prime number to form the 'Multiplicative' 'SubGroup'.
96 fieldCharac :: Integer
97 -- fieldCharac = reflect (Proxy::Proxy p)
98
99 -- ** Class 'Additive'
100 class Additive a where
101 zero :: a
102 (+) :: a -> a -> a; infixl 6 +
103 instance Additive Integer where
104 zero = 0
105 (+) = (N.+)
106 instance Additive Int where
107 zero = 0
108 (+) = (N.+)
109
110 -- *** Class 'Negable'
111 class Additive a => Negable a where
112 neg :: a -> a
113 (-) :: a -> a -> a; infixl 6 -
114 x-y = x + (neg y)
115 instance Negable Integer where
116 neg = N.negate
117 instance Negable Int where
118 neg = N.negate
119
120 -- ** Class 'Multiplicative'
121 class Multiplicative a where
122 one :: a
123 (*) :: a -> a -> a; infixl 7 *
124 instance Multiplicative Integer where
125 one = 1
126 (*) = (N.*)
127 instance Multiplicative Int where
128 one = 1
129 (*) = (N.*)
130
131 -- ** Class 'Invertible'
132 class Multiplicative a => Invertible a where
133 inv :: a -> a
134 (/) :: a -> a -> a; infixl 7 /
135 x/y = x * inv y
136
137 -- * Type 'G'
138 -- | The type of the elements of a 'Multiplicative' 'SubGroup' of a 'PrimeField'.
139 newtype G q f = G { unG :: f }
140 deriving (Show)
141
142 -- | @('runG' g)@ returns the element of the 'SubGroup' 'g'
143 -- as an 'Integer' within @[0..'fieldCharac'-1]@.
144 runG :: PrimeField p => G q (F p) -> Integer
145 runG = runF . unG
146
147 instance PrimeField p => Eq (G q (F p)) where
148 (==) = (==) `on` unG
149 instance PrimeField p => Ord (G q (F p)) where
150 compare = compare `on` unG
151
152 -- ** Class 'SubGroupOfPrimeField'
153 -- | A 'SubGroup' of a 'PrimeField'.
154 -- Used for signing (Schnorr) and encrypting (ElGamal).
155 class Invertible (G q (F (P q))) => SubGroup q where
156 -- | Setting 'q' determines 'p', equals to @'P' q@.
157 type P q :: *
158 -- | A generator of the 'SubGroup'.
159 -- NOTE: since @F p@ is a 'PrimeField',
160 -- the 'Multiplicative' 'SubGroup' is cyclic,
161 -- and there are phi('fieldCharac'-1) many choices for the generator of the group,
162 -- where phi is the Euler totient function.
163 groupGen :: G q (F (P q))
164 -- | The order of the 'SubGroup'.
165 --
166 -- WARNING: 'groupOrder' MUST be a prime number dividing @('fieldCharac'-1)@
167 -- to ensure that ensures that ElGamal is secure in terms
168 -- of the DDH assumption.
169 groupOrder :: F (P q)
170
171 instance
172 ( PrimeField p
173 , SubGroup q
174 , P q ~ p
175 , Multiplicative (F p)
176 ) => Multiplicative (G q (F p)) where
177 one = G one
178 -- NOTE: add 'groupOrder' so the exponent given to (^) is positive.
179 G x * G y = G (x * y)
180 instance
181 ( PrimeField p
182 , SubGroup q
183 , P q ~ p
184 , Multiplicative (F p)
185 ) => Invertible (G q (F p)) where
186 inv = (^ (neg one + groupOrder @q))
187
188 -- | @(hash prefix gs)@ returns as a number in @('F' p)@
189 -- the SHA256 of the given 'prefix' prefixing the decimal representation
190 -- of given 'SubGroup' elements 'gs', each one postfixed with a comma (",").
191 hash ::
192 PrimeField p =>
193 SubGroup q =>
194 BS.ByteString -> [G q (F p)] -> F p
195 hash prefix gs =
196 let s = prefix <> foldMap (\x -> fromString (show (unF (unG x))) <> fromString ",") gs in
197 let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in
198 primeField (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Integer) h)
199
200 -- * Groups
201
202 -- ** Type 'WeakParams'
203 -- | Weak parameters for debugging purposes only.
204 data WeakParams
205 instance PrimeField WeakParams where
206 fieldCharac = 263
207 instance SubGroup WeakParams where
208 type P WeakParams = WeakParams
209 groupGen = G (F 2)
210 groupOrder = F 131
211
212 -- ** Type 'BeleniosParams'
213 -- | Parameters used in Belenios.
214 -- A 2048-bit 'fieldCharac' of a 'PrimeField',
215 -- with a 256-bit 'groupOrder' for a 'Multiplicative' 'SubGroup'
216 -- generated by 'groupGen',
217 data BeleniosParams
218 instance PrimeField BeleniosParams where
219 fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
220 instance SubGroup BeleniosParams where
221 type P BeleniosParams = BeleniosParams
222 groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627)
223 groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441