{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Crypto.EllipticCurve.BLS12_381.Internal (
  -- * Unsafe Types
  ScalarPtr (..),
  PointPtr (..),
  AffinePtr (..),
  PointArrayPtr (..),
  AffineArrayPtr (..),
  AffineBlockPtr (..),
  Point1Ptr,
  Point2Ptr,
  Affine1Ptr,
  Affine2Ptr,
  PTPtr,

  -- * Phantom Types
  Curve1,
  Curve2,

  -- * Error codes
  c_blst_success,
  c_blst_error_bad_encoding,
  c_blst_error_point_not_on_curve,
  c_blst_error_point_not_in_group,
  c_blst_error_aggr_type_mismatch,
  c_blst_error_verify_fail,
  c_blst_error_pk_is_infinity,
  c_blst_error_bad_scalar,

  -- * Safe types
  Affine,
  Affine1,
  Affine2,
  BLSTError (..),
  Point (..),
  Point1,
  Point2,
  PT,
  Scalar (..),
  Fr (..),
  unsafePointFromPointPtr,

  -- * The period of scalars
  scalarPeriod,

  -- * Curve abstraction
  BLS (
    c_blst_on_curve,
    c_blst_add_or_double,
    c_blst_mult,
    c_blst_cneg,
    c_blst_scratch_sizeof,
    c_blst_to_affines,
    c_blst_mult_pippenger,
    c_blst_hash,
    c_blst_compress,
    c_blst_serialize,
    c_blst_uncompress,
    c_blst_deserialize,
    c_blst_in_g,
    c_blst_to_affine,
    c_blst_from_affine,
    c_blst_affine_in_g,
    c_blst_generator,
    c_blst_p_is_equal,
    c_blst_p_is_inf
  ),

  -- * Pairing check
  c_blst_miller_loop,

  -- * FP12 functions

  --
  c_blst_fp12_mul,
  c_blst_fp12_is_equal,
  c_blst_fp12_finalverify,

  -- * Scalar functions
  c_blst_scalar_fr_check,
  c_blst_scalar_from_fr,
  c_blst_fr_from_scalar,
  c_blst_scalar_from_be_bytes,
  c_blst_bendian_from_scalar,

  -- * Marshalling functions
  sizePoint,
  withPoint,
  withNewPoint,
  withNewPoint_,
  withNewPoint',
  clonePoint,
  compressedSizePoint,
  serializedSizePoint,
  sizeAffine,
  withAffine,
  withNewAffine,
  withNewAffine_,
  withNewAffine',
  withPointArray,
  withAffineBlockArrayPtr,
  sizePT,
  withPT,
  withNewPT,
  withNewPT_,
  withNewPT',
  sizeScalar,
  withScalar,
  withNewScalar,
  withNewScalar_,
  withNewScalar',
  withScalarArray,
  cloneScalar,
  sizeFr,
  withFr,
  withNewFr,
  withNewFr_,
  withNewFr',
  cloneFr,

  -- * Utility
  integerAsCStrL,
  cstrToInteger,
  integerToBS,
  padBS,

  -- * Point1/G1 operations
  blsInGroup,
  blsAddOrDouble,
  blsMult,
  blsCneg,
  blsNeg,
  blsMSM,
  blsCompress,
  blsSerialize,
  blsUncompress,
  blsDeserialize,
  blsHash,
  blsGenerator,
  blsIsInf,
  blsZero,
  toAffine,
  fromAffine,
  affineInG,

  -- * PT operations
  ptMult,
  ptFinalVerify,

  -- * Scalar / Fr operations
  scalarFromFr,
  frFromScalar,
  frFromCanonicalScalar,
  scalarFromBS,
  scalarToBS,
  scalarFromInteger,
  scalarToInteger,
  scalarCanonical,

  -- * Pairings
  millerLoop,
)
where

import Control.Monad (forM_)
import Data.Bits (shiftL, shiftR, (.|.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Unsafe as BSU
import Data.Foldable (foldrM)
import Data.Proxy (Proxy (..))
import Data.Void
import Foreign (Storable (..), poke, sizeOf)
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)
import System.IO.Unsafe (unsafePerformIO)

---- Phantom Types

data Curve1
data Curve2

---- Unsafe PointPtr types

-- | A pointer to a (projective) point one of the two elliptical curves
newtype PointPtr curve = PointPtr (Ptr Void)

-- | A pointer to a null-terminated array of pointers to points
newtype PointArrayPtr curve = PointArrayPtr (Ptr Void)

type Point1Ptr = PointPtr Curve1
type Point2Ptr = PointPtr Curve2

type Point1ArrayPtr = PointArrayPtr Curve1
type Point2ArrayPtr = PointArrayPtr Curve2

-- | A pointer to an affine point on one of the two elliptical curves
newtype AffinePtr curve = AffinePtr (Ptr Void)

-- | A pointer to a contiguous array of affine points
newtype AffineBlockPtr curve = AffineBlockPtr (Ptr Void)

-- | A pointer to a null-terminated array of pointers to affine points
newtype AffineArrayPtr curve = AffineArrayPtr (Ptr Void)

type Affine1Ptr = AffinePtr Curve1
type Affine2Ptr = AffinePtr Curve2

type Affine1BlockPtr = AffineBlockPtr Curve1
type Affine2BlockPtr = AffineBlockPtr Curve2

type Affine1ArrayPtr = AffineArrayPtr Curve1
type Affine2ArrayPtr = AffineArrayPtr Curve2

newtype PTPtr = PTPtr (Ptr Void)

unsafePointFromPointPtr :: PointPtr curve -> Point curve
unsafePointFromPointPtr :: forall curve. PointPtr curve -> Point curve
unsafePointFromPointPtr (PointPtr Ptr Void
ptr) =
  ForeignPtr Void -> Point curve
forall curve. ForeignPtr Void -> Point curve
Point (ForeignPtr Void -> Point curve)
-> (IO (ForeignPtr Void) -> ForeignPtr Void)
-> IO (ForeignPtr Void)
-> Point curve
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (ForeignPtr Void) -> ForeignPtr Void
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr Void) -> Point curve)
-> IO (ForeignPtr Void) -> Point curve
forall a b. (a -> b) -> a -> b
$ Ptr Void -> IO (ForeignPtr Void)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Void
ptr

eqAffinePtr :: forall curve. BLS curve => AffinePtr curve -> AffinePtr curve -> IO Bool
eqAffinePtr :: forall curve.
BLS curve =>
AffinePtr curve -> AffinePtr curve -> IO Bool
eqAffinePtr (AffinePtr Ptr Void
a) (AffinePtr Ptr Void
b) =
  (CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
== CSize
0) (CSize -> Bool) -> IO CSize -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> Ptr Any -> CSize -> IO CSize
forall a. Ptr a -> Ptr a -> CSize -> IO CSize
c_memcmp (Ptr Void -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Void
a) (Ptr Void -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Void
b) (Proxy curve -> CSize
forall curve. BLS curve => Proxy curve -> CSize
sizeAffine_ (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))

instance BLS curve => Eq (AffinePtr curve) where
  AffinePtr curve
a == :: AffinePtr curve -> AffinePtr curve -> Bool
== AffinePtr curve
b = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AffinePtr curve -> AffinePtr curve -> IO Bool
forall curve.
BLS curve =>
AffinePtr curve -> AffinePtr curve -> IO Bool
eqAffinePtr AffinePtr curve
a AffinePtr curve
b

---- Safe Point types / marshalling

-- | A point on an elliptic curve. This type guarantees that the point is part of the
-- | prime order subgroup.
newtype Point curve = Point (ForeignPtr Void)

-- Making sure different 'Point's are not 'Coercible', which would ruin the
-- intended type safety:
type role Point nominal

type Point1 = Point Curve1
type Point2 = Point Curve2

newtype Affine curve = Affine (ForeignPtr Void)

-- Making sure different 'Affine's are not 'Coercible', which would ruin the
-- intended type safety:
type role Affine nominal

type Affine1 = Affine Curve1
type Affine2 = Affine Curve2

-- | Target element without the final exponantiation. By defining target elements
-- | as such, we save up the final exponantiation when computing a pairing, and only
-- | compute it when necessary (e.g. comparison with another point or serialisation)
newtype PT = PT (ForeignPtr Void)

-- | Sizes of various representations of elliptic curve points.
-- | Size of a curve point in memory
sizePoint :: forall curve. BLS curve => Proxy curve -> Int
sizePoint :: forall curve. BLS curve => Proxy curve -> Int
sizePoint = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (Proxy curve -> CSize) -> Proxy curve -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy curve -> CSize
forall curve. BLS curve => Proxy curve -> CSize
sizePoint_

-- | Size of a curved point when serialized in compressed form
compressedSizePoint :: forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint :: forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (Proxy curve -> CSize) -> Proxy curve -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy curve -> CSize
forall curve. BLS curve => Proxy curve -> CSize
compressedSizePoint_

-- | Size of a curved point when serialized in uncompressed form
serializedSizePoint :: forall curve. BLS curve => Proxy curve -> Int
serializedSizePoint :: forall curve. BLS curve => Proxy curve -> Int
serializedSizePoint = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (Proxy curve -> CSize) -> Proxy curve -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy curve -> CSize
forall curve. BLS curve => Proxy curve -> CSize
serializedSizePoint_

-- | In-memory size of the affine representation of a curve point
sizeAffine :: forall curve. BLS curve => Proxy curve -> Int
sizeAffine :: forall curve. BLS curve => Proxy curve -> Int
sizeAffine = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (Proxy curve -> CSize) -> Proxy curve -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy curve -> CSize
forall curve. BLS curve => Proxy curve -> CSize
sizeAffine_

withPoint :: forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint :: forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint (Point ForeignPtr Void
p) PointPtr curve -> IO a
go = ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p (PointPtr curve -> IO a
go (PointPtr curve -> IO a)
-> (Ptr Void -> PointPtr curve) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> PointPtr curve
forall curve. Ptr Void -> PointPtr curve
PointPtr)

withNewPoint :: forall curve a. BLS curve => (PointPtr curve -> IO a) -> IO (a, Point curve)
withNewPoint :: forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (a, Point curve)
withNewPoint PointPtr curve -> IO a
go = do
  ForeignPtr Void
p <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
sizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
  a
x <- ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p (PointPtr curve -> IO a
go (PointPtr curve -> IO a)
-> (Ptr Void -> PointPtr curve) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> PointPtr curve
forall curve. Ptr Void -> PointPtr curve
PointPtr)
  (a, Point curve) -> IO (a, Point curve)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, ForeignPtr Void -> Point curve
forall curve. ForeignPtr Void -> Point curve
Point ForeignPtr Void
p)

withNewPoint_ :: BLS curve => (PointPtr curve -> IO a) -> IO a
withNewPoint_ :: forall curve a. BLS curve => (PointPtr curve -> IO a) -> IO a
withNewPoint_ = ((a, Point curve) -> a) -> IO (a, Point curve) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Point curve) -> a
forall a b. (a, b) -> a
fst (IO (a, Point curve) -> IO a)
-> ((PointPtr curve -> IO a) -> IO (a, Point curve))
-> (PointPtr curve -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointPtr curve -> IO a) -> IO (a, Point curve)
forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (a, Point curve)
withNewPoint

withNewPoint' :: BLS curve => (PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' :: forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' = ((a, Point curve) -> Point curve)
-> IO (a, Point curve) -> IO (Point curve)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Point curve) -> Point curve
forall a b. (a, b) -> b
snd (IO (a, Point curve) -> IO (Point curve))
-> ((PointPtr curve -> IO a) -> IO (a, Point curve))
-> (PointPtr curve -> IO a)
-> IO (Point curve)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointPtr curve -> IO a) -> IO (a, Point curve)
forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (a, Point curve)
withNewPoint

clonePoint :: forall curve. BLS curve => Point curve -> IO (Point curve)
clonePoint :: forall curve. BLS curve => Point curve -> IO (Point curve)
clonePoint (Point ForeignPtr Void
a) = do
  ForeignPtr Void
b <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
sizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
  ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
a ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ap ->
    ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
b ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
bp ->
      Ptr Void -> Ptr Void -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Void
bp Ptr Void
ap (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
sizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
  Point curve -> IO (Point curve)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Void -> Point curve
forall curve. ForeignPtr Void -> Point curve
Point ForeignPtr Void
b)

withAffine :: forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine :: forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine (Affine ForeignPtr Void
p) AffinePtr curve -> IO a
go = ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p (AffinePtr curve -> IO a
go (AffinePtr curve -> IO a)
-> (Ptr Void -> AffinePtr curve) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> AffinePtr curve
forall curve. Ptr Void -> AffinePtr curve
AffinePtr)

withNewAffine :: forall curve a. BLS curve => (AffinePtr curve -> IO a) -> IO (a, Affine curve)
withNewAffine :: forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (a, Affine curve)
withNewAffine AffinePtr curve -> IO a
go = do
  ForeignPtr Void
p <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
sizeAffine (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
  a
x <- ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p (AffinePtr curve -> IO a
go (AffinePtr curve -> IO a)
-> (Ptr Void -> AffinePtr curve) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> AffinePtr curve
forall curve. Ptr Void -> AffinePtr curve
AffinePtr)
  (a, Affine curve) -> IO (a, Affine curve)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, ForeignPtr Void -> Affine curve
forall curve. ForeignPtr Void -> Affine curve
Affine ForeignPtr Void
p)

withNewAffine_ :: BLS curve => (AffinePtr curve -> IO a) -> IO a
withNewAffine_ :: forall curve a. BLS curve => (AffinePtr curve -> IO a) -> IO a
withNewAffine_ = ((a, Affine curve) -> a) -> IO (a, Affine curve) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Affine curve) -> a
forall a b. (a, b) -> a
fst (IO (a, Affine curve) -> IO a)
-> ((AffinePtr curve -> IO a) -> IO (a, Affine curve))
-> (AffinePtr curve -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AffinePtr curve -> IO a) -> IO (a, Affine curve)
forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (a, Affine curve)
withNewAffine

withNewAffine' :: BLS curve => (AffinePtr curve -> IO a) -> IO (Affine curve)
withNewAffine' :: forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (Affine curve)
withNewAffine' = ((a, Affine curve) -> Affine curve)
-> IO (a, Affine curve) -> IO (Affine curve)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Affine curve) -> Affine curve
forall a b. (a, b) -> b
snd (IO (a, Affine curve) -> IO (Affine curve))
-> ((AffinePtr curve -> IO a) -> IO (a, Affine curve))
-> (AffinePtr curve -> IO a)
-> IO (Affine curve)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AffinePtr curve -> IO a) -> IO (a, Affine curve)
forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (a, Affine curve)
withNewAffine

withPointArray :: [Point curve] -> (Int -> PointArrayPtr curve -> IO a) -> IO a
withPointArray :: forall curve a.
[Point curve] -> (Int -> PointArrayPtr curve -> IO a) -> IO a
withPointArray [Point curve]
points Int -> PointArrayPtr curve -> IO a
go = do
  let numPoints :: Int
numPoints = [Point curve] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point curve]
points
      sizeReference :: Int
sizeReference = Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
  -- Allocate space for the points and a null terminator
  Int -> (Ptr (Ptr Void) -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
numPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeReference) ((Ptr (Ptr Void) -> IO a) -> IO a)
-> (Ptr (Ptr Void) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Void)
ptr ->
    -- The accumulate function ensures that each `withPoint` call is properly nested.
    -- This guarantees that the foreign pointers remain valid while we populate `ptr`.
    -- If we instead used `zipWithM_` for example, the pointers could be finalized too early.
    -- By nesting `withPoint` calls in `accumulate`, we ensure they stay in scope until `go` is executed.
    let accumulate :: Ptr (Ptr Void) -> [Point curve] -> IO a
accumulate Ptr (Ptr Void)
curPtr [] = do
          Ptr (Ptr Void) -> Ptr Void -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Void)
curPtr Ptr Void
forall a. Ptr a
nullPtr
          Int -> PointArrayPtr curve -> IO a
go Int
numPoints (Ptr Void -> PointArrayPtr curve
forall curve. Ptr Void -> PointArrayPtr curve
PointArrayPtr (Ptr (Ptr Void) -> Ptr Void
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Void)
ptr))
        accumulate Ptr (Ptr Void)
curPtr (Point curve
point : [Point curve]
rest) =
          Point curve -> (PointPtr curve -> IO a) -> IO a
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
point ((PointPtr curve -> IO a) -> IO a)
-> (PointPtr curve -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(PointPtr Ptr Void
pPtr) -> do
            Ptr (Ptr Void) -> Ptr Void -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Void)
curPtr Ptr Void
pPtr
            Ptr (Ptr Void) -> [Point curve] -> IO a
accumulate (Ptr (Ptr Void)
curPtr Ptr (Ptr Void) -> Int -> Ptr (Ptr Void)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
sizeReference) [Point curve]
rest
     in Ptr (Ptr Void) -> [Point curve] -> IO a
accumulate Ptr (Ptr Void)
ptr [Point curve]
points

-- | Given a block of affine points and a count, produce a pointer array
withAffineBlockArrayPtr ::
  forall curve a.
  BLS curve =>
  Ptr Void -> Int -> (AffineArrayPtr curve -> IO a) -> IO a
withAffineBlockArrayPtr :: forall curve a.
BLS curve =>
Ptr Void -> Int -> (AffineArrayPtr curve -> IO a) -> IO a
withAffineBlockArrayPtr Ptr Void
affinesBlockPtr Int
numPoints AffineArrayPtr curve -> IO a
go = do
  Int -> (Ptr Void -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
numPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())) ((Ptr Void -> IO a) -> IO a) -> (Ptr Void -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Void
affineVectorPtr -> do
    let ptrArray :: Ptr (Ptr ())
ptrArray = Ptr Void -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr Void
affineVectorPtr :: Ptr (Ptr ())
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
numPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
      let ptr :: Ptr ()
ptr = Ptr Void
affinesBlockPtr Ptr Void -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
sizeAffine (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
      Ptr (Ptr ()) -> Int -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (Ptr ())
ptrArray Int
i Ptr ()
ptr
    AffineArrayPtr curve -> IO a
go (Ptr Void -> AffineArrayPtr curve
forall curve. Ptr Void -> AffineArrayPtr curve
AffineArrayPtr Ptr Void
affineVectorPtr)

withPT :: PT -> (PTPtr -> IO a) -> IO a
withPT :: forall a. PT -> (PTPtr -> IO a) -> IO a
withPT (PT ForeignPtr Void
pt) PTPtr -> IO a
go = ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
pt (PTPtr -> IO a
go (PTPtr -> IO a) -> (Ptr Void -> PTPtr) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> PTPtr
PTPtr)

withNewPT :: (PTPtr -> IO a) -> IO (a, PT)
withNewPT :: forall a. (PTPtr -> IO a) -> IO (a, PT)
withNewPT PTPtr -> IO a
go = do
  ForeignPtr Void
p <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizePT
  a
x <- ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p (PTPtr -> IO a
go (PTPtr -> IO a) -> (Ptr Void -> PTPtr) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> PTPtr
PTPtr)
  (a, PT) -> IO (a, PT)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, ForeignPtr Void -> PT
PT ForeignPtr Void
p)

withNewPT_ :: (PTPtr -> IO a) -> IO a
withNewPT_ :: forall a. (PTPtr -> IO a) -> IO a
withNewPT_ = ((a, PT) -> a) -> IO (a, PT) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, PT) -> a
forall a b. (a, b) -> a
fst (IO (a, PT) -> IO a)
-> ((PTPtr -> IO a) -> IO (a, PT)) -> (PTPtr -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PTPtr -> IO a) -> IO (a, PT)
forall a. (PTPtr -> IO a) -> IO (a, PT)
withNewPT

withNewPT' :: (PTPtr -> IO a) -> IO PT
withNewPT' :: forall a. (PTPtr -> IO a) -> IO PT
withNewPT' = ((a, PT) -> PT) -> IO (a, PT) -> IO PT
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, PT) -> PT
forall a b. (a, b) -> b
snd (IO (a, PT) -> IO PT)
-> ((PTPtr -> IO a) -> IO (a, PT)) -> (PTPtr -> IO a) -> IO PT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PTPtr -> IO a) -> IO (a, PT)
forall a. (PTPtr -> IO a) -> IO (a, PT)
withNewPT

sizePT :: Int
sizePT :: Int
sizePT = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
c_size_blst_fp12

---- Curve operations

-- | BLS curve operations. Class methods are low-level; user code will want to
-- use higher-level wrappers such as 'blsAddOrDouble', 'blsMult', 'blsCneg', 'blsNeg', etc.
class BLS curve where
  c_blst_on_curve :: PointPtr curve -> IO Bool

  c_blst_add_or_double :: PointPtr curve -> PointPtr curve -> PointPtr curve -> IO ()
  c_blst_mult :: PointPtr curve -> PointPtr curve -> ScalarPtr -> CSize -> IO ()
  c_blst_cneg :: PointPtr curve -> Bool -> IO ()

  c_blst_scratch_sizeof :: Proxy curve -> CSize -> CSize
  c_blst_to_affines :: AffineBlockPtr curve -> PointArrayPtr curve -> CSize -> IO ()
  c_blst_mult_pippenger ::
    PointPtr curve -> AffineArrayPtr curve -> CSize -> ScalarArrayPtr -> CSize -> ScratchPtr -> IO ()

  c_blst_hash ::
    PointPtr curve -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
  c_blst_compress :: Ptr CChar -> PointPtr curve -> IO ()
  c_blst_serialize :: Ptr CChar -> PointPtr curve -> IO ()
  c_blst_uncompress :: AffinePtr curve -> Ptr CChar -> IO CInt
  c_blst_deserialize :: AffinePtr curve -> Ptr CChar -> IO CInt

  c_blst_in_g :: PointPtr curve -> IO Bool
  c_blst_to_affine :: AffinePtr curve -> PointPtr curve -> IO ()
  c_blst_from_affine :: PointPtr curve -> AffinePtr curve -> IO ()
  c_blst_affine_in_g :: AffinePtr curve -> IO Bool
  c_blst_generator :: PointPtr curve

  c_blst_p_is_equal :: PointPtr curve -> PointPtr curve -> IO Bool
  c_blst_p_is_inf :: PointPtr curve -> IO Bool

  sizePoint_ :: Proxy curve -> CSize
  serializedSizePoint_ :: Proxy curve -> CSize
  compressedSizePoint_ :: Proxy curve -> CSize
  sizeAffine_ :: Proxy curve -> CSize

instance BLS Curve1 where
  c_blst_on_curve :: PointPtr Curve1 -> IO Bool
c_blst_on_curve = PointPtr Curve1 -> IO Bool
c_blst_p1_on_curve

  c_blst_add_or_double :: PointPtr Curve1 -> PointPtr Curve1 -> PointPtr Curve1 -> IO ()
c_blst_add_or_double = PointPtr Curve1 -> PointPtr Curve1 -> PointPtr Curve1 -> IO ()
c_blst_p1_add_or_double
  c_blst_mult :: PointPtr Curve1 -> PointPtr Curve1 -> ScalarPtr -> CSize -> IO ()
c_blst_mult = PointPtr Curve1 -> PointPtr Curve1 -> ScalarPtr -> CSize -> IO ()
c_blst_p1_mult
  c_blst_cneg :: PointPtr Curve1 -> Bool -> IO ()
c_blst_cneg = PointPtr Curve1 -> Bool -> IO ()
c_blst_p1_cneg

  c_blst_scratch_sizeof :: Proxy Curve1 -> CSize -> CSize
c_blst_scratch_sizeof Proxy Curve1
_ = CSize -> CSize
c_blst_p1s_mult_pippenger_scratch_sizeof
  c_blst_to_affines :: AffineBlockPtr Curve1 -> PointArrayPtr Curve1 -> CSize -> IO ()
c_blst_to_affines = AffineBlockPtr Curve1 -> PointArrayPtr Curve1 -> CSize -> IO ()
c_blst_p1s_to_affine
  c_blst_mult_pippenger :: PointPtr Curve1
-> AffineArrayPtr Curve1
-> CSize
-> ScalarArrayPtr
-> CSize
-> ScratchPtr
-> IO ()
c_blst_mult_pippenger = PointPtr Curve1
-> AffineArrayPtr Curve1
-> CSize
-> ScalarArrayPtr
-> CSize
-> ScratchPtr
-> IO ()
c_blst_p1s_mult_pippenger

  c_blst_hash :: PointPtr Curve1
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
c_blst_hash = PointPtr Curve1
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
c_blst_hash_to_g1
  c_blst_compress :: Ptr CChar -> PointPtr Curve1 -> IO ()
c_blst_compress = Ptr CChar -> PointPtr Curve1 -> IO ()
c_blst_p1_compress
  c_blst_serialize :: Ptr CChar -> PointPtr Curve1 -> IO ()
c_blst_serialize = Ptr CChar -> PointPtr Curve1 -> IO ()
c_blst_p1_serialize
  c_blst_uncompress :: AffinePtr Curve1 -> Ptr CChar -> IO CInt
c_blst_uncompress = AffinePtr Curve1 -> Ptr CChar -> IO CInt
c_blst_p1_uncompress
  c_blst_deserialize :: AffinePtr Curve1 -> Ptr CChar -> IO CInt
c_blst_deserialize = AffinePtr Curve1 -> Ptr CChar -> IO CInt
c_blst_p1_deserialize

  c_blst_in_g :: PointPtr Curve1 -> IO Bool
c_blst_in_g = PointPtr Curve1 -> IO Bool
c_blst_p1_in_g1
  c_blst_to_affine :: AffinePtr Curve1 -> PointPtr Curve1 -> IO ()
c_blst_to_affine = AffinePtr Curve1 -> PointPtr Curve1 -> IO ()
c_blst_p1_to_affine
  c_blst_from_affine :: PointPtr Curve1 -> AffinePtr Curve1 -> IO ()
c_blst_from_affine = PointPtr Curve1 -> AffinePtr Curve1 -> IO ()
c_blst_p1_from_affine
  c_blst_affine_in_g :: AffinePtr Curve1 -> IO Bool
c_blst_affine_in_g = AffinePtr Curve1 -> IO Bool
c_blst_p1_affine_in_g1

  c_blst_generator :: PointPtr Curve1
c_blst_generator = PointPtr Curve1
c_blst_p1_generator

  c_blst_p_is_equal :: PointPtr Curve1 -> PointPtr Curve1 -> IO Bool
c_blst_p_is_equal = PointPtr Curve1 -> PointPtr Curve1 -> IO Bool
c_blst_p1_is_equal
  c_blst_p_is_inf :: PointPtr Curve1 -> IO Bool
c_blst_p_is_inf = PointPtr Curve1 -> IO Bool
c_blst_p1_is_inf

  sizePoint_ :: Proxy Curve1 -> CSize
sizePoint_ Proxy Curve1
_ = CSize
c_size_blst_p1
  compressedSizePoint_ :: Proxy Curve1 -> CSize
compressedSizePoint_ Proxy Curve1
_ = CSize
48
  serializedSizePoint_ :: Proxy Curve1 -> CSize
serializedSizePoint_ Proxy Curve1
_ = CSize
96
  sizeAffine_ :: Proxy Curve1 -> CSize
sizeAffine_ Proxy Curve1
_ = CSize
c_size_blst_affine1

instance BLS Curve2 where
  c_blst_on_curve :: PointPtr Curve2 -> IO Bool
c_blst_on_curve = PointPtr Curve2 -> IO Bool
c_blst_p2_on_curve

  c_blst_add_or_double :: PointPtr Curve2 -> PointPtr Curve2 -> PointPtr Curve2 -> IO ()
c_blst_add_or_double = PointPtr Curve2 -> PointPtr Curve2 -> PointPtr Curve2 -> IO ()
c_blst_p2_add_or_double
  c_blst_mult :: PointPtr Curve2 -> PointPtr Curve2 -> ScalarPtr -> CSize -> IO ()
c_blst_mult = PointPtr Curve2 -> PointPtr Curve2 -> ScalarPtr -> CSize -> IO ()
c_blst_p2_mult
  c_blst_cneg :: PointPtr Curve2 -> Bool -> IO ()
c_blst_cneg = PointPtr Curve2 -> Bool -> IO ()
c_blst_p2_cneg

  c_blst_scratch_sizeof :: Proxy Curve2 -> CSize -> CSize
c_blst_scratch_sizeof Proxy Curve2
_ = CSize -> CSize
c_blst_p2s_mult_pippenger_scratch_sizeof
  c_blst_to_affines :: AffineBlockPtr Curve2 -> PointArrayPtr Curve2 -> CSize -> IO ()
c_blst_to_affines = AffineBlockPtr Curve2 -> PointArrayPtr Curve2 -> CSize -> IO ()
c_blst_p2s_to_affine
  c_blst_mult_pippenger :: PointPtr Curve2
-> AffineArrayPtr Curve2
-> CSize
-> ScalarArrayPtr
-> CSize
-> ScratchPtr
-> IO ()
c_blst_mult_pippenger = PointPtr Curve2
-> AffineArrayPtr Curve2
-> CSize
-> ScalarArrayPtr
-> CSize
-> ScratchPtr
-> IO ()
c_blst_p2s_mult_pippenger

  c_blst_hash :: PointPtr Curve2
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
c_blst_hash = PointPtr Curve2
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
c_blst_hash_to_g2
  c_blst_compress :: Ptr CChar -> PointPtr Curve2 -> IO ()
c_blst_compress = Ptr CChar -> PointPtr Curve2 -> IO ()
c_blst_p2_compress
  c_blst_serialize :: Ptr CChar -> PointPtr Curve2 -> IO ()
c_blst_serialize = Ptr CChar -> PointPtr Curve2 -> IO ()
c_blst_p2_serialize
  c_blst_uncompress :: AffinePtr Curve2 -> Ptr CChar -> IO CInt
c_blst_uncompress = AffinePtr Curve2 -> Ptr CChar -> IO CInt
c_blst_p2_uncompress
  c_blst_deserialize :: AffinePtr Curve2 -> Ptr CChar -> IO CInt
c_blst_deserialize = AffinePtr Curve2 -> Ptr CChar -> IO CInt
c_blst_p2_deserialize

  c_blst_in_g :: PointPtr Curve2 -> IO Bool
c_blst_in_g = PointPtr Curve2 -> IO Bool
c_blst_p2_in_g2
  c_blst_to_affine :: AffinePtr Curve2 -> PointPtr Curve2 -> IO ()
c_blst_to_affine = AffinePtr Curve2 -> PointPtr Curve2 -> IO ()
c_blst_p2_to_affine
  c_blst_from_affine :: PointPtr Curve2 -> AffinePtr Curve2 -> IO ()
c_blst_from_affine = PointPtr Curve2 -> AffinePtr Curve2 -> IO ()
c_blst_p2_from_affine
  c_blst_affine_in_g :: AffinePtr Curve2 -> IO Bool
c_blst_affine_in_g = AffinePtr Curve2 -> IO Bool
c_blst_p2_affine_in_g2

  c_blst_generator :: PointPtr Curve2
c_blst_generator = PointPtr Curve2
c_blst_p2_generator

  c_blst_p_is_equal :: PointPtr Curve2 -> PointPtr Curve2 -> IO Bool
c_blst_p_is_equal = PointPtr Curve2 -> PointPtr Curve2 -> IO Bool
c_blst_p2_is_equal
  c_blst_p_is_inf :: PointPtr Curve2 -> IO Bool
c_blst_p_is_inf = PointPtr Curve2 -> IO Bool
c_blst_p2_is_inf

  sizePoint_ :: Proxy Curve2 -> CSize
sizePoint_ Proxy Curve2
_ = CSize
c_size_blst_p2
  compressedSizePoint_ :: Proxy Curve2 -> CSize
compressedSizePoint_ Proxy Curve2
_ = CSize
96
  serializedSizePoint_ :: Proxy Curve2 -> CSize
serializedSizePoint_ Proxy Curve2
_ = CSize
192
  sizeAffine_ :: Proxy Curve2 -> CSize
sizeAffine_ Proxy Curve2
_ = CSize
c_size_blst_affine2

instance BLS curve => Eq (Affine curve) where
  Affine curve
a == :: Affine curve -> Affine curve -> Bool
== Affine curve
b = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Affine curve -> (AffinePtr curve -> IO Bool) -> IO Bool
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine Affine curve
a ((AffinePtr curve -> IO Bool) -> IO Bool)
-> (AffinePtr curve -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
aptr ->
      Affine curve -> (AffinePtr curve -> IO Bool) -> IO Bool
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine Affine curve
b ((AffinePtr curve -> IO Bool) -> IO Bool)
-> (AffinePtr curve -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
bptr ->
        AffinePtr curve -> AffinePtr curve -> IO Bool
forall curve.
BLS curve =>
AffinePtr curve -> AffinePtr curve -> IO Bool
eqAffinePtr AffinePtr curve
aptr AffinePtr curve
bptr

---- Safe Scalar types / marshalling

sizeScalar :: Int
sizeScalar :: Int
sizeScalar = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
c_size_blst_scalar

newtype Scalar = Scalar (ForeignPtr Void)

withIntScalar :: Integer -> (ScalarPtr -> IO a) -> IO a
withIntScalar :: forall a. Integer -> (ScalarPtr -> IO a) -> IO a
withIntScalar Integer
i ScalarPtr -> IO a
go = do
  Scalar
s <- Integer -> IO Scalar
scalarFromInteger Integer
i
  Scalar -> (ScalarPtr -> IO a) -> IO a
forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar Scalar
s ScalarPtr -> IO a
go

withScalar :: Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar :: forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar (Scalar ForeignPtr Void
p2) ScalarPtr -> IO a
go = do
  ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p2 (ScalarPtr -> IO a
go (ScalarPtr -> IO a) -> (Ptr Void -> ScalarPtr) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> ScalarPtr
ScalarPtr)

withNewScalar :: (ScalarPtr -> IO a) -> IO (a, Scalar)
withNewScalar :: forall a. (ScalarPtr -> IO a) -> IO (a, Scalar)
withNewScalar ScalarPtr -> IO a
go = do
  ForeignPtr Void
p2 <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeScalar
  a
x <- ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p2 (ScalarPtr -> IO a
go (ScalarPtr -> IO a) -> (Ptr Void -> ScalarPtr) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> ScalarPtr
ScalarPtr)
  (a, Scalar) -> IO (a, Scalar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, ForeignPtr Void -> Scalar
Scalar ForeignPtr Void
p2)

withNewScalar_ :: (ScalarPtr -> IO a) -> IO a
withNewScalar_ :: forall a. (ScalarPtr -> IO a) -> IO a
withNewScalar_ = ((a, Scalar) -> a) -> IO (a, Scalar) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Scalar) -> a
forall a b. (a, b) -> a
fst (IO (a, Scalar) -> IO a)
-> ((ScalarPtr -> IO a) -> IO (a, Scalar))
-> (ScalarPtr -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScalarPtr -> IO a) -> IO (a, Scalar)
forall a. (ScalarPtr -> IO a) -> IO (a, Scalar)
withNewScalar

withNewScalar' :: (ScalarPtr -> IO a) -> IO Scalar
withNewScalar' :: forall a. (ScalarPtr -> IO a) -> IO Scalar
withNewScalar' = ((a, Scalar) -> Scalar) -> IO (a, Scalar) -> IO Scalar
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Scalar) -> Scalar
forall a b. (a, b) -> b
snd (IO (a, Scalar) -> IO Scalar)
-> ((ScalarPtr -> IO a) -> IO (a, Scalar))
-> (ScalarPtr -> IO a)
-> IO Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScalarPtr -> IO a) -> IO (a, Scalar)
forall a. (ScalarPtr -> IO a) -> IO (a, Scalar)
withNewScalar

withScalarArray :: [Scalar] -> (Int -> ScalarArrayPtr -> IO a) -> IO a
withScalarArray :: forall a. [Scalar] -> (Int -> ScalarArrayPtr -> IO a) -> IO a
withScalarArray [Scalar]
scalars Int -> ScalarArrayPtr -> IO a
go = do
  let numScalars :: Int
numScalars = [Scalar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Scalar]
scalars
      sizeReference :: Int
sizeReference = Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())
  -- Allocate space for the scalars and a null terminator
  Int -> (Ptr (Ptr Void) -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
numScalars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeReference) ((Ptr (Ptr Void) -> IO a) -> IO a)
-> (Ptr (Ptr Void) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Void)
ptr ->
    -- The accumulate function ensures that each `withScalar` call is properly nested.
    -- This guarantees that the foreign pointers remain valid while we populate `ptr`.
    -- If we instead used `zipWithM_` for example, the pointers could be finalized too early.
    -- By nesting `withScalar` calls in `accumulate`, we ensure they stay in scope until `go` is executed.
    let accumulate :: Ptr (Ptr Void) -> [Scalar] -> IO a
accumulate Ptr (Ptr Void)
curPtr [] = do
          Ptr (Ptr Void) -> Ptr Void -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Void)
curPtr Ptr Void
forall a. Ptr a
nullPtr
          Int -> ScalarArrayPtr -> IO a
go Int
numScalars (Ptr Void -> ScalarArrayPtr
ScalarArrayPtr (Ptr (Ptr Void) -> Ptr Void
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Void)
ptr))
        accumulate Ptr (Ptr Void)
curPtr (Scalar
scalar : [Scalar]
rest) =
          Scalar -> (ScalarPtr -> IO a) -> IO a
forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar Scalar
scalar ((ScalarPtr -> IO a) -> IO a) -> (ScalarPtr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(ScalarPtr Ptr Void
pPtr) -> do
            Ptr (Ptr Void) -> Ptr Void -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Void)
curPtr Ptr Void
pPtr
            Ptr (Ptr Void) -> [Scalar] -> IO a
accumulate (Ptr (Ptr Void)
curPtr Ptr (Ptr Void) -> Int -> Ptr (Ptr Void)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
sizeReference) [Scalar]
rest
     in Ptr (Ptr Void) -> [Scalar] -> IO a
accumulate Ptr (Ptr Void)
ptr [Scalar]
scalars

cloneScalar :: Scalar -> IO Scalar
cloneScalar :: Scalar -> IO Scalar
cloneScalar (Scalar ForeignPtr Void
a) = do
  ForeignPtr Void
b <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeScalar
  ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
a ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ap ->
    ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
b ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
bp ->
      Ptr Void -> Ptr Void -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Void
bp Ptr Void
ap Int
sizeScalar
  Scalar -> IO Scalar
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Void -> Scalar
Scalar ForeignPtr Void
b)

sizeFr :: Int
sizeFr :: Int
sizeFr = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
c_size_blst_fr

newtype Fr = Fr (ForeignPtr Void)

withFr :: Fr -> (FrPtr -> IO a) -> IO a
withFr :: forall a. Fr -> (FrPtr -> IO a) -> IO a
withFr (Fr ForeignPtr Void
p2) FrPtr -> IO a
go = do
  ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p2 (FrPtr -> IO a
go (FrPtr -> IO a) -> (Ptr Void -> FrPtr) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> FrPtr
FrPtr)

withNewFr :: (FrPtr -> IO a) -> IO (a, Fr)
withNewFr :: forall a. (FrPtr -> IO a) -> IO (a, Fr)
withNewFr FrPtr -> IO a
go = do
  ForeignPtr Void
p2 <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeFr
  a
x <- ForeignPtr Void -> (Ptr Void -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
p2 (FrPtr -> IO a
go (FrPtr -> IO a) -> (Ptr Void -> FrPtr) -> Ptr Void -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Void -> FrPtr
FrPtr)
  (a, Fr) -> IO (a, Fr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, ForeignPtr Void -> Fr
Fr ForeignPtr Void
p2)

withNewFr_ :: (FrPtr -> IO a) -> IO a
withNewFr_ :: forall a. (FrPtr -> IO a) -> IO a
withNewFr_ = ((a, Fr) -> a) -> IO (a, Fr) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Fr) -> a
forall a b. (a, b) -> a
fst (IO (a, Fr) -> IO a)
-> ((FrPtr -> IO a) -> IO (a, Fr)) -> (FrPtr -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrPtr -> IO a) -> IO (a, Fr)
forall a. (FrPtr -> IO a) -> IO (a, Fr)
withNewFr

withNewFr' :: (FrPtr -> IO a) -> IO Fr
withNewFr' :: forall a. (FrPtr -> IO a) -> IO Fr
withNewFr' = ((a, Fr) -> Fr) -> IO (a, Fr) -> IO Fr
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Fr) -> Fr
forall a b. (a, b) -> b
snd (IO (a, Fr) -> IO Fr)
-> ((FrPtr -> IO a) -> IO (a, Fr)) -> (FrPtr -> IO a) -> IO Fr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrPtr -> IO a) -> IO (a, Fr)
forall a. (FrPtr -> IO a) -> IO (a, Fr)
withNewFr

cloneFr :: Fr -> IO Fr
cloneFr :: Fr -> IO Fr
cloneFr (Fr ForeignPtr Void
a) = do
  ForeignPtr Void
b <- Int -> IO (ForeignPtr Void)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeFr
  ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
a ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ap ->
    ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
b ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
bp ->
      Ptr Void -> Ptr Void -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Void
bp Ptr Void
ap Int
sizeFr
  Fr -> IO Fr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Void -> Fr
Fr ForeignPtr Void
b)

scalarToInteger :: Scalar -> IO Integer
scalarToInteger :: Scalar -> IO Integer
scalarToInteger Scalar
scalar = Scalar -> (ScalarPtr -> IO Integer) -> IO Integer
forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar Scalar
scalar ((ScalarPtr -> IO Integer) -> IO Integer)
-> (ScalarPtr -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
scalarPtr -> do
  Int -> (Ptr CChar -> IO Integer) -> IO Integer
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeScalar ((Ptr CChar -> IO Integer) -> IO Integer)
-> (Ptr CChar -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
rawPtr -> do
    Ptr CChar -> ScalarPtr -> IO ()
c_blst_bendian_from_scalar Ptr CChar
rawPtr ScalarPtr
scalarPtr
    Ptr CChar -> Int -> IO Integer
cstrToInteger Ptr CChar
rawPtr Int
sizeScalar

cstrToInteger :: Ptr CChar -> Int -> IO Integer
cstrToInteger :: Ptr CChar -> Int -> IO Integer
cstrToInteger Ptr CChar
p Int
l = do
  Int -> Ptr CUChar -> IO Integer
go Int
l (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p)
  where
    go :: Int -> Ptr CUChar -> IO Integer
    go :: Int -> Ptr CUChar -> IO Integer
go Int
n Ptr CUChar
ptr
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Integer -> IO Integer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
      | Bool
otherwise = do
          CUChar
val <- Ptr CUChar -> IO CUChar
forall a. Storable a => Ptr a -> IO a
peek Ptr CUChar
ptr
          Integer
res <- Int -> Ptr CUChar -> IO Integer
go (Int -> Int
forall a. Enum a => a -> a
pred Int
n) (Ptr CUChar -> Int -> Ptr CUChar
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CUChar
ptr Int
1)
          Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ Integer
res Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL (CUChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUChar
val) (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Enum a => a -> a
pred Int
n)

integerToBS :: Integer -> ByteString
integerToBS :: Integer -> ByteString
integerToBS Integer
k
  | Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot convert negative Integer to ByteString"
  | Bool
otherwise = Int -> [Word8] -> Integer -> ByteString
forall {t}.
(Integral t, Bits t) =>
Int -> [Word8] -> t -> ByteString
go Int
0 [] Integer
k
  where
    go :: Int -> [Word8] -> t -> ByteString
go !Int
i ![Word8]
acc t
0 = Int -> [Word8] -> ByteString
BSI.unsafePackLenBytes Int
i [Word8]
acc
    go !Int
i ![Word8]
acc t
n = Int -> [Word8] -> t -> ByteString
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
acc) (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

padBS :: Int -> ByteString -> ByteString
padBS :: Int -> ByteString -> ByteString
padBS Int
i ByteString
b
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ByteString
b =
      Int -> Word8 -> ByteString
BS.replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
b) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b
  | Bool
otherwise =
      ByteString
b

integerAsCStrL :: Int -> Integer -> (Ptr CChar -> Int -> IO a) -> IO a
integerAsCStrL :: forall a. Int -> Integer -> (Ptr CChar -> Int -> IO a) -> IO a
integerAsCStrL Int
i Integer
n Ptr CChar -> Int -> IO a
f = do
  let bs :: ByteString
bs = Int -> ByteString -> ByteString
padBS Int
i (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> ByteString
integerToBS Integer
n
  ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ (Ptr CChar -> Int -> IO a) -> CStringLen -> IO a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Ptr CChar -> Int -> IO a
f

scalarFromInteger :: Integer -> IO Scalar
scalarFromInteger :: Integer -> IO Scalar
scalarFromInteger Integer
n = do
  (ScalarPtr -> IO ()) -> IO Scalar
forall a. (ScalarPtr -> IO a) -> IO Scalar
withNewScalar' ((ScalarPtr -> IO ()) -> IO Scalar)
-> (ScalarPtr -> IO ()) -> IO Scalar
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
scalarPtr -> do
    Int -> Integer -> (Ptr CChar -> Int -> IO ()) -> IO ()
forall a. Int -> Integer -> (Ptr CChar -> Int -> IO a) -> IO a
integerAsCStrL Int
sizeScalar (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
scalarPeriod) ((Ptr CChar -> Int -> IO ()) -> IO ())
-> (Ptr CChar -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
str Int
_length -> do
      ScalarPtr -> Ptr CChar -> IO ()
c_blst_scalar_from_bendian ScalarPtr
scalarPtr Ptr CChar
str

---- Unsafe types

newtype ScalarPtr = ScalarPtr (Ptr Void)

-- A pointer to a null-terminated array of pointers to scalars
newtype ScalarArrayPtr = ScalarArrayPtr (Ptr Void)
newtype FrPtr = FrPtr (Ptr Void)
newtype ScratchPtr = ScratchPtr (Ptr Void)

---- Raw Scalar / Fr functions

foreign import ccall "size_blst_scalar" c_size_blst_scalar :: CSize
foreign import ccall "size_blst_fr" c_size_blst_fr :: CSize

foreign import ccall "blst_scalar_fr_check" c_blst_scalar_fr_check :: ScalarPtr -> IO Bool

foreign import ccall "blst_scalar_from_fr" c_blst_scalar_from_fr :: ScalarPtr -> FrPtr -> IO ()
foreign import ccall "blst_fr_from_scalar" c_blst_fr_from_scalar :: FrPtr -> ScalarPtr -> IO ()
foreign import ccall "blst_scalar_from_be_bytes"
  c_blst_scalar_from_be_bytes :: ScalarPtr -> Ptr CChar -> CSize -> IO Bool
foreign import ccall "blst_scalar_from_bendian"
  c_blst_scalar_from_bendian :: ScalarPtr -> Ptr CChar -> IO ()

---- Raw Point1 functions

foreign import ccall "size_blst_p1" c_size_blst_p1 :: CSize
foreign import ccall "blst_p1_on_curve" c_blst_p1_on_curve :: Point1Ptr -> IO Bool

foreign import ccall "blst_p1_add_or_double"
  c_blst_p1_add_or_double :: Point1Ptr -> Point1Ptr -> Point1Ptr -> IO ()
foreign import ccall "blst_p1_mult"
  c_blst_p1_mult :: Point1Ptr -> Point1Ptr -> ScalarPtr -> CSize -> IO ()
foreign import ccall "blst_p1_cneg" c_blst_p1_cneg :: Point1Ptr -> Bool -> IO ()

foreign import ccall "blst_hash_to_g1"
  c_blst_hash_to_g1 ::
    Point1Ptr -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
foreign import ccall "blst_p1_compress" c_blst_p1_compress :: Ptr CChar -> Point1Ptr -> IO ()
foreign import ccall "blst_p1_serialize" c_blst_p1_serialize :: Ptr CChar -> Point1Ptr -> IO ()
foreign import ccall "blst_p1_uncompress" c_blst_p1_uncompress :: Affine1Ptr -> Ptr CChar -> IO CInt
foreign import ccall "blst_p1_deserialize"
  c_blst_p1_deserialize :: Affine1Ptr -> Ptr CChar -> IO CInt

foreign import ccall "blst_p1_in_g1" c_blst_p1_in_g1 :: Point1Ptr -> IO Bool

foreign import ccall "blst_p1_generator" c_blst_p1_generator :: Point1Ptr

foreign import ccall "blst_p1_is_equal" c_blst_p1_is_equal :: Point1Ptr -> Point1Ptr -> IO Bool
foreign import ccall "blst_p1_is_inf" c_blst_p1_is_inf :: Point1Ptr -> IO Bool

foreign import ccall "blst_p1s_mult_pippenger_scratch_sizeof"
  c_blst_p1s_mult_pippenger_scratch_sizeof :: CSize -> CSize
foreign import ccall "blst_p1s_to_affine"
  c_blst_p1s_to_affine :: Affine1BlockPtr -> Point1ArrayPtr -> CSize -> IO ()
foreign import ccall "blst_p1s_mult_pippenger"
  c_blst_p1s_mult_pippenger ::
    Point1Ptr -> Affine1ArrayPtr -> CSize -> ScalarArrayPtr -> CSize -> ScratchPtr -> IO ()

---- Raw Point2 functions

foreign import ccall "size_blst_p2" c_size_blst_p2 :: CSize
foreign import ccall "blst_p2_on_curve" c_blst_p2_on_curve :: Point2Ptr -> IO Bool

foreign import ccall "blst_p2_add_or_double"
  c_blst_p2_add_or_double :: Point2Ptr -> Point2Ptr -> Point2Ptr -> IO ()
foreign import ccall "blst_p2_mult"
  c_blst_p2_mult :: Point2Ptr -> Point2Ptr -> ScalarPtr -> CSize -> IO ()
foreign import ccall "blst_p2_cneg" c_blst_p2_cneg :: Point2Ptr -> Bool -> IO ()

foreign import ccall "blst_hash_to_g2"
  c_blst_hash_to_g2 ::
    Point2Ptr -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
foreign import ccall "blst_p2_compress" c_blst_p2_compress :: Ptr CChar -> Point2Ptr -> IO ()
foreign import ccall "blst_p2_serialize" c_blst_p2_serialize :: Ptr CChar -> Point2Ptr -> IO ()
foreign import ccall "blst_p2_uncompress" c_blst_p2_uncompress :: Affine2Ptr -> Ptr CChar -> IO CInt
foreign import ccall "blst_p2_deserialize"
  c_blst_p2_deserialize :: Affine2Ptr -> Ptr CChar -> IO CInt

foreign import ccall "blst_p2_in_g2" c_blst_p2_in_g2 :: Point2Ptr -> IO Bool

foreign import ccall "blst_p2_generator" c_blst_p2_generator :: Point2Ptr

foreign import ccall "blst_p2_is_equal" c_blst_p2_is_equal :: Point2Ptr -> Point2Ptr -> IO Bool
foreign import ccall "blst_p2_is_inf" c_blst_p2_is_inf :: Point2Ptr -> IO Bool

foreign import ccall "blst_p2s_mult_pippenger_scratch_sizeof"
  c_blst_p2s_mult_pippenger_scratch_sizeof :: CSize -> CSize
foreign import ccall "blst_p2s_to_affine"
  c_blst_p2s_to_affine :: Affine2BlockPtr -> Point2ArrayPtr -> CSize -> IO ()
foreign import ccall "blst_p2s_mult_pippenger"
  c_blst_p2s_mult_pippenger ::
    Point2Ptr -> Affine2ArrayPtr -> CSize -> ScalarArrayPtr -> CSize -> ScratchPtr -> IO ()

---- Affine operations

foreign import ccall "size_blst_affine1" c_size_blst_affine1 :: CSize
foreign import ccall "size_blst_affine2" c_size_blst_affine2 :: CSize

foreign import ccall "blst_p1_to_affine"
  c_blst_p1_to_affine :: AffinePtr Curve1 -> PointPtr Curve1 -> IO ()
foreign import ccall "blst_p2_to_affine"
  c_blst_p2_to_affine :: AffinePtr Curve2 -> PointPtr Curve2 -> IO ()
foreign import ccall "blst_p1_from_affine"
  c_blst_p1_from_affine :: PointPtr Curve1 -> AffinePtr Curve1 -> IO ()
foreign import ccall "blst_p2_from_affine"
  c_blst_p2_from_affine :: PointPtr Curve2 -> AffinePtr Curve2 -> IO ()

foreign import ccall "blst_p1_affine_in_g1" c_blst_p1_affine_in_g1 :: AffinePtr Curve1 -> IO Bool
foreign import ccall "blst_p2_affine_in_g2" c_blst_p2_affine_in_g2 :: AffinePtr Curve2 -> IO Bool

---- PT operations

foreign import ccall "size_blst_fp12" c_size_blst_fp12 :: CSize
foreign import ccall "blst_fp12_mul" c_blst_fp12_mul :: PTPtr -> PTPtr -> PTPtr -> IO ()
foreign import ccall "blst_fp12_is_equal" c_blst_fp12_is_equal :: PTPtr -> PTPtr -> IO Bool
foreign import ccall "blst_fp12_finalverify" c_blst_fp12_finalverify :: PTPtr -> PTPtr -> IO Bool

---- Pairing

foreign import ccall "blst_miller_loop"
  c_blst_miller_loop :: PTPtr -> Affine2Ptr -> Affine1Ptr -> IO ()

---- Raw BLST error constants

foreign import ccall "blst_success" c_blst_success :: CInt
foreign import ccall "blst_error_bad_encoding" c_blst_error_bad_encoding :: CInt
foreign import ccall "blst_error_point_not_on_curve" c_blst_error_point_not_on_curve :: CInt
foreign import ccall "blst_error_point_not_in_group" c_blst_error_point_not_in_group :: CInt
foreign import ccall "blst_error_aggr_type_mismatch" c_blst_error_aggr_type_mismatch :: CInt
foreign import ccall "blst_error_verify_fail" c_blst_error_verify_fail :: CInt
foreign import ccall "blst_error_pk_is_infinity" c_blst_error_pk_is_infinity :: CInt
foreign import ccall "blst_error_bad_scalar" c_blst_error_bad_scalar :: CInt

---- Utility functions

foreign import ccall "memcmp" c_memcmp :: Ptr a -> Ptr a -> CSize -> IO CSize
foreign import ccall "blst_bendian_from_scalar"
  c_blst_bendian_from_scalar :: Ptr CChar -> ScalarPtr -> IO ()

data BLSTError
  = BLST_SUCCESS
  | BLST_BAD_ENCODING
  | BLST_POINT_NOT_ON_CURVE
  | BLST_POINT_NOT_IN_GROUP
  | BLST_AGGR_TYPE_MISMATCH
  | BLST_VERIFY_FAIL
  | BLST_PK_IS_INFINITY
  | BLST_BAD_SCALAR
  | BLST_UNKNOWN_ERROR
  deriving (Int -> BLSTError -> ShowS
[BLSTError] -> ShowS
BLSTError -> [Char]
(Int -> BLSTError -> ShowS)
-> (BLSTError -> [Char])
-> ([BLSTError] -> ShowS)
-> Show BLSTError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BLSTError -> ShowS
showsPrec :: Int -> BLSTError -> ShowS
$cshow :: BLSTError -> [Char]
show :: BLSTError -> [Char]
$cshowList :: [BLSTError] -> ShowS
showList :: [BLSTError] -> ShowS
Show, BLSTError -> BLSTError -> Bool
(BLSTError -> BLSTError -> Bool)
-> (BLSTError -> BLSTError -> Bool) -> Eq BLSTError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BLSTError -> BLSTError -> Bool
== :: BLSTError -> BLSTError -> Bool
$c/= :: BLSTError -> BLSTError -> Bool
/= :: BLSTError -> BLSTError -> Bool
Eq, Eq BLSTError
Eq BLSTError =>
(BLSTError -> BLSTError -> Ordering)
-> (BLSTError -> BLSTError -> Bool)
-> (BLSTError -> BLSTError -> Bool)
-> (BLSTError -> BLSTError -> Bool)
-> (BLSTError -> BLSTError -> Bool)
-> (BLSTError -> BLSTError -> BLSTError)
-> (BLSTError -> BLSTError -> BLSTError)
-> Ord BLSTError
BLSTError -> BLSTError -> Bool
BLSTError -> BLSTError -> Ordering
BLSTError -> BLSTError -> BLSTError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BLSTError -> BLSTError -> Ordering
compare :: BLSTError -> BLSTError -> Ordering
$c< :: BLSTError -> BLSTError -> Bool
< :: BLSTError -> BLSTError -> Bool
$c<= :: BLSTError -> BLSTError -> Bool
<= :: BLSTError -> BLSTError -> Bool
$c> :: BLSTError -> BLSTError -> Bool
> :: BLSTError -> BLSTError -> Bool
$c>= :: BLSTError -> BLSTError -> Bool
>= :: BLSTError -> BLSTError -> Bool
$cmax :: BLSTError -> BLSTError -> BLSTError
max :: BLSTError -> BLSTError -> BLSTError
$cmin :: BLSTError -> BLSTError -> BLSTError
min :: BLSTError -> BLSTError -> BLSTError
Ord, Int -> BLSTError
BLSTError -> Int
BLSTError -> [BLSTError]
BLSTError -> BLSTError
BLSTError -> BLSTError -> [BLSTError]
BLSTError -> BLSTError -> BLSTError -> [BLSTError]
(BLSTError -> BLSTError)
-> (BLSTError -> BLSTError)
-> (Int -> BLSTError)
-> (BLSTError -> Int)
-> (BLSTError -> [BLSTError])
-> (BLSTError -> BLSTError -> [BLSTError])
-> (BLSTError -> BLSTError -> [BLSTError])
-> (BLSTError -> BLSTError -> BLSTError -> [BLSTError])
-> Enum BLSTError
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BLSTError -> BLSTError
succ :: BLSTError -> BLSTError
$cpred :: BLSTError -> BLSTError
pred :: BLSTError -> BLSTError
$ctoEnum :: Int -> BLSTError
toEnum :: Int -> BLSTError
$cfromEnum :: BLSTError -> Int
fromEnum :: BLSTError -> Int
$cenumFrom :: BLSTError -> [BLSTError]
enumFrom :: BLSTError -> [BLSTError]
$cenumFromThen :: BLSTError -> BLSTError -> [BLSTError]
enumFromThen :: BLSTError -> BLSTError -> [BLSTError]
$cenumFromTo :: BLSTError -> BLSTError -> [BLSTError]
enumFromTo :: BLSTError -> BLSTError -> [BLSTError]
$cenumFromThenTo :: BLSTError -> BLSTError -> BLSTError -> [BLSTError]
enumFromThenTo :: BLSTError -> BLSTError -> BLSTError -> [BLSTError]
Enum, BLSTError
BLSTError -> BLSTError -> Bounded BLSTError
forall a. a -> a -> Bounded a
$cminBound :: BLSTError
minBound :: BLSTError
$cmaxBound :: BLSTError
maxBound :: BLSTError
Bounded)

mkBLSTError :: CInt -> BLSTError
mkBLSTError :: CInt -> BLSTError
mkBLSTError CInt
e
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_success =
      BLSTError
BLST_SUCCESS
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_bad_encoding =
      BLSTError
BLST_BAD_ENCODING
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_point_not_on_curve =
      BLSTError
BLST_POINT_NOT_ON_CURVE
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_point_not_in_group =
      BLSTError
BLST_POINT_NOT_IN_GROUP
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_aggr_type_mismatch =
      BLSTError
BLST_AGGR_TYPE_MISMATCH
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_verify_fail =
      BLSTError
BLST_VERIFY_FAIL
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_pk_is_infinity =
      BLSTError
BLST_PK_IS_INFINITY
  | CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
c_blst_error_bad_scalar =
      BLSTError
BLST_BAD_SCALAR
  | Bool
otherwise =
      BLSTError
BLST_UNKNOWN_ERROR

---- Curve point operations

instance BLS curve => Eq (Point curve) where
  Point curve
a == :: Point curve -> Point curve -> Bool
== Point curve
b = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
    Point curve -> (PointPtr curve -> IO Bool) -> IO Bool
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
a ((PointPtr curve -> IO Bool) -> IO Bool)
-> (PointPtr curve -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
aptr ->
      Point curve -> (PointPtr curve -> IO Bool) -> IO Bool
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
b ((PointPtr curve -> IO Bool) -> IO Bool)
-> (PointPtr curve -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
bptr ->
        PointPtr curve -> PointPtr curve -> IO Bool
forall curve.
BLS curve =>
PointPtr curve -> PointPtr curve -> IO Bool
c_blst_p_is_equal PointPtr curve
aptr PointPtr curve
bptr

instance Eq Scalar where
  Scalar
a == :: Scalar -> Scalar -> Bool
== Scalar
b = Scalar -> ByteString
scalarToBS Scalar
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar -> ByteString
scalarToBS Scalar
b

instance Eq Fr where
  Fr
a == :: Fr -> Fr -> Bool
== Fr
b =
    IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Scalar -> Scalar -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Scalar -> Scalar -> Bool) -> IO Scalar -> IO (Scalar -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fr -> IO Scalar
scalarFromFr Fr
a IO (Scalar -> Bool) -> IO Scalar -> IO Bool
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fr -> IO Scalar
scalarFromFr Fr
b

-- | Check whether a point is in the group corresponding to its elliptic curve
blsInGroup :: BLS curve => Point curve -> Bool
blsInGroup :: forall curve. BLS curve => Point curve -> Bool
blsInGroup Point curve
p = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point curve -> (PointPtr curve -> IO Bool) -> IO Bool
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
p PointPtr curve -> IO Bool
forall curve. BLS curve => PointPtr curve -> IO Bool
c_blst_in_g

-- | Curve point addition.
blsAddOrDouble :: BLS curve => Point curve -> Point curve -> Point curve
blsAddOrDouble :: forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
blsAddOrDouble Point curve
in1 Point curve
in2 = IO (Point curve) -> Point curve
forall a. IO a -> a
unsafePerformIO (IO (Point curve) -> Point curve)
-> IO (Point curve) -> Point curve
forall a b. (a -> b) -> a -> b
$ do
  (PointPtr curve -> IO ()) -> IO (Point curve)
forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' ((PointPtr curve -> IO ()) -> IO (Point curve))
-> (PointPtr curve -> IO ()) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
outp -> do
    Point curve -> (PointPtr curve -> IO ()) -> IO ()
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
in1 ((PointPtr curve -> IO ()) -> IO ())
-> (PointPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
in1p -> do
      Point curve -> (PointPtr curve -> IO ()) -> IO ()
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
in2 ((PointPtr curve -> IO ()) -> IO ())
-> (PointPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
in2p -> do
        PointPtr curve -> PointPtr curve -> PointPtr curve -> IO ()
forall curve.
BLS curve =>
PointPtr curve -> PointPtr curve -> PointPtr curve -> IO ()
c_blst_add_or_double PointPtr curve
outp PointPtr curve
in1p PointPtr curve
in2p

-- | Scalar multiplication of a curve point. The scalar will be brought into
-- the range of modular arithmetic by means of a modulo operation over the
-- 'scalarPeriod'. Negative number will also be brought to the range
-- [0, 'scalarPeriod' - 1] via modular reduction.
blsMult :: BLS curve => Point curve -> Integer -> Point curve
blsMult :: forall curve. BLS curve => Point curve -> Integer -> Point curve
blsMult Point curve
in1 Integer
inS = IO (Point curve) -> Point curve
forall a. IO a -> a
unsafePerformIO (IO (Point curve) -> Point curve)
-> IO (Point curve) -> Point curve
forall a b. (a -> b) -> a -> b
$ do
  (PointPtr curve -> IO ()) -> IO (Point curve)
forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' ((PointPtr curve -> IO ()) -> IO (Point curve))
-> (PointPtr curve -> IO ()) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
outp -> do
    Point curve -> (PointPtr curve -> IO ()) -> IO ()
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
in1 ((PointPtr curve -> IO ()) -> IO ())
-> (PointPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
in1p -> do
      Integer -> (ScalarPtr -> IO ()) -> IO ()
forall a. Integer -> (ScalarPtr -> IO a) -> IO a
withIntScalar Integer
inS ((ScalarPtr -> IO ()) -> IO ()) -> (ScalarPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
inSp -> do
        -- Multiply by 8, because blst_mult takes number of *bits*, but
        -- sizeScalar is in *bytes*
        PointPtr curve -> PointPtr curve -> ScalarPtr -> CSize -> IO ()
forall curve.
BLS curve =>
PointPtr curve -> PointPtr curve -> ScalarPtr -> CSize -> IO ()
c_blst_mult PointPtr curve
outp PointPtr curve
in1p ScalarPtr
inSp (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeScalar CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
* CSize
8)

-- | Conditional curve point negation.
-- @blsCneg x cond = if cond then neg x else x@
blsCneg :: BLS curve => Point curve -> Bool -> Point curve
blsCneg :: forall curve. BLS curve => Point curve -> Bool -> Point curve
blsCneg Point curve
in1 Bool
cond = IO (Point curve) -> Point curve
forall a. IO a -> a
unsafePerformIO (IO (Point curve) -> Point curve)
-> IO (Point curve) -> Point curve
forall a b. (a -> b) -> a -> b
$ do
  Point curve
out1 <- Point curve -> IO (Point curve)
forall curve. BLS curve => Point curve -> IO (Point curve)
clonePoint Point curve
in1
  Point curve -> (PointPtr curve -> IO ()) -> IO ()
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
out1 ((PointPtr curve -> IO ()) -> IO ())
-> (PointPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
out1p ->
    PointPtr curve -> Bool -> IO ()
forall curve. BLS curve => PointPtr curve -> Bool -> IO ()
c_blst_cneg PointPtr curve
out1p Bool
cond
  Point curve -> IO (Point curve)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point curve
out1

-- | Unconditional curve point negation
blsNeg :: BLS curve => Point curve -> Point curve
blsNeg :: forall curve. BLS curve => Point curve -> Point curve
blsNeg Point curve
p = Point curve -> Bool -> Point curve
forall curve. BLS curve => Point curve -> Bool -> Point curve
blsCneg Point curve
p Bool
True

blsUncompress :: forall curve. BLS curve => ByteString -> Either BLSTError (Point curve)
blsUncompress :: forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsUncompress ByteString
bs = IO (Either BLSTError (Point curve))
-> Either BLSTError (Point curve)
forall a. IO a -> a
unsafePerformIO (IO (Either BLSTError (Point curve))
 -> Either BLSTError (Point curve))
-> IO (Either BLSTError (Point curve))
-> Either BLSTError (Point curve)
forall a b. (a -> b) -> a -> b
$ do
  ByteString
-> (CStringLen -> IO (Either BLSTError (Point curve)))
-> IO (Either BLSTError (Point curve))
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Either BLSTError (Point curve)))
 -> IO (Either BLSTError (Point curve)))
-> (CStringLen -> IO (Either BLSTError (Point curve)))
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bytes, Int
numBytes) ->
    if Int
numBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve)
      then do
        (CInt
err, Affine curve
affine) <- (AffinePtr curve -> IO CInt) -> IO (CInt, Affine curve)
forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (a, Affine curve)
withNewAffine ((AffinePtr curve -> IO CInt) -> IO (CInt, Affine curve))
-> (AffinePtr curve -> IO CInt) -> IO (CInt, Affine curve)
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
ap -> AffinePtr curve -> Ptr CChar -> IO CInt
forall curve. BLS curve => AffinePtr curve -> Ptr CChar -> IO CInt
c_blst_uncompress AffinePtr curve
ap Ptr CChar
bytes
        let p :: Point curve
p = Affine curve -> Point curve
forall curve. BLS curve => Affine curve -> Point curve
fromAffine Affine curve
affine
        if CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
          then
            Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError (Point curve)
forall a b. a -> Either a b
Left (BLSTError -> Either BLSTError (Point curve))
-> BLSTError -> Either BLSTError (Point curve)
forall a b. (a -> b) -> a -> b
$ CInt -> BLSTError
mkBLSTError CInt
err
          else
            if Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
blsInGroup Point curve
p
              then
                Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ Point curve -> Either BLSTError (Point curve)
forall a b. b -> Either a b
Right Point curve
p
              else
                Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError (Point curve)
forall a b. a -> Either a b
Left BLSTError
BLST_POINT_NOT_IN_GROUP
      else do
        Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError (Point curve)
forall a b. a -> Either a b
Left BLSTError
BLST_BAD_ENCODING

blsDeserialize :: forall curve. BLS curve => ByteString -> Either BLSTError (Point curve)
blsDeserialize :: forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsDeserialize ByteString
bs = IO (Either BLSTError (Point curve))
-> Either BLSTError (Point curve)
forall a. IO a -> a
unsafePerformIO (IO (Either BLSTError (Point curve))
 -> Either BLSTError (Point curve))
-> IO (Either BLSTError (Point curve))
-> Either BLSTError (Point curve)
forall a b. (a -> b) -> a -> b
$ do
  ByteString
-> (CStringLen -> IO (Either BLSTError (Point curve)))
-> IO (Either BLSTError (Point curve))
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Either BLSTError (Point curve)))
 -> IO (Either BLSTError (Point curve)))
-> (CStringLen -> IO (Either BLSTError (Point curve)))
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bytes, Int
numBytes) ->
    if Int
numBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
serializedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve)
      then do
        (CInt
err, Affine curve
affine) <- (AffinePtr curve -> IO CInt) -> IO (CInt, Affine curve)
forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (a, Affine curve)
withNewAffine ((AffinePtr curve -> IO CInt) -> IO (CInt, Affine curve))
-> (AffinePtr curve -> IO CInt) -> IO (CInt, Affine curve)
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
ap -> AffinePtr curve -> Ptr CChar -> IO CInt
forall curve. BLS curve => AffinePtr curve -> Ptr CChar -> IO CInt
c_blst_deserialize AffinePtr curve
ap Ptr CChar
bytes
        let p :: Point curve
p = Affine curve -> Point curve
forall curve. BLS curve => Affine curve -> Point curve
fromAffine Affine curve
affine
        if CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
          then
            Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError (Point curve)
forall a b. a -> Either a b
Left (BLSTError -> Either BLSTError (Point curve))
-> BLSTError -> Either BLSTError (Point curve)
forall a b. (a -> b) -> a -> b
$ CInt -> BLSTError
mkBLSTError CInt
err
          else
            if Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
blsInGroup Point curve
p
              then
                Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ Point curve -> Either BLSTError (Point curve)
forall a b. b -> Either a b
Right Point curve
p
              else
                Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError (Point curve)
forall a b. a -> Either a b
Left BLSTError
BLST_POINT_NOT_IN_GROUP
      else do
        Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError (Point curve)
 -> IO (Either BLSTError (Point curve)))
-> Either BLSTError (Point curve)
-> IO (Either BLSTError (Point curve))
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError (Point curve)
forall a b. a -> Either a b
Left BLSTError
BLST_BAD_ENCODING

blsCompress :: forall curve. BLS curve => Point curve -> ByteString
blsCompress :: forall curve. BLS curve => Point curve -> ByteString
blsCompress Point curve
p = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
ptr) Int
0 (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
  where
    ptr :: ForeignPtr CChar
ptr = IO (ForeignPtr CChar) -> ForeignPtr CChar
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr CChar) -> ForeignPtr CChar)
-> IO (ForeignPtr CChar) -> ForeignPtr CChar
forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr CChar
cstr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
      ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
cstr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cstrp -> do
        Point curve -> (PointPtr curve -> IO ()) -> IO ()
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
p ((PointPtr curve -> IO ()) -> IO ())
-> (PointPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
pp -> do
          Ptr CChar -> PointPtr curve -> IO ()
forall curve. BLS curve => Ptr CChar -> PointPtr curve -> IO ()
c_blst_compress Ptr CChar
cstrp PointPtr curve
pp
      ForeignPtr CChar -> IO (ForeignPtr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr CChar
cstr

blsSerialize :: forall curve. BLS curve => Point curve -> ByteString
blsSerialize :: forall curve. BLS curve => Point curve -> ByteString
blsSerialize Point curve
p = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
ptr) Int
0 (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
serializedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
  where
    ptr :: ForeignPtr CChar
ptr = IO (ForeignPtr CChar) -> ForeignPtr CChar
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr CChar) -> ForeignPtr CChar)
-> IO (ForeignPtr CChar) -> ForeignPtr CChar
forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr CChar
cstr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
serializedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve))
      ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
cstr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cstrp -> do
        Point curve -> (PointPtr curve -> IO ()) -> IO ()
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
p ((PointPtr curve -> IO ()) -> IO ())
-> (PointPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
pp -> do
          Ptr CChar -> PointPtr curve -> IO ()
forall curve. BLS curve => Ptr CChar -> PointPtr curve -> IO ()
c_blst_serialize Ptr CChar
cstrp PointPtr curve
pp
      ForeignPtr CChar -> IO (ForeignPtr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr CChar
cstr

-- | @blsHash msg mDST mAug@ generates the elliptic curve blsHash for the given
-- message @msg@; @mDST@ and @mAug@ are the optional @aug@ and @dst@
-- arguments.
blsHash :: BLS curve => ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
blsHash :: forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
blsHash ByteString
msg Maybe ByteString
mDST Maybe ByteString
mAug = IO (Point curve) -> Point curve
forall a. IO a -> a
unsafePerformIO (IO (Point curve) -> Point curve)
-> IO (Point curve) -> Point curve
forall a b. (a -> b) -> a -> b
$
  ByteString -> (CStringLen -> IO (Point curve)) -> IO (Point curve)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
msg ((CStringLen -> IO (Point curve)) -> IO (Point curve))
-> (CStringLen -> IO (Point curve)) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
msgPtr, Int
msgLen) ->
    Maybe ByteString
-> (CStringLen -> IO (Point curve)) -> IO (Point curve)
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
mDST ((CStringLen -> IO (Point curve)) -> IO (Point curve))
-> (CStringLen -> IO (Point curve)) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
dstPtr, Int
dstLen) ->
      Maybe ByteString
-> (CStringLen -> IO (Point curve)) -> IO (Point curve)
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
mAug ((CStringLen -> IO (Point curve)) -> IO (Point curve))
-> (CStringLen -> IO (Point curve)) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
augPtr, Int
augLen) ->
        (PointPtr curve -> IO ()) -> IO (Point curve)
forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' ((PointPtr curve -> IO ()) -> IO (Point curve))
-> (PointPtr curve -> IO ()) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
pPtr ->
          PointPtr curve
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
forall curve.
BLS curve =>
PointPtr curve
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
c_blst_hash
            PointPtr curve
pPtr
            Ptr CChar
msgPtr
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msgLen)
            Ptr CChar
dstPtr
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dstLen)
            Ptr CChar
augPtr
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
augLen)

toAffine :: BLS curve => Point curve -> Affine curve
toAffine :: forall curve. BLS curve => Point curve -> Affine curve
toAffine Point curve
p = IO (Affine curve) -> Affine curve
forall a. IO a -> a
unsafePerformIO (IO (Affine curve) -> Affine curve)
-> IO (Affine curve) -> Affine curve
forall a b. (a -> b) -> a -> b
$
  Point curve
-> (PointPtr curve -> IO (Affine curve)) -> IO (Affine curve)
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
p ((PointPtr curve -> IO (Affine curve)) -> IO (Affine curve))
-> (PointPtr curve -> IO (Affine curve)) -> IO (Affine curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
pp ->
    (AffinePtr curve -> IO ()) -> IO (Affine curve)
forall curve a.
BLS curve =>
(AffinePtr curve -> IO a) -> IO (Affine curve)
withNewAffine' ((AffinePtr curve -> IO ()) -> IO (Affine curve))
-> (AffinePtr curve -> IO ()) -> IO (Affine curve)
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
affinePtr ->
      AffinePtr curve -> PointPtr curve -> IO ()
forall curve.
BLS curve =>
AffinePtr curve -> PointPtr curve -> IO ()
c_blst_to_affine AffinePtr curve
affinePtr PointPtr curve
pp

fromAffine :: BLS curve => Affine curve -> Point curve
fromAffine :: forall curve. BLS curve => Affine curve -> Point curve
fromAffine Affine curve
affine = IO (Point curve) -> Point curve
forall a. IO a -> a
unsafePerformIO (IO (Point curve) -> Point curve)
-> IO (Point curve) -> Point curve
forall a b. (a -> b) -> a -> b
$
  Affine curve
-> (AffinePtr curve -> IO (Point curve)) -> IO (Point curve)
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine Affine curve
affine ((AffinePtr curve -> IO (Point curve)) -> IO (Point curve))
-> (AffinePtr curve -> IO (Point curve)) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
affinePtr ->
    (PointPtr curve -> IO ()) -> IO (Point curve)
forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' ((PointPtr curve -> IO ()) -> IO (Point curve))
-> (PointPtr curve -> IO ()) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
pp ->
      PointPtr curve -> AffinePtr curve -> IO ()
forall curve.
BLS curve =>
PointPtr curve -> AffinePtr curve -> IO ()
c_blst_from_affine PointPtr curve
pp AffinePtr curve
affinePtr

-- | Infinity check on curve points.
blsIsInf :: BLS curve => Point curve -> Bool
blsIsInf :: forall curve. BLS curve => Point curve -> Bool
blsIsInf Point curve
p = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point curve -> (PointPtr curve -> IO Bool) -> IO Bool
forall a curve. Point curve -> (PointPtr curve -> IO a) -> IO a
withPoint Point curve
p PointPtr curve -> IO Bool
forall curve. BLS curve => PointPtr curve -> IO Bool
c_blst_p_is_inf

affineInG :: BLS curve => Affine curve -> Bool
affineInG :: forall curve. BLS curve => Affine curve -> Bool
affineInG Affine curve
affine =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Affine curve -> (AffinePtr curve -> IO Bool) -> IO Bool
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine Affine curve
affine AffinePtr curve -> IO Bool
forall curve. BLS curve => AffinePtr curve -> IO Bool
c_blst_affine_in_g

blsGenerator :: BLS curve => Point curve
blsGenerator :: forall curve. BLS curve => Point curve
blsGenerator = PointPtr curve -> Point curve
forall curve. PointPtr curve -> Point curve
unsafePointFromPointPtr PointPtr curve
forall curve. BLS curve => PointPtr curve
c_blst_generator

blsZero :: forall curve. BLS curve => Point curve
blsZero :: forall curve. BLS curve => Point curve
blsZero =
  -- Compressed serialised G1 points are bytestrings of length 48: see CIP-0381.
  let b :: ByteString
b = [Word8] -> ByteString
BS.pack (Word8
0xc0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
0x00)
   in case ByteString -> Either BLSTError (Point curve)
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsUncompress ByteString
b of
        Left BLSTError
err ->
          [Char] -> Point curve
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point curve) -> [Char] -> Point curve
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected failure deserialising point at infinity on BLS12_381.G1: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ BLSTError -> [Char]
forall a. Show a => a -> [Char]
show BLSTError
err
        Right Point curve
infinity ->
          Point curve
infinity -- The zero point on this curve is chosen to be the point at infinity.
          ---- Scalar / Fr operations

scalarFromFr :: Fr -> IO Scalar
scalarFromFr :: Fr -> IO Scalar
scalarFromFr Fr
fr =
  (ScalarPtr -> IO ()) -> IO Scalar
forall a. (ScalarPtr -> IO a) -> IO Scalar
withNewScalar' ((ScalarPtr -> IO ()) -> IO Scalar)
-> (ScalarPtr -> IO ()) -> IO Scalar
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
scalarPtr ->
    Fr -> (FrPtr -> IO ()) -> IO ()
forall a. Fr -> (FrPtr -> IO a) -> IO a
withFr Fr
fr ((FrPtr -> IO ()) -> IO ()) -> (FrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FrPtr
frPtr ->
      ScalarPtr -> FrPtr -> IO ()
c_blst_scalar_from_fr ScalarPtr
scalarPtr FrPtr
frPtr

frFromScalar :: Scalar -> IO Fr
frFromScalar :: Scalar -> IO Fr
frFromScalar Scalar
scalar =
  (FrPtr -> IO ()) -> IO Fr
forall a. (FrPtr -> IO a) -> IO Fr
withNewFr' ((FrPtr -> IO ()) -> IO Fr) -> (FrPtr -> IO ()) -> IO Fr
forall a b. (a -> b) -> a -> b
$ \FrPtr
frPtr ->
    Scalar -> (ScalarPtr -> IO ()) -> IO ()
forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar Scalar
scalar ((ScalarPtr -> IO ()) -> IO ()) -> (ScalarPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
scalarPtr ->
      FrPtr -> ScalarPtr -> IO ()
c_blst_fr_from_scalar FrPtr
frPtr ScalarPtr
scalarPtr

frFromCanonicalScalar :: Scalar -> IO (Maybe Fr)
frFromCanonicalScalar :: Scalar -> IO (Maybe Fr)
frFromCanonicalScalar Scalar
scalar
  | Scalar -> Bool
scalarCanonical Scalar
scalar =
      Fr -> Maybe Fr
forall a. a -> Maybe a
Just (Fr -> Maybe Fr) -> IO Fr -> IO (Maybe Fr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scalar -> IO Fr
frFromScalar Scalar
scalar
  | Bool
otherwise =
      Maybe Fr -> IO (Maybe Fr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Fr
forall a. Maybe a
Nothing

scalarFromBS :: ByteString -> Either BLSTError Scalar
scalarFromBS :: ByteString -> Either BLSTError Scalar
scalarFromBS ByteString
bs = IO (Either BLSTError Scalar) -> Either BLSTError Scalar
forall a. IO a -> a
unsafePerformIO (IO (Either BLSTError Scalar) -> Either BLSTError Scalar)
-> IO (Either BLSTError Scalar) -> Either BLSTError Scalar
forall a b. (a -> b) -> a -> b
$ do
  ByteString
-> (CStringLen -> IO (Either BLSTError Scalar))
-> IO (Either BLSTError Scalar)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Either BLSTError Scalar))
 -> IO (Either BLSTError Scalar))
-> (CStringLen -> IO (Either BLSTError Scalar))
-> IO (Either BLSTError Scalar)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
l) ->
    if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sizeScalar
      then do
        (Bool
success, Scalar
scalar) <- (ScalarPtr -> IO Bool) -> IO (Bool, Scalar)
forall a. (ScalarPtr -> IO a) -> IO (a, Scalar)
withNewScalar ((ScalarPtr -> IO Bool) -> IO (Bool, Scalar))
-> (ScalarPtr -> IO Bool) -> IO (Bool, Scalar)
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
scalarPtr ->
          ScalarPtr -> Ptr CChar -> CSize -> IO Bool
c_blst_scalar_from_be_bytes ScalarPtr
scalarPtr Ptr CChar
cstr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
        if Bool
success
          then
            Either BLSTError Scalar -> IO (Either BLSTError Scalar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError Scalar -> IO (Either BLSTError Scalar))
-> Either BLSTError Scalar -> IO (Either BLSTError Scalar)
forall a b. (a -> b) -> a -> b
$ Scalar -> Either BLSTError Scalar
forall a b. b -> Either a b
Right Scalar
scalar
          else
            Either BLSTError Scalar -> IO (Either BLSTError Scalar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError Scalar -> IO (Either BLSTError Scalar))
-> Either BLSTError Scalar -> IO (Either BLSTError Scalar)
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError Scalar
forall a b. a -> Either a b
Left BLSTError
BLST_BAD_SCALAR
      else
        Either BLSTError Scalar -> IO (Either BLSTError Scalar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BLSTError Scalar -> IO (Either BLSTError Scalar))
-> Either BLSTError Scalar -> IO (Either BLSTError Scalar)
forall a b. (a -> b) -> a -> b
$ BLSTError -> Either BLSTError Scalar
forall a b. a -> Either a b
Left BLSTError
BLST_BAD_SCALAR

scalarToBS :: Scalar -> ByteString
scalarToBS :: Scalar -> ByteString
scalarToBS Scalar
scalar = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
ptr) Int
0 Int
sizeScalar
  where
    ptr :: ForeignPtr CChar
ptr = IO (ForeignPtr CChar) -> ForeignPtr CChar
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr CChar) -> ForeignPtr CChar)
-> IO (ForeignPtr CChar) -> ForeignPtr CChar
forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr CChar
cstr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeScalar
      ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
cstr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cstrp -> do
        Scalar -> (ScalarPtr -> IO ()) -> IO ()
forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar Scalar
scalar ((ScalarPtr -> IO ()) -> IO ()) -> (ScalarPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ScalarPtr
scalarPtr -> do
          Ptr CChar -> ScalarPtr -> IO ()
c_blst_bendian_from_scalar Ptr CChar
cstrp ScalarPtr
scalarPtr
      ForeignPtr CChar -> IO (ForeignPtr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr CChar
cstr

scalarCanonical :: Scalar -> Bool
scalarCanonical :: Scalar -> Bool
scalarCanonical Scalar
scalar =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Scalar -> (ScalarPtr -> IO Bool) -> IO Bool
forall a. Scalar -> (ScalarPtr -> IO a) -> IO a
withScalar Scalar
scalar ScalarPtr -> IO Bool
c_blst_scalar_fr_check

---- MSM operations

-- | Multi-scalar multiplication using the Pippenger algorithm.
-- The scalars will be brought into the range of modular arithmetic
-- by means of a modulo operation over the 'scalarPeriod'.
-- Negative numbers will also be brought to the range
-- [0, 'scalarPeriod' - 1] via modular reduction.
blsMSM :: forall curve. BLS curve => [(Integer, Point curve)] -> Point curve
blsMSM :: forall curve. BLS curve => [(Integer, Point curve)] -> Point curve
blsMSM [(Integer, Point curve)]
ssAndps = IO (Point curve) -> Point curve
forall a. IO a -> a
unsafePerformIO (IO (Point curve) -> Point curve)
-> IO (Point curve) -> Point curve
forall a b. (a -> b) -> a -> b
$ do
  Scalar
zeroScalar <- Integer -> IO Scalar
scalarFromInteger Integer
0
  [(Scalar, Point curve)]
filteredPoints <-
    ((Integer, Point curve)
 -> [(Scalar, Point curve)] -> IO [(Scalar, Point curve)])
-> [(Scalar, Point curve)]
-> [(Integer, Point curve)]
-> IO [(Scalar, Point curve)]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
      ( \(Integer
s, Point curve
pt) [(Scalar, Point curve)]
acc -> do
          -- Here we filter out pairs that will not contribute to the result.
          -- This is also for safety, as the c_blst_to_affines C call
          -- will fail if the input contains the point at infinity.
          -- see https://github.com/supranational/blst/blob/165ec77634495175aefd045a48d3469af6950ea4/src/multi_scalar.c#L11C32-L11C37
          if Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
blsIsInf Point curve
pt
            then [(Scalar, Point curve)] -> IO [(Scalar, Point curve)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Scalar, Point curve)]
acc
            else do
              Scalar
scalar <- Integer -> IO Scalar
scalarFromInteger Integer
s
              -- We also filter out the zero scalar, as for any point pt
              -- we have:
              --
              --    pt ^ 0 = id
              --
              -- Which yields no contribution to summation, and
              -- thus we can skip the point and scalar pair. This filter
              -- saves us an extra input to the more expensive exponential
              -- operation.
              if Scalar
scalar Scalar -> Scalar -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar
zeroScalar
                then [(Scalar, Point curve)] -> IO [(Scalar, Point curve)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Scalar, Point curve)]
acc
                else [(Scalar, Point curve)] -> IO [(Scalar, Point curve)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Scalar
scalar, Point curve
pt) (Scalar, Point curve)
-> [(Scalar, Point curve)] -> [(Scalar, Point curve)]
forall a. a -> [a] -> [a]
: [(Scalar, Point curve)]
acc)
      )
      []
      [(Integer, Point curve)]
ssAndps
  case [(Scalar, Point curve)]
filteredPoints of
    [] -> Point curve -> IO (Point curve)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point curve
forall curve. BLS curve => Point curve
blsZero
    -- If there is only one point, we revert to blsMult function
    -- The blst_mult_pippenger C call will also not work for
    -- this case on windows builds.
    [(Scalar
scalar, Point curve
pt)] -> do
      Integer
i <- Scalar -> IO Integer
scalarToInteger Scalar
scalar
      Point curve -> IO (Point curve)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
blsMult Point curve
pt Integer
i)
    [(Scalar, Point curve)]
_ -> do
      let ([Scalar]
scalars, [Point curve]
points) = [(Scalar, Point curve)] -> ([Scalar], [Point curve])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Scalar, Point curve)]
filteredPoints

      forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' @curve ((PointPtr curve -> IO ()) -> IO (Point curve))
-> (PointPtr curve -> IO ()) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
resultPtr -> do
        [Point curve] -> (Int -> PointArrayPtr curve -> IO ()) -> IO ()
forall curve a.
[Point curve] -> (Int -> PointArrayPtr curve -> IO a) -> IO a
withPointArray [Point curve]
points ((Int -> PointArrayPtr curve -> IO ()) -> IO ())
-> (Int -> PointArrayPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
numPoints PointArrayPtr curve
pointArrayPtr -> do
          [Scalar] -> (Int -> ScalarArrayPtr -> IO ()) -> IO ()
forall a. [Scalar] -> (Int -> ScalarArrayPtr -> IO a) -> IO a
withScalarArray [Scalar]
scalars ((Int -> ScalarArrayPtr -> IO ()) -> IO ())
-> (Int -> ScalarArrayPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
_ ScalarArrayPtr
scalarArrayPtr -> do
            let numPoints' :: CSize
                numPoints' :: CSize
numPoints' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numPoints
                scratchSize :: Int
                scratchSize :: Int
scratchSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ Proxy curve -> CSize -> CSize
forall curve. BLS curve => Proxy curve -> CSize -> CSize
c_blst_scratch_sizeof (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve) CSize
numPoints'
            Int -> (Ptr Void -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
numPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
* Proxy curve -> Int
forall curve. BLS curve => Proxy curve -> Int
sizeAffine (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @curve)) ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
affinesBlockPtr -> do
              AffineBlockPtr curve -> PointArrayPtr curve -> CSize -> IO ()
forall curve.
BLS curve =>
AffineBlockPtr curve -> PointArrayPtr curve -> CSize -> IO ()
c_blst_to_affines (Ptr Void -> AffineBlockPtr curve
forall curve. Ptr Void -> AffineBlockPtr curve
AffineBlockPtr Ptr Void
affinesBlockPtr) PointArrayPtr curve
pointArrayPtr CSize
numPoints'
              Ptr Void -> Int -> (AffineArrayPtr curve -> IO ()) -> IO ()
forall curve a.
BLS curve =>
Ptr Void -> Int -> (AffineArrayPtr curve -> IO a) -> IO a
withAffineBlockArrayPtr Ptr Void
affinesBlockPtr Int
numPoints ((AffineArrayPtr curve -> IO ()) -> IO ())
-> (AffineArrayPtr curve -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AffineArrayPtr curve
affineArrayPtr -> do
                Int -> (Ptr Void -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
scratchSize ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
scratchPtr -> do
                  PointPtr curve
-> AffineArrayPtr curve
-> CSize
-> ScalarArrayPtr
-> CSize
-> ScratchPtr
-> IO ()
forall curve.
BLS curve =>
PointPtr curve
-> AffineArrayPtr curve
-> CSize
-> ScalarArrayPtr
-> CSize
-> ScratchPtr
-> IO ()
c_blst_mult_pippenger
                    PointPtr curve
resultPtr
                    AffineArrayPtr curve
affineArrayPtr
                    CSize
numPoints'
                    ScalarArrayPtr
scalarArrayPtr
                    (CSize
255 :: CSize)
                    (Ptr Void -> ScratchPtr
ScratchPtr Ptr Void
scratchPtr)

---- PT operations

ptMult :: PT -> PT -> PT
ptMult :: PT -> PT -> PT
ptMult PT
a PT
b = IO PT -> PT
forall a. IO a -> a
unsafePerformIO (IO PT -> PT) -> IO PT -> PT
forall a b. (a -> b) -> a -> b
$
  PT -> (PTPtr -> IO PT) -> IO PT
forall a. PT -> (PTPtr -> IO a) -> IO a
withPT PT
a ((PTPtr -> IO PT) -> IO PT) -> (PTPtr -> IO PT) -> IO PT
forall a b. (a -> b) -> a -> b
$ \PTPtr
ap ->
    PT -> (PTPtr -> IO PT) -> IO PT
forall a. PT -> (PTPtr -> IO a) -> IO a
withPT PT
b ((PTPtr -> IO PT) -> IO PT) -> (PTPtr -> IO PT) -> IO PT
forall a b. (a -> b) -> a -> b
$ \PTPtr
bp ->
      (PTPtr -> IO ()) -> IO PT
forall a. (PTPtr -> IO a) -> IO PT
withNewPT' ((PTPtr -> IO ()) -> IO PT) -> (PTPtr -> IO ()) -> IO PT
forall a b. (a -> b) -> a -> b
$ \PTPtr
cp ->
        PTPtr -> PTPtr -> PTPtr -> IO ()
c_blst_fp12_mul PTPtr
cp PTPtr
ap PTPtr
bp

ptEq :: PT -> PT -> Bool
ptEq :: PT -> PT -> Bool
ptEq PT
a PT
b = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  PT -> (PTPtr -> IO Bool) -> IO Bool
forall a. PT -> (PTPtr -> IO a) -> IO a
withPT PT
a ((PTPtr -> IO Bool) -> IO Bool) -> (PTPtr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PTPtr
ap ->
    PT -> (PTPtr -> IO Bool) -> IO Bool
forall a. PT -> (PTPtr -> IO a) -> IO a
withPT PT
b ((PTPtr -> IO Bool) -> IO Bool) -> (PTPtr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PTPtr
bp ->
      PTPtr -> PTPtr -> IO Bool
c_blst_fp12_is_equal PTPtr
ap PTPtr
bp

ptFinalVerify :: PT -> PT -> Bool
ptFinalVerify :: PT -> PT -> Bool
ptFinalVerify PT
a PT
b = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  PT -> (PTPtr -> IO Bool) -> IO Bool
forall a. PT -> (PTPtr -> IO a) -> IO a
withPT PT
a ((PTPtr -> IO Bool) -> IO Bool) -> (PTPtr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PTPtr
ap ->
    PT -> (PTPtr -> IO Bool) -> IO Bool
forall a. PT -> (PTPtr -> IO a) -> IO a
withPT PT
b ((PTPtr -> IO Bool) -> IO Bool) -> (PTPtr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PTPtr
bp ->
      PTPtr -> PTPtr -> IO Bool
c_blst_fp12_finalverify PTPtr
ap PTPtr
bp

instance Eq PT where
  == :: PT -> PT -> Bool
(==) = PT -> PT -> Bool
ptEq

---- Pairings

millerLoop :: Point1 -> Point2 -> PT
millerLoop :: Point1 -> Point2 -> PT
millerLoop Point1
p1 Point2
p2 =
  IO PT -> PT
forall a. IO a -> a
unsafePerformIO (IO PT -> PT) -> IO PT -> PT
forall a b. (a -> b) -> a -> b
$
    Affine Curve1 -> (AffinePtr Curve1 -> IO PT) -> IO PT
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine (Point1 -> Affine Curve1
forall curve. BLS curve => Point curve -> Affine curve
toAffine Point1
p1) ((AffinePtr Curve1 -> IO PT) -> IO PT)
-> (AffinePtr Curve1 -> IO PT) -> IO PT
forall a b. (a -> b) -> a -> b
$ \AffinePtr Curve1
ap1 ->
      Affine Curve2 -> (AffinePtr Curve2 -> IO PT) -> IO PT
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine (Point2 -> Affine Curve2
forall curve. BLS curve => Point curve -> Affine curve
toAffine Point2
p2) ((AffinePtr Curve2 -> IO PT) -> IO PT)
-> (AffinePtr Curve2 -> IO PT) -> IO PT
forall a b. (a -> b) -> a -> b
$ \AffinePtr Curve2
ap2 ->
        (PTPtr -> IO ()) -> IO PT
forall a. (PTPtr -> IO a) -> IO PT
withNewPT' ((PTPtr -> IO ()) -> IO PT) -> (PTPtr -> IO ()) -> IO PT
forall a b. (a -> b) -> a -> b
$ \PTPtr
ppt ->
          PTPtr -> AffinePtr Curve2 -> AffinePtr Curve1 -> IO ()
c_blst_miller_loop PTPtr
ppt AffinePtr Curve2
ap2 AffinePtr Curve1
ap1

---- Utility

withMaybeCStringLen :: Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen :: forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
Nothing CStringLen -> IO a
go = CStringLen -> IO a
go (Ptr CChar
forall a. Ptr a
nullPtr, Int
0)
withMaybeCStringLen (Just ByteString
bs) CStringLen -> IO a
go = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs CStringLen -> IO a
go

-- | The period of scalar modulo operations.
scalarPeriod :: Integer
scalarPeriod :: Integer
scalarPeriod = Integer
0x73eda753299d7d483339d80809a1d80553bda402fffe5bfeffffffff00000001