mcl (empty) → 1.0.0
raw patch · 22 files changed
+2663/−0 lines, 22 filesdep +QuickCheckdep +basedep +binarybuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, binary, bytestring, criterion, deepseq, ghc-prim, groups, integer-gmp, mcl, primitive, test-framework, test-framework-quickcheck2
Files
- LICENSE +30/−0
- Setup.hs +31/−0
- benchmark/Main.hs +174/−0
- cbits/mcl_fp254bnb.cpp +533/−0
- mcl.cabal +100/−0
- src/MCL/Curves/Fp254BNb.hs +27/−0
- src/MCL/Curves/Fp254BNb/Fp.hs +159/−0
- src/MCL/Curves/Fp254BNb/Fp12.hs +163/−0
- src/MCL/Curves/Fp254BNb/Fp2.hs +150/−0
- src/MCL/Curves/Fp254BNb/Fr.hs +159/−0
- src/MCL/Curves/Fp254BNb/G1.hs +172/−0
- src/MCL/Curves/Fp254BNb/G2.hs +171/−0
- src/MCL/Curves/Fp254BNb/GT.hs +61/−0
- src/MCL/Curves/Fp254BNb/Pairing.hs +15/−0
- src/MCL/Internal/Field.hs +111/−0
- src/MCL/Internal/Group.hs +81/−0
- src/MCL/Internal/Prim.hs +9/−0
- src/MCL/Internal/Prim/Class.hs +16/−0
- src/MCL/Internal/Prim/Pinned.hs +111/−0
- src/MCL/Internal/Prim/Unpinned.hs +131/−0
- src/MCL/Internal/Utils.hsc +100/−0
- test/Main.hs +159/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, IOHK++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Andrzej Rybczak nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -Wall #-}+import Data.Maybe+import Distribution.PackageDescription+import Distribution.Simple+import Distribution.Simple.PreProcess++main :: IO ()+main = defaultMainWithHooks hooks+ { hookedPreProcessors = hscDropCpp11 $ hookedPreProcessors hooks+ }+ where+ hooks = simpleUserHooks++ -- gcc shows a warning if -std=c++11 is used when compiling a C file, but+ -- clang is more strict and considers that an error, so we need to filter it+ -- out.+ hscDropCpp11 pps = ("hsc", newHsc) : deleteKey "hsc" pps+ where+ newHsc binfo = fromMaybe ppHsc2hs (lookup "hsc" pps) binfo+ { ccOptions = filter (not . f) (ccOptions binfo)+ }+ where+ f flag = flag == "-std=c++11"++----------------------------------------++deleteKey :: Eq k => k -> [(k, v)] -> [(k, v)]+deleteKey _ [] = []+deleteKey k (x@(a, _):xs) = if k == a+ then deleteKey k xs+ else x : deleteKey k xs
+ benchmark/Main.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import Control.DeepSeq+import Criterion.Main+import Data.Binary+import Data.ByteString.Lazy (ByteString)+import Data.Group+import Data.Maybe++import MCL.Curves.Fp254BNb++main :: IO ()+main = defaultMain+ [ bgroup "Fp"+ [ benchFpArith fp_a fp_b+ , bench "hash_to" $ nf hashToFp "54o6vyua2984v357b35n63"+ , bgroup "from_integer"+ [ bench "small" $ nf mkFp small_integer+ , bench "large" $ nf mkFp large_integer+ ]+ , bench "eq" $ nf (uncurry (==)) (fp_a, fp_b)+ , bench "to_integer" $ nf fromFp fp_a+ , bench "is_zero" $ nf fp_isZero fp_a+ , bench "sqrt" $ nf fp_squareRoot fp_a+ , bench "show" $ nf show fp_a+ , benchBinary fp_a+ ]+ , bgroup "Fp2"+ [ benchFpArith fp2_a fp2_b+ , bench "from_base" $ nf (uncurry mkFp2) (fp_a, fp_b)+ , bench "eq" $ nf (uncurry (==)) (fp2_a, fp2_b)+ , bench "is_zero" $ nf fp_isZero fp_a+ , bench "sqrt" $ nf fp2_squareRoot fp2_a+ , bench "show" $ nf show fp2_a+ , benchBinary fp2_a+ ]+ , bgroup "Fp12"+ [ benchFpArith fp12_a fp12_b+ , bench "eq" $ nf (uncurry (==)) (fp12_a, fp12_b)+ , bench "is_zero" $ nf fp12_isZero fp12_a+ , bench "show" $ nf show fp12_a+ , benchBinary fp12_a+ ]+ , bgroup "Fr"+ [ benchFpArith fr_a fr_b+ , bench "hash_to" $ nf hashToFr "6mn8o8rmn634wcxq354x31"+ , bgroup "from_integer"+ [ bench "small" $ nf mkFr small_integer+ , bench "large" $ nf mkFr large_integer+ ]+ , bench "eq" $ nf (uncurry (==)) (fr_a, fr_b)+ , bench "to_integer" $ nf fromFr fr_a+ , bench "is_zero" $ nf fr_isZero fr_a+ , bench "show" $ nf show fr_a+ , benchBinary fr_a+ ]+ , bgroup "G1"+ [ benchGroupArith g1_powFr g1_p g1_q+ , bench "construct" $ nf (uncurry mkG1) (g1_p_x, g1_p_y)+ , bench "map_to" $ nf mapToG1 fp_a+ , bench "eq" $ nf (uncurry (==)) (g1_p, g1_q)+ , bench "is_zero" $ nf g1_isZero g1_p+ , bench "affine" $ nf g1_affineCoords g1_p+ , bench "show" $ nf show g1_p+ , benchBinary g1_p+ ]+ , bgroup "G2"+ [ benchGroupArith g2_powFr g2_p g2_q+ , bench "construct" $ nf (uncurry mkG2) (g2_p_x, g2_p_y)+ , bench "map_to" $ nf mapToG2 fp2_a+ , bench "eq" $ nf (uncurry (==)) (g2_p, g2_q)+ , bench "is_zero" $ nf g2_isZero g2_p+ , bench "affine" $ nf g2_affineCoords g2_p+ , bench "show" $ nf show g2_p+ , benchBinary g2_p+ ]+ , bgroup "GT"+ [ bench "pow" $ nf (uncurry pow) (gt_a, large_integer)+ , bench "pow_native" $ nf (uncurry gt_powFr) (gt_a, large_integer_fr)+ ]+ , bgroup "pairing"+ [ bench "compute1" $ nf (uncurry pairing) (g1_p, g2_q)+ , bench "compute2" $ nf (uncurry pairing) (g1_q, g2_p)+ ]+ ]++----------------------------------------++benchFpArith :: (Fractional a, NFData a) => a -> a -> Benchmark+benchFpArith a b = bgroup "arith"+ [ bench "add" $ nf (uncurry (+)) (a, b)+ , bench "subtract" $ nf (uncurry (-)) (a, b)+ , bench "multiply" $ nf (uncurry (*)) (a, b)+ , bench "negate" $ nf negate a+ , bench "invert" $ nf recip a+ ]++benchGroupArith :: (Group g, NFData g) => (g -> Fr -> g) -> g -> g -> Benchmark+benchGroupArith fpow p q = bgroup "arith"+ [ bench "add" $ nf (uncurry mappend) (p, q)+ , bench "invert" $ nf invert p+ , bgroup "mul"+ [ bench "small" $ nf (uncurry pow) (p, small_integer)+ , bench "large" $ nf (uncurry pow) (p, large_integer)+ , bench "native" $ nf (uncurry fpow) (p, large_integer_fr)+ ]+ ]++benchBinary :: forall a. (Binary a, NFData a) => a -> Benchmark+benchBinary a = bgroup "binary"+ [ bench "put" $ nf encode a+ , bench "get" $ nf (decode :: ByteString -> a) (encode a)+ ]++----------------------------------------++fr_a, fr_b :: Fr+fr_a = hashToFr "a"+fr_b = hashToFr "b"++fp_a, fp_b :: Fp+fp_a = hashToFp "a"+fp_b = hashToFp "b"++fp2_a, fp2_b :: Fp2+fp2_a = mkFp2 (hashToFp "a") (hashToFp "b")+fp2_b = mkFp2 (hashToFp "c") (hashToFp "d")++fp12_a, fp12_b :: Fp12+fp12_a = mkFp12 (mkFp2 (hashToFp "a") (hashToFp "b"))+ (mkFp2 (hashToFp "c") (hashToFp "d"))+ (mkFp2 (hashToFp "e") (hashToFp "f"))+ (mkFp2 (hashToFp "g") (hashToFp "h"))+ (mkFp2 (hashToFp "i") (hashToFp "j"))+ (mkFp2 (hashToFp "k") (hashToFp "l"))++fp12_b = mkFp12 (mkFp2 (hashToFp "m") (hashToFp "n"))+ (mkFp2 (hashToFp "o") (hashToFp "p"))+ (mkFp2 (hashToFp "q") (hashToFp "r"))+ (mkFp2 (hashToFp "s") (hashToFp "t"))+ (mkFp2 (hashToFp "u") (hashToFp "v"))+ (mkFp2 (hashToFp "w") (hashToFp "x"))++----------------------------------------++g1_p, g1_q :: G1+g1_p = mapToG1 fp_a+g1_q = mapToG1 fp_b++g1_p_x, g1_p_y :: Fp+(g1_p_x, g1_p_y) = fromJust $ g1_affineCoords g1_p++----------------------------------------++g2_p, g2_q :: G2+g2_p = mapToG2 fp2_a+g2_q = mapToG2 fp2_b++g2_p_x, g2_p_y :: Fp2+(g2_p_x, g2_p_y) = fromJust $ g2_affineCoords g2_p++gt_a :: GT+gt_a = pairing g1_p g2_q++----------------------------------------++small_integer, large_integer :: Integer+small_integer = 42+large_integer = fr_modulus `quot` 2++large_integer_fr :: Fr+large_integer_fr = mkFr large_integer
+ cbits/mcl_fp254bnb.cpp view
@@ -0,0 +1,533 @@+#include <mcl/bn256.hpp>+#include "impl.hpp"++using namespace hs_mcl;+using namespace mcl::bn256;++namespace {++void initialize_parameters()+{+ // C++11 guarantees static variable initializers to be run at most once and in+ // a thread-safe manner.+ static void *initializer = [] {+ bn256init(mcl::bn::CurveFp254BNb);+ return nullptr;+ }();+ static_cast<void>(initializer);+}++}++extern "C" {++////////////////////////////////////////////////////////////+// Fr++int hs_mcl_fp254bnb_fr_size()+{+ return sizeof(Fr);+}++int hs_mcl_fp254bnb_fr_limbs()+{+ initialize_parameters();++ return Fr::getByteSize() / sizeof(mp_limb_t);+}++void hs_mcl_fp254bnb_fr_modulus(mp_limb_t *result,+ const size_t result_length_bytes)+{+ initialize_parameters();++ mpz_class_to_gmp_integer(BN::param.r, result, result_length_bytes);+}++void hs_mcl_fp254bnb_fr_hash_to(const char *s, const size_t s_length, Fr *result)+{+ initialize_parameters();++ return field_impl::hash_to(s, s_length, result);+}++void hs_mcl_fp254bnb_fr_add(const Fr *a, const Fr *b, Fr *result)+{+ return field_impl::add(a, b, result);+}++void hs_mcl_fp254bnb_fr_subtract(const Fr *a, const Fr *b, Fr *result)+{+ return field_impl::subtract(a, b, result);+}++void hs_mcl_fp254bnb_fr_multiply(const Fr *a, const Fr *b, Fr *result)+{+ return field_impl::multiply(a, b, result);+}++void hs_mcl_fp254bnb_fr_negate(const Fr *a, Fr *result)+{+ return field_impl::negate(a, result);+}++void hs_mcl_fp254bnb_fr_from_integer(const mp_limb_t *scalar,+ const mp_size_t scalar_limbs,+ Fr *result)+{+ initialize_parameters();++ return field_impl::from_gmp_integer(scalar, scalar_limbs, result);+}++void hs_mcl_fp254bnb_fr_from_hsint(const HsInt scalar, Fr *result)+{+ initialize_parameters();++ return field_impl::from_hsint(scalar, result);+}++void hs_mcl_fp254bnb_fr_invert(const Fr *a, Fr *result)+{+ return field_impl::invert(a, result);+}++int hs_mcl_fp254bnb_fr_eq(const Fr *a, const Fr *b)+{+ return field_impl::eq(a, b);+}++void hs_mcl_fp254bnb_fr_to_gmp_integer(const Fr *a, mp_limb_t *result,+ const int result_length_bytes)+{+ return field_impl::to_gmp_integer(a, result, result_length_bytes);+}++int hs_mcl_fp254bnb_fr_is_zero(const Fr *a)+{+ return field_impl::is_zero(a);+}++int hs_mcl_fp254bnb_fr_sqrt(const Fr *a, Fr *result)+{+ return field_impl::sqrt(a, result);+}++////////////////////////////////////////////////////////////+// Fp++int hs_mcl_fp254bnb_fp_size()+{+ return sizeof(Fp);+}++int hs_mcl_fp254bnb_fp_limbs()+{+ initialize_parameters();++ return Fp::getByteSize() / sizeof(mp_limb_t);+}++void hs_mcl_fp254bnb_fp_modulus(mp_limb_t *result,+ const size_t result_length_bytes)+{+ initialize_parameters();++ mpz_class_to_gmp_integer(BN::param.p, result, result_length_bytes);+}++void hs_mcl_fp254bnb_fp_hash_to(const char *s, const size_t s_length, Fp *result)+{+ initialize_parameters();++ return field_impl::hash_to(s, s_length, result);+}++void hs_mcl_fp254bnb_fp_add(const Fp *a, const Fp *b, Fp *result)+{+ return field_impl::add(a, b, result);+}++void hs_mcl_fp254bnb_fp_subtract(const Fp *a, const Fp *b, Fp *result)+{+ return field_impl::subtract(a, b, result);+}++void hs_mcl_fp254bnb_fp_multiply(const Fp *a, const Fp *b, Fp *result)+{+ return field_impl::multiply(a, b, result);+}++void hs_mcl_fp254bnb_fp_negate(const Fp *a, Fp *result)+{+ return field_impl::negate(a, result);+}++void hs_mcl_fp254bnb_fp_from_integer(const mp_limb_t *scalar,+ const mp_size_t scalar_limbs,+ Fp *result)+{+ initialize_parameters();++ return field_impl::from_gmp_integer(scalar, scalar_limbs, result);+}++void hs_mcl_fp254bnb_fp_from_hsint(const HsInt scalar, Fp *result)+{+ initialize_parameters();++ return field_impl::from_hsint(scalar, result);+}++void hs_mcl_fp254bnb_fp_invert(const Fp *a, Fp *result)+{+ return field_impl::invert(a, result);+}++int hs_mcl_fp254bnb_fp_eq(const Fp *a, const Fp *b)+{+ return field_impl::eq(a, b);+}++void hs_mcl_fp254bnb_fp_to_gmp_integer(const Fp *a, mp_limb_t *result,+ const int result_length_bytes)+{+ return field_impl::to_gmp_integer(a, result, result_length_bytes);+}++int hs_mcl_fp254bnb_fp_is_zero(const Fp *a)+{+ return field_impl::is_zero(a);+}++int hs_mcl_fp254bnb_fp_sqrt(const Fp *a, Fp *result)+{+ return field_impl::sqrt(a, result);+}++////////////////////////////////////////////////////////////+// Fp2++int hs_mcl_fp254bnb_fp2_size()+{+ return sizeof(Fp2);+}++void hs_mcl_fp254bnb_fp2_add(const Fp2 *a, const Fp2 *b, Fp2 *result)+{+ return field_impl::add(a, b, result);+}++void hs_mcl_fp254bnb_fp2_subtract(const Fp2 *a, const Fp2 *b, Fp2 *result)+{+ return field_impl::subtract(a, b, result);+}++void hs_mcl_fp254bnb_fp2_multiply(const Fp2 *a, const Fp2 *b, Fp2 *result)+{+ return field_impl::multiply(a, b, result);+}++void hs_mcl_fp254bnb_fp2_negate(const Fp2 *a, Fp2 *result)+{+ return field_impl::negate(a, result);+}++void hs_mcl_fp254bnb_fp2_from_base(const Fp *c0, const Fp *c1, Fp2 *result)+{+ return field_impl::from_base(result, *c0, *c1);+}++void hs_mcl_fp254bnb_fp2_invert(const Fp2 *a, Fp2 *result)+{+ return field_impl::invert(a, result);+}++int hs_mcl_fp254bnb_fp2_eq(const Fp2 *a, const Fp2 *b)+{+ return field_impl::eq(a, b);+}++void hs_mcl_fp254bnb_fp2_c0(const Fp2 *a, Fp *result)+{+ mem_util::copy(result, a->a);+}++void hs_mcl_fp254bnb_fp2_c1(const Fp2 *a, Fp *result)+{+ mem_util::copy(result, a->b);+}++int hs_mcl_fp254bnb_fp2_is_zero(const Fp2 *a)+{+ return field_impl::is_zero(a);+}++int hs_mcl_fp254bnb_fp2_sqrt(const Fp2 *a, Fp2 *result)+{+ return field_impl::sqrt(a, result);+}++////////////////////////////////////////////////////////////+// Fp12++int hs_mcl_fp254bnb_fp12_size()+{+ return sizeof(Fp12);+}++void hs_mcl_fp254bnb_fp12_add(const Fp12 *a, const Fp12 *b, Fp12 *result)+{+ return field_impl::add(a, b, result);+}++void hs_mcl_fp254bnb_fp12_subtract(const Fp12 *a, const Fp12 *b, Fp12 *result)+{+ return field_impl::subtract(a, b, result);+}++void hs_mcl_fp254bnb_fp12_multiply(const Fp12 *a, const Fp12 *b, Fp12 *result)+{+ return field_impl::multiply(a, b, result);+}++void hs_mcl_fp254bnb_fp12_negate(const Fp12 *a, Fp12 *result)+{+ return field_impl::negate(a, result);+}++void hs_mcl_fp254bnb_fp12_from_base(const Fp2 *c0, const Fp2 *c1, const Fp2 *c2,+ const Fp2 *c3, const Fp2 *c4, const Fp2 *c5,+ Fp12 *result)+{+ return field_impl::from_base(result, *c0, *c1, *c2, *c3, *c4, *c5);+}++void hs_mcl_fp254bnb_fp12_invert(const Fp12 *a, Fp12 *result)+{+ return field_impl::invert(a, result);+}++int hs_mcl_fp254bnb_fp12_eq(const Fp12 *a, const Fp12 *b)+{+ return field_impl::eq(a, b);+}++void hs_mcl_fp254bnb_fp12_c0(const Fp12 *a, Fp2 *result)+{+ mem_util::copy(result, a->a.a);+}++void hs_mcl_fp254bnb_fp12_c1(const Fp12 *a, Fp2 *result)+{+ mem_util::copy(result, a->a.b);+}++void hs_mcl_fp254bnb_fp12_c2(const Fp12 *a, Fp2 *result)+{+ mem_util::copy(result, a->a.c);+}++void hs_mcl_fp254bnb_fp12_c3(const Fp12 *a, Fp2 *result)+{+ mem_util::copy(result, a->b.a);+}++void hs_mcl_fp254bnb_fp12_c4(const Fp12 *a, Fp2 *result)+{+ mem_util::copy(result, a->b.b);+}++void hs_mcl_fp254bnb_fp12_c5(const Fp12 *a, Fp2 *result)+{+ mem_util::copy(result, a->b.c);+}++int hs_mcl_fp254bnb_fp12_is_zero(const Fp12 *a)+{+ return field_impl::is_zero(a);+}++////////////////////////////////////////////////////////////+// G1++int hs_mcl_fp254bnb_g1_size()+{+ return sizeof(G1);+}++void hs_mcl_fp254bnb_g1_zero(G1 *result)+{+ initialize_parameters();++ return group_impl::zero(result);+}++int hs_mcl_fp254bnb_g1_construct(const Fp *x, const Fp *y, G1 *result)+{+ return group_impl::construct(x, y, result);+}++void hs_mcl_fp254bnb_g1_map_to(const Fp *a, G1 *result)+{+ return group_impl::map_to(BN::mapToG1, a, result);+}++void hs_mcl_fp254bnb_g1_add(const G1 *p, const G1 *q, G1 *result)+{+ return group_impl::add(p, q, result);+}++void hs_mcl_fp254bnb_g1_invert(const G1 *p, G1 *result)+{+ return group_impl::invert(p, result);+}++void hs_mcl_fp254bnb_g1_scalar_mul_native(const int const_time,+ const Fr *scalar,+ const G1 *p,+ G1 *result)+{+ return group_impl::scalar_mul_native(const_time, scalar, p, result);+}++void hs_mcl_fp254bnb_g1_scalar_mul(const int const_time,+ const mp_limb_t *scalar,+ const mp_size_t scalar_limbs,+ const int is_negative,+ const G1 *p,+ G1 *result)+{+ return group_impl::scalar_mul(const_time, scalar, scalar_limbs,+ is_negative, p, result);+}++void hs_mcl_fp254bnb_g1_scalar_mul_small(const int const_time,+ const HsInt scalar,+ const G1 *p,+ G1 *result)+{+ return group_impl::scalar_mul_small<Fr>(const_time, scalar, p, result);+}++int hs_mcl_fp254bnb_g1_eq(const G1 *p, const G1 *q)+{+ return group_impl::eq(p, q);+}++int hs_mcl_fp254bnb_g1_is_zero(const G1 *p)+{+ return group_impl::is_zero(p);+}++void hs_mcl_fp254bnb_g1_affine_coords(const G1 *p, Fp *result_x, Fp *result_y)+{+ return group_impl::affine_coords(p, result_x, result_y);+}++int hs_mcl_fp254bnb_g1_y_from_x(const int y_lsb, const Fp *x, Fp *result)+{+ return group_impl::y_from_x<G1>(y_lsb, x, result);+}++////////////////////////////////////////////////////////////+// G2++int hs_mcl_fp254bnb_g2_size()+{+ return sizeof(G2);+}++void hs_mcl_fp254bnb_g2_zero(G2 *result)+{+ initialize_parameters();++ return group_impl::zero(result);+}++int hs_mcl_fp254bnb_g2_construct(const Fp2 *x, const Fp2 *y, G2 *result)+{+ return group_impl::construct(x, y, result);+}++void hs_mcl_fp254bnb_g2_map_to(const Fp2 *a, G2 *result)+{+ return group_impl::map_to(BN::mapToG2, a, result);+}++void hs_mcl_fp254bnb_g2_add(const G2 *p, const G2 *q, G2 *result)+{+ return group_impl::add(p, q, result);+}++void hs_mcl_fp254bnb_g2_invert(const G2 *p, G2 *result)+{+ return group_impl::invert(p, result);+}++void hs_mcl_fp254bnb_g2_scalar_mul_native(const int const_time,+ const Fr *scalar,+ const G2 *p,+ G2 *result)+{+ return group_impl::scalar_mul_native(const_time, scalar, p, result);+}++void hs_mcl_fp254bnb_g2_scalar_mul(const int const_time,+ const mp_limb_t *scalar,+ const mp_size_t scalar_limbs,+ const int is_negative,+ const G2 *p,+ G2 *result)+{+ return group_impl::scalar_mul(const_time, scalar, scalar_limbs,+ is_negative, p, result);+}++void hs_mcl_fp254bnb_g2_scalar_mul_small(const int const_time,+ const HsInt scalar,+ const G2 *p,+ G2 *result)+{+ return group_impl::scalar_mul_small<Fr>(const_time, scalar, p, result);+}++int hs_mcl_fp254bnb_g2_eq(const G2 *p, const G2 *q)+{+ return group_impl::eq(p, q);+}++int hs_mcl_fp254bnb_g2_is_zero(const G2 *p)+{+ return group_impl::is_zero(p);+}++void hs_mcl_fp254bnb_g2_affine_coords(const G2 *p, Fp2 *result_x, Fp2 *result_y)+{+ return group_impl::affine_coords(p, result_x, result_y);+}++int hs_mcl_fp254bnb_g2_y_from_x(const int y_lsb, const Fp2 *x, Fp2 *result)+{+ return group_impl::y_from_x<G2>(y_lsb, x, result);+}++////////////////////////////////////////////////////////////+// GT++void hs_mcl_fp254bnb_gt_pow_native(const int const_time, const Fp12 *a,+ const Fr *b, Fp12 *result)+{+ return field_impl::pow_native(const_time, a, b, result);+}++////////////////////////////////////////////////////////////+// Pairing++void hs_mcl_fp254bnb_pairing(const G1 *p, const G2 *q, Fp12 *result)+{+ mem_util::init(result);+ BN::pairing(*result, *p, *q);+}++}
+ mcl.cabal view
@@ -0,0 +1,100 @@+name: mcl+version: 1.0.0+synopsis: Bindings to mcl, a generic and fast pairing-based cryptography library+description: Base library: https://github.com/herumi/mcl+license: BSD3+license-file: LICENSE+author: Andrzej Rybczak+maintainer: andrzej@well-typed.com+copyright: 2017 IOHK+category: Crypto, Math++build-type: Custom+cabal-version: >=1.10+custom-setup+ setup-depends: base < 5,+ Cabal++source-repository head+ type: git+ location: https://github.com/arybczak/haskell-mcl++library+ exposed-modules: MCL.Curves.Fp254BNb+ MCL.Curves.Fp254BNb.Fp+ MCL.Curves.Fp254BNb.Fp2+ MCL.Curves.Fp254BNb.Fp12+ MCL.Curves.Fp254BNb.Fr+ MCL.Curves.Fp254BNb.G1+ MCL.Curves.Fp254BNb.G2+ MCL.Curves.Fp254BNb.GT+ MCL.Curves.Fp254BNb.Pairing+ MCL.Internal.Field+ MCL.Internal.Group+ MCL.Internal.Prim+ MCL.Internal.Prim.Class+ MCL.Internal.Prim.Pinned+ MCL.Internal.Prim.Unpinned+ MCL.Internal.Utils++ build-depends: base < 5,+ binary,+ bytestring,+ deepseq,+ ghc-prim,+ groups,+ integer-gmp,+ primitive++ hs-source-dirs: src++ ghc-options: -Wall+ if impl(ghc >= 8)+ ghc-options: -Wredundant-constraints++ default-language: Haskell2010++ cc-options: -std=c++11 -Wall -Wextra++ c-sources: cbits/mcl_fp254bnb.cpp++ extra-libraries: crypto gmpxx mcl stdc++++Benchmark bench+ build-depends: mcl,+ base < 5,+ binary,+ bytestring,+ criterion,+ deepseq,+ groups++ ghc-options: -Wall -threaded -rtsopts+ if impl(ghc >= 8)+ ghc-options: -Wredundant-constraints++ type: exitcode-stdio-1.0+ main-is: Main.hs++ hs-source-dirs: benchmark+ default-language: Haskell2010++test-suite tests+ build-depends: mcl,+ QuickCheck,+ base < 5,+ binary,+ groups,+ test-framework,+ test-framework-quickcheck2++ ghc-options: -Wall -threaded -rtsopts+ if impl(ghc >= 8)+ ghc-options: -Wredundant-constraints+++ type: exitcode-stdio-1.0+ main-is: Main.hs++ hs-source-dirs: test+ default-language: Haskell2010
+ src/MCL/Curves/Fp254BNb.hs view
@@ -0,0 +1,27 @@+-- | Elliptic curve offering 128 bits of security from Barreto-Naehrig+-- family. It uses the following parameters:+--+-- - @p = 16798108731015832284940804142231733909889187121439069848933715426072753864723@+-- - @r = 16798108731015832284940804142231733909759579603404752749028378864165570215949@+-- - @E : Y² = X³ + 2, defined over 'Fp'.@+-- - @E' : Y² = X³ + 2/(1 + α), defined over 'Fp2'.@+--+module MCL.Curves.Fp254BNb+ ( module MCL.Curves.Fp254BNb.Fp+ , module MCL.Curves.Fp254BNb.Fp2+ , module MCL.Curves.Fp254BNb.Fp12+ , module MCL.Curves.Fp254BNb.Fr+ , module MCL.Curves.Fp254BNb.G1+ , module MCL.Curves.Fp254BNb.G2+ , module MCL.Curves.Fp254BNb.GT+ , module MCL.Curves.Fp254BNb.Pairing+ ) where++import MCL.Curves.Fp254BNb.Fp+import MCL.Curves.Fp254BNb.Fp12+import MCL.Curves.Fp254BNb.Fp2+import MCL.Curves.Fp254BNb.Fr+import MCL.Curves.Fp254BNb.G1+import MCL.Curves.Fp254BNb.G2+import MCL.Curves.Fp254BNb.GT+import MCL.Curves.Fp254BNb.Pairing
+ src/MCL/Curves/Fp254BNb/Fp.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.Fp+ ( Fp+ , mkFp+ , hashToFp+ , fromFp+ , fp_modulus+ , fp_isZero+ , fp_squareRoot+ ) where++import Control.DeepSeq+import Data.Binary+import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals+import qualified Data.ByteString as BS++import MCL.Internal.Utils+import qualified MCL.Internal.Field as I+import qualified MCL.Internal.Prim as I++-- | Prime finite field of characteristic @p@.+data Fp = Fp { unFp :: I.CC Fp }++instance Binary Fp where+ put = putBytesFx 32 . fromFp+ get = mkFp <$> getBytesFx 32++instance NFData Fp where+ rnf = (`seq` ())++instance Num Fp where+ (+) = I.addFp+ (-) = I.subtractFp+ (*) = I.multiplyFp+ negate = I.negateFp+ abs = I.absFp+ signum = I.signumFp+ fromInteger = I.mkFp++instance Fractional Fp where+ recip = I.recipFp+ fromRational = I.fromRationalFp++instance Eq Fp where+ (==) = I.eqFp++instance Show Fp where+ showsPrec = I.showsPrecFp++-- | Construct an element of Fp from Integer.+{-# INLINE mkFp #-}+mkFp :: Integer -> Fp+mkFp = I.mkFp++-- | Hash arbitrary message to Fp by computing its SHA256 hash and treating its+-- first 253 bits as the value of Fp.+{-# INLINE hashToFp #-}+hashToFp :: BS.ByteString -> Fp+hashToFp = I.hashToFp++-- | Convert the element of Fp back to non-negative Integer.+{-# INLINE fromFp #-}+fromFp :: Fp -> Integer+fromFp = I.fromFp++-- | Modulus of Fp.+{-# NOINLINE fp_modulus #-}+fp_modulus :: Integer+fp_modulus = I.modulus (proxy# :: Proxy# Fp)++-- | Check if the element of Fp is zero.+{-# INLINE fp_isZero #-}+fp_isZero :: Fp -> Bool+fp_isZero = I.isZero++-- | Compute square root of the element @a ∈ Fp@. If polynomial @x² - a@ has no+-- roots in Fp, no result is returned.+{-# INLINE fp_squareRoot #-}+fp_squareRoot :: Fp -> Maybe Fp+fp_squareRoot = I.squareRoot++----------------------------------------++-- | Internal+instance I.Prim Fp where+ prim_size _ = fromIntegral c_mcl_fp254bnb_fp_size+ prim_wrap = Fp+ prim_unwrap = unFp++-- | Internal+instance I.BaseField Fp where+ c_limbs _ = fromIntegral c_mcl_fp254bnb_fp_limbs+ c_modulus _ = c_mcl_fp254bnb_fp_modulus+ c_hash_to _ = c_mcl_fp254bnb_fp_hash_to+ c_from_integer _ = c_mcl_fp254bnb_fp_from_integer+ c_from_hsint _ = c_mcl_fp254bnb_fp_from_hsint+ c_to_integer _ = c_mcl_fp254bnb_fp_to_gmp_integer++-- | Internal+instance I.HasArith Fp where+ c_add _ = c_mcl_fp254bnb_fp_add+ c_subtract _ = c_mcl_fp254bnb_fp_subtract+ c_multiply _ = c_mcl_fp254bnb_fp_multiply+ c_negate _ = c_mcl_fp254bnb_fp_negate+ c_invert _ = c_mcl_fp254bnb_fp_invert+ c_eq _ = c_mcl_fp254bnb_fp_eq+ c_is_zero _ = c_mcl_fp254bnb_fp_is_zero++-- | Internal+instance I.HasSqrt Fp where+ c_sqrt _ = c_mcl_fp254bnb_fp_sqrt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_size"+ c_mcl_fp254bnb_fp_size :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_limbs"+ c_mcl_fp254bnb_fp_limbs :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_modulus"+ c_mcl_fp254bnb_fp_modulus :: I.MC Integer -> CSize -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_hash_to"+ c_mcl_fp254bnb_fp_hash_to :: Ptr CChar -> CSize -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_add"+ c_mcl_fp254bnb_fp_add :: I.CC Fp -> I.CC Fp -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_subtract"+ c_mcl_fp254bnb_fp_subtract :: I.CC Fp -> I.CC Fp -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_multiply"+ c_mcl_fp254bnb_fp_multiply :: I.CC Fp -> I.CC Fp -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_negate"+ c_mcl_fp254bnb_fp_negate :: I.CC Fp -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_from_integer"+ c_mcl_fp254bnb_fp_from_integer :: I.CC Integer -> GmpSize# -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_from_hsint"+ c_mcl_fp254bnb_fp_from_hsint :: Int# -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_invert"+ c_mcl_fp254bnb_fp_invert :: I.CC Fp -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_eq"+ c_mcl_fp254bnb_fp_eq :: I.CC Fp -> I.CC Fp -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_to_gmp_integer"+ c_mcl_fp254bnb_fp_to_gmp_integer :: I.CC Fp -> I.MC Integer -> CSize -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_is_zero"+ c_mcl_fp254bnb_fp_is_zero :: I.CC Fp -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp_sqrt"+ c_mcl_fp254bnb_fp_sqrt :: I.CC Fp -> I.MC Fp -> IO CInt
+ src/MCL/Curves/Fp254BNb/Fp12.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.Fp12+ ( Fp12+ , beta+ , mkFp12+ , fp12_c0+ , fp12_c1+ , fp12_c2+ , fp12_c3+ , fp12_c4+ , fp12_c5+ , fp12_isZero+ ) where++import Control.DeepSeq+import Data.Binary+import Foreign.C.Types++import MCL.Curves.Fp254BNb.Fp2+import qualified MCL.Internal.Field as I+import qualified MCL.Internal.Prim as I++-- | Sixth degree field extension of 'Fp2' defined as @Fp2(β)@, where @β⁶ = 1 + α@.+data Fp12 = Fp12 { unFp12 :: I.CC Fp12 }++instance Binary Fp12 where+ put n = put (fp12_c0 n) *> put (fp12_c1 n) *> put (fp12_c2 n)+ *> put (fp12_c3 n) *> put (fp12_c4 n) *> put (fp12_c5 n)+ get = mkFp12 <$> get <*> get <*> get <*> get <*> get <*> get++instance NFData Fp12 where+ rnf = (`seq` ())++instance Num Fp12 where+ (+) = I.addFp+ (-) = I.subtractFp+ (*) = I.multiplyFp+ negate = I.negateFp+ abs = I.absFp+ signum = I.signumFp+ fromInteger n = mkFp12 (fromInteger n) 0 0 0 0 0++instance Fractional Fp12 where+ recip = I.recipFp+ fromRational = I.fromRationalFp++instance Eq Fp12 where+ (==) = I.eqFp++instance Show Fp12 where+ showsPrec p a = showsPrec p (fp12_c0 a, fp12_c1 a, fp12_c2 a,+ fp12_c3 a, fp12_c4 a, fp12_c5 a)++-- | Root of the polynomial @x⁶ - 1 - α@.+{-# NOINLINE beta #-}+beta :: Fp12+beta = mkFp12 0 0 0 1 0 0++-- Construct an element of Fp12 from six coordinates in Fp2.+{-# INLINE mkFp12 #-}+mkFp12 :: Fp2 -> Fp2 -> Fp2 -> Fp2 -> Fp2 -> Fp2 -> Fp12+mkFp12 = I.unsafeOp6_ c_mcl_fp254bnb_fp12_from_base++-- | Return first Fp2 coordinate of the element in Fp12.+{-# INLINE fp12_c0 #-}+fp12_c0 :: Fp12 -> Fp2+fp12_c0 = I.unsafeOp1_ c_mcl_fp254bnb_fp12_c0++-- | Return second Fp2 coordinate of the element in Fp12.+{-# INLINE fp12_c1 #-}+fp12_c1 :: Fp12 -> Fp2+fp12_c1 = I.unsafeOp1_ c_mcl_fp254bnb_fp12_c1++-- | Return third Fp2 coordinate of the element in Fp12.+{-# INLINE fp12_c2 #-}+fp12_c2 :: Fp12 -> Fp2+fp12_c2 = I.unsafeOp1_ c_mcl_fp254bnb_fp12_c2++-- | Return fourth Fp2 coordinate of the element in Fp12.+{-# INLINE fp12_c3 #-}+fp12_c3 :: Fp12 -> Fp2+fp12_c3 = I.unsafeOp1_ c_mcl_fp254bnb_fp12_c3++-- | Return fifth Fp2 coordinate of the element in Fp12.+{-# INLINE fp12_c4 #-}+fp12_c4 :: Fp12 -> Fp2+fp12_c4 = I.unsafeOp1_ c_mcl_fp254bnb_fp12_c4++-- | Return sixth Fp2 coordinate of the element in Fp12.+{-# INLINE fp12_c5 #-}+fp12_c5 :: Fp12 -> Fp2+fp12_c5 = I.unsafeOp1_ c_mcl_fp254bnb_fp12_c5++-- | Check whether the element of Fp12 is zero.+{-# INLINE fp12_isZero #-}+fp12_isZero :: Fp12 -> Bool+fp12_isZero = I.isZero++----------------------------------------++-- | Internal+instance I.Prim Fp12 where+ prim_size _ = fromIntegral c_mcl_fp254bnb_fp12_size+ prim_wrap = Fp12+ prim_unwrap = unFp12++-- | Internal+instance I.HasArith Fp12 where+ c_add _ = c_mcl_fp254bnb_fp12_add+ c_subtract _ = c_mcl_fp254bnb_fp12_subtract+ c_multiply _ = c_mcl_fp254bnb_fp12_multiply+ c_negate _ = c_mcl_fp254bnb_fp12_negate+ c_invert _ = c_mcl_fp254bnb_fp12_invert+ c_eq _ = c_mcl_fp254bnb_fp12_eq+ c_is_zero _ = c_mcl_fp254bnb_fp12_is_zero++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_size"+ c_mcl_fp254bnb_fp12_size :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_add"+ c_mcl_fp254bnb_fp12_add :: I.CC Fp12 -> I.CC Fp12 -> I.MC Fp12 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_subtract"+ c_mcl_fp254bnb_fp12_subtract :: I.CC Fp12 -> I.CC Fp12 -> I.MC Fp12 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_multiply"+ c_mcl_fp254bnb_fp12_multiply :: I.CC Fp12 -> I.CC Fp12 -> I.MC Fp12 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_negate"+ c_mcl_fp254bnb_fp12_negate :: I.CC Fp12 -> I.MC Fp12 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_from_base"+ c_mcl_fp254bnb_fp12_from_base :: I.CC Fp2 -> I.CC Fp2 -> I.CC Fp2+ -> I.CC Fp2 -> I.CC Fp2 -> I.CC Fp2+ -> I.MC Fp12 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_invert"+ c_mcl_fp254bnb_fp12_invert :: I.CC Fp12 -> I.MC Fp12 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_eq"+ c_mcl_fp254bnb_fp12_eq :: I.CC Fp12 -> I.CC Fp12 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_c0"+ c_mcl_fp254bnb_fp12_c0 :: I.CC Fp12 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_c1"+ c_mcl_fp254bnb_fp12_c1 :: I.CC Fp12 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_c2"+ c_mcl_fp254bnb_fp12_c2 :: I.CC Fp12 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_c3"+ c_mcl_fp254bnb_fp12_c3 :: I.CC Fp12 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_c4"+ c_mcl_fp254bnb_fp12_c4 :: I.CC Fp12 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_c5"+ c_mcl_fp254bnb_fp12_c5 :: I.CC Fp12 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp12_is_zero"+ c_mcl_fp254bnb_fp12_is_zero :: I.CC Fp12 -> IO CInt
+ src/MCL/Curves/Fp254BNb/Fp2.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.Fp2+ ( Fp2+ , alpha+ , mkFp2+ , fp2_c0+ , fp2_c1+ , fp2_isZero+ , fp2_squareRoot+ ) where++import Control.DeepSeq+import Data.Binary+import Foreign.C.Types++import MCL.Curves.Fp254BNb.Fp+import qualified MCL.Internal.Field as I+import qualified MCL.Internal.Prim as I++-- | Quadratic field extension of 'Fp' defined as @Fp(α)@, where @α² = -1@.+data Fp2 = Fp2 { unFp2 :: I.CC Fp2 }++instance Binary Fp2 where+ put n = put (fp2_c0 n) >> put (fp2_c1 n)+ get = mkFp2 <$> get <*> get++instance NFData Fp2 where+ rnf = (`seq` ())++instance Num Fp2 where+ (+) = I.addFp+ (-) = I.subtractFp+ (*) = I.multiplyFp+ negate = I.negateFp+ abs = I.absFp+ signum = I.signumFp+ fromInteger n = mkFp2 (fromInteger n) 0++instance Fractional Fp2 where+ recip = I.recipFp+ fromRational = I.fromRationalFp++instance Eq Fp2 where+ (==) = I.eqFp++instance Show Fp2 where+ showsPrec p a = case c0 of+ 0 -> ext False+ n -> showsPrec p n . ext True+ where+ c0 = fp2_c0 a+ c1 = fp2_c1 a++ plus True = (" + " ++)+ plus False = id++ ext out = case c1 of+ 0 -> if out then id else ("0" ++)+ 1 -> plus out . ("a" ++)+ _ -> plus out . showsPrec p c1 . ("a" ++)++-- | Root of the polynomial @x² + 1@.+{-# NOINLINE alpha #-}+alpha :: Fp2+alpha = mkFp2 0 1++-- | Construct an element of Fp from two coordinates in Fp.+{-# INLINE mkFp2 #-}+mkFp2 :: Fp -> Fp -> Fp2+mkFp2 = I.unsafeOp2_ c_mcl_fp254bnb_fp2_from_base++-- | Return first Fp coordinate of the element in Fp2.+{-# INLINE fp2_c0 #-}+fp2_c0 :: Fp2 -> Fp+fp2_c0 = I.unsafeOp1_ c_mcl_fp254bnb_fp2_c0++-- | Return second Fp coordinate of the element in Fp2.+{-# INLINE fp2_c1 #-}+fp2_c1 :: Fp2 -> Fp+fp2_c1 = I.unsafeOp1_ c_mcl_fp254bnb_fp2_c1++-- | Check whether the element of Fp2 is zero.+{-# INLINE fp2_isZero #-}+fp2_isZero :: Fp2 -> Bool+fp2_isZero = I.isZero++-- | Compute square root of the element @a ∈ Fp2@. If polynomial @x² - a@ has no+-- roots in Fp2, no result is returned.+{-# INLINE fp2_squareRoot #-}+fp2_squareRoot :: Fp2 -> Maybe Fp2+fp2_squareRoot = I.squareRoot++----------------------------------------++-- | Internal+instance I.Prim Fp2 where+ prim_size _ = fromIntegral c_mcl_fp254bnb_fp2_size+ prim_wrap = Fp2+ prim_unwrap = unFp2++-- | Internal+instance I.HasArith Fp2 where+ c_add _ = c_mcl_fp254bnb_fp2_add+ c_subtract _ = c_mcl_fp254bnb_fp2_subtract+ c_multiply _ = c_mcl_fp254bnb_fp2_multiply+ c_negate _ = c_mcl_fp254bnb_fp2_negate+ c_invert _ = c_mcl_fp254bnb_fp2_invert+ c_eq _ = c_mcl_fp254bnb_fp2_eq+ c_is_zero _ = c_mcl_fp254bnb_fp2_is_zero++-- | Internal+instance I.HasSqrt Fp2 where+ c_sqrt _ = c_mcl_fp254bnb_fp2_sqrt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_size"+ c_mcl_fp254bnb_fp2_size :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_add"+ c_mcl_fp254bnb_fp2_add :: I.CC Fp2 -> I.CC Fp2 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_subtract"+ c_mcl_fp254bnb_fp2_subtract :: I.CC Fp2 -> I.CC Fp2 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_multiply"+ c_mcl_fp254bnb_fp2_multiply :: I.CC Fp2 -> I.CC Fp2 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_negate"+ c_mcl_fp254bnb_fp2_negate :: I.CC Fp2 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_from_base"+ c_mcl_fp254bnb_fp2_from_base :: I.CC Fp -> I.CC Fp -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_invert"+ c_mcl_fp254bnb_fp2_invert :: I.CC Fp2 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_eq"+ c_mcl_fp254bnb_fp2_eq :: I.CC Fp2 -> I.CC Fp2 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_c0"+ c_mcl_fp254bnb_fp2_c0 :: I.CC Fp2 -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_c1"+ c_mcl_fp254bnb_fp2_c1 :: I.CC Fp2 -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_is_zero"+ c_mcl_fp254bnb_fp2_is_zero :: I.CC Fp2 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fp2_sqrt"+ c_mcl_fp254bnb_fp2_sqrt :: I.CC Fp2 -> I.MC Fp2 -> IO CInt
+ src/MCL/Curves/Fp254BNb/Fr.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.Fr+ ( Fr+ , mkFr+ , hashToFr+ , fromFr+ , fr_modulus+ , fr_isZero+ , fr_squareRoot+ ) where++import Control.DeepSeq+import Data.Binary+import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals+import qualified Data.ByteString as BS++import MCL.Internal.Utils+import qualified MCL.Internal.Field as I+import qualified MCL.Internal.Prim as I++-- | Prime finite field of characteristic @r@.+data Fr = Fr { unFr :: I.CC Fr }++instance Binary Fr where+ put = putBytesFx 32 . fromFr+ get = mkFr <$> getBytesFx 32++instance NFData Fr where+ rnf = (`seq` ())++instance Num Fr where+ (+) = I.addFp+ (-) = I.subtractFp+ (*) = I.multiplyFp+ negate = I.negateFp+ abs = I.absFp+ signum = I.signumFp+ fromInteger = mkFr++instance Fractional Fr where+ recip = I.recipFp+ fromRational = I.fromRationalFp++instance Eq Fr where+ (==) = I.eqFp++instance Show Fr where+ showsPrec = I.showsPrecFp++-- | Construct an element of Fr from Integer.+{-# INLINE mkFr #-}+mkFr :: Integer -> Fr+mkFr = I.mkFp++-- | Hash arbitrary message to Fr by computing its SHA256 hash and treating its+-- first 253 bits as the value of Fr.+{-# INLINE hashToFr #-}+hashToFr :: BS.ByteString -> Fr+hashToFr = I.hashToFp++-- | Convert the element of Fr back to non-negative Integer.+{-# INLINE fromFr #-}+fromFr :: Fr -> Integer+fromFr = I.fromFp++-- | Modulus of Fr.+{-# NOINLINE fr_modulus #-}+fr_modulus :: Integer+fr_modulus = I.modulus (proxy# :: Proxy# Fr)++-- | Check if the element of Fr is zero.+{-# INLINE fr_isZero #-}+fr_isZero :: Fr -> Bool+fr_isZero = I.isZero++-- | Compute square root of the element @a ∈ Fr@. If polynomial @x² - a@ has no+-- roots in Fr, no result is returned.+{-# INLINE fr_squareRoot #-}+fr_squareRoot :: Fr -> Maybe Fr+fr_squareRoot = I.squareRoot++----------------------------------------++-- | Internal+instance I.Prim Fr where+ prim_size _ = fromIntegral c_mcl_fp254bnb_fr_size+ prim_wrap = Fr+ prim_unwrap = unFr++-- | Internal+instance I.BaseField Fr where+ c_limbs _ = fromIntegral c_mcl_fp254bnb_fr_limbs+ c_modulus _ = c_mcl_fp254bnb_fr_modulus+ c_hash_to _ = c_mcl_fp254bnb_fr_hash_to+ c_from_integer _ = c_mcl_fp254bnb_fr_from_integer+ c_from_hsint _ = c_mcl_fp254bnb_fr_from_hsint+ c_to_integer _ = c_mcl_fp254bnb_fr_to_gmp_integer++-- | Internal+instance I.HasArith Fr where+ c_add _ = c_mcl_fp254bnb_fr_add+ c_subtract _ = c_mcl_fp254bnb_fr_subtract+ c_multiply _ = c_mcl_fp254bnb_fr_multiply+ c_negate _ = c_mcl_fp254bnb_fr_negate+ c_invert _ = c_mcl_fp254bnb_fr_invert+ c_eq _ = c_mcl_fp254bnb_fr_eq+ c_is_zero _ = c_mcl_fp254bnb_fr_is_zero++-- | Internal+instance I.HasSqrt Fr where+ c_sqrt _ = c_mcl_fp254bnb_fr_sqrt++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_size"+ c_mcl_fp254bnb_fr_size :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_limbs"+ c_mcl_fp254bnb_fr_limbs :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_modulus"+ c_mcl_fp254bnb_fr_modulus :: I.MC Integer -> CSize -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_hash_to"+ c_mcl_fp254bnb_fr_hash_to :: Ptr CChar -> CSize -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_add"+ c_mcl_fp254bnb_fr_add :: I.CC Fr -> I.CC Fr -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_subtract"+ c_mcl_fp254bnb_fr_subtract :: I.CC Fr -> I.CC Fr -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_multiply"+ c_mcl_fp254bnb_fr_multiply :: I.CC Fr -> I.CC Fr -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_negate"+ c_mcl_fp254bnb_fr_negate :: I.CC Fr -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_from_integer"+ c_mcl_fp254bnb_fr_from_integer :: I.CC Integer -> GmpSize# -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_from_hsint"+ c_mcl_fp254bnb_fr_from_hsint :: Int# -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_invert"+ c_mcl_fp254bnb_fr_invert :: I.CC Fr -> I.MC Fr -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_eq"+ c_mcl_fp254bnb_fr_eq :: I.CC Fr -> I.CC Fr -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_to_gmp_integer"+ c_mcl_fp254bnb_fr_to_gmp_integer :: I.CC Fr -> I.MC Integer -> CSize -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_is_zero"+ c_mcl_fp254bnb_fr_is_zero :: I.CC Fr -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_fr_sqrt"+ c_mcl_fp254bnb_fr_sqrt :: I.CC Fr -> I.MC Fr -> IO CInt
+ src/MCL/Curves/Fp254BNb/G1.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.G1+ ( G1+ , mkG1+ , mapToG1+ , g1_zero+ , g1_isZero+ , g1_affineCoords+ , g1_getYfromX+ , g1_powFr+ ) where++import Control.DeepSeq+import Data.Binary+import Data.Bits+import Data.Group+import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals++import MCL.Curves.Fp254BNb.Fp+import MCL.Curves.Fp254BNb.Fr+import MCL.Internal.Utils+import qualified MCL.Internal.Group as I+import qualified MCL.Internal.Prim as I++-- | Subgroup of @E(Fp)@ (i.e. curve points with coordinates in Fp) of order+-- @r@.+data G1 = G1 { unG1 :: I.CC G1 }++instance Binary G1 where+ put = putCurvePoint g1_affineCoords putY+ where+ putY y = put . cintToBool . fromIntegral $ fromFp y .&. 1++ get = getCurvePoint g1_zero $ \x y_lsb ->+ mkG1 x =<< g1_getYfromX y_lsb x++instance NFData G1 where+ rnf = (`seq` ())++instance Eq G1 where+ (==) = I.eqG++instance Show G1 where+ showsPrec = I.showsPrecG++-- | Point addition.+instance Monoid G1 where+ mempty = I.zero+ mappend = I.plusG++-- | Note: 'pow' uses const-time method, just as 'g1_powFr'.+instance Group G1 where+ invert = I.invertG+ pow = flip I.scalarMul++instance Abelian G1++-- | Construct non-zero element of G1 from two coordinates in Fp. If @(X,Y)@+-- does not lie on G1, no result is returned.+{-# INLINE mkG1 #-}+mkG1+ :: Fp -- ^ X coordinate+ -> Fp -- ^ Y coordinate+ -> Maybe G1+mkG1 = I.mkG++-- | Map an element of Fp to a curve point. Note: @mapToG1 . hashToFp@ does NOT+-- yield generically secure hash function. For more details see page 3 of+-- "Indifferentiable Hashing to Barreto-Naehrig Curves"+-- (<https://www.di.ens.fr/~fouque/pub/latincrypt12.pdf>).+{-# INLINE mapToG1 #-}+mapToG1 :: Fp -> G1+mapToG1 = I.mapToG++-- | Neutral element of G1 (point at infinity).+{-# NOINLINE g1_zero #-}+g1_zero :: G1+g1_zero = I.zero++-- | Check if the element of G1 is point at infinity.+{-# INLINE g1_isZero #-}+g1_isZero :: G1 -> Bool+g1_isZero = I.isZero++-- | Return affine coordinates of the element @a ∈ G1@. No result is returned if+-- @a@ is the point at inifinity.+{-# INLINE g1_affineCoords #-}+g1_affineCoords :: G1 -> Maybe (Fp, Fp)+g1_affineCoords = I.affineCoords++-- | Attempt to recover Y coordinate from its least significant bit and X+-- coordinate.+{-# INLINE g1_getYfromX #-}+g1_getYfromX+ :: Bool -- ^ Least significant bit of Y coordinate+ -> Fp -- ^ X coordinate+ -> Maybe Fp+g1_getYfromX = I.getYfromX (proxy# :: Proxy# G1)++-- | Multiply the element of G1 by a scalar @x ∈ Fr@. Note: it uses const-time+-- method, i.e. the time it takes to calculate the result depends only on the+-- bitlength of @x@.+{-# INLINE g1_powFr #-}+g1_powFr :: G1 -> Fr -> G1+g1_powFr = I.powFr++----------------------------------------++-- | Internal+instance I.Prim G1 where+ prim_size _ = fromIntegral c_mcl_fp254bnb_g1_size+ prim_wrap = G1+ prim_unwrap = unG1++-- | Internal+instance I.CurveGroup Fp G1 where+ c_zero _ = c_mcl_fp254bnb_g1_zero+ c_construct _ = c_mcl_fp254bnb_g1_construct+ c_map_to _ = c_mcl_fp254bnb_g1_map_to+ c_add _ = c_mcl_fp254bnb_g1_add+ c_invert _ = c_mcl_fp254bnb_g1_invert+ c_scalar_mul_native _ = c_mcl_fp254bnb_g1_scalar_mul_native+ c_scalar_mul_bignat _ = c_mcl_fp254bnb_g1_scalar_mul+ c_scalar_mul_hsint _ = c_mcl_fp254bnb_g1_scalar_mul_small+ c_eq _ = c_mcl_fp254bnb_g1_eq+ c_is_zero _ = c_mcl_fp254bnb_g1_is_zero+ c_affine_coords _ = c_mcl_fp254bnb_g1_affine_coords+ c_y_from_x _ = c_mcl_fp254bnb_g1_y_from_x++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_size"+ c_mcl_fp254bnb_g1_size :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_zero"+ c_mcl_fp254bnb_g1_zero :: I.MC G1 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g1_construct"+ c_mcl_fp254bnb_g1_construct :: I.CC Fp -> I.CC Fp -> I.MC G1 -> IO CInt++foreign import ccall safe "hs_mcl_fp254bnb_g1_map_to"+ c_mcl_fp254bnb_g1_map_to :: I.CC Fp -> I.MC G1 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_add"+ c_mcl_fp254bnb_g1_add :: I.CC G1 -> I.CC G1 -> I.MC G1 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_invert"+ c_mcl_fp254bnb_g1_invert :: I.CC G1 -> I.MC G1 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g1_scalar_mul_native"+ c_mcl_fp254bnb_g1_scalar_mul_native :: CInt -> I.CC Fr -> I.CC G1 -> I.MC G1 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g1_scalar_mul"+ c_mcl_fp254bnb_g1_scalar_mul :: CInt -> I.CC Integer -> GmpSize# -> CInt+ -> I.CC G1 -> I.MC G1 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g1_scalar_mul_small"+ c_mcl_fp254bnb_g1_scalar_mul_small :: CInt -> Int# -> I.CC G1 -> I.MC G1 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_eq"+ c_mcl_fp254bnb_g1_eq :: I.CC G1 -> I.CC G1 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_is_zero"+ c_mcl_fp254bnb_g1_is_zero :: I.CC G1 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_affine_coords"+ c_mcl_fp254bnb_g1_affine_coords :: I.CC G1 -> I.MC Fp -> I.MC Fp -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g1_y_from_x"+ c_mcl_fp254bnb_g1_y_from_x :: CInt -> I.CC Fp -> I.MC Fp -> IO CInt
+ src/MCL/Curves/Fp254BNb/G2.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.G2+ ( G2+ , mkG2+ , mapToG2+ , g2_zero+ , g2_isZero+ , g2_affineCoords+ , g2_getYfromX+ , g2_powFr+ ) where++import Control.DeepSeq+import Data.Binary+import Data.Bits+import Data.Group+import Data.Primitive.ByteArray+import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals++import MCL.Curves.Fp254BNb.Fp+import MCL.Curves.Fp254BNb.Fp2+import MCL.Curves.Fp254BNb.Fr+import MCL.Internal.Utils+import qualified MCL.Internal.Group as I+import qualified MCL.Internal.Prim as I++-- | Subgroup of @E'(Fp2)@ (i.e. curve points with coordinates in Fp2) of order+-- @r@.+data G2 = G2 { unG2 :: I.CC G2 }++instance Binary G2 where+ put = putCurvePoint g2_affineCoords putY+ where+ putY y = put . cintToBool . fromIntegral $ fromFp (fp2_c0 y) .&. 1++ get = getCurvePoint g2_zero $ \x y_lsb ->+ mkG2 x =<< g2_getYfromX y_lsb x++instance NFData G2 where+ rnf = (`seq` ())++instance Eq G2 where+ (==) = I.eqG++instance Show G2 where+ showsPrec = I.showsPrecG++-- | Point addition.+instance Monoid G2 where+ mempty = I.zero+ mappend = I.plusG++-- | Note: 'pow' uses const-time method, just as 'g2_powFr'.+instance Group G2 where+ invert = I.invertG+ pow = flip I.scalarMul++instance Abelian G2++-- | Construct non-zero element of G2 from two coordinates in Fp2. If @(X,Y)@+-- does not lie on G2, no result is returned.+{-# INLINABLE mkG2 #-}+mkG2+ :: Fp2 -- ^ X coordinate+ -> Fp2 -- ^ Y coordinate+ -> Maybe G2+mkG2 = I.mkG++-- | Map an element of Fp2 to a curve point.+{-# INLINABLE mapToG2 #-}+mapToG2 :: Fp2 -> G2+mapToG2 = I.mapToG++-- | Neutral element of G2 (point at infinity).+{-# NOINLINE g2_zero #-}+g2_zero :: G2+g2_zero = I.zero++-- | Check if the element of G2 is point at infinity.+{-# INLINABLE g2_isZero #-}+g2_isZero :: G2 -> Bool+g2_isZero = I.isZero++-- | Return affine coordinates of the element @a ∈ G2@. No result is returned if+-- @a@ is the point at inifinity.+{-# INLINABLE g2_affineCoords #-}+g2_affineCoords :: G2 -> Maybe (Fp2, Fp2)+g2_affineCoords = I.affineCoords++-- | Attempt to recover Y coordinate from its least significant bit and X+-- coordinate.+{-# INLINABLE g2_getYfromX #-}+g2_getYfromX+ :: Bool -- ^ Least significant bit of Y coordinate+ -> Fp2 -- ^ X coordinate+ -> Maybe Fp2+g2_getYfromX = I.getYfromX (proxy# :: Proxy# G2)++-- | Multiply the element of G2 by a scalar @x ∈ Fr@. Note: it uses const-time+-- method, i.e. the time it takes to calculate the result depends only on the+-- bitlength of @x@.+{-# INLINABLE g2_powFr #-}+g2_powFr :: G2 -> Fr -> G2+g2_powFr = I.powFr++----------------------------------------++-- | Internal+instance I.Prim G2 where+ prim_size _ = fromIntegral c_mcl_fp254bnb_g2_size+ prim_wrap = G2+ prim_unwrap = unG2++-- | Internal+instance I.CurveGroup Fp2 G2 where+ c_zero _ = c_mcl_fp254bnb_g2_zero+ c_construct _ = c_mcl_fp254bnb_g2_construct+ c_map_to _ = c_mcl_fp254bnb_g2_map_to+ c_add _ = c_mcl_fp254bnb_g2_add+ c_invert _ = c_mcl_fp254bnb_g2_invert+ c_scalar_mul_native _ = c_mcl_fp254bnb_g2_scalar_mul_native+ c_scalar_mul_bignat _ = c_mcl_fp254bnb_g2_scalar_mul+ c_scalar_mul_hsint _ = c_mcl_fp254bnb_g2_scalar_mul_small+ c_eq _ = c_mcl_fp254bnb_g2_eq+ c_is_zero _ = c_mcl_fp254bnb_g2_is_zero+ c_affine_coords _ = c_mcl_fp254bnb_g2_affine_coords+ c_y_from_x _ = c_mcl_fp254bnb_g2_y_from_x++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_size"+ c_mcl_fp254bnb_g2_size :: CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_zero"+ c_mcl_fp254bnb_g2_zero :: I.MC G2 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g2_construct"+ c_mcl_fp254bnb_g2_construct :: I.CC Fp2 -> I.CC Fp2 -> I.MC G2 -> IO CInt++foreign import ccall safe "hs_mcl_fp254bnb_g2_map_to"+ c_mcl_fp254bnb_g2_map_to :: I.CC Fp2 -> I.MC G2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_add"+ c_mcl_fp254bnb_g2_add :: I.CC G2 -> I.CC G2 -> I.MC G2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_invert"+ c_mcl_fp254bnb_g2_invert :: I.CC G2 -> I.MC G2 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g2_scalar_mul_native"+ c_mcl_fp254bnb_g2_scalar_mul_native :: CInt -> I.CC Fr -> I.CC G2 -> I.MC G2 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g2_scalar_mul"+ c_mcl_fp254bnb_g2_scalar_mul :: CInt -> ByteArray# -> GmpSize# -> CInt+ -> I.CC G2 -> I.MC G2 -> IO ()++foreign import ccall safe "hs_mcl_fp254bnb_g2_scalar_mul_small"+ c_mcl_fp254bnb_g2_scalar_mul_small :: CInt -> Int# -> I.CC G2 -> I.MC G2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_eq"+ c_mcl_fp254bnb_g2_eq :: I.CC G2 -> I.CC G2 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_is_zero"+ c_mcl_fp254bnb_g2_is_zero :: I.CC G2 -> IO CInt++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_affine_coords"+ c_mcl_fp254bnb_g2_affine_coords :: I.CC G2 -> I.MC Fp2 -> I.MC Fp2 -> IO ()++foreign import ccall unsafe "hs_mcl_fp254bnb_g2_y_from_x"+ c_mcl_fp254bnb_g2_y_from_x :: CInt -> I.CC Fp2 -> I.MC Fp2 -> IO CInt
+ src/MCL/Curves/Fp254BNb/GT.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.GT+ ( GT+ , mkGT+ , gt_powFr+ ) where++import Control.DeepSeq+import Data.Binary+import Data.Group+import Foreign.C.Types+import GHC.Exts++import MCL.Curves.Fp254BNb.Fp12+import MCL.Curves.Fp254BNb.Fr+import qualified MCL.Internal.Prim as I++-- | Subgroup of Fp12* of @r@-th roots of unity.+newtype GT = GT_ { unGT :: Fp12 }+ deriving (Binary, Eq, NFData)++instance Show GT where+ showsPrec p (GT_ a) = showsPrec p a++instance Monoid GT where+ mempty = GT_ 1+ mappend (GT_ a) (GT_ b) = GT_ (a * b)++instance Group GT where+ invert (GT_ a) = GT_ (recip a)+ pow a p = a `gt_powFr` mkFr (toInteger p)++instance Abelian GT++-- | Construct an element of GT from @a ∈ Fp12@. If @a@ is not an @r@-th root of+-- unity, no result is returned.+{-# INLINABLE mkGT #-}+mkGT :: Fp12 -> Maybe GT+mkGT a = case a ^ fr_modulus of+ 1 -> Just (GT_ a)+ _ -> Nothing++-- | Raise the element of GT to the power @x ∈ Fr@. Note: it uses const-time+-- method, i.e. the time it takes to calculate the result depends only on the+-- bitlength of @x@.+{-# INLINABLE gt_powFr #-}+gt_powFr :: GT -> Fr -> GT+gt_powFr (GT_ a) = GT_ . I.safeOp2_ (c_mcl_fp254bnb_gt_pow_native 1) a++----------------------------------------++-- | Internal+instance I.Prim GT where+ prim_size _ = I.prim_size (proxy# :: Proxy# Fp12)+ prim_wrap = \ba -> GT_ (I.prim_wrap ba)+ prim_unwrap = \gt -> I.prim_unwrap (unGT gt)++foreign import ccall safe "hs_mcl_fp254bnb_gt_pow_native"+ c_mcl_fp254bnb_gt_pow_native :: CInt -> I.CC Fp12 -> I.CC Fr -> I.MC Fp12 -> IO ()
+ src/MCL/Curves/Fp254BNb/Pairing.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Curves.Fp254BNb.Pairing (pairing) where++import MCL.Curves.Fp254BNb.Fp12+import MCL.Curves.Fp254BNb.G1+import MCL.Curves.Fp254BNb.G2+import MCL.Curves.Fp254BNb.GT+import qualified MCL.Internal.Prim as I++-- | Compute optimal ate pairing.+pairing :: G1 -> G2 -> GT+pairing = I.safeOp2_ c_mcl_fp254bnb_pairing++foreign import ccall safe "hs_mcl_fp254bnb_pairing"+ c_mcl_fp254bnb_pairing :: I.CC G1 -> I.CC G2 -> I.MC Fp12 -> IO ()
+ src/MCL/Internal/Field.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+module MCL.Internal.Field where++import Data.Ratio+import Data.Typeable+import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import MCL.Internal.Prim+import MCL.Internal.Utils++class Prim fp => BaseField fp where+ c_limbs :: Proxy# fp -> Int+ c_modulus :: Proxy# fp -> MC Integer -> CSize -> IO ()+ c_hash_to :: Proxy# fp -> Ptr CChar -> CSize -> MC fp -> IO ()+ c_from_integer :: Proxy# fp -> CC Integer -> GmpSize# -> MC fp -> IO ()+ c_from_hsint :: Proxy# fp -> Int# -> MC fp -> IO ()+ c_to_integer :: Proxy# fp -> CC fp -> MC Integer -> CSize -> IO ()++{-# INLINABLE mkFp #-}+mkFp :: forall fp. (BaseField fp, Typeable fp) => Integer -> fp+mkFp n = unsafeOp0_ $ case n `mod` (modulus fp) of+ Jp# x@(BN# ba) -> c_from_integer fp ba (sizeofBigNat# x)+ Jn# _ -> error $ "mkFp (" ++ fpRep ++ "): n mod p is negative"+ S# k -> c_from_hsint fp k+ where+ fp = proxy# :: Proxy# fp+ fpRep = show $ typeRep (Proxy :: Proxy fp)++{-# INLINABLE hashToFp #-}+hashToFp :: forall fp. BaseField fp => BS.ByteString -> fp+hashToFp bs = unsafeOp0 . BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->+ newPrim_ $ c_hash_to (proxy# :: Proxy# fp) ptr (fromIntegral len)++{-# INLINABLE fromFp #-}+fromFp :: forall fp. BaseField fp => fp -> Integer+fromFp = unsafeOp1 (importInteger (c_limbs fp)) (c_to_integer fp)+ where+ fp = proxy# :: Proxy# fp++{-# INLINABLE modulus #-}+modulus :: BaseField fp => Proxy# fp -> Integer+modulus fp = unsafeOp0 $ importInteger (c_limbs fp) (c_modulus fp)++{-# INLINABLE showsPrecFp #-}+showsPrecFp :: BaseField fp => Int -> fp -> ShowS+showsPrecFp p = showsPrec p . fromFp++----------------------------------------++class Prim fp => HasArith fp where+ c_add :: Proxy# fp -> CC fp -> CC fp -> MC fp -> IO ()+ c_subtract :: Proxy# fp -> CC fp -> CC fp -> MC fp -> IO ()+ c_multiply :: Proxy# fp -> CC fp -> CC fp -> MC fp -> IO ()+ c_negate :: Proxy# fp -> CC fp -> MC fp -> IO ()+ c_invert :: Proxy# fp -> CC fp -> MC fp -> IO ()+ c_eq :: Proxy# fp -> CC fp -> CC fp -> IO CInt+ c_is_zero :: Proxy# fp -> CC fp -> IO CInt++{-# INLINABLE isZero #-}+isZero :: forall fp. HasArith fp => fp -> Bool+isZero = unsafeOp1 (fmap cintToBool) $ c_is_zero (proxy# :: Proxy# fp)++{-# INLINABLE addFp #-}+addFp :: forall fp. HasArith fp => fp -> fp -> fp+addFp = unsafeOp2_ $ c_add (proxy# :: Proxy# fp)++{-# INLINABLE subtractFp #-}+subtractFp :: forall fp. HasArith fp => fp -> fp -> fp+subtractFp = unsafeOp2_ $ c_subtract (proxy# :: Proxy# fp)++{-# INLINABLE multiplyFp #-}+multiplyFp :: forall fp. HasArith fp => fp -> fp -> fp+multiplyFp = unsafeOp2_ $ c_multiply (proxy# :: Proxy# fp)++{-# INLINABLE negateFp #-}+negateFp :: forall fp. HasArith fp => fp -> fp+negateFp = unsafeOp1_ $ c_negate (proxy# :: Proxy# fp)++{-# INLINABLE absFp #-}+absFp :: fp -> fp+absFp = id++{-# INLINABLE signumFp #-}+signumFp :: forall fp. (HasArith fp, Num fp) => fp -> fp+signumFp fp = if isZero fp then fp else 1++{-# INLINABLE recipFp #-}+recipFp :: forall fp. HasArith fp => fp -> fp+recipFp = unsafeOp1_ $ c_invert (proxy# :: Proxy# fp)++{-# INLINABLE fromRationalFp #-}+fromRationalFp :: Fractional fp => Rational -> fp+fromRationalFp r = fromIntegral (numerator r) / fromIntegral (denominator r)++{-# INLINABLE eqFp #-}+eqFp :: forall fp. HasArith fp => fp -> fp -> Bool+eqFp = unsafeOp2 (fmap cintToBool) $ c_eq (proxy# :: Proxy# fp)++----------------------------------------++class HasArith fp => HasSqrt fp where+ c_sqrt :: Proxy# fp -> CC fp -> MC fp -> IO CInt++{-# INLINABLE squareRoot #-}+squareRoot :: forall fp. HasSqrt fp => fp -> Maybe fp+squareRoot = unsafeOp1 maybeNewPrim $ c_sqrt (proxy# :: Proxy# fp)
+ src/MCL/Internal/Group.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+module MCL.Internal.Group where++import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals++import MCL.Internal.Prim+import MCL.Internal.Utils++class (Prim fp, Prim g) => CurveGroup fp g | g -> fp where+ c_zero :: Proxy# g -> MC g -> IO ()+ c_construct :: Proxy# g -> CC fp -> CC fp -> MC g -> IO CInt+ c_map_to :: Proxy# g -> CC fp -> MC g -> IO ()+ c_add :: Proxy# g -> CC g -> CC g -> MC g -> IO ()+ c_invert :: Proxy# g -> CC g -> MC g -> IO ()+ c_scalar_mul_native :: Proxy# g -> CInt -> CC fr -> CC g -> MC g -> IO ()+ c_scalar_mul_bignat :: Proxy# g -> CInt -> CC Integer -> GmpSize#+ -> CInt -> CC g -> MC g -> IO ()+ c_scalar_mul_hsint :: Proxy# g -> CInt -> Int# -> CC g -> MC g -> IO ()+ c_eq :: Proxy# g -> CC g -> CC g -> IO CInt+ c_is_zero :: Proxy# g -> CC g -> IO CInt+ c_affine_coords :: Proxy# g -> CC g -> MC fp -> MC fp -> IO ()+ c_y_from_x :: Proxy# g -> CInt -> CC fp -> MC fp -> IO CInt++{-# INLINABLE mkG #-}+mkG :: forall fp g. CurveGroup fp g => fp -> fp -> Maybe g+mkG = safeOp2 maybeNewPrimPinned $ c_construct (proxy# :: Proxy# g)++{-# INLINABLE mapToG #-}+mapToG :: forall fp g. CurveGroup fp g => fp -> g+mapToG = safeOp1_ $ c_map_to (proxy# :: Proxy# g)++{-# INLINABLE zero #-}+zero :: forall fp g. CurveGroup fp g => g+zero = unsafeOp0_ $ c_zero (proxy# :: Proxy# g)++{-# INLINABLE isZero #-}+isZero :: forall fp g. CurveGroup fp g => g -> Bool+isZero = unsafeOp1 (fmap cintToBool) $ c_is_zero (proxy# :: Proxy# g)++{-# INLINABLE affineCoords #-}+affineCoords :: forall fp g. CurveGroup fp g => g -> Maybe (fp, fp)+affineCoords fp+ | isZero fp = Nothing+ | otherwise = Just $ unsafeOp1 new2Prim (c_affine_coords (proxy# :: Proxy# g)) fp++{-# INLINABLE getYfromX #-}+getYfromX :: CurveGroup fp g => Proxy# g -> Bool -> fp -> Maybe fp+getYfromX g = unsafeOp1 maybeNewPrim . c_y_from_x g . boolToCInt++{-# INLINABLE powFr #-}+powFr :: forall fp fr g. (CurveGroup fp g, Prim fr) => g -> fr -> g+powFr = safeOp2_ $ \p x -> c_scalar_mul_native (proxy# :: Proxy# g) 1 x p++{-# INLINABLE eqG #-}+eqG :: forall fp g. CurveGroup fp g => g -> g -> Bool+eqG = unsafeOp2 (fmap cintToBool) $ c_eq (proxy# :: Proxy# g)++{-# INLINABLE plusG #-}+plusG :: forall fp g. CurveGroup fp g => g -> g -> g+plusG = unsafeOp2_ $ c_add (proxy# :: Proxy# g)++{-# INLINABLE invertG #-}+invertG :: forall fp g. CurveGroup fp g => g -> g+invertG = unsafeOp1_ $ c_invert (proxy# :: Proxy# g)++{-# INLINABLE scalarMul #-}+scalarMul :: forall a fp g. (CurveGroup fp g, Integral a) => a -> g -> g+scalarMul n = safeOp1_ $ \p -> case toInteger n of+ Jp# x@(BN# ba) -> c_scalar_mul_bignat g 1 ba (sizeofBigNat# x) 0 p+ Jn# x@(BN# ba) -> c_scalar_mul_bignat g 1 ba (sizeofBigNat# x) 1 p+ S# k -> c_scalar_mul_hsint g 1 k p+ where+ g = proxy# :: Proxy# g++{-# INLINABLE showsPrecG #-}+showsPrecG :: forall fp g. (CurveGroup fp g, Show fp) => Int -> g -> ShowS+showsPrecG = \p -> maybe ("0" ++) (showsPrec p) . affineCoords
+ src/MCL/Internal/Prim.hs view
@@ -0,0 +1,9 @@+module MCL.Internal.Prim+ ( module MCL.Internal.Prim.Class+ , module MCL.Internal.Prim.Pinned+ , module MCL.Internal.Prim.Unpinned+ ) where++import MCL.Internal.Prim.Class+import MCL.Internal.Prim.Pinned+import MCL.Internal.Prim.Unpinned
+ src/MCL/Internal/Prim/Class.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE MagicHash #-}+module MCL.Internal.Prim.Class where++import Data.Primitive.ByteArray+import GHC.Exts++-- | C representation of a const MCL object or Integer.+type CC t = ByteArray#++-- | C representation of a mutable MCL object or Integer.+type MC t = MutableByteArray# RealWorld++class Prim t where+ prim_size :: Proxy# t -> Int+ prim_wrap :: CC t -> t+ prim_unwrap :: t -> CC t
+ src/MCL/Internal/Prim/Pinned.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+module MCL.Internal.Prim.Pinned where++import Data.Functor.Identity+import Data.Primitive.ByteArray+import Foreign.C.Types+import GHC.Exts+import System.IO.Unsafe++import MCL.Internal.Prim.Class+import MCL.Internal.Utils++-- | Pass pinned copy of the object to a safe C function.+{-# INLINABLE withPrimPinned #-}+withPrimPinned :: Prim t => t -> (CC t -> IO r) -> IO r+withPrimPinned fp k = do+ ByteArray ba <- pinnedByteArrayCopy $ ByteArray (prim_unwrap fp)+ k ba+ where+ pinnedByteArrayCopy :: ByteArray -> IO ByteArray+ pinnedByteArrayCopy src = do+ mdest <- newPinnedByteArray srcSize+ copyByteArray mdest 0 src 0 srcSize+ unsafeFreezeByteArray mdest+ where+ srcSize = sizeofByteArray src++-- | Use pinned memory to get a result from a safe C function.+{-# INLINABLE newPrimPinned #-}+newPrimPinned+ :: forall m t r. Prim t+ => (r -> CC t -> m t)+ -> (MC t -> IO r)+ -> IO (m t)+newPrimPinned = withPinnedByteArray1 (prim_size (proxy# :: Proxy# t))++{-# INLINABLE newPrimPinned_ #-}+newPrimPinned_ :: forall t. Prim t => (MC t -> IO ()) -> IO t+newPrimPinned_ = unwrap . newPrimPinned (\_ ba -> Identity (prim_wrap ba))+ where+ unwrap :: IO (Identity t) -> IO t+ unwrap = coerce++{-# INLINABLE maybeNewPrimPinned #-}+maybeNewPrimPinned :: Prim t => (MC t -> IO CInt) -> IO (Maybe t)+maybeNewPrimPinned = newPrimPinned $ \success ba ->+ if cintToBool success+ then Just (prim_wrap ba)+ else Nothing++----------------------------------------++{-# INLINABLE safeOp0 #-}+safeOp0 :: IO r -> r+safeOp0 = unsafeDupablePerformIO++{-# INLINABLE safeOp1 #-}+safeOp1+ :: Prim t+ => (s -> IO r)+ -> (CC t -> s)+ -> (t -> r)+safeOp1 k c_fun fa =+ safeOp0 . withPrimPinned fa $ \a -> k (c_fun a)++{-# INLINABLE safeOp1_ #-}+safeOp1_+ :: (Prim t, Prim r)+ => (CC t -> MC r -> IO ())+ -> (t -> r)+safeOp1_ = safeOp1 newPrimPinned_++{-# INLINABLE safeOp2 #-}+safeOp2+ :: (Prim t1, Prim t2)+ => (s -> IO r)+ -> (CC t1 -> CC t2 -> s)+ -> (t1 -> t2 -> r)+safeOp2 k c_fun fa fb =+ safeOp0 . withPrimPinned fa $ \a -> withPrimPinned fb $ \b -> k (c_fun a b)++{-# INLINABLE safeOp2_ #-}+safeOp2_+ :: (Prim t1, Prim t2, Prim r)+ => (CC t1 -> CC t2 -> MC r -> IO ())+ -> (t1 -> t2 -> r)+safeOp2_ = safeOp2 newPrimPinned_++----------------------------------------+-- Utils++{-# INLINABLE withPinnedByteArray1 #-}+withPinnedByteArray1+ :: Int+ -> (s -> ByteArray# -> r)+ -> (MutableByteArray# RealWorld -> IO s)+ -> IO r+withPinnedByteArray1 size k c_fun = do+ mba@(MutableByteArray umba) <- newPinnedByteArray size+ r <- c_fun umba+ ByteArray uba <- unpinnedFreezeByteArray mba+ return (k r uba)+ where+ unpinnedFreezeByteArray :: MutableByteArray RealWorld -> IO ByteArray+ unpinnedFreezeByteArray src = do+ mdest <- newByteArray srcSize+ copyMutableByteArray mdest 0 src 0 srcSize+ unsafeFreezeByteArray mdest+ where+ srcSize = sizeofMutableByteArray src
+ src/MCL/Internal/Prim/Unpinned.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+module MCL.Internal.Prim.Unpinned where++import Data.Functor.Identity+import Data.Primitive.ByteArray+import Foreign.C.Types+import GHC.Exts+import System.IO.Unsafe++import MCL.Internal.Prim.Class+import MCL.Internal.Utils++{-# INLINABLE withPrim #-}+withPrim :: Prim t => t -> (CC t -> IO r) -> IO r+withPrim fp k = k (prim_unwrap fp)++{-# INLINABLE newPrim #-}+newPrim+ :: forall m t r. Prim t+ => (r -> CC t -> m t)+ -> (MC t -> IO r)+ -> IO (m t)+newPrim = withByteArray1 (prim_size (proxy# :: Proxy# t))++{-# INLINABLE newPrim_ #-}+newPrim_ :: forall t. Prim t => (MC t -> IO ()) -> IO t+newPrim_ = unwrap . newPrim (\_ ba -> Identity (prim_wrap ba))+ where+ unwrap :: IO (Identity t) -> IO t+ unwrap = coerce++{-# INLINABLE maybeNewPrim #-}+maybeNewPrim :: Prim t => (MC t -> IO CInt) -> IO (Maybe t)+maybeNewPrim = newPrim $ \success ba ->+ if cintToBool success+ then Just (prim_wrap ba)+ else Nothing++{-# INLINABLE new2Prim #-}+new2Prim :: forall t. Prim t => (MC t -> MC t -> IO ()) -> IO (t, t)+new2Prim = withByteArray2 (prim_size (proxy# :: Proxy# t)) prim_wrap++----------------------------------------++{-# INLINABLE unsafeOp0 #-}+unsafeOp0 :: IO r -> r+unsafeOp0 = unsafeDupablePerformIO++{-# INLINABLE unsafeOp0_ #-}+unsafeOp0_ :: Prim r => (MC r -> IO ()) -> r+unsafeOp0_ = unsafeOp0 . newPrim_++{-# INLINABLE unsafeOp1 #-}+unsafeOp1+ :: Prim t+ => (s -> IO r)+ -> (CC t -> s)+ -> (t -> r)+unsafeOp1 k c_fun fa =+ unsafeOp0 . withPrim fa $ \a -> k (c_fun a)++{-# INLINABLE unsafeOp1_ #-}+unsafeOp1_+ :: (Prim t, Prim r)+ => (CC t -> MC r -> IO ())+ -> (t -> r)+unsafeOp1_ = unsafeOp1 newPrim_++{-# INLINABLE unsafeOp2 #-}+unsafeOp2+ :: (Prim t1, Prim t2)+ => (s -> IO r)+ -> (CC t1 -> CC t2 -> s)+ -> (t1 -> t2 -> r)+unsafeOp2 k c_fun fa fb =+ unsafeOp0 . withPrim fa $ \a -> withPrim fb $ \b -> k (c_fun a b)++{-# INLINABLE unsafeOp2_ #-}+unsafeOp2_+ :: (Prim t1, Prim t2, Prim r)+ => (CC t1 -> CC t2 -> MC r -> IO ())+ -> (t1 -> t2 -> r)+unsafeOp2_ = unsafeOp2 newPrim_++{-# INLINABLE unsafeOp6 #-}+unsafeOp6+ :: (Prim t1, Prim t2, Prim t3, Prim t4, Prim t5, Prim t6)+ => (s -> IO r)+ -> (CC t1 -> CC t2 -> CC t3 -> CC t4 -> CC t5 -> CC t6 -> s)+ -> (t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> r)+unsafeOp6 k c_fun fa fb fc fd fe ff =+ unsafeOp0 . withPrim fa $ \a -> withPrim fb $ \b -> withPrim fc $ \c ->+ withPrim fd $ \d -> withPrim fe $ \e -> withPrim ff $ \f ->+ k (c_fun a b c d e f)++{-# INLINABLE unsafeOp6_ #-}+unsafeOp6_+ :: (Prim t1, Prim t2, Prim t3, Prim t4, Prim t5, Prim t6, Prim r)+ => (CC t1 -> CC t2 -> CC t3 -> CC t4 -> CC t5 -> CC t6 -> MC r -> IO ())+ -> (t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> r)+unsafeOp6_ = unsafeOp6 newPrim_++----------------------------------------+-- Utils++{-# INLINABLE withByteArray1 #-}+withByteArray1+ :: Int+ -> (s -> ByteArray# -> r)+ -> (MutableByteArray# RealWorld -> IO s)+ -> IO r+withByteArray1 size k c_fun = do+ mba@(MutableByteArray umba) <- newByteArray size+ r <- c_fun umba+ ByteArray uba <- unsafeFreezeByteArray mba+ return (k r uba)++{-# INLINABLE withByteArray2 #-}+withByteArray2+ :: Int+ -> (ByteArray# -> r)+ -> (MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> IO ())+ -> IO (r, r)+withByteArray2 size k c_fun = do+ mba@(MutableByteArray umba) <- newByteArray size+ mbb@(MutableByteArray umbb) <- newByteArray size+ c_fun umba umbb+ ByteArray uba <- unsafeFreezeByteArray mba+ ByteArray ubb <- unsafeFreezeByteArray mbb+ return (k uba, k ubb)
+ src/MCL/Internal/Utils.hsc view
@@ -0,0 +1,100 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module MCL.Internal.Utils+ ( cintToBool+ , boolToCInt+ , putBytesFx+ , getBytesFx+ , putCurvePoint+ , getCurvePoint+ , importInteger+ ) where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.Bits+import Data.List+import Data.Primitive.ByteArray+import Data.Typeable+import Foreign.C.Types+import GHC.Exts+import GHC.Integer.GMP.Internals++#include <gmp.h>++{-# INLINE cintToBool #-}+cintToBool :: CInt -> Bool+cintToBool 0 = False+cintToBool _ = True++{-# INLINE boolToCInt #-}+boolToCInt :: Bool -> CInt+boolToCInt False = 0+boolToCInt True = 1++{-# INLINABLE putBytesFx #-}+putBytesFx :: Int -> Integer -> Put+putBytesFx 0 _ = return ()+putBytesFx n k = do+ putWord64le (fromIntegral k)+ putBytesFx (n - 8) (k `shiftR` 64)++{-# INLINABLE getBytesFx #-}+getBytesFx :: Int -> Get Integer+getBytesFx n = foldl' assemble 0 <$> collect [] (n `div` 8)+ where+ collect acc 0 = return acc+ collect acc k = do+ w <- getWord64le+ collect (w : acc) (k - 1)++ assemble :: Integer -> Word64 -> Integer+ assemble acc w = acc `shiftL` 64 .|. fromIntegral w++{-# INLINABLE putCurvePoint #-}+putCurvePoint+ :: Binary x+ => (g -> Maybe (x, y))+ -> (y -> Put)+ -> g+ -> Put+putCurvePoint affineCoords putY p = case affineCoords p of+ Nothing -> putWord8 0+ Just (x, y) -> putWord8 1 >> put x >> putY y++{-# INLINABLE getCurvePoint #-}+getCurvePoint+ :: (Typeable g, Binary x, Binary y)+ => g+ -> (x -> y -> Maybe g)+ -> Get g+getCurvePoint zero mkG = getWord8 >>= \case+ 0 -> return zero+ 1 -> do+ x <- get+ y <- get+ case mkG x y of+ Nothing -> fail $ errPrefix ++ "invalid point"+ Just p -> return p+ n -> fail $ errPrefix ++ "expected 0 or 1, got " ++ show n+ where+ errPrefix = "getCurvePoint (" ++ show (typeOf zero) ++ "): "++----------------------------------------++{-# INLINABLE importInteger #-}+importInteger+ :: Int+ -> (MutableByteArray## RealWorld -> CSize -> IO ())+ -> IO Integer+importInteger limbs c_fun = do+ mba@(MutableByteArray umba) <- newByteArray size+ let csize = fromIntegral size+ c_fun umba csize+ ByteArray uba <- unsafeFreezeByteArray mba+ return $ Jp## (BN## uba)+ where+ size = limbs * #{size mp_limb_t}
+ test/Main.hs view
@@ -0,0 +1,159 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main (main) where++import Data.Binary+import Data.Bits+import Data.Group+import Data.List+import Data.Monoid+import Data.Proxy+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck hiding ((.&.))++import MCL.Curves.Fp254BNb++main :: IO ()+main = defaultMain+ [ testGroup "Fr" $ let fr = Proxy :: Proxy Fr in+ [ testProperty "arithmetic" $ testFieldOps fr+ , testProperty "construction" $ fr_testFromTo+ , testProperty "square root" $ fr_testSquareRoot+ , testProperty "serialization" $ testBinary fr+ ]+ , testGroup "Fp" $ let fp = Proxy :: Proxy Fp in+ [ testProperty "arithmetic" $ testFieldOps fp+ , testProperty "construction" $ fp_testFromTo+ , testProperty "square root" $ fp_testSquareRoot+ , testProperty "serialization" $ testBinary fp+ ]+ , testGroup "Fp2" $ let fp2 = Proxy :: Proxy Fp2 in+ [ testProperty "arithmetic" $ testFieldOps fp2+ , testProperty "construction" $ fp2_testFromTo+ , testProperty "square root" $ fp2_testSquareRoot+ , testProperty "serialization" $ testBinary fp2+ ]+ , testGroup "Fp12" $ let fp12 = Proxy :: Proxy Fp12 in+ [ testProperty "arithmetic" $ testFieldOps fp12+ , testProperty "construction" $ fp12_testFromTo+ , testProperty "serialization" $ testBinary fp12+ ]+ , testGroup "G1" $ let g1 = Proxy :: Proxy G1 in+ [ testProperty "arithmetic" $ testGroupOps g1+ , testProperty "serialization" $ testBinary g1+ ]+ , testGroup "G2" $ let g2 = Proxy :: Proxy G2 in+ [ testProperty "arithmetic" $ testGroupOps g2+ , testProperty "serialization" $ testBinary g2+ ]+ , testGroup "pairing"+ [ testProperty "bilinearity" $ testPairing+ ]+ ]++----------------------------------------++arbitraryF :: (Integer -> fp) -> Gen fp+arbitraryF mkF = do+ w1 <- (0x1fffffff .&.) <$> arbitrary+ w2 <- arbitrary+ w3 <- arbitrary+ w4 <- arbitrary+ return . mkF $ foldl' assemble 0 [w1, w2, w3, w4]+ where+ assemble :: Integer -> Word64 -> Integer+ assemble acc w = acc `shiftL` 64 .|. fromIntegral w++instance Arbitrary Fr where+ arbitrary = arbitraryF mkFr++instance Arbitrary Fp where+ arbitrary = arbitraryF mkFp++instance Arbitrary Fp2 where+ arbitrary = mkFp2 <$> arbitrary <*> arbitrary++instance Arbitrary Fp12 where+ arbitrary = mkFp12 <$> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary G1 where+ arbitrary = mapToG1 <$> arbitrary++instance Arbitrary G2 where+ arbitrary = mapToG2 <$> arbitrary++----------------------------------------++testFieldOps+ :: forall proxy fp. (Arbitrary fp, Eq fp, Fractional fp, Show fp)+ => proxy fp+ -> Property+testFieldOps _ = conjoin+ [ property $ \(a::fp) b c -> (a + b) + c == a + (b + c)+ , property $ \(a::fp) b -> a + b == b + a+ , property $ \(a::fp) b -> a - b == -(b - a)+ , property $ \(a::fp) b c -> a * (b + c) == a * b + a * c+ , property $ \(a::fp) b c -> (a + b) * c == a * c + b * c+ , property $ \(a::fp) -> a == -(-a)+ , property $ \(a::fp) -> recip (recip a) == a+ ]++testGroupOps+ :: forall proxy g. (Arbitrary g, Eq g, Abelian g, Show g)+ => proxy g+ -> Property+testGroupOps _ = conjoin+ [ property $ \(a::g) -> (a <> mempty) == a+ , property $ \(a::g) -> (mempty <> a) == a+ , property $ \(a::g) b c -> (a <> b) <> c == a <> (b <> c)+ , property $ \(a::g) b -> a <> b == b <> a+ , property $ \(a::g) b -> a <> invert b == invert (b <> invert a)+ , property $ \(a::g) b (c::Int) -> (a <> b) `pow` c == a `pow` c <> b `pow` c+ , property $ \(a::g) -> a == invert (invert a)+ ]++testBinary+ :: forall proxy a. (Arbitrary a, Binary a, Eq a, Show a)+ => proxy a+ -> Property+testBinary _ = property $ \(a::a) -> decode (encode a) == a++testPairing :: Property+testPairing = conjoin+ [ property $ \p q r s -> pairing (p <> q) (r <> s) == pairing p r <> pairing p s+ <> pairing q r <> pairing q s+ ]++----------------------------------------++fr_testFromTo :: Fr -> Bool+fr_testFromTo a = a == mkFr (fromFr a)++fp_testFromTo :: Fp -> Bool+fp_testFromTo a = a == mkFp (fromFp a)++fp2_testFromTo :: Fp2 -> Bool+fp2_testFromTo a = a == mkFp2 (fp2_c0 a) (fp2_c1 a)++fp12_testFromTo :: Fp12 -> Bool+fp12_testFromTo a = a == mkFp12 (fp12_c0 a) (fp12_c1 a) (fp12_c2 a)+ (fp12_c3 a) (fp12_c4 a) (fp12_c5 a)++----------------------------------------++fr_testSquareRoot :: Fr -> Bool+fr_testSquareRoot a = t == Just a || t == Just (-a)+ where+ t = fr_squareRoot (a * a)++fp_testSquareRoot :: Fp -> Bool+fp_testSquareRoot a = t == Just a || t == Just (-a)+ where+ t = fp_squareRoot (a * a)++fp2_testSquareRoot :: Fp2 -> Bool+fp2_testSquareRoot a = t == Just a || t == Just (-a)+ where+ t = fp2_squareRoot (a * a)