{-# 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)
import           Data.Word
import           Foreign.C
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           Foreign.StablePtr
import           GHC.Conc
import           GHC.Stack                (HasCallStack)
import           Z.Foreign

import           ZooKeeper.Exception
import           ZooKeeper.Internal.Types



-------------------------------------------------------------------------------

zooVersion :: Version

{-# LINE 28 "src/ZooKeeper/Internal/FFI.hsc" #-}
zooVersion = makeVersion [ (3)
{-# LINE 29 "src/ZooKeeper/Internal/FFI.hsc" #-}
                         , (4)
{-# LINE 30 "src/ZooKeeper/Internal/FFI.hsc" #-}
                         , (10)
{-# LINE 31 "src/ZooKeeper/Internal/FFI.hsc" #-}
                         ]

{-# LINE 35 "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 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 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 unsafe "hs_zk.h zoo_check_op_init"
  c_zoo_check_op_init :: Ptr CZooOp -> BA# Word8 -> CInt -> IO ()

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

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