{-# 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,
parseVersion)
import Data.Word
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.StablePtr
import GHC.Conc
import GHC.Stack (HasCallStack)
import Text.ParserCombinators.ReadP (readP_to_S)
import qualified Z.Data.CBytes as CBytes
import Z.Foreign
import ZooKeeper.Exception
import ZooKeeper.Internal.Types
zooVersion :: Version
{-# LINE 32 "src/ZooKeeper/Internal/FFI.hsc" #-}
zooVersion = makeVersion [ (3)
{-# LINE 33 "src/ZooKeeper/Internal/FFI.hsc" #-}
, (4)
{-# LINE 34 "src/ZooKeeper/Internal/FFI.hsc" #-}
, (12)
{-# LINE 35 "src/ZooKeeper/Internal/FFI.hsc" #-}
]
{-# LINE 41 "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 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
withZKAsync :: HasCallStack
=> Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)
-> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)
-> IO (Either CInt a)
withZKAsync :: 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' :: 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 ()
mvar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
StablePtr PrimMVar
sp <- MVar () -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar MVar ()
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 () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mvar IO () -> IO ThreadId -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ThreadId
forkIO (do MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
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 (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 :: 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 ()
mvar1 <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
StablePtr PrimMVar
sp1 <- MVar () -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar MVar ()
mvar1
ForeignPtr a
fp1 <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
size1
MVar ()
mvar2 <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
StablePtr PrimMVar
sp2 <- MVar () -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar MVar ()
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 () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mvar2 IO () -> IO ThreadId -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ThreadId
forkIO (do MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
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 () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mvar1 IO () -> IO ThreadId -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ThreadId
forkIO (do MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
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 #-}