{-# 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" #-}
-- For zookeeper-3.4
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

-- | Sets the debugging level for the zookeeper library
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           -- Ptr CZooOp
    -> MBA# CZooOpResult     -- Ptr 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           -- ^ path
    -> BA# Word8 -> Int -> Int
    -> AclVector
    -> CreateMode
    -> MBA# Word8 -> CInt   -- ^ (path_buffer, path_buffer_len)
    -> 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     -- pointer to Stat
    -> 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     -- pointer to Stat
    -> 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

-------------------------------------------------------------------------------
-- Helpers

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 #-}