hjugement-protocol/src/Voting/Protocol/Arithmetic.hs

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