packages feed

pairing 0.1.4 → 0.2

raw patch · 7 files changed

+232/−17 lines, 7 filesdep +arithmoidep +quickcheck-instancesdep ~base

Dependencies added: arithmoi, quickcheck-instances

Dependency ranges changed: base

Files

bench/BenchPairing.hs view
@@ -126,6 +126,9 @@     7590136428571280465598215063146990078553196689176860926896020586846726844869     8036135660414384292776446470327730948618639044617118659780848199544099832559) +test_hash :: ByteString+test_hash = toS "TyqIPUBYojDVOnDPacfMGrGOzpaQDWD3KZCpqzLhpE4A3kRUCQFUx040Ok139J8WDVV2C99Sfge3G20Q8MEgu23giWmqRxqOc8pH"+ benchmarks :: [Benchmark] benchmarks   = [ bgroup "Frobenius in Fq12"@@ -225,6 +228,8 @@               $ whnf (uncurry Point.gAdd) (test_g1_1, test_g1_2)           , bench "multiply"               $ whnf (uncurry Point.gMul) (test_g1_1, 42)+          , bench "hashToG1"+              $ whnfIO (Group.hashToG1 test_hash)           ]        , bgroup "G2"
pairing.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 43144795bee309fae69b35b31181420ba97ece4cfbaa916533435650a806da34+-- hash: dabb8024b0664bed6aa89f042dbbc95b098bf5f62fb35bd2d70d4a79992e2314  name:           pairing-version:        0.1.4+version:        0.2 synopsis:       Optimal ate pairing over Barreto-Naehrig curves description:    Optimal ate pairing over Barreto-Naehrig curves category:       Cryptography@@ -47,14 +47,16 @@       Pairing.Pairing       Pairing.Jacobian       Pairing.CyclicGroup+      Pairing.Hash   other-modules:-      Paths_pairing+      Pairing.Modular   hs-source-dirs:       src-  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll RankNTypes DataKinds KindSignatures GeneralizedNewtypeDeriving TypeApplications ExistentialQuantification ScopedTypeVariables DeriveGeneric   ghc-options: -fwarn-tabs -fwarn-incomplete-patterns -fwarn-incomplete-record-updates -fwarn-redundant-constraints -fwarn-implicit-prelude -fwarn-overflowed-literals -fwarn-orphans -fwarn-identities -fwarn-dodgy-exports -fwarn-dodgy-imports -fwarn-duplicate-exports -fwarn-overlapping-patterns -fwarn-missing-fields -fwarn-missing-methods -fwarn-missing-signatures -fwarn-noncanonical-monad-instances -fwarn-unused-pattern-binds -fwarn-unused-type-patterns -fwarn-unrecognised-pragmas -fwarn-wrong-do-bind -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-unused-do-bind   build-depends:       QuickCheck+    , arithmoi     , base >=4.7 && <5     , bytestring     , cryptonite@@ -77,12 +79,14 @@       tests   build-depends:       QuickCheck+    , arithmoi     , base     , bytestring     , cryptonite     , memory     , pairing     , protolude >=0.2+    , quickcheck-instances     , random     , tasty     , tasty-discover@@ -100,6 +104,7 @@       bench, tests   build-depends:       QuickCheck+    , arithmoi     , base >=4.7 && <5     , bytestring     , criterion@@ -107,6 +112,7 @@     , memory     , pairing     , protolude >=0.2+    , quickcheck-instances     , random     , tasty     , tasty-hunit
src/Pairing/Fq.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE Strict #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveGeneric #-}- -- | Prime field with characteristic _q, over which the elliptic curve -- is defined and the other finite field extensions. First field in -- the tower:@@ -19,7 +15,8 @@   fqOne,   fqNqr,   euclidean,-  random+  random,+  Pairing.Fq.fromBytes ) where  import Protolude@@ -27,6 +24,12 @@ import Crypto.Number.Generate (generateMax) import Pairing.Params as Params import Pairing.CyclicGroup+import Pairing.Modular as M+import Data.Bits+import qualified Data.ByteString as BS+import Data.Bits+import Math.NumberTheory.Moduli.Class+import Math.NumberTheory.Moduli.Sqrt  ------------------------------------------------------------------------------- -- Types@@ -56,15 +59,15 @@ -- | Turn an integer into an @Fq@ number, should be used instead of -- the @Fq@ constructor. new :: Integer -> Fq-new a = Fq (a `mod` _q)+new a = Fq $ withQ $ (getVal . newMod a)  {-# INLINE norm #-} norm :: Fq -> Fq-norm (Fq a) = Fq (a `mod` _q)+norm (Fq a) = new a  {-# INLINE fqAdd #-} fqAdd :: Fq -> Fq -> Fq-fqAdd (Fq a) (Fq b) = norm (Fq (a+b))+fqAdd (Fq a) (Fq b) = Fq $ withQ (modBinOp a b (+))  {-# INLINE fqAbs #-} fqAbs :: Fq -> Fq@@ -72,19 +75,19 @@  {-# INLINE fqSig #-} fqSig :: Fq -> Fq-fqSig (Fq a) = Fq (signum a  `mod` _q)+fqSig (Fq a) = Fq $ withQ (modUnOp a signum)  {-# INLINE fqMul #-} fqMul :: Fq -> Fq -> Fq-fqMul (Fq a) (Fq b) = norm (Fq (a*b))+fqMul (Fq a) (Fq b) = Fq $ withQ (modBinOp a b (*))  {-# INLINE fqNeg #-} fqNeg :: Fq -> Fq-fqNeg (Fq a) = Fq ((-a) `mod` _q)+fqNeg (Fq a) = Fq $ withQ (modUnOp a negate)  {-# INLINE fqDiv #-} fqDiv :: Fq -> Fq -> Fq-fqDiv a b = fqMul a (inv b)+fqDiv (Fq a) (Fq b) = Fq $ withQ (modBinOp a b (/))  {-# INLINE fqNqr #-} -- | Quadratic non-residue@@ -128,3 +131,8 @@ random = do   seed <- generateMax _q   pure (Fq seed)++fromBytes :: ByteString -> Fq+fromBytes bs = Fq $ withQ (M.toInteger . M.fromBytes bs)++
src/Pairing/Group.hs view
@@ -14,6 +14,9 @@   g2,   b1,   b2,+  hashToG1,+  randomG1,+  randomG2 ) where  import Protolude@@ -26,6 +29,8 @@ import Pairing.Params import Pairing.CyclicGroup import Test.QuickCheck+import Pairing.Hash+import Crypto.Random (MonadRandom)  -- | G1 is E(Fq) defined by y^2 = x^3 + b type G1 = Point Fq@@ -132,3 +137,16 @@  instance Arbitrary (Point Fq2) where -- G2   arbitrary = gMul g2 . abs <$> (arbitrary :: Gen Integer)++hashToG1 :: (MonadIO m, MonadRandom m) => ByteString -> m G1+hashToG1 = swEncBN++randomG1 :: (MonadIO m, MonadRandom m) => m G1+randomG1 = do+  Fq r <- Fq.random+  pure (gMul g1 r)++randomG2 :: (MonadIO m, MonadRandom m) => m G2+randomG2 = do+  Fq r <- Fq.random+  pure (gMul g2 r)
+ src/Pairing/Hash.hs view
@@ -0,0 +1,86 @@+module Pairing.Hash (+    swEncBN+  ) where++import Protolude+import Pairing.Params+import Pairing.Point+import Pairing.Modular as M+import Pairing.Fq as Fq+import Math.NumberTheory.Moduli.Class+import Math.NumberTheory.Moduli.Sqrt+import Crypto.Random (MonadRandom)+import Data.List++sqrtOfMinusThree :: forall m . KnownNat m => Proxy m -> Mod m+sqrtOfMinusThree mName = sqrtOf mName (-3)++-- |+-- Picks the postive square root only+-- |++sqrtOf :: forall m . KnownNat m => Proxy m -> Mod m -> Mod m+sqrtOf mName i = case sqrtsMod i of+  [] -> panic ("Could not calculate sqrt " <> show i)+  (x:_) -> x++w ::  forall m . KnownNat m => Proxy m -> Mod m -> Mod m -> Mod m+w mname sq3 t = (sq3 * t) / (1 + (b mname) + (t `powMod` 2))++b ::  forall m . KnownNat m => Proxy m -> Mod m+b mName = fromInteger @(Mod m) _b++x1 :: forall m . KnownNat m => Proxy m -> Mod m -> Mod m -> Mod m+x1 mName t w = ((sqrtOfMinusThree mName) - 1) / 2 - (t * w)++x2 :: forall m . KnownNat m => Proxy m -> Mod m -> Mod m+x2 mName x1' = (-1) - x1'++x3 :: forall m . KnownNat m => Proxy m -> Mod m -> Mod m+x3 mName w = 1 + (1 / (w `powMod` 2))++chi :: forall m . KnownNat m => Proxy m -> Mod m -> Integer+chi mName a+  | a == 0 = 0+  | isSquare mName a = 1+  | otherwise = -1++alphaBeta :: forall m . KnownNat m => Proxy m -> Mod m -> Mod m -> Integer+alphaBeta mName pr px = chi mName ((pr * pr) * ((px `powMod` 3) + (b mName)))++i :: Integer -> Integer -> Integer+i pa pb = (((pa - 1) * pb) `mod` 3) + 1++swy :: forall m . KnownNat m => Proxy m -> Mod m -> Mod m -> Mod m -> Mod m -> Integer+swy mn pr3 pt pxi pb = ch * y+  where+    ch = chi mn ((pr3 `powMod` 2) * pt)+    y = getVal $ sqrtOf mn ((pxi `powMod` 3) + pb)++-- | Encodes a given byte string to a point on the BN curve.+-- The implemenation uses the Shallue van de Woestijne encoding to BN curves as specifed+-- in Section 6 of Indifferentiable Hashing to Barreto Naehrig Curves+-- by Pierre-Alain Fouque and Mehdi Tibouchi.+-- This function evaluates an empty bytestring or one that contains \NUL to zero+-- which according to Definiton 2 of the paper is sent to an arbitrary point on the curve+--+swEncBN :: (MonadIO m, MonadRandom m) => ByteString -> m (Point Fq)+swEncBN bs = withQM $ \mn -> do+  let t = M.fromBytes bs mn+  let sq3 = sqrtOfMinusThree mn+  let w' = w mn sq3 t+  let x1' = x1 mn t w'+  if (t == 0) then+    pure $ (Point (Fq.new (getVal x1')) (Fq.new (getVal $ sqrtOf mn (1 + (b mn)))))+  else do+    let x2' = x2 mn x1'+    let x3' = x3 mn w'+    let lst = [x1', x2', x3']+    r1 <- randomMod mn+    r2 <- randomMod mn+    r3 <- randomMod mn+    let al = alphaBeta mn r1 x1'+    let bet = alphaBeta mn r2 x2'+    let i' = i al bet+    let swy' = swy mn r3 t (genericIndex lst (i' -  1)) (b mn)+    pure (Point (Fq.new (getVal $ genericIndex lst (i' - 1))) (Fq.new swy'))
+ src/Pairing/Modular.hs view
@@ -0,0 +1,85 @@+module Pairing.Modular where
+
+import Protolude
+import Math.NumberTheory.Moduli.Class
+import Math.NumberTheory.Moduli.Sqrt
+import Math.NumberTheory.UniqueFactorisation
+import Pairing.Params
+import Crypto.Random (MonadRandom)
+import Crypto.Number.Generate (generateMax)
+import qualified Data.ByteString as BS
+
+-- Mod conversion and management
+withQ :: (forall m . KnownNat m => Proxy m -> r) -> r
+withQ cont = case someNatVal _q of 
+  Nothing -> panic ("Somehow " <> show _q <> " was not a Nat")
+  Just (SomeNat mName) -> cont mName
+
+-- Mod conversion and management
+withQM :: (forall n. KnownNat n => Proxy n -> m r) -> m r
+withQM cont = case someNatVal _q of 
+  Nothing -> panic ("Somehow " <> show _q <> " was not a Nat")
+  Just (SomeNat mName) -> cont mName
+
+newMod :: forall m . KnownNat m => Integer -> Proxy m -> Mod m
+newMod n mName = fromInteger @(Mod m) n
+
+toInteger :: Mod m -> Integer
+toInteger = getVal
+
+modUnOp :: forall m . KnownNat m => Integer -> (Mod m -> Mod m) -> Proxy m -> Integer
+modUnOp n f mName = getVal $ f (fromInteger @(Mod m) n)
+
+modBinOp :: forall m . KnownNat m => Integer -> Integer -> (Mod m -> Mod m -> Mod m) -> Proxy m -> Integer
+modBinOp r s f mName = getVal $ f (fromInteger @(Mod m) r) (fromInteger @(Mod m) s)
+
+multInverse :: KnownNat m => Mod m -> Maybe (Mod m)
+multInverse n = do
+  m <- isMultElement n
+  let mm = invertGroup m
+  pure (multElement mm)  
+
+modUnOpM :: forall m a . (KnownNat m, Monad a) => Integer -> (Mod m -> a (Mod m)) -> Proxy m -> a Integer
+modUnOpM n f mName = do
+  a <- f (fromInteger @(Mod m) n)
+  pure (getVal a)
+
+modPow :: Integral p => Integer -> p -> Integer
+modPow a b = withQ (modUnOp a (flip powMod b))
+
+modSqrt :: Integer -> [Integer]
+modSqrt a = withQ (modUnOpM a sqrtsMod)
+
+threeModFourCongruence :: Integer -> Bool
+threeModFourCongruence q = q `mod` 4 == 3 `mod` 4
+
+isSquare :: forall m . KnownNat m => Proxy m -> Mod m -> Bool
+isSquare _ a = if (threeModFourCongruence _q) then (length kp > 0) else False
+  where
+    kp = sqrtsMod a
+
+isSquareIn3Mod4 :: Integer -> Integer
+isSquareIn3Mod4 a = if (threeModFourCongruence _q) then sq else 0
+  where
+    sq = withQ (modUnOp a f)
+    f m = m `powMod` p2
+    p2 = (_q + 1) `quot` 4
+
+legendre :: Integer -> Integer
+legendre a = if  conv > 1 then (-1) else conv 
+  where
+    conv = withQ (modUnOp a f)
+    f m = m `powMod` p2
+    p2 = (_q - 1) `quot` 2
+
+randomMod :: forall n m. (MonadRandom m, KnownNat n) => Proxy n -> m (Mod n)
+randomMod mName = do
+  seed <- generateMax _q
+  pure (fromInteger @(Mod n) seed)
+
+fromBytes :: forall n. (KnownNat n) => ByteString -> Proxy n -> Mod n
+fromBytes bs mn = newMod (fromBytes' bs) mn
+  where
+    fromBytes' :: ByteString -> Integer
+    fromBytes' = BS.foldl' f 0
+    f a b = a `shiftL` 8 .|. fromIntegral b
tests/TestGroups.hs view
@@ -13,7 +13,9 @@ import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.HUnit-+import qualified Test.QuickCheck.Monadic as TQM (monadicIO, assert)+import Test.QuickCheck.Instances ()+import Data.ByteString as BS (null, dropWhile) import TestCommon  -------------------------------------------------------------------------------@@ -58,6 +60,11 @@ unit_order_g1_valid :: Assertion unit_order_g1_valid   = gMul g1 _r @=? Infinity++prop_hashToG1 :: ByteString -> Property+prop_hashToG1 bs = TQM.monadicIO $ do+  toCurve <- liftIO (hashToG1 bs) +  TQM.assert (isOnCurveG1 toCurve)  ------------------------------------------------------------------------------- -- G2