module Database.Zookeeper.CApi
(
toStat
, toState
, toZKError
, allocaStat
, withAclList
, wrapWatcher
, fromLogLevel
, fromCreateFlag
, fromCreateFlags
, wrapAclCompletion
, wrapDataCompletion
, wrapVoidCompletion
, wrapStringCompletion
, wrapStringsCompletion
, tryZ
, isZOK
, onZOK
, whenZOK
, c_zooSet2
, c_zooAWGet
, c_zooState
, c_zooDelete
, c_zooSetAcl
, c_zooAGetAcl
, c_zooACreate
, c_zooAddAuth
, c_zooWExists
, c_zooClientId
, c_zookeeperInit
, c_zookeeperClose
, c_zooSetWatcher
, c_zooRecvTimeout
, c_isUnrecoverable
, c_zooAWGetChildren
, c_zooSetDebugLevel
) where
import Foreign
import Foreign.C
import qualified Data.ByteString as B
import Control.Applicative
import Database.Zookeeper.Types
tryZ :: IO CInt -> IO a -> IO (Either ZKError a)
tryZ zkIO nextIO = do
rc <- zkIO
rc `onZOK` nextIO
isZOK :: CInt -> Bool
isZOK rc = rc == (0)
onZOK :: CInt -> IO a -> IO (Either ZKError a)
onZOK rc nextIO
| isZOK rc = fmap Right nextIO
| otherwise = return (Left $ toZKError rc)
whenZOK :: CInt -> IO (Either ZKError a) -> IO (Either ZKError a)
whenZOK rc succIO
| isZOK rc = succIO
| otherwise = return (Left $ toZKError rc)
toStat :: Ptr CStat -> IO Stat
toStat ptr = Stat <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 60)) ptr
<*> liftA toEphemeralOwner (((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr)
where
toEphemeralOwner 0 = Nothing
toEphemeralOwner c = Just c
fromCreateFlag :: CreateFlag -> CInt
fromCreateFlag Sequence = (2)
fromCreateFlag Ephemeral = (1)
fromCreateFlags :: [CreateFlag] -> CInt
fromCreateFlags = foldr (.|.) 0 . map fromCreateFlag
fromPerm :: Perm -> CInt
fromPerm CanRead = (1)
fromPerm CanAdmin = (16)
fromPerm CanWrite = (2)
fromPerm CanCreate = (4)
fromPerm CanDelete = (8)
fromLogLevel :: ZLogLevel -> CInt
fromLogLevel ZLogError = (1)
fromLogLevel ZLogWarn = (2)
fromLogLevel ZLogInfo = (3)
fromLogLevel ZLogDebug = (4)
fromPerms :: [Perm] -> CInt
fromPerms = foldr (.|.) 0 . map fromPerm
toPerms :: CInt -> [Perm]
toPerms n = buildList [ ((1), CanRead)
, ((16), CanAdmin)
, ((2), CanWrite)
, ((4), CanCreate)
, ((8), CanDelete)
]
where
buildList [] = []
buildList ((t, a):xs)
| n .&. t == t = a : buildList xs
| otherwise = buildList xs
toStringList :: Ptr CStrVec -> IO [String]
toStringList strvPtr = do
count <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) strvPtr
dataPtr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) strvPtr
buildList [] count dataPtr
where
buildList :: [String] -> Int32 -> Ptr CString -> IO [String]
buildList acc 0 _ = return $ reverse acc
buildList acc n ptr = do
item <- peek ptr >>= peekCString
buildList (item : acc) (n1) (ptr `plusPtr` (sizeOf ptr))
allocaStat :: (Ptr CStat -> IO a) -> IO a
allocaStat fun = allocaBytes ((72)) fun
toAclList :: Ptr CAclVec -> IO AclList
toAclList aclvPtr = do
count <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) aclvPtr
aclPtr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) aclvPtr
fmap List (buildList [] count aclPtr)
where
buildList :: [Acl] -> Int32 -> Ptr CAcl -> IO [Acl]
buildList acc 0 _ = return acc
buildList acc n ptr = do
acl <- Acl <$> (((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= peekCString)
<*> (((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr >>= peekCString)
<*> (fmap toPerms (((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr))
buildList (acl : acc) (n1) (ptr `plusPtr` ((24)))
withAclList :: AclList -> (Ptr CAclVec -> IO a) -> IO a
withAclList CreatorAll cont = cont c_zooCreatorAclAll
withAclList OpenAclUnsafe cont = cont c_zooOpenAclUnsafe
withAclList ReadAclUnsafe cont = cont c_zooReadAclUnsafe
withAclList (List acls) cont =
allocaBytes ((16)) $ \aclvPtr -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) aclvPtr count
allocaBytes (count * ((24))) $ \aclPtr -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) aclvPtr aclPtr
pokeAcls acls aclvPtr aclPtr
where
count = length acls
pokeAcls [] aclvPtr _ = cont aclvPtr
pokeAcls (acl:rest) aclvPtr aclPtr = do
withCString (aclScheme acl) $ \schemePtr -> do
withCString (aclId acl) $ \idPtr -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) aclPtr idPtr
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) aclPtr (fromPerms (aclFlags acl))
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) aclPtr schemePtr
pokeAcls rest aclvPtr (aclPtr `plusPtr` ((24)))
toZKError :: CInt -> ZKError
toZKError (101) = NoNodeError
toZKError (102) = NoAuthError
toZKError (116) = ClosingError
toZKError (117) = NothingError
toZKError (100) = ApiError
toZKError (111) = NotEmptyError
toZKError (103) = BadVersionError
toZKError (114) = InvalidACLError
toZKError (115) = AuthFailedError
toZKError (110) = NodeExistsError
toZKError (1) = SystemError
toZKError (8) = BadArgumentsError
toZKError (9) = InvalidStateError
toZKError (118) = SessionMovedError
toZKError (6) = UnimplmenetedError
toZKError (4) = ConnectionLossError
toZKError (112) = SessionExpiredError
toZKError (113) = InvalidCallbackError
toZKError (5) = MarshallingError
toZKError (7) = OperationTimeoutError
toZKError (3) = DataInconsistencyError
toZKError (2) = RuntimeInconsistencyError
toZKError (108) = NoChildrenForEphemeralsError
toZKError code = (UnknownError $ fromIntegral code)
toState :: CInt -> State
toState (3) = ConnectedState
toState (1) = ConnectingState
toState (2) = AssociatingState
toState (113) = AuthFailedState
toState (112) = ExpiredSessionState
toState code = UnknownState $ fromIntegral code
toEvent :: CInt -> Event
toEvent (4) = ChildEvent
toEvent (1) = CreatedEvent
toEvent (2) = DeletedEvent
toEvent (3) = ChangedEvent
toEvent (1) = SessionEvent
toEvent (2) = NotWatchingEvent
toEvent code = UnknownEvent $ fromIntegral code
wrapWatcher :: Maybe Watcher -> IO (FunPtr CWatcherFn)
wrapWatcher Nothing = return nullFunPtr
wrapWatcher (Just fn) = c_watcherFn $ \zh cevent cstate cpath _ -> do
let event = toEvent cevent
state = toState cstate
path <- if (cpath == nullPtr)
then return Nothing
else fmap Just (peekCString cpath)
fn (Zookeeper zh) event state path
wrapAclCompletion :: AclCompletion -> IO (FunPtr CAclCompletionFn)
wrapAclCompletion fn =
c_aclCompletionFn $ \rc aclPtr statPtr _ ->
fn =<< (onZOK rc $ do
aclList <- toAclList aclPtr
stat <- toStat statPtr
return (aclList, stat))
wrapDataCompletion :: DataCompletion -> IO (FunPtr CDataCompletionFn)
wrapDataCompletion fn =
c_dataCompletionFn $ \rc valPtr valLen statPtr _ ->
fn =<< (onZOK rc $ do
stat <- toStat statPtr
if (valLen == 1)
then return (Nothing, stat)
else fmap (\s -> (Just s, stat)) (B.packCStringLen (valPtr, fromIntegral valLen)))
wrapStringCompletion :: StringCompletion -> IO (FunPtr CStringCompletionFn)
wrapStringCompletion fn =
c_stringCompletionFn $ \rc strPtr _ ->
fn =<< (onZOK rc $ do
peekCString strPtr)
wrapStringsCompletion :: StringsCompletion -> IO (FunPtr CStringsCompletionFn)
wrapStringsCompletion fn =
c_stringsCompletionFn $ \rc strvPtr _ ->
fn =<< (onZOK rc (toStringList strvPtr))
wrapVoidCompletion :: VoidCompletion -> IO (FunPtr CVoidCompletionFn)
wrapVoidCompletion fn =
c_voidCompletionFn $ \rc _ -> (fn =<< onZOK rc (return ()))
foreign import ccall safe "wrapper"
c_watcherFn :: CWatcherFn
-> IO (FunPtr CWatcherFn)
foreign import ccall safe "wrapper"
c_dataCompletionFn :: CDataCompletionFn
-> IO (FunPtr CDataCompletionFn)
foreign import ccall safe "wrapper"
c_stringsCompletionFn :: CStringsCompletionFn
-> IO (FunPtr CStringsCompletionFn)
foreign import ccall safe "wrapper"
c_stringCompletionFn :: CStringCompletionFn
-> IO (FunPtr CStringCompletionFn)
foreign import ccall safe "wrapper"
c_aclCompletionFn :: CAclCompletionFn
-> IO (FunPtr CAclCompletionFn)
foreign import ccall safe "wrapper"
c_voidCompletionFn :: CVoidCompletionFn
-> IO (FunPtr CVoidCompletionFn)
foreign import ccall safe "zookeeper.h zookeeper_init"
c_zookeeperInit :: CString
-> FunPtr CWatcherFn
-> CInt
-> Ptr CClientID
-> Ptr ()
-> CInt
-> IO (Ptr CZHandle)
foreign import ccall safe "zookeeper.h zookeeper_close"
c_zookeeperClose :: Ptr CZHandle -> IO ()
foreign import ccall safe "zookeeper.h zoo_set_watcher"
c_zooSetWatcher :: Ptr CZHandle -> FunPtr CWatcherFn -> IO ()
foreign import ccall safe "zookeeper.h zoo_acreate"
c_zooACreate :: Ptr CZHandle -> CString -> CString -> CInt -> Ptr CAclVec -> CInt -> FunPtr CStringCompletionFn -> Ptr () -> IO CInt
foreign import ccall safe "zookeeper.h zoo_delete"
c_zooDelete :: Ptr CZHandle -> CString -> CInt -> IO CInt
foreign import ccall safe "zookeeper.h zoo_wexists"
c_zooWExists :: Ptr CZHandle -> CString -> FunPtr CWatcherFn -> Ptr () -> Ptr CStat -> IO CInt
foreign import ccall safe "zookeeper.h zoo_state"
c_zooState :: Ptr CZHandle -> IO CInt
foreign import ccall safe "zookeeper.h zoo_client_id"
c_zooClientId :: Ptr CZHandle -> IO (Ptr CClientID)
foreign import ccall safe "zookeeper.h zoo_recv_timeout"
c_zooRecvTimeout :: Ptr CZHandle -> IO CInt
foreign import ccall safe "zookeeper.h zoo_add_auth"
c_zooAddAuth :: Ptr CZHandle -> CString -> CString -> CInt -> FunPtr CVoidCompletionFn -> Ptr () -> IO CInt
foreign import ccall safe "zookeeper.h is_unrecoverable"
c_isUnrecoverable :: Ptr CZHandle -> IO CInt
foreign import ccall safe "zookeeper.h zoo_set_debug_level"
c_zooSetDebugLevel :: CInt -> IO ()
foreign import ccall safe "zookeeper.h zoo_aget_acl"
c_zooAGetAcl :: Ptr CZHandle -> CString -> FunPtr CAclCompletionFn -> Ptr () -> IO CInt
foreign import ccall safe "zookeeper.h zoo_set_acl"
c_zooSetAcl :: Ptr CZHandle -> CString -> CInt -> Ptr CAclVec -> IO CInt
foreign import ccall safe "zookeeper.h zoo_awget"
c_zooAWGet :: Ptr CZHandle -> CString -> FunPtr CWatcherFn -> Ptr () -> FunPtr CDataCompletionFn -> Ptr () -> IO CInt
foreign import ccall safe "zookeeper.h zoo_set2"
c_zooSet2 :: Ptr CZHandle -> CString -> CString -> CInt -> CInt -> Ptr CStat -> IO CInt
foreign import ccall safe "zookeeper.h zoo_awget_children"
c_zooAWGetChildren :: Ptr CZHandle -> CString -> FunPtr CWatcherFn -> Ptr () -> FunPtr CStringsCompletionFn -> Ptr () -> IO CInt
foreign import ccall safe "zookeeper.h &ZOO_CREATOR_ALL_ACL"
c_zooCreatorAclAll :: Ptr CAclVec
foreign import ccall safe "zookeeper.h &ZOO_OPEN_ACL_UNSAFE"
c_zooOpenAclUnsafe :: Ptr CAclVec
foreign import ccall safe "zookeeper.h &ZOO_READ_ACL_UNSAFE"
c_zooReadAclUnsafe :: Ptr CAclVec