{-# LINE 1 "src/ZooKeeper/Internal/FFI.hsc" #-}
{-# 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 Z.Foreign
import ZooKeeper.Exception
import ZooKeeper.Internal.Types
zooVersion :: Version
{-# LINE 30 "src/ZooKeeper/Internal/FFI.hsc" #-}
zooVersion = makeVersion [ (3)
{-# LINE 31 "src/ZooKeeper/Internal/FFI.hsc" #-}
, (4)
{-# LINE 32 "src/ZooKeeper/Internal/FFI.hsc" #-}
, (12)
{-# LINE 33 "src/ZooKeeper/Internal/FFI.hsc" #-}
]
{-# LINE 39 "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 unsafe "hs_zk.h hs_zookeeper_init"
c_hs_zookeeper_init
:: StablePtr PrimMVar -> Int -> Ptr HsWatcherCtx
-> BA# Word8
-> CInt
-> ClientID
-> CInt
-> IO ZHandle
foreign import ccall safe "hs_zk.h zookeeper_close"
c_zookeeper_close_safe :: 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 unsafe "hs_zk.h zoo_check_op_init"
c_zoo_check_op_init :: Ptr CZooOp -> BA# Word8 -> CInt -> IO ()
foreign import ccall unsafe "hs_zk.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
{-# INLINE withZKAsync2 #-}