{-# LINE 1 "src/ZooKeeper/Internal/FFI.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UnliftedFFITypes #-}
module ZooKeeper.Internal.FFI where
import Control.Concurrent
import Control.Exception
import Control.Monad (void)
import Data.Version (Version, makeVersion)
import Data.Word
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.StablePtr
import GHC.Conc
import GHC.Stack (HasCallStack)
import qualified Z.Data.CBytes as CBytes
import Z.Foreign
import ZooKeeper.Exception
import ZooKeeper.Internal.Types
{-# LINE 30 "src/ZooKeeper/Internal/FFI.hsc" #-}
zooVersion :: Version
{-# LINE 35 "src/ZooKeeper/Internal/FFI.hsc" #-}
zooVersion :: Version
zooVersion = [Int] -> Version
makeVersion [ (Int
3)
{-# LINE 37 "src/ZooKeeper/Internal/FFI.hsc" #-}
, (Int
4)
{-# LINE 38 "src/ZooKeeper/Internal/FFI.hsc" #-}
, (Int
12)
{-# LINE 39 "src/ZooKeeper/Internal/FFI.hsc" #-}
]
{-# LINE 46 "src/ZooKeeper/Internal/FFI.hsc" #-}
foreign import ccall unsafe "hs_zk.h &logLevel"
c_log_level :: Ptr ZooLogLevel
foreign import ccall unsafe "hs_zk.h zoo_set_debug_level"
zooSetDebugLevel :: ZooLogLevel -> IO ()
foreign import capi unsafe "zookeeper/zookeeper.h zoo_set_log_stream"
c_zoo_set_log_stream :: Ptr CFile -> IO ()
foreign import ccall unsafe "hs_zoo_set_std_log_stream"
hs_zoo_set_std_log_stream :: CInt -> IO ()
foreign import ccall "wrapper"
mkCWatcherFnPtr :: CWatcherFn -> IO (FunPtr CWatcherFn)
mkWatcherFnPtr :: WatcherFn -> IO (FunPtr CWatcherFn)
mkWatcherFnPtr :: WatcherFn -> IO (FunPtr CWatcherFn)
mkWatcherFnPtr WatcherFn
fn = CWatcherFn -> IO (FunPtr CWatcherFn)
mkCWatcherFnPtr (CWatcherFn -> IO (FunPtr CWatcherFn))
-> CWatcherFn -> IO (FunPtr CWatcherFn)
forall a b. (a -> b) -> a -> b
$ \ZHandle
zh CInt
ev CInt
st CString
cpath Ptr ()
_ctx -> do
CBytes
path <- CString -> IO CBytes
CBytes.fromCString CString
cpath
WatcherFn
fn ZHandle
zh (CInt -> ZooEvent
ZooEvent CInt
ev) (CInt -> ZooState
ZooState CInt
st) CBytes
path
foreign import ccall safe "zookeeper.h zookeeper_init"
zookeeper_init
:: Ptr Word8
-> FunPtr CWatcherFn
-> CInt
-> ClientID
-> Ptr a
-> CInt
-> IO ZHandle
foreign import ccall safe "hs_zk.h zookeeper_close"
c_zookeeper_close :: ZHandle -> IO CInt
foreign import ccall unsafe "hs_zk.h zoo_client_id"
c_zoo_client_id :: ZHandle -> IO ClientID
foreign import ccall unsafe "hs_zk.h zoo_state"
c_zoo_state :: ZHandle -> IO ZooState
foreign import ccall unsafe "hs_zk.h zoo_recv_timeout"
c_zoo_recv_timeout :: ZHandle -> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aget_acl"
c_hs_zoo_aget_acl
:: ZHandle -> BA# Word8
-> StablePtr PrimMVar -> Int -> Ptr AclCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_acreate"
c_hs_zoo_acreate
:: ZHandle
-> BA# Word8
-> BA# Word8 -> Int -> Int
-> AclVector
-> CreateMode
-> StablePtr PrimMVar -> Int -> Ptr StringCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_acreate"
c_hs_zoo_acreate'
:: ZHandle
-> BA# Word8
-> Ptr CChar -> Int -> Int
-> AclVector
-> CreateMode
-> StablePtr PrimMVar -> Int -> Ptr StringCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aset"
c_hs_zoo_aset
:: ZHandle
-> BA# Word8
-> BA# Word8 -> Int -> Int
-> CInt
-> StablePtr PrimMVar -> Int -> Ptr StatCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aset"
c_hs_zoo_aset'
:: ZHandle
-> BA# Word8
-> Ptr Word8 -> Int -> Int
-> CInt
-> StablePtr PrimMVar -> Int -> Ptr StatCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aget"
c_hs_zoo_aget
:: ZHandle
-> BA# Word8
-> CInt
-> StablePtr PrimMVar -> Int -> Ptr DataCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_awget"
c_hs_zoo_awget
:: ZHandle -> BA# Word8
-> StablePtr PrimMVar -> StablePtr PrimMVar -> Int
-> Ptr HsWatcherCtx -> Ptr DataCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_adelete"
c_hs_zoo_adelete
:: ZHandle
-> BA# Word8 -> CInt
-> StablePtr PrimMVar -> Int -> Ptr VoidCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aexists"
c_hs_zoo_aexists
:: ZHandle -> BA# Word8 -> CInt
-> StablePtr PrimMVar -> Int -> Ptr StatCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_awexists"
c_hs_zoo_awexists
:: ZHandle -> BA# Word8
-> StablePtr PrimMVar -> StablePtr PrimMVar -> Int
-> Ptr HsWatcherCtx -> Ptr StatCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aget_children"
c_hs_zoo_aget_children
:: ZHandle -> BA# Word8 -> CInt
-> StablePtr PrimMVar -> Int -> Ptr StringsCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_awget_children"
c_hs_zoo_awget_children
:: ZHandle -> BA# Word8
-> StablePtr PrimMVar -> StablePtr PrimMVar -> Int
-> Ptr HsWatcherCtx -> Ptr StringsCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_aget_children2"
c_hs_zoo_aget_children2
:: ZHandle -> BA# Word8 -> CInt
-> StablePtr PrimMVar -> Int -> Ptr StringsStatCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_awget_children2"
c_hs_zoo_awget_children2
:: ZHandle -> BA# Word8
-> StablePtr PrimMVar -> StablePtr PrimMVar -> Int
-> Ptr HsWatcherCtx -> Ptr StringsStatCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_amulti"
c_hs_zoo_amulti
:: ZHandle -> CInt
-> MBA# CZooOp
-> MBA# CZooOpResult
-> StablePtr PrimMVar -> Int -> Ptr VoidCompletion
-> IO CInt
foreign import ccall unsafe "hs_zk.h hs_zoo_create_op_init"
c_hs_zoo_create_op_init
:: Ptr CZooOp
-> BA# Word8
-> BA# Word8 -> Int -> Int
-> AclVector
-> CreateMode
-> MBA# Word8 -> CInt
-> IO ()
foreign import ccall unsafe "hs_zk.h hs_zoo_create_op_init"
c_hs_zoo_create_op_init'
:: Ptr CZooOp
-> BA# Word8
-> Ptr CChar -> Int -> Int
-> AclVector
-> CreateMode
-> MBA# Word8 -> CInt
-> IO ()
foreign import ccall unsafe "hs_zk.h zoo_delete_op_init"
c_zoo_delete_op_init :: Ptr CZooOp -> BA# Word8 -> CInt -> IO ()
foreign import ccall unsafe "hs_zk.h hs_zoo_set_op_init"
c_hs_zoo_set_op_init
:: Ptr CZooOp
-> BA# Word8
-> BA# Word8 -> Int -> Int
-> CInt
-> MBA# Word8
-> IO ()
foreign import ccall unsafe "hs_zk.h hs_zoo_set_op_init"
c_hs_zoo_set_op_init'
:: Ptr CZooOp
-> BA# Word8
-> Ptr Word8 -> Int -> Int
-> CInt
-> MBA# Word8
-> IO ()
foreign import ccall safe "zookeeper.h zoo_set_watcher"
zoo_set_watcher :: ZHandle -> FunPtr CWatcherFn -> IO (FunPtr CWatcherFn)
foreign import ccall unsafe "zookeeper.h zoo_check_op_init"
c_zoo_check_op_init :: Ptr CZooOp -> BA# Word8 -> CInt -> IO ()
foreign import ccall unsafe "zookeeper.h is_unrecoverable"
c_is_unrecoverable :: ZHandle -> IO CInt
foreign import capi unsafe "stdio.h fopen"
c_fopen :: BA# Word8 -> BA# Word8 -> IO (Ptr CFile)
foreign import capi unsafe "stdio.h fclose"
c_fclose :: Ptr CFile -> IO CInt
foreign import capi unsafe "stdio.h fflush"
c_fflush :: Ptr CFile -> IO CInt
withZKAsync :: HasCallStack
=> Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
withZKAsync :: forall a.
HasCallStack =>
Int
-> (Ptr a -> IO CInt)
-> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
withZKAsync = TouchListBytes
-> Int
-> (Ptr a -> IO CInt)
-> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
forall a.
HasCallStack =>
TouchListBytes
-> Int
-> (Ptr a -> IO CInt)
-> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
withZKAsync' []
{-# INLINE withZKAsync #-}
withZKAsync' :: HasCallStack
=> TouchListBytes
-> Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
withZKAsync' :: forall a.
HasCallStack =>
TouchListBytes
-> Int
-> (Ptr a -> IO CInt)
-> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
withZKAsync' TouchListBytes
bas Int
size Ptr a -> IO CInt
peek_result Ptr a -> IO a
peek_data StablePtr PrimMVar -> Int -> Ptr a -> IO CInt
f = IO (Either CInt a) -> IO (Either CInt a)
forall a. IO a -> IO a
mask_ (IO (Either CInt a) -> IO (Either CInt a))
-> IO (Either CInt a) -> IO (Either CInt a)
forall a b. (a -> b) -> a -> b
$ do
MVar Any
mvar <- IO (MVar Any)
forall a. IO (MVar a)
newEmptyMVar
StablePtr PrimMVar
sp <- MVar Any -> IO (StablePtr PrimMVar)
forall a. MVar a -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar MVar Any
mvar
ForeignPtr a
fp <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
size
ForeignPtr a -> (Ptr a -> IO (Either CInt a)) -> IO (Either CInt a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO (Either CInt a)) -> IO (Either CInt a))
-> (Ptr a -> IO (Either CInt a)) -> IO (Either CInt a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
data' -> do
(Int
cap, Bool
_) <- ThreadId -> IO (Int, Bool)
threadCapability (ThreadId -> IO (Int, Bool)) -> IO ThreadId -> IO (Int, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ThreadId
myThreadId
IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => CInt -> IO CInt
CInt -> IO CInt
throwZooErrorIfNotOK (CInt -> IO CInt) -> IO CInt -> IO CInt
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StablePtr PrimMVar -> Int -> Ptr a -> IO CInt
f StablePtr PrimMVar
sp Int
cap Ptr a
data'
MVar Any -> IO Any
forall a. MVar a -> IO a
takeMVar MVar Any
mvar IO Any -> IO ThreadId -> IO Any
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ThreadId
forkIO (do MVar Any -> IO Any
forall a. MVar a -> IO a
takeMVar MVar Any
mvar; ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp; TouchListBytes -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch TouchListBytes
bas)
CInt
rc <- Ptr a -> IO CInt
peek_result Ptr a
data'
case CInt
rc of
CInt
CZOK -> a -> Either CInt a
forall a b. b -> Either a b
Right (a -> Either CInt a) -> IO a -> IO (Either CInt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
peek_data Ptr a
data'
CInt
_ -> Either CInt a -> IO (Either CInt a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CInt a -> IO (Either CInt a))
-> Either CInt a -> IO (Either CInt a)
forall a b. (a -> b) -> a -> b
$ CInt -> Either CInt a
forall a b. a -> Either a b
Left CInt
rc
{-# INLINE withZKAsync' #-}
withZKAsync2
:: HasCallStack
=> Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)
-> (Either CInt a -> IO ())
-> Int -> (Ptr b -> IO CInt) -> (Ptr b -> IO b)
-> (Either CInt b -> IO ())
-> (StablePtr PrimMVar -> StablePtr PrimMVar -> Int -> Ptr a -> Ptr b -> IO CInt)
-> IO ()
withZKAsync2 :: forall a b.
HasCallStack =>
Int
-> (Ptr a -> IO CInt)
-> (Ptr a -> IO a)
-> (Either CInt a -> IO ())
-> Int
-> (Ptr b -> IO CInt)
-> (Ptr b -> IO b)
-> (Either CInt b -> IO ())
-> (StablePtr PrimMVar
-> StablePtr PrimMVar -> Int -> Ptr a -> Ptr b -> IO CInt)
-> IO ()
withZKAsync2 Int
size1 Ptr a -> IO CInt
peekRet1 Ptr a -> IO a
peekData1 Either CInt a -> IO ()
f1 Int
size2 Ptr b -> IO CInt
peekRet2 Ptr b -> IO b
peekData2 Either CInt b -> IO ()
f2 StablePtr PrimMVar
-> StablePtr PrimMVar -> Int -> Ptr a -> Ptr b -> IO CInt
g = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
MVar Any
mvar1 <- IO (MVar Any)
forall a. IO (MVar a)
newEmptyMVar
StablePtr PrimMVar
sp1 <- MVar Any -> IO (StablePtr PrimMVar)
forall a. MVar a -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar MVar Any
mvar1
ForeignPtr a
fp1 <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
size1
MVar Any
mvar2 <- IO (MVar Any)
forall a. IO (MVar a)
newEmptyMVar
StablePtr PrimMVar
sp2 <- MVar Any -> IO (StablePtr PrimMVar)
forall a. MVar a -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar MVar Any
mvar2
ForeignPtr b
fp2 <- Int -> IO (ForeignPtr b)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
size2
ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp1 ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
data1' ->
ForeignPtr b -> (Ptr b -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
fp2 ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr b
data2' -> do
(Int
cap, Bool
_) <- ThreadId -> IO (Int, Bool)
threadCapability (ThreadId -> IO (Int, Bool)) -> IO ThreadId -> IO (Int, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ThreadId
myThreadId
IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => CInt -> IO CInt
CInt -> IO CInt
throwZooErrorIfNotOK (CInt -> IO CInt) -> IO CInt -> IO CInt
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StablePtr PrimMVar
-> StablePtr PrimMVar -> Int -> Ptr a -> Ptr b -> IO CInt
g StablePtr PrimMVar
sp1 StablePtr PrimMVar
sp2 Int
cap Ptr a
data1' Ptr b
data2'
MVar Any -> IO Any
forall a. MVar a -> IO a
takeMVar MVar Any
mvar2 IO Any -> IO ThreadId -> IO Any
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ThreadId
forkIO (do MVar Any -> IO Any
forall a. MVar a -> IO a
takeMVar MVar Any
mvar2; ForeignPtr b -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr b
fp2; ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp1)
CInt
rc2 <- Ptr b -> IO CInt
peekRet2 Ptr b
data2'
case CInt
rc2 of
CInt
CZOK -> Either CInt b -> IO ()
f2 (Either CInt b -> IO ()) -> IO (Either CInt b) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> Either CInt b
forall a b. b -> Either a b
Right (b -> Either CInt b) -> IO b -> IO (Either CInt b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr b -> IO b
peekData2 Ptr b
data2'
CInt
_ -> Either CInt b -> IO ()
f2 (Either CInt b -> IO ()) -> Either CInt b -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> Either CInt b
forall a b. a -> Either a b
Left CInt
rc2
MVar Any -> IO Any
forall a. MVar a -> IO a
takeMVar MVar Any
mvar1 IO Any -> IO ThreadId -> IO Any
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ThreadId
forkIO (do MVar Any -> IO Any
forall a. MVar a -> IO a
takeMVar MVar Any
mvar1; ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp1)
CInt
rc1 <- Ptr a -> IO CInt
peekRet1 Ptr a
data1'
case CInt
rc1 of
CInt
CZOK -> Either CInt a -> IO ()
f1 (Either CInt a -> IO ()) -> IO (Either CInt a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Either CInt a
forall a b. b -> Either a b
Right (a -> Either CInt a) -> IO a -> IO (Either CInt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
peekData1 Ptr a
data1'
CInt
_ -> Either CInt a -> IO ()
f1 (Either CInt a -> IO ()) -> Either CInt a -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> Either CInt a
forall a b. a -> Either a b
Left CInt
rc1
{-# INLINABLE withZKAsync2 #-}