hjugement-protocol/Protocol/Arithmetic.hs

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