Add Haskell bindings to new C crypto jets.

BlockstreamResearch · Jun 2, 2021 · 7fa0a11 · 7fa0a11
1 parent 539a30d
commit 7fa0a11
Show file tree

Hide file tree

Showing 4 changed files with 214 additions and 25 deletions.
diff --git a/Haskell/Core/Simplicity/FFI/Jets.hs b/Haskell/Core/Simplicity/FFI/Jets.hs
@@ -5,12 +5,19 @@ module Simplicity.FFI.Jets
  , subtract_32, full_subtract_32
  , multiply_32, full_multiply_32
  , sha_256_block
+ , fe_normalize, fe_negate, fe_add, fe_square, fe_multiply, fe_multiply_beta, fe_invert, fe_square_root, fe_is_zero, fe_is_odd
+ , scalar_normalize, scalar_negate, scalar_add, scalar_square, scalar_multiply, scalar_multiply_lambda, scalar_invert, scalar_is_zero
+ , gej_infinity, gej_normalize, gej_negate, ge_negate, gej_double, gej_add, gej_ge_add_ex, gej_ge_add, gej_is_infinity, gej_x_equiv, gej_y_is_odd, gej_is_on_curve, ge_is_on_curve
+ , scale, generate, linear_combination_1, linear_verify_1
+ , decompress, point_verify_1
+ , bip0340_verify
  ) where
 
 import Foreign.Ptr (Ptr)
 
 import Simplicity.FFI.Frame
 import qualified Simplicity.Programs.Sha256.Lib as Sha256
+import Simplicity.Programs.LibSecp256k1.Lib (FE, Scalar, GE, GEJ, Point, PubKey, Sig)
 import qualified Simplicity.Programs.LibSecp256k1.Lib as LibSecp256k1
 import Simplicity.Ty.Word
 
@@ -20,8 +27,48 @@ foreign import ccall unsafe "" c_subtract_32 :: Ptr FrameItem -> Ptr FrameItem -
 foreign import ccall unsafe "" c_full_subtract_32 :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
 foreign import ccall unsafe "" c_multiply_32 :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
 foreign import ccall unsafe "" c_full_multiply_32 :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+
 foreign import ccall unsafe "" c_sha_256_block :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
 
+foreign import ccall unsafe "" c_fe_normalize :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_negate :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_add :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_square :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_multiply :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_multiply_beta :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_invert :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_square_root :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_is_zero :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_fe_is_odd :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_normalize :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_negate :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_add :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_square :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_multiply :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_multiply_lambda :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_invert :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scalar_is_zero :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_infinity :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_normalize :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_negate :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_ge_negate :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_double :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_add :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_ge_add_ex :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_ge_add :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_is_infinity :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_x_equiv :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_y_is_odd :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_gej_is_on_curve :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_ge_is_on_curve :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_scale :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_generate :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_linear_combination_1 :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_linear_verify_1 :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_decompress :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_point_verify_1 :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+foreign import ccall unsafe "" c_bip0340_verify :: Ptr FrameItem -> Ptr FrameItem -> IO Bool
+
 add_32 :: (Word32, Word32) -> Maybe (Bit, Word32)
 add_32 = unsafeLocalCoreJet c_add_32
 
@@ -42,3 +89,118 @@ full_multiply_32 = unsafeLocalCoreJet c_full_multiply_32
 
 sha_256_block :: (Sha256.Hash, Sha256.Block) -> Maybe Sha256.Hash
 sha_256_block = unsafeLocalCoreJet c_sha_256_block
+
+fe_normalize :: FE -> Maybe FE
+fe_normalize = unsafeLocalCoreJet c_fe_normalize
+
+fe_negate :: FE -> Maybe FE
+fe_negate = unsafeLocalCoreJet c_fe_negate
+
+fe_add :: (FE, FE) -> Maybe FE
+fe_add = unsafeLocalCoreJet c_fe_add
+
+fe_square :: FE -> Maybe FE
+fe_square = unsafeLocalCoreJet c_fe_square
+
+fe_multiply :: (FE, FE) -> Maybe FE
+fe_multiply = unsafeLocalCoreJet c_fe_multiply
+
+fe_multiply_beta :: FE -> Maybe FE
+fe_multiply_beta = unsafeLocalCoreJet c_fe_multiply_beta
+
+fe_invert :: FE -> Maybe FE
+fe_invert = unsafeLocalCoreJet c_fe_invert
+
+fe_square_root :: FE -> Maybe (Either () FE)
+fe_square_root = unsafeLocalCoreJet c_fe_square_root
+
+fe_is_zero :: FE -> Maybe Bit
+fe_is_zero = unsafeLocalCoreJet c_fe_is_zero
+
+fe_is_odd :: FE -> Maybe Bit
+fe_is_odd = unsafeLocalCoreJet c_fe_is_odd
+
+scalar_normalize :: Scalar -> Maybe Scalar
+scalar_normalize = unsafeLocalCoreJet c_scalar_normalize
+
+scalar_negate :: Scalar -> Maybe Scalar
+scalar_negate = unsafeLocalCoreJet c_scalar_negate
+
+scalar_add :: (Scalar, Scalar) -> Maybe Scalar
+scalar_add = unsafeLocalCoreJet c_scalar_add
+
+scalar_square :: Scalar -> Maybe Scalar
+scalar_square = unsafeLocalCoreJet c_scalar_square
+
+scalar_multiply :: (Scalar, Scalar) -> Maybe Scalar
+scalar_multiply = unsafeLocalCoreJet c_scalar_multiply
+
+scalar_multiply_lambda :: Scalar -> Maybe Scalar
+scalar_multiply_lambda = unsafeLocalCoreJet c_scalar_multiply_lambda
+
+scalar_invert :: Scalar -> Maybe Scalar
+scalar_invert = unsafeLocalCoreJet c_scalar_invert
+
+scalar_is_zero :: Scalar -> Maybe Bit
+scalar_is_zero = unsafeLocalCoreJet c_scalar_is_zero
+
+gej_infinity :: () -> Maybe GEJ
+gej_infinity = unsafeLocalCoreJet c_gej_infinity
+
+gej_normalize :: GEJ -> Maybe GE
+gej_normalize = unsafeLocalCoreJet c_gej_normalize
+
+gej_negate :: GEJ -> Maybe GEJ
+gej_negate = unsafeLocalCoreJet c_gej_negate
+
+ge_negate :: GE -> Maybe GE
+ge_negate = unsafeLocalCoreJet c_ge_negate
+
+gej_double :: GEJ -> Maybe GEJ
+gej_double = unsafeLocalCoreJet c_gej_double
+
+gej_add :: (GEJ, GEJ) -> Maybe GEJ
+gej_add = unsafeLocalCoreJet c_gej_add
+
+gej_ge_add_ex :: (GEJ, GE) -> Maybe (FE, GEJ)
+gej_ge_add_ex = unsafeLocalCoreJet c_gej_ge_add_ex
+
+gej_ge_add :: (GEJ, GE) -> Maybe GEJ
+gej_ge_add = unsafeLocalCoreJet c_gej_ge_add
+
+gej_is_infinity :: GEJ -> Maybe Bit
+gej_is_infinity = unsafeLocalCoreJet c_gej_is_infinity
+
+gej_x_equiv :: (GEJ, FE) -> Maybe Bit
+gej_x_equiv = unsafeLocalCoreJet c_gej_x_equiv
+
+gej_y_is_odd :: GEJ -> Maybe Bit
+gej_y_is_odd = unsafeLocalCoreJet c_gej_y_is_odd
+
+gej_is_on_curve :: GEJ -> Maybe Bit
+gej_is_on_curve = unsafeLocalCoreJet c_gej_is_on_curve
+
+ge_is_on_curve :: GE -> Maybe Bit
+ge_is_on_curve = unsafeLocalCoreJet c_ge_is_on_curve
+
+scale :: (Scalar, GEJ) -> Maybe GEJ
+scale = unsafeCoreJet c_scale -- not local because the C code operates on global variables
+
+generate :: Scalar -> Maybe GEJ
+generate = unsafeCoreJet c_generate -- not local because the C code operates on global variables
+
+linear_combination_1 :: ((Scalar, GEJ), Scalar) -> Maybe GEJ
+linear_combination_1 = unsafeCoreJet c_linear_combination_1 -- not local because the C code operates on global variables
+
+linear_verify_1 :: (((Scalar, GE), Scalar), GE) -> Maybe ()
+linear_verify_1 = unsafeCoreJet c_linear_verify_1 -- not local because the C code operates on global variables
+
+decompress :: Point -> Maybe (Either () GE)
+decompress = unsafeLocalCoreJet c_decompress
+
+point_verify_1 :: (((Scalar, Point), Scalar), Point) -> Maybe ()
+point_verify_1 = unsafeCoreJet c_point_verify_1 -- not local because the C code operates on global variables
+
+bip0340_verify :: ((PubKey, Word256), Sig) -> Maybe ()
+bip0340_verify = unsafeCoreJet c_bip0340_verify -- not local because the C code operates on global variables
+
diff --git a/Haskell/cbits/jets.c b/Haskell/cbits/jets.c
@@ -1,29 +1,54 @@
 #include "jets.h"
 
-bool c_add_32(frameItem* dst, const frameItem *src) {
-  return add_32(dst, *src, NULL);
+#define WRAP_(jet)                                                                                                            \
+bool c_##jet(frameItem* dst, const frameItem* src) {                                                                          \
+  return jet(dst, *src, NULL);                                                                                                \
 }
 
-bool c_full_add_32(frameItem* dst, const frameItem *src) {
-  return full_add_32(dst, *src, NULL);
-}
+WRAP_(add_32)
+WRAP_(full_add_32)
+WRAP_(subtract_32)
+WRAP_(full_subtract_32)
+WRAP_(multiply_32)
+WRAP_(full_multiply_32)
 
-bool c_subtract_32(frameItem* dst, const frameItem *src) {
-  return subtract_32(dst, *src, NULL);
-}
+WRAP_(sha_256_block)
 
-bool c_full_subtract_32(frameItem* dst, const frameItem *src) {
-  return full_subtract_32(dst, *src, NULL);
-}
-
-bool c_multiply_32(frameItem* dst, const frameItem *src) {
-  return multiply_32(dst, *src, NULL);
-}
-
-bool c_full_multiply_32(frameItem* dst, const frameItem *src) {
-  return full_multiply_32(dst, *src, NULL);
-}
-
-bool c_sha_256_block(frameItem* dst, const frameItem* src) {
-  return sha_256_block(dst, *src, NULL);
-}
+WRAP_(fe_normalize)
+WRAP_(fe_negate)
+WRAP_(fe_add)
+WRAP_(fe_square)
+WRAP_(fe_multiply)
+WRAP_(fe_multiply_beta)
+WRAP_(fe_invert)
+WRAP_(fe_square_root)
+WRAP_(fe_is_zero)
+WRAP_(fe_is_odd)
+WRAP_(scalar_normalize)
+WRAP_(scalar_negate)
+WRAP_(scalar_add)
+WRAP_(scalar_square)
+WRAP_(scalar_multiply)
+WRAP_(scalar_multiply_lambda)
+WRAP_(scalar_invert)
+WRAP_(scalar_is_zero)
+WRAP_(gej_infinity)
+WRAP_(gej_normalize)
+WRAP_(gej_negate)
+WRAP_(ge_negate)
+WRAP_(gej_double)
+WRAP_(gej_add)
+WRAP_(gej_ge_add_ex)
+WRAP_(gej_ge_add)
+WRAP_(gej_is_infinity)
+WRAP_(gej_x_equiv)
+WRAP_(gej_y_is_odd)
+WRAP_(gej_is_on_curve)
+WRAP_(ge_is_on_curve)
+WRAP_(scale)
+WRAP_(generate)
+WRAP_(linear_combination_1)
+WRAP_(linear_verify_1)
+WRAP_(decompress)
+WRAP_(point_verify_1)
+WRAP_(bip0340_verify)
diff --git a/Simplicity.Haskell.nix b/Simplicity.Haskell.nix
@@ -5,7 +5,8 @@ mkDerivation (rec {
   src = lib.sourceFilesBySuffices
       (lib.sourceByRegex ./. ["^LICENSE$" "^Simplicity\.cabal$" "^Setup.hs$" "^Tests.hs$" "^Haskell$" "^Haskell/.*"
                               "^libsha256compression$" "^libsha256compression/.*"
-                              "^C$" "^C/uword.h" "^C/bitstring.h" "^C/frame.*" "^C/jets.*" "^C/sha256.h"])
+                              "^C$" "^C/uword.h$" "^C/bitstring.h$" "^C/callonce.h$" "^C/frame.*" "^C/jets.*" "^C/jets-secp256k1.c$"
+                              "^C/secp256k1$" "^C/secp256k1/.*" "^C/sha256.h$"])
     ["LICENSE" ".cabal" ".hs" ".hsig" ".h" ".c"];
   libraryHaskellDepends = [ base binary cereal lens-family MemoTrie mtl SHA split tardis unification-fd vector ];
   testHaskellDepends = libraryHaskellDepends ++ [ QuickCheck tasty tasty-hunit tasty-quickcheck ];

diff --git a/Simplicity.cabal b/Simplicity.cabal
@@ -15,7 +15,7 @@ tested-with:         GHC ==8.6.4
 
 library Simplicity-Core
   C-sources:           libsha256compression/sha256/compression.c,
-                       C/frame.c, C/jets.c,
+                       C/frame.c, C/jets.c, C/jets-secp256k1.c
                        Haskell/cbits/frame.c, Haskell/cbits/jets.c
   Include-dirs:        libsha256compression/include,
                        C
@@ -124,6 +124,7 @@ library
                        Simplicity.Term.Core,
                        Simplicity.CoreJets,
                        Simplicity.Functor, Simplicity.Tensor,
+                       Simplicity.FFI.Jets,
                        Simplicity.BitMachine, Simplicity.BitMachine.Authentic, Simplicity.BitMachine.Ty,
                        Simplicity.BitMachine.Translate, Simplicity.BitMachine.Translate.TCO,
                        Simplicity.BitMachine.StaticAnalysis, Simplicity.BitMachine.StaticAnalysis.TCO,