hjugement-protocol/Protocol/Arith.hs

   1 module Protocol.Arith where
   2
   3 import Data.Bits
   4 import Data.Bool
   5 import Data.Eq (Eq(..))
   6 import Data.Foldable (Foldable(..))
   7 import Data.Function ((.), on)
   8 import Data.Int (Int)
   9 import Data.Ord (Ord(..), Ordering(..))
  10 import Data.Semigroup (Semigroup(..))
  11 import Data.String (IsString(..))
  12 import Prelude (Integer, Integral(..), fromIntegral)
  13 import Text.Show (Show(..))
  14 import qualified Crypto.Hash as Crypto
  15 import qualified Data.ByteArray as ByteArray
  16 import qualified Data.ByteString as BS
  17 import qualified Prelude as N
  18
  19 -- * Type 'F'
  20 -- | The type of the elements of a 'PrimeField'.
  21 --
  22 -- A field must satisfy the following properties:
  23 --
  24 -- * @(f, ('+'), 'zero')@ forms an abelian group,
  25 --   called the 'Additive' group of 'f'.
  26 --
  27 -- * @('NonNull' f, ('*'), 'one')@ forms an abelian group,
  28 --   called the 'Multiplicative' group of 'f'.
  29 --
  30 -- * ('*') is associative:
  31 --   @(a'*'b)'*'c == a'*'(b'*'c)@ and
  32 --   @a'*'(b'*'c) == (a'*'b)'*'c@.
  33 --
  34 -- * ('*') and ('+') are both commutative:
  35 --   @a'*'b == b'*'a@ and
  36 --   @a'+'b == b'+'a@
  37 --
  38 -- * ('*') and ('+') are both left and right distributive:
  39 --   @a'*'(b'+'c) == (a'*'b) '+' (a'*'c)@ and
  40 --   @(a'+'b)'*'c == (a'*'c) '+' (b'*'c)@
  41 --
  42 -- WARNING: the underlying 'Integer' may be anything
  43 -- (though most of the time 'mod'ulo 'fieldCharac' to keep it "small"),
  44 -- use 'runF' to get a normalized value.
  45 newtype F p = F { unF :: Integer }
  46  deriving (Show)
  47
  48 -- | @('runF' f)@ returns the element of the 'PrimeField' 'f'
  49 -- as an 'Integer' within @[0..'fieldCharac'-1]@.
  50 runF :: forall p. PrimeField p => F p -> Integer
  51 runF (F i) = abs (i `mod` fieldCharac @p)
  52         where abs z | z < 0     = z + fieldCharac @p
  53                     | otherwise = z
  54
  55 primeField :: forall p i. PrimeField p => Integral i => i -> F p
  56 primeField i = F (fromIntegral i `mod` fieldCharac @p)
  57
  58 instance PrimeField p => Eq (F p) where
  59         (==) = (==) `on` runF @p
  60 instance PrimeField p => Ord (F p) where
  61         compare = compare `on` runF @p
  62 instance PrimeField p => Additive (F p) where
  63         zero = F 0
  64         F x + F y = F ((x + y) `mod` fieldCharac @p)
  65 instance PrimeField p => Negable (F p) where
  66         neg (F x) = F (N.negate x)
  67 instance PrimeField p => Multiplicative (F p) where
  68         one = F 1
  69         -- | Because 'fieldCharac' is prime,
  70         -- all elements of the field are invertible modulo 'fieldCharac'.
  71         F x * F y = F ((x * y) `mod` fieldCharac @p)
  72
  73 infixr 8 ^
  74 -- | @(b ^ e)@ returns the modular exponentiation of base 'b' by exponent 'e'.
  75 (^) ::
  76  PrimeField p =>
  77  SubGroup q =>
  78  P q ~ p =>
  79  G q (F p) -> F p -> G q (F p)
  80 (^) b e =
  81         case e`compare`zero of
  82          LT -> inv b ^ e
  83          EQ -> one
  84          GT -> t * (b*b) ^ F (unF e`shiftR`1)
  85                 where
  86                 t | testBit (unF e) 0 = G (F (runG b))
  87                         | otherwise = one
  88
  89 -- ** Class 'PrimeField'
  90 -- | Parameter for a prime field.
  91 class PrimeField p where
  92         -- | The prime number characteristic of a 'PrimeField'.
  93         --
  94         -- ElGamal's hardness to decrypt
  95         -- requires a large prime number to form the 'Multiplicative' 'SubGroup'.
  96         fieldCharac :: Integer
  97         -- fieldCharac = reflect (Proxy::Proxy p)
  98
  99 -- ** Class 'Additive'
 100 class Additive a where
 101         zero :: a
 102         (+) :: a -> a -> a; infixl 6 +
 103 instance Additive Integer where
 104         zero = 0
 105         (+)  = (N.+)
 106 instance Additive Int where
 107         zero = 0
 108         (+)  = (N.+)
 109
 110 -- *** Class 'Negable'
 111 class Additive a => Negable a where
 112         neg :: a -> a
 113         (-) :: a -> a -> a; infixl 6 -
 114         x-y = x + (neg y)
 115 instance Negable Integer where
 116         neg  = N.negate
 117 instance Negable Int where
 118         neg  = N.negate
 119
 120 -- ** Class 'Multiplicative'
 121 class Multiplicative a where
 122         one :: a
 123         (*) :: a -> a -> a; infixl 7 *
 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 f = G { unG :: f }
 140  deriving (Show)
 141
 142 -- | @('runG' g)@ returns the element of the 'SubGroup' 'g'
 143 -- as an 'Integer' within @[0..'fieldCharac'-1]@.
 144 runG :: PrimeField p => G q (F p) -> Integer
 145 runG = runF . unG
 146
 147 instance PrimeField p => Eq (G q (F p)) where
 148         (==) = (==) `on` unG
 149 instance PrimeField p => Ord (G q (F p)) where
 150         compare = compare `on` unG
 151
 152 -- ** Class 'SubGroupOfPrimeField'
 153 -- | A 'SubGroup' of a 'PrimeField'.
 154 -- Used for signing (Schnorr) and encrypting (ElGamal).
 155 class Invertible (G q (F (P q))) => 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 (F (P 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 instance
 172  ( PrimeField p
 173  , SubGroup q
 174  , P q ~ p
 175  , Multiplicative (F p)
 176  ) => Multiplicative (G q (F p)) where
 177         one = G one
 178         -- NOTE: add 'groupOrder' so the exponent given to (^) is positive.
 179         G x * G y = G (x * y)
 180 instance
 181  ( PrimeField p
 182  , SubGroup q
 183  , P q ~ p
 184  , Multiplicative (F p)
 185  ) => Invertible (G q (F p)) where
 186         inv = (^ (neg one + groupOrder @q))
 187
 188 -- | @(hash prefix gs)@ returns as a number in @('F' p)@
 189 -- the SHA256 of the given 'prefix' prefixing the decimal representation
 190 -- of given 'SubGroup' elements 'gs', each one postfixed with a comma (",").
 191 hash ::
 192  PrimeField p =>
 193  SubGroup q =>
 194  BS.ByteString -> [G q (F p)] -> F p
 195 hash prefix gs =
 196         let s = prefix <> foldMap (\x -> fromString (show (unF (unG x))) <> fromString ",") gs in
 197         let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in
 198         primeField (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Integer) h)
 199
 200 -- * Groups
 201
 202 -- ** Type 'WeakParams'
 203 -- | Weak parameters for debugging purposes only.
 204 data WeakParams
 205 instance PrimeField WeakParams where
 206         fieldCharac = 263
 207 instance SubGroup WeakParams where
 208         type P WeakParams = WeakParams
 209         groupGen = G (F 2)
 210         groupOrder = F 131
 211
 212 -- ** Type 'BeleniosParams'
 213 -- | Parameters used in Belenios.
 214 -- A 2048-bit 'fieldCharac' of a 'PrimeField',
 215 -- with a 256-bit 'groupOrder' for a 'Multiplicative' 'SubGroup'
 216 -- generated by 'groupGen',
 217 data BeleniosParams
 218 instance PrimeField BeleniosParams where
 219         fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
 220 instance SubGroup BeleniosParams where
 221         type P BeleniosParams = BeleniosParams
 222         groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627)
 223         groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441