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