hjugement-protocol/Protocol/Arithmetic.hs

   1 module Protocol.Arithmetic 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 Numeric.Natural (Natural)
  16 import Prelude (Integer, Integral(..), fromIntegral, Enum(..))
  17 import Text.Show (Show(..))
  18 import qualified Control.Monad.Trans.State.Strict as S
  19 import qualified Crypto.Hash as Crypto
  20 import qualified Data.ByteArray as ByteArray
  21 import qualified Data.ByteString as BS
  22 import qualified Data.List as List
  23 import qualified Prelude as N
  24 import qualified System.Random as Random
  25
  26 -- * Type 'F'
  27 -- | The type of the elements of a 'PrimeField'.
  28 --
  29 -- A field must satisfy the following properties:
  30 --
  31 -- * @(f, ('+'), 'zero')@ forms an abelian group,
  32 --   called the 'Additive' group of 'f'.
  33 --
  34 -- * @('NonNull' f, ('*'), 'one')@ forms an abelian group,
  35 --   called the 'Multiplicative' group of 'f'.
  36 --
  37 -- * ('*') is associative:
  38 --   @(a'*'b)'*'c == a'*'(b'*'c)@ and
  39 --   @a'*'(b'*'c) == (a'*'b)'*'c@.
  40 --
  41 -- * ('*') and ('+') are both commutative:
  42 --   @a'*'b == b'*'a@ and
  43 --   @a'+'b == b'+'a@
  44 --
  45 -- * ('*') and ('+') are both left and right distributive:
  46 --   @a'*'(b'+'c) == (a'*'b) '+' (a'*'c)@ and
  47 --   @(a'+'b)'*'c == (a'*'c) '+' (b'*'c)@
  48 --
  49 -- The 'Natural' is always within @[0..'fieldCharac'-1]@.
  50 newtype F p = F { unF :: Natural }
  51  deriving (Eq,Ord,Show)
  52
  53 inF :: forall p i. PrimeField p => Integral i => i -> F p
  54 inF i = F (abs (fromIntegral i `mod` fieldCharac @p))
  55         where abs x | x < 0 = x + fieldCharac @p
  56                     | otherwise = x
  57
  58 instance PrimeField p => Additive (F p) where
  59         zero = F 0
  60         F x + F y = F ((x + y) `mod` fieldCharac @p)
  61 instance PrimeField p => Negable (F p) where
  62         neg (F x) | x == 0 = zero
  63                   | otherwise = F (fromIntegral (N.negate (toInteger x) + toInteger (fieldCharac @p)))
  64 instance PrimeField p => Multiplicative (F p) where
  65         one = F 1
  66         -- | Because 'fieldCharac' is prime,
  67         -- all elements of the field are invertible modulo 'fieldCharac'.
  68         F x * F y = F ((x * y) `mod` fieldCharac @p)
  69 instance PrimeField p => Random.Random (F p) where
  70         randomR (F lo, F hi) =
  71                 first (F . fromIntegral) .
  72                 Random.randomR
  73                  ( 0`max`toInteger lo
  74                  , toInteger hi`min`(toInteger (fieldCharac @p) - 1))
  75         random = first (F . fromIntegral) . Random.randomR (0, toInteger (fieldCharac @p) - 1)
  76
  77 -- ** Class 'PrimeField'
  78 -- | Parameter for a prime field.
  79 class PrimeField p where
  80         -- | The prime number characteristic of a 'PrimeField'.
  81         --
  82         -- ElGamal's hardness to decrypt requires a large prime number
  83         -- to form the 'Multiplicative' 'SubGroup'.
  84         fieldCharac :: Natural
  85
  86 -- ** Class 'Additive'
  87 class Additive a where
  88         zero :: a
  89         (+) :: a -> a -> a; infixl 6 +
  90         sum :: Foldable f => f a -> a
  91         sum = foldl' (+) zero
  92 instance Additive Natural where
  93         zero = 0
  94         (+)  = (N.+)
  95 instance Additive Integer where
  96         zero = 0
  97         (+)  = (N.+)
  98 instance Additive Int where
  99         zero = 0
 100         (+)  = (N.+)
 101
 102 -- *** Class 'Negable'
 103 class Additive a => Negable a where
 104         neg :: a -> a
 105         (-) :: a -> a -> a; infixl 6 -
 106         x-y = x + neg y
 107 instance Negable Integer where
 108         neg  = N.negate
 109 instance Negable Int where
 110         neg  = N.negate
 111
 112 -- ** Class 'Multiplicative'
 113 class Multiplicative a where
 114         one :: a
 115         (*) :: a -> a -> a; infixl 7 *
 116 instance Multiplicative Natural where
 117         one = 1
 118         (*) = (N.*)
 119 instance Multiplicative Integer where
 120         one = 1
 121         (*) = (N.*)
 122 instance Multiplicative Int where
 123         one = 1
 124         (*) = (N.*)
 125
 126 -- ** Class 'Invertible'
 127 class Multiplicative a => Invertible a where
 128         inv :: a -> a
 129         (/) :: a -> a -> a; infixl 7 /
 130         x/y = x * inv y
 131
 132 -- * Type 'G'
 133 -- | The type of the elements of a 'Multiplicative' 'SubGroup' of a 'PrimeField'.
 134 newtype G q = G { unG :: F (P q) }
 135  deriving (Eq,Ord,Show)
 136
 137 -- | @('natG' g)@ returns the element of the 'SubGroup' 'g'
 138 -- as an 'Natural' within @[0..'fieldCharac'-1]@.
 139 natG :: SubGroup q => G q -> Natural
 140 natG = unF . unG
 141
 142 instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (G q) where
 143         one = G one
 144         G x * G y = G (x * y)
 145 instance (SubGroup q, Multiplicative (F (P q))) => Invertible (G q) where
 146         -- | NOTE: add 'groupOrder' so the exponent given to (^) is positive.
 147         inv = (^ (E (neg one + groupOrder @q)))
 148
 149 -- ** Class 'SubGroupOfPrimeField'
 150 -- | A 'SubGroup' of a 'PrimeField'.
 151 -- Used for signing (Schnorr) and encrypting (ElGamal).
 152 class
 153  ( PrimeField (P q)
 154  , Multiplicative (F (P q))
 155  ) => 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
 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         -- | '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 accross calls to 'groupGenInverses'.
 178         --
 179         -- Used by 'validableEncryption'.
 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 'validateEncryption',
 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