hjugement-protocol/Protocol/Arith.hs

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