{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Crypto.Secp256k1.Internal.Context
-- License     : UNLICENSE
-- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>
-- Stability   : experimental
-- Portability : POSIX
--
-- The API for this module may change at any time. This is an internal module only
-- exposed for hacking and experimentation.
module Crypto.Secp256k1.Internal.Context where

import Control.Exception (bracket)
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 System.IO.Unsafe (unsafePerformIO)

newtype Ctx = Ctx {Ctx -> Ptr LCtx
get :: Ptr LCtx}

randomizeContext :: Ctx -> IO ()
randomizeContext :: Ctx -> IO ()
randomizeContext (Ctx 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 = Ptr LCtx -> Ctx
Ctx (Ptr LCtx -> Ctx) -> IO (Ptr LCtx) -> IO Ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CtxFlags -> IO (Ptr LCtx)
contextCreate CtxFlags
signVerify

cloneContext :: Ctx -> IO Ctx
cloneContext :: Ctx -> IO Ctx
cloneContext = (Ptr LCtx -> Ctx) -> IO (Ptr LCtx) -> IO Ctx
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr LCtx -> Ctx
Ctx (IO (Ptr LCtx) -> IO Ctx)
-> (Ctx -> IO (Ptr LCtx)) -> Ctx -> IO Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr LCtx -> IO (Ptr LCtx)
contextClone (Ptr LCtx -> IO (Ptr LCtx))
-> (Ctx -> Ptr LCtx) -> Ctx -> IO (Ptr LCtx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

destroyContext :: Ctx -> IO ()
destroyContext :: Ctx -> IO ()
destroyContext = Ptr LCtx -> IO ()
contextDestroy (Ptr LCtx -> IO ()) -> (Ctx -> Ptr LCtx) -> Ctx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

withContext :: (Ctx -> IO a) -> IO a
withContext :: forall a. (Ctx -> IO a) -> IO a
withContext = IO Ctx -> (Ctx -> IO ()) -> (Ctx -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Ctx
create Ctx -> IO ()
destroy
  where
    create :: IO Ctx
create = do
      Ctx
ctx <- IO Ctx
createContext
      Ctx -> IO ()
randomizeContext Ctx
ctx
      Ctx -> IO Ctx
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ctx
ctx
    destroy :: Ctx -> IO ()
destroy = Ctx -> IO ()
destroyContext

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_set_illegal_callback"
  setIllegalCallback ::
    Ptr LCtx ->
    -- | message, data
    FunPtr (CString -> Ptr a -> IO ()) ->
    -- | data
    Ptr a ->
    IO ()

foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback"
  setErrorCallback ::
    Ptr LCtx ->
    -- | message, data
    FunPtr (CString -> Ptr a -> IO ()) ->
    -- | data
    Ptr a ->
    IO ()

foreign import ccall safe "secp256k1.h secp256k1_context_randomize"
  contextRandomize ::
    Ptr LCtx ->
    Ptr Seed32 ->
    IO Ret