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 'Integer' is always within @[0..'fieldCharac'-1]@.
  50 newtype F p = F { unF :: Integer }
  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 (N.negate x + 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 . Random.randomR
  72                  (max 0 lo, min hi (fieldCharac @p - 1))
  73         random = first F . Random.randomR (0, fieldCharac @p - 1)
  74
  75 -- ** Class 'PrimeField'
  76 -- | Parameter for a prime field.
  77 class PrimeField p where
  78         -- | The prime number characteristic of a 'PrimeField'.
  79         --
  80         -- ElGamal's hardness to decrypt requires a large prime number
  81         -- to form the 'Multiplicative' 'SubGroup'.
  82         fieldCharac :: Integer
  83
  84 -- ** Class 'Additive'
  85 class Additive a where
  86         zero :: a
  87         (+) :: a -> a -> a; infixl 6 +
  88         sum :: Foldable f => f a -> a
  89         sum = foldl' (+) zero
  90 instance Additive Integer where
  91         zero = 0
  92         (+)  = (N.+)
  93 instance Additive Int where
  94         zero = 0
  95         (+)  = (N.+)
  96 instance Additive Natural where
  97         zero = 0
  98         (+)  = (N.+)
  99
 100 -- *** Class 'Negable'
 101 class Additive a => Negable a where
 102         neg :: a -> a
 103         (-) :: a -> a -> a; infixl 6 -
 104         x-y = x + neg y
 105 instance Negable Integer where
 106         neg  = N.negate
 107 instance Negable Int where
 108         neg  = N.negate
 109
 110 -- ** Class 'Multiplicative'
 111 class Multiplicative a where
 112         one :: a
 113         (*) :: a -> a -> a; infixl 7 *
 114 instance Multiplicative Integer where
 115         one = 1
 116         (*) = (N.*)
 117 instance Multiplicative Int where
 118         one = 1
 119         (*) = (N.*)
 120
 121 -- ** Class 'Invertible'
 122 class Multiplicative a => Invertible a where
 123         inv :: a -> a
 124         (/) :: a -> a -> a; infixl 7 /
 125         x/y = x * inv y
 126
 127 -- * Type 'G'
 128 -- | The type of the elements of a 'Multiplicative' 'SubGroup' of a 'PrimeField'.
 129 newtype G q = G { unG :: F (P q) }
 130  deriving (Eq,Ord,Show)
 131
 132 -- | @('intG' g)@ returns the element of the 'SubGroup' 'g'
 133 -- as an 'Integer' within @[0..'fieldCharac'-1]@.
 134 intG :: SubGroup q => G q -> Integer
 135 intG = unF . unG
 136
 137 instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (G q) where
 138         one = G one
 139         G x * G y = G (x * y)
 140 instance (SubGroup q, Multiplicative (F (P q))) => Invertible (G q) where
 141         -- | NOTE: add 'groupOrder' so the exponent given to (^) is positive.
 142         inv = (^ (E (neg one + groupOrder @q)))
 143
 144 -- ** Class 'SubGroupOfPrimeField'
 145 -- | A 'SubGroup' of a 'PrimeField'.
 146 -- Used for signing (Schnorr) and encrypting (ElGamal).
 147 class
 148  ( PrimeField (P q)
 149  , Multiplicative (F (P q))
 150  ) => SubGroup q where
 151         -- | Setting 'q' determines 'p', equals to @'P' q@.
 152         type P q :: *
 153         -- | A generator of the 'SubGroup'.
 154         -- NOTE: since @F p@ is a 'PrimeField',
 155         -- the 'Multiplicative' 'SubGroup' is cyclic,
 156         -- and there are phi('fieldCharac'-1) many choices for the generator of the group,
 157         -- where phi is the Euler totient function.
 158         groupGen :: G q
 159         -- | The order of the 'SubGroup'.
 160         --
 161         -- WARNING: 'groupOrder' MUST be a prime number dividing @('fieldCharac'-1)@
 162         -- to ensure that ensures that ElGamal is secure in terms
 163         -- of the DDH assumption.
 164         groupOrder :: F (P q)
 165
 166         -- | 'groupGenInverses' returns the infinite list
 167         -- of 'inv'erse powers of 'groupGen':
 168         -- @['groupGen' '^' 'neg' i | i <- [0..]]@,
 169         -- but by computing each value from the previous one.
 170         --
 171         -- NOTE: 'groupGenInverses' is in the 'SubGroup' class in order to keep
 172         -- computed terms in memory accross calls to 'groupGenInverses'.
 173         --
 174         -- Used by 'validableEncryption'.
 175         groupGenInverses :: [G q]
 176         groupGenInverses = go one
 177                 where
 178                 go g = g : go (g * invGen)
 179                 invGen = inv groupGen
 180
 181 -- | @('hash' prefix gs)@ returns as a number in @('F' p)@
 182 -- the SHA256 of the given 'prefix' prefixing the decimal representation
 183 -- of given 'SubGroup' elements 'gs', each one postfixed with a comma (",").
 184 --
 185 -- Used by 'proveEncryption' and 'validateEncryption',
 186 -- where the 'prefix' contains the 'statement' to be proven,
 187 -- and the 'gs' contains the 'commitments'.
 188 hash ::
 189  SubGroup q =>
 190  BS.ByteString -> [G q] -> E q
 191 hash prefix gs =
 192         let s = prefix <> foldMap (\(G (F i)) -> fromString (show i) <> fromString ",") gs in
 193         let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in
 194         inE (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Integer) h)
 195
 196 -- * Type 'E'
 197 -- | An exponent of a (necessarily cyclic) 'SubGroup' of a 'PrimeField'.
 198 -- The value is always in @[0..'groupOrder'-1]@.
 199 newtype E q = E { unE :: F (P q) }
 200  deriving (Eq,Ord,Show)
 201
 202 inE :: forall q i. SubGroup q => Integral i => i -> E q
 203 inE i = E (F (abs (fromIntegral i `mod` unF (groupOrder @q))))
 204         where abs x | x < 0 = x + unF (groupOrder @q)
 205                     | otherwise = x
 206
 207 intE :: forall q. SubGroup q => E q -> Integer
 208 intE = unF . unE
 209
 210 instance (SubGroup q, Additive (F (P q))) => Additive (E q) where
 211         zero = E zero
 212         E (F x) + E (F y) = E (F ((x + y) `mod` unF (groupOrder @q)))
 213 instance (SubGroup q, Negable (F (P q))) => Negable (E q) where
 214         neg (E (F x)) | x == 0 = zero
 215                       | otherwise = E (F (neg x + unF (groupOrder @q)))
 216 instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (E q) where
 217         one = E one
 218         E (F x) * E (F y) = E (F ((x * y) `mod` unF (groupOrder @q)))
 219 instance SubGroup q => Random.Random (E q) where
 220         randomR (E (F lo), E (F hi)) =
 221                 first (E . F) . Random.randomR
 222                  (max 0 lo, min hi (unF (groupOrder @q) - 1))
 223         random = first (E . F) . Random.randomR (0, unF (groupOrder @q) - 1)
 224 instance SubGroup q => Enum (E q) where
 225         toEnum = inE
 226         fromEnum = fromIntegral . intE
 227         enumFromTo lo hi = List.unfoldr
 228          (\i -> if i<=hi then Just (i, i+one) else Nothing) lo
 229
 230 infixr 8 ^
 231 -- | @(b '^' e)@ returns the modular exponentiation of base 'b' by exponent 'e'.
 232 (^) :: SubGroup q => G q -> E q -> G q
 233 (^) b (E (F e))
 234  | e == zero = one
 235  | otherwise = t * (b*b) ^ E (F (e`shiftR`1))
 236         where
 237         t | testBit e 0 = b
 238                 | otherwise   = one
 239
 240 -- * Type 'RandomGen'
 241 type RandomGen = Random.RandomGen
 242
 243 -- | @('randomR' i)@ returns a random integer in @[0..i-1]@.
 244 randomR ::
 245  Monad m =>
 246  RandomGen r =>
 247  Random.Random i =>
 248  Negable i =>
 249  Multiplicative i =>
 250  i -> S.StateT r m i
 251 randomR i = S.StateT $ return . Random.randomR (zero, i-one)
 252
 253 -- | @('random')@ returns a random integer
 254 -- in the range determined by its type.
 255 random ::
 256  Monad m =>
 257  RandomGen r =>
 258  Random.Random i =>
 259  Negable i =>
 260  Multiplicative i =>
 261  S.StateT r m i
 262 random = S.StateT $ return . Random.random
 263
 264 -- * Groups
 265
 266 -- ** Type 'WeakParams'
 267 -- | Weak parameters for debugging purposes only.
 268 data WeakParams
 269 instance PrimeField WeakParams where
 270         fieldCharac = 263
 271 instance SubGroup WeakParams where
 272         type P WeakParams = WeakParams
 273         groupGen = G (F 2)
 274         groupOrder = F 131
 275
 276 -- ** Type 'BeleniosParams'
 277 -- | Parameters used in Belenios.
 278 -- A 2048-bit 'fieldCharac' of a 'PrimeField',
 279 -- with a 256-bit 'groupOrder' for a 'Multiplicative' 'SubGroup'
 280 -- generated by 'groupGen',
 281 data BeleniosParams
 282 instance PrimeField BeleniosParams where
 283         fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
 284 instance SubGroup BeleniosParams where
 285         type P BeleniosParams = BeleniosParams
 286         groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627)
 287         groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441