{-# LANGUAGE NoFieldSelectors #-}
module Crypto.Secp256k1.Internal.Context where
import Control.Exception (bracket, mask_)
import Control.Monad (unless)
import Crypto.Secp256k1.Internal.ForeignTypes
( CtxFlags,
LCtx,
Ret,
Seed32,
isSuccess,
)
import Crypto.Secp256k1.Internal.Util (withRandomSeed)
import Foreign (FunPtr, Ptr)
import Foreign.C (CInt (..), CString, CUInt (..))
import Foreign.ForeignPtr
( FinalizerPtr,
ForeignPtr,
finalizeForeignPtr,
newForeignPtr,
withForeignPtr,
)
import GHC.Conc (writeTVar)
import System.IO.Unsafe (unsafePerformIO)
newtype Ctx = Ctx {Ctx -> ForeignPtr LCtx
get :: ForeignPtr LCtx}
randomizeContext :: Ctx -> IO ()
randomizeContext :: Ctx -> IO ()
randomizeContext (Ctx ForeignPtr LCtx
fctx) = ForeignPtr LCtx -> (Ptr LCtx -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LCtx
fctx ((Ptr LCtx -> IO ()) -> IO ()) -> (Ptr LCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr LCtx
ctx -> do
Ret
ret <- (Ptr Seed32 -> IO Ret) -> IO Ret
forall a. (Ptr Seed32 -> IO a) -> IO a
withRandomSeed ((Ptr Seed32 -> IO Ret) -> IO Ret)
-> (Ptr Seed32 -> IO Ret) -> IO Ret
forall a b. (a -> b) -> a -> b
$ Ptr LCtx -> Ptr Seed32 -> IO Ret
contextRandomize Ptr LCtx
ctx
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ret -> Bool
isSuccess Ret
ret) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not randomize context"
createContext :: IO Ctx
createContext :: IO Ctx
createContext = do
Ctx
ctx <- IO Ctx -> IO Ctx
forall a. IO a -> IO a
mask_ (IO Ctx -> IO Ctx) -> IO Ctx -> IO Ctx
forall a b. (a -> b) -> a -> b
$ do
Ptr LCtx
pctx <- CtxFlags -> IO (Ptr LCtx)
contextCreate CtxFlags
signVerify
ForeignPtr LCtx -> Ctx
Ctx (ForeignPtr LCtx -> Ctx) -> IO (ForeignPtr LCtx) -> IO Ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr LCtx -> Ptr LCtx -> IO (ForeignPtr LCtx)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr LCtx
contextDestroyFunPtr Ptr LCtx
pctx
Ctx -> IO ()
randomizeContext Ctx
ctx
Ctx -> IO Ctx
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ctx
ctx
cloneContext :: Ctx -> IO Ctx
cloneContext :: Ctx -> IO Ctx
cloneContext (Ctx ForeignPtr LCtx
fctx) =
ForeignPtr LCtx -> (Ptr LCtx -> IO Ctx) -> IO Ctx
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LCtx
fctx ((Ptr LCtx -> IO Ctx) -> IO Ctx) -> (Ptr LCtx -> IO Ctx) -> IO Ctx
forall a b. (a -> b) -> a -> b
$ \Ptr LCtx
ctx -> IO Ctx -> IO Ctx
forall a. IO a -> IO a
mask_ (IO Ctx -> IO Ctx) -> IO Ctx -> IO Ctx
forall a b. (a -> b) -> a -> b
$ do
Ptr LCtx
ctx' <- Ptr LCtx -> IO (Ptr LCtx)
contextClone Ptr LCtx
ctx
ForeignPtr LCtx -> Ctx
Ctx (ForeignPtr LCtx -> Ctx) -> IO (ForeignPtr LCtx) -> IO Ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr LCtx -> Ptr LCtx -> IO (ForeignPtr LCtx)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr LCtx
contextDestroyFunPtr Ptr LCtx
ctx'
destroyContext :: Ctx -> IO ()
destroyContext :: Ctx -> IO ()
destroyContext (Ctx ForeignPtr LCtx
fctx)= ForeignPtr LCtx -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LCtx
fctx
withContext :: (Ctx -> IO a) -> IO a
withContext :: forall a. (Ctx -> IO a) -> IO a
withContext = (IO Ctx
createContext IO Ctx -> (Ctx -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
verify :: CtxFlags
verify :: CtxFlags
verify = CtxFlags
0x0101
sign :: CtxFlags
sign :: CtxFlags
sign = CtxFlags
0x0201
signVerify :: CtxFlags
signVerify :: CtxFlags
signVerify = CtxFlags
0x0301
foreign import ccall safe "secp256k1.h secp256k1_context_create"
contextCreate ::
CtxFlags ->
IO (Ptr LCtx)
foreign import ccall safe "secp256k1.h secp256k1_context_clone"
contextClone ::
Ptr LCtx ->
IO (Ptr LCtx)
foreign import ccall safe "secp256k1.h secp256k1_context_destroy"
contextDestroy :: Ptr LCtx -> IO ()
foreign import ccall safe "secp256k1.h &secp256k1_context_destroy"
contextDestroyFunPtr :: FunPtr (Ptr LCtx -> IO ())
foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback"
setIllegalCallback ::
Ptr LCtx ->
FunPtr (CString -> Ptr a -> IO ()) ->
Ptr a ->
IO ()
foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback"
setErrorCallback ::
Ptr LCtx ->
FunPtr (CString -> Ptr a -> IO ()) ->
Ptr a ->
IO ()
foreign import ccall safe "secp256k1.h secp256k1_context_randomize"
contextRandomize ::
Ptr LCtx ->
Ptr Seed32 ->
IO Ret