{-# LINE 1 "src/ZooKeeper/Internal/Types.hsc" #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP                 #-}

module ZooKeeper.Internal.Types where

import           Control.Exception (bracket_)
import           Control.Monad     (forM)
import           Data.Int
import           Foreign
import           Foreign.C
import           Numeric           (showHex)
import           Z.Data.CBytes     (CBytes)
import qualified Z.Data.CBytes     as CBytes
import qualified Z.Data.Text       as Text
import           Z.Data.Vector     (Bytes)
import qualified Z.Foreign         as Z



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

newtype ZHandle = ZHandle { ZHandle -> Ptr ()
unZHandle :: Ptr () }
  deriving (Int -> ZHandle -> ShowS
[ZHandle] -> ShowS
ZHandle -> String
(Int -> ZHandle -> ShowS)
-> (ZHandle -> String) -> ([ZHandle] -> ShowS) -> Show ZHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZHandle] -> ShowS
$cshowList :: [ZHandle] -> ShowS
show :: ZHandle -> String
$cshow :: ZHandle -> String
showsPrec :: Int -> ZHandle -> ShowS
$cshowsPrec :: Int -> ZHandle -> ShowS
Show, ZHandle -> ZHandle -> Bool
(ZHandle -> ZHandle -> Bool)
-> (ZHandle -> ZHandle -> Bool) -> Eq ZHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZHandle -> ZHandle -> Bool
$c/= :: ZHandle -> ZHandle -> Bool
== :: ZHandle -> ZHandle -> Bool
$c== :: ZHandle -> ZHandle -> Bool
Eq)

newtype ClientID = ClientID { ClientID -> Ptr ()
unClientID :: Ptr () }
  deriving (Int -> ClientID -> ShowS
[ClientID] -> ShowS
ClientID -> String
(Int -> ClientID -> ShowS)
-> (ClientID -> String) -> ([ClientID] -> ShowS) -> Show ClientID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientID] -> ShowS
$cshowList :: [ClientID] -> ShowS
show :: ClientID -> String
$cshow :: ClientID -> String
showsPrec :: Int -> ClientID -> ShowS
$cshowsPrec :: Int -> ClientID -> ShowS
Show, ClientID -> ClientID -> Bool
(ClientID -> ClientID -> Bool)
-> (ClientID -> ClientID -> Bool) -> Eq ClientID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientID -> ClientID -> Bool
$c/= :: ClientID -> ClientID -> Bool
== :: ClientID -> ClientID -> Bool
$c== :: ClientID -> ClientID -> Bool
Eq)

newtype ZooLogLevel = ZooLogLevel CInt
  deriving (ZooLogLevel -> ZooLogLevel -> Bool
(ZooLogLevel -> ZooLogLevel -> Bool)
-> (ZooLogLevel -> ZooLogLevel -> Bool) -> Eq ZooLogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZooLogLevel -> ZooLogLevel -> Bool
$c/= :: ZooLogLevel -> ZooLogLevel -> Bool
== :: ZooLogLevel -> ZooLogLevel -> Bool
$c== :: ZooLogLevel -> ZooLogLevel -> Bool
Eq, Ptr b -> Int -> IO ZooLogLevel
Ptr b -> Int -> ZooLogLevel -> IO ()
Ptr ZooLogLevel -> IO ZooLogLevel
Ptr ZooLogLevel -> Int -> IO ZooLogLevel
Ptr ZooLogLevel -> Int -> ZooLogLevel -> IO ()
Ptr ZooLogLevel -> ZooLogLevel -> IO ()
ZooLogLevel -> Int
(ZooLogLevel -> Int)
-> (ZooLogLevel -> Int)
-> (Ptr ZooLogLevel -> Int -> IO ZooLogLevel)
-> (Ptr ZooLogLevel -> Int -> ZooLogLevel -> IO ())
-> (forall b. Ptr b -> Int -> IO ZooLogLevel)
-> (forall b. Ptr b -> Int -> ZooLogLevel -> IO ())
-> (Ptr ZooLogLevel -> IO ZooLogLevel)
-> (Ptr ZooLogLevel -> ZooLogLevel -> IO ())
-> Storable ZooLogLevel
forall b. Ptr b -> Int -> IO ZooLogLevel
forall b. Ptr b -> Int -> ZooLogLevel -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ZooLogLevel -> ZooLogLevel -> IO ()
$cpoke :: Ptr ZooLogLevel -> ZooLogLevel -> IO ()
peek :: Ptr ZooLogLevel -> IO ZooLogLevel
$cpeek :: Ptr ZooLogLevel -> IO ZooLogLevel
pokeByteOff :: Ptr b -> Int -> ZooLogLevel -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooLogLevel -> IO ()
peekByteOff :: Ptr b -> Int -> IO ZooLogLevel
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooLogLevel
pokeElemOff :: Ptr ZooLogLevel -> Int -> ZooLogLevel -> IO ()
$cpokeElemOff :: Ptr ZooLogLevel -> Int -> ZooLogLevel -> IO ()
peekElemOff :: Ptr ZooLogLevel -> Int -> IO ZooLogLevel
$cpeekElemOff :: Ptr ZooLogLevel -> Int -> IO ZooLogLevel
alignment :: ZooLogLevel -> Int
$calignment :: ZooLogLevel -> Int
sizeOf :: ZooLogLevel -> Int
$csizeOf :: ZooLogLevel -> Int
Storable)

instance Show ZooLogLevel where
  show :: ZooLogLevel -> String
show ZooLogLevel
ZooLogError = String
"ERROR"
  show ZooLogLevel
ZooLogWarn  = String
"WARN"
  show ZooLogLevel
ZooLogInfo  = String
"INFO"
  show ZooLogLevel
ZooLogDebug = String
"DEBUG"
  show (ZooLogLevel CInt
x) = String
"ZooLogLevel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x

pattern ZooLogError, ZooLogWarn, ZooLogInfo, ZooLogDebug :: ZooLogLevel
pattern $bZooLogError :: ZooLogLevel
$mZooLogError :: forall r. ZooLogLevel -> (Void# -> r) -> (Void# -> r) -> r
ZooLogError = ZooLogLevel (1)
{-# LINE 40 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooLogWarn  = ZooLogLevel (2)
{-# LINE 41 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooLogInfo  = ZooLogLevel (3)
{-# LINE 42 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooLogDebug = ZooLogLevel (4)
{-# LINE 43 "src/ZooKeeper/Internal/Types.hsc" #-}

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

-- | ACL permissions.
newtype ZooPerm = ZooPerm { ZooPerm -> CInt
unZooPerm :: CInt }
  deriving (ZooPerm -> ZooPerm -> Bool
(ZooPerm -> ZooPerm -> Bool)
-> (ZooPerm -> ZooPerm -> Bool) -> Eq ZooPerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZooPerm -> ZooPerm -> Bool
$c/= :: ZooPerm -> ZooPerm -> Bool
== :: ZooPerm -> ZooPerm -> Bool
$c== :: ZooPerm -> ZooPerm -> Bool
Eq, Eq ZooPerm
ZooPerm
Eq ZooPerm
-> (ZooPerm -> ZooPerm -> ZooPerm)
-> (ZooPerm -> ZooPerm -> ZooPerm)
-> (ZooPerm -> ZooPerm -> ZooPerm)
-> (ZooPerm -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> ZooPerm
-> (Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> Bool)
-> (ZooPerm -> Maybe Int)
-> (ZooPerm -> Int)
-> (ZooPerm -> Bool)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int -> ZooPerm)
-> (ZooPerm -> Int)
-> Bits ZooPerm
Int -> ZooPerm
ZooPerm -> Bool
ZooPerm -> Int
ZooPerm -> Maybe Int
ZooPerm -> ZooPerm
ZooPerm -> Int -> Bool
ZooPerm -> Int -> ZooPerm
ZooPerm -> ZooPerm -> ZooPerm
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: ZooPerm -> Int
$cpopCount :: ZooPerm -> Int
rotateR :: ZooPerm -> Int -> ZooPerm
$crotateR :: ZooPerm -> Int -> ZooPerm
rotateL :: ZooPerm -> Int -> ZooPerm
$crotateL :: ZooPerm -> Int -> ZooPerm
unsafeShiftR :: ZooPerm -> Int -> ZooPerm
$cunsafeShiftR :: ZooPerm -> Int -> ZooPerm
shiftR :: ZooPerm -> Int -> ZooPerm
$cshiftR :: ZooPerm -> Int -> ZooPerm
unsafeShiftL :: ZooPerm -> Int -> ZooPerm
$cunsafeShiftL :: ZooPerm -> Int -> ZooPerm
shiftL :: ZooPerm -> Int -> ZooPerm
$cshiftL :: ZooPerm -> Int -> ZooPerm
isSigned :: ZooPerm -> Bool
$cisSigned :: ZooPerm -> Bool
bitSize :: ZooPerm -> Int
$cbitSize :: ZooPerm -> Int
bitSizeMaybe :: ZooPerm -> Maybe Int
$cbitSizeMaybe :: ZooPerm -> Maybe Int
testBit :: ZooPerm -> Int -> Bool
$ctestBit :: ZooPerm -> Int -> Bool
complementBit :: ZooPerm -> Int -> ZooPerm
$ccomplementBit :: ZooPerm -> Int -> ZooPerm
clearBit :: ZooPerm -> Int -> ZooPerm
$cclearBit :: ZooPerm -> Int -> ZooPerm
setBit :: ZooPerm -> Int -> ZooPerm
$csetBit :: ZooPerm -> Int -> ZooPerm
bit :: Int -> ZooPerm
$cbit :: Int -> ZooPerm
zeroBits :: ZooPerm
$czeroBits :: ZooPerm
rotate :: ZooPerm -> Int -> ZooPerm
$crotate :: ZooPerm -> Int -> ZooPerm
shift :: ZooPerm -> Int -> ZooPerm
$cshift :: ZooPerm -> Int -> ZooPerm
complement :: ZooPerm -> ZooPerm
$ccomplement :: ZooPerm -> ZooPerm
xor :: ZooPerm -> ZooPerm -> ZooPerm
$cxor :: ZooPerm -> ZooPerm -> ZooPerm
.|. :: ZooPerm -> ZooPerm -> ZooPerm
$c.|. :: ZooPerm -> ZooPerm -> ZooPerm
.&. :: ZooPerm -> ZooPerm -> ZooPerm
$c.&. :: ZooPerm -> ZooPerm -> ZooPerm
$cp1Bits :: Eq ZooPerm
Bits)

instance Show ZooPerm where
  show :: ZooPerm -> String
show ZooPerm
ZooPermRead   = String
"ZooPermRead"
  show ZooPerm
ZooPermWrite  = String
"ZooPermWrite"
  show ZooPerm
ZooPermCreate = String
"ZooPermCreate"
  show ZooPerm
ZooPermDelete = String
"ZooPermDelete"
  show ZooPerm
ZooPermAdmin  = String
"ZooPermAdmin"
  show ZooPerm
ZooPermAll    = String
"ZooPermAll"
  show (ZooPerm CInt
x)   = String
"ZooPerm: 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex CInt
x String
""

pattern ZooPermRead, ZooPermWrite, ZooPermCreate, ZooPermDelete, ZooPermAdmin :: ZooPerm
pattern $bZooPermRead :: ZooPerm
$mZooPermRead :: forall r. ZooPerm -> (Void# -> r) -> (Void# -> r) -> r
ZooPermRead   = ZooPerm (1)
{-# LINE 61 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermWrite  = ZooPerm (2)
{-# LINE 62 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermCreate = ZooPerm (4)
{-# LINE 63 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermDelete = ZooPerm (8)
{-# LINE 64 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermAdmin  = ZooPerm (16)
{-# LINE 65 "src/ZooKeeper/Internal/Types.hsc" #-}

pattern ZooPermAll :: ZooPerm
pattern $bZooPermAll :: ZooPerm
$mZooPermAll :: forall r. ZooPerm -> (Void# -> r) -> (Void# -> r) -> r
ZooPermAll = ZooPerm (31)
{-# LINE 68 "src/ZooKeeper/Internal/Types.hsc" #-}

{-# INLINE toZooPerms #-}
toZooPerms :: CInt -> [ZooPerm]
toZooPerms :: CInt -> [ZooPerm]
toZooPerms CInt
n = [ZooPerm] -> [ZooPerm]
go [ZooPerm]
allPerms
  where
    go :: [ZooPerm] -> [ZooPerm]
go [] = []
    go (ZooPerm
x:[ZooPerm]
xs)
      | CInt -> ZooPerm
ZooPerm CInt
n ZooPerm -> ZooPerm -> ZooPerm
forall a. Bits a => a -> a -> a
.&. ZooPerm
x ZooPerm -> ZooPerm -> Bool
forall a. Eq a => a -> a -> Bool
== ZooPerm
x = ZooPerm
x ZooPerm -> [ZooPerm] -> [ZooPerm]
forall a. a -> [a] -> [a]
: ([ZooPerm] -> [ZooPerm]
go ([ZooPerm] -> [ZooPerm]) -> [ZooPerm] -> [ZooPerm]
forall a b. (a -> b) -> a -> b
$! [ZooPerm]
xs)
      | Bool
otherwise            = [ZooPerm] -> [ZooPerm]
go ([ZooPerm] -> [ZooPerm]) -> [ZooPerm] -> [ZooPerm]
forall a b. (a -> b) -> a -> b
$! [ZooPerm]
xs
    allPerms :: [ZooPerm]
allPerms = [ZooPerm
ZooPermRead, ZooPerm
ZooPermWrite, ZooPerm
ZooPermCreate, ZooPerm
ZooPermDelete, ZooPerm
ZooPermAdmin]

{-# INLINE fromZooPerms #-}
fromZooPerms :: [ZooPerm] -> CInt
fromZooPerms :: [ZooPerm] -> CInt
fromZooPerms = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 ([CInt] -> CInt) -> ([ZooPerm] -> [CInt]) -> [ZooPerm] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZooPerm -> CInt) -> [ZooPerm] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map ZooPerm -> CInt
unZooPerm

{-# INLINE compactZooPerms #-}
compactZooPerms :: [ZooPerm] -> ZooPerm
compactZooPerms :: [ZooPerm] -> ZooPerm
compactZooPerms = CInt -> ZooPerm
ZooPerm (CInt -> ZooPerm) -> ([ZooPerm] -> CInt) -> [ZooPerm] -> ZooPerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ZooPerm] -> CInt
fromZooPerms

data ZooAcl = ZooAcl
  { ZooAcl -> [ZooPerm]
aclPerms    :: [ZooPerm]
  , ZooAcl -> CBytes
aclIdScheme :: CBytes
  , ZooAcl -> CBytes
aclId       :: CBytes
  } deriving Int -> ZooAcl -> ShowS
[ZooAcl] -> ShowS
ZooAcl -> String
(Int -> ZooAcl -> ShowS)
-> (ZooAcl -> String) -> ([ZooAcl] -> ShowS) -> Show ZooAcl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZooAcl] -> ShowS
$cshowList :: [ZooAcl] -> ShowS
show :: ZooAcl -> String
$cshow :: ZooAcl -> String
showsPrec :: Int -> ZooAcl -> ShowS
$cshowsPrec :: Int -> ZooAcl -> ShowS
Show

{-# INLINE sizeOfZooAcl #-}
sizeOfZooAcl :: Int
sizeOfZooAcl :: Int
sizeOfZooAcl = ((Int
24))
{-# LINE 96 "src/ZooKeeper/Internal/Types.hsc" #-}

peekZooAcl :: Ptr ZooAcl -> IO ZooAcl
peekZooAcl :: Ptr ZooAcl -> IO ZooAcl
peekZooAcl Ptr ZooAcl
ptr = do
  [ZooPerm]
perms <- CInt -> [ZooPerm]
toZooPerms (CInt -> [ZooPerm]) -> IO CInt -> IO [ZooPerm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr ZooAcl
hsc_ptr -> Ptr ZooAcl -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ZooAcl
hsc_ptr Int
0)) Ptr ZooAcl
ptr
{-# LINE 100 "src/ZooKeeper/Internal/Types.hsc" #-}
  scheme_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 101 "src/ZooKeeper/Internal/Types.hsc" #-}
  id_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 102 "src/ZooKeeper/Internal/Types.hsc" #-}
  scheme <- CBytes.fromCString scheme_ptr <* free scheme_ptr
  CBytes
acl_id <- CString -> IO CBytes
CBytes.fromCString CString
id_ptr IO CBytes -> IO () -> IO CBytes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
id_ptr
  ZooAcl -> IO ZooAcl
forall (m :: * -> *) a. Monad m => a -> m a
return (ZooAcl -> IO ZooAcl) -> ZooAcl -> IO ZooAcl
forall a b. (a -> b) -> a -> b
$ [ZooPerm] -> CBytes -> CBytes -> ZooAcl
ZooAcl [ZooPerm]
perms CBytes
scheme CBytes
acl_id

-- TODO
unsafeAllocaZooAcl :: ZooAcl -> IO Z.ByteArray
unsafeAllocaZooAcl :: ZooAcl -> IO ByteArray
unsafeAllocaZooAcl = ZooAcl -> IO ByteArray
forall a. HasCallStack => a
undefined

-- FIXME: consider this
-- data AclVector = AclVector (Ptr ()) | AclList [ZooAcl]
newtype AclVector = AclVector (Ptr ())
  deriving (Int -> AclVector -> ShowS
[AclVector] -> ShowS
AclVector -> String
(Int -> AclVector -> ShowS)
-> (AclVector -> String)
-> ([AclVector] -> ShowS)
-> Show AclVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AclVector] -> ShowS
$cshowList :: [AclVector] -> ShowS
show :: AclVector -> String
$cshow :: AclVector -> String
showsPrec :: Int -> AclVector -> ShowS
$cshowsPrec :: Int -> AclVector -> ShowS
Show, AclVector -> AclVector -> Bool
(AclVector -> AclVector -> Bool)
-> (AclVector -> AclVector -> Bool) -> Eq AclVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AclVector -> AclVector -> Bool
$c/= :: AclVector -> AclVector -> Bool
== :: AclVector -> AclVector -> Bool
$c== :: AclVector -> AclVector -> Bool
Eq)

-- | This is a completely open ACL
foreign import ccall unsafe "hs_zk.h &ZOO_OPEN_ACL_UNSAFE"
  zooOpenAclUnsafe :: AclVector

-- | This ACL gives the world the ability to read.
foreign import ccall unsafe "hs_zk.h &ZOO_READ_ACL_UNSAFE"
  zooReadAclUnsafe :: AclVector

-- | This ACL gives the creators authentication id's all permissions.
foreign import ccall unsafe "hs_zk.h &ZOO_CREATOR_ALL_ACL"
  zooCreatorAllAcl :: AclVector

toAclList :: AclVector -> IO [ZooAcl]
toAclList :: AclVector -> IO [ZooAcl]
toAclList (AclVector Ptr ()
ptr) = do
  Int
count <- forall b. (Integral Int32, Num b) => Int32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 (Int32 -> Int) -> IO Int32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
0)) Ptr ()
ptr
{-# LINE 130 "src/ZooKeeper/Internal/Types.hsc" #-}
  data_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 131 "src/ZooKeeper/Internal/Types.hsc" #-}
  forM [0..count-1] $ \idx -> do
    let data_ptr' = data_ptr `plusPtr` (idx * sizeOfZooAcl)
    peekZooAcl data_ptr'

-- TODO
fromAclList :: [ZooAcl] -> IO AclVector
fromAclList :: [ZooAcl] -> IO AclVector
fromAclList = [ZooAcl] -> IO AclVector
forall a. HasCallStack => a
undefined

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

-- | Interest Consts
--
-- These constants are used to express interest in an event and to
-- indicate to zookeeper which events have occurred. They can
-- be ORed together to express multiple interests. These flags are
-- used in the interest and event parameters of
-- zookeeper_interest and zookeeper_process.
newtype ZooInterest = ZooInterest CInt
  deriving (ZooInterest -> ZooInterest -> Bool
(ZooInterest -> ZooInterest -> Bool)
-> (ZooInterest -> ZooInterest -> Bool) -> Eq ZooInterest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZooInterest -> ZooInterest -> Bool
$c/= :: ZooInterest -> ZooInterest -> Bool
== :: ZooInterest -> ZooInterest -> Bool
$c== :: ZooInterest -> ZooInterest -> Bool
Eq, Ptr b -> Int -> IO ZooInterest
Ptr b -> Int -> ZooInterest -> IO ()
Ptr ZooInterest -> IO ZooInterest
Ptr ZooInterest -> Int -> IO ZooInterest
Ptr ZooInterest -> Int -> ZooInterest -> IO ()
Ptr ZooInterest -> ZooInterest -> IO ()
ZooInterest -> Int
(ZooInterest -> Int)
-> (ZooInterest -> Int)
-> (Ptr ZooInterest -> Int -> IO ZooInterest)
-> (Ptr ZooInterest -> Int -> ZooInterest -> IO ())
-> (forall b. Ptr b -> Int -> IO ZooInterest)
-> (forall b. Ptr b -> Int -> ZooInterest -> IO ())
-> (Ptr ZooInterest -> IO ZooInterest)
-> (Ptr ZooInterest -> ZooInterest -> IO ())
-> Storable ZooInterest
forall b. Ptr b -> Int -> IO ZooInterest
forall b. Ptr b -> Int -> ZooInterest -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ZooInterest -> ZooInterest -> IO ()
$cpoke :: Ptr ZooInterest -> ZooInterest -> IO ()
peek :: Ptr ZooInterest -> IO ZooInterest
$cpeek :: Ptr ZooInterest -> IO ZooInterest
pokeByteOff :: Ptr b -> Int -> ZooInterest -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooInterest -> IO ()
peekByteOff :: Ptr b -> Int -> IO ZooInterest
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooInterest
pokeElemOff :: Ptr ZooInterest -> Int -> ZooInterest -> IO ()
$cpokeElemOff :: Ptr ZooInterest -> Int -> ZooInterest -> IO ()
peekElemOff :: Ptr ZooInterest -> Int -> IO ZooInterest
$cpeekElemOff :: Ptr ZooInterest -> Int -> IO ZooInterest
alignment :: ZooInterest -> Int
$calignment :: ZooInterest -> Int
sizeOf :: ZooInterest -> Int
$csizeOf :: ZooInterest -> Int
Storable)

instance Show ZooInterest where
  show :: ZooInterest -> String
show ZooInterest
ZookeeperWrite  = String
"ZookeeperWrite"
  show ZooInterest
ZookeeperRead   = String
"ZookeeperRead"
  show (ZooInterest CInt
x) = String
"ZooInterest: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
x

pattern ZookeeperWrite :: ZooInterest
pattern $bZookeeperWrite :: ZooInterest
$mZookeeperWrite :: forall r. ZooInterest -> (Void# -> r) -> (Void# -> r) -> r
ZookeeperWrite = ZooInterest (1)
{-# LINE 158 "src/ZooKeeper/Internal/Types.hsc" #-}

pattern ZookeeperRead :: ZooInterest
pattern $bZookeeperRead :: ZooInterest
$mZookeeperRead :: forall r. ZooInterest -> (Void# -> r) -> (Void# -> r) -> r
ZookeeperRead = ZooInterest (2)
{-# LINE 161 "src/ZooKeeper/Internal/Types.hsc" #-}

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

-- | State Consts
--
-- These constants represent the states of a zookeeper connection. They are
-- possible parameters of the watcher callback.
newtype ZooState = ZooState CInt
  deriving (ZooState -> ZooState -> Bool
(ZooState -> ZooState -> Bool)
-> (ZooState -> ZooState -> Bool) -> Eq ZooState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZooState -> ZooState -> Bool
$c/= :: ZooState -> ZooState -> Bool
== :: ZooState -> ZooState -> Bool
$c== :: ZooState -> ZooState -> Bool
Eq, Ptr b -> Int -> IO ZooState
Ptr b -> Int -> ZooState -> IO ()
Ptr ZooState -> IO ZooState
Ptr ZooState -> Int -> IO ZooState
Ptr ZooState -> Int -> ZooState -> IO ()
Ptr ZooState -> ZooState -> IO ()
ZooState -> Int
(ZooState -> Int)
-> (ZooState -> Int)
-> (Ptr ZooState -> Int -> IO ZooState)
-> (Ptr ZooState -> Int -> ZooState -> IO ())
-> (forall b. Ptr b -> Int -> IO ZooState)
-> (forall b. Ptr b -> Int -> ZooState -> IO ())
-> (Ptr ZooState -> IO ZooState)
-> (Ptr ZooState -> ZooState -> IO ())
-> Storable ZooState
forall b. Ptr b -> Int -> IO ZooState
forall b. Ptr b -> Int -> ZooState -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ZooState -> ZooState -> IO ()
$cpoke :: Ptr ZooState -> ZooState -> IO ()
peek :: Ptr ZooState -> IO ZooState
$cpeek :: Ptr ZooState -> IO ZooState
pokeByteOff :: Ptr b -> Int -> ZooState -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooState -> IO ()
peekByteOff :: Ptr b -> Int -> IO ZooState
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooState
pokeElemOff :: Ptr ZooState -> Int -> ZooState -> IO ()
$cpokeElemOff :: Ptr ZooState -> Int -> ZooState -> IO ()
peekElemOff :: Ptr ZooState -> Int -> IO ZooState
$cpeekElemOff :: Ptr ZooState -> Int -> IO ZooState
alignment :: ZooState -> Int
$calignment :: ZooState -> Int
sizeOf :: ZooState -> Int
$csizeOf :: ZooState -> Int
Storable)
  deriving newtype (Int -> ZooState -> Builder ()
(Int -> ZooState -> Builder ()) -> Print ZooState
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> ZooState -> Builder ()
$ctoUTF8BuilderP :: Int -> ZooState -> Builder ()
Text.Print)

instance Show ZooState where
  show :: ZooState -> String
show ZooState
ZooExpiredSession   = String
"ExpiredSession"
  show ZooState
ZooAuthFailed       = String
"AuthFailed"
  show ZooState
ZooConnectingState  = String
"ConnectingState"
  show ZooState
ZooAssociatingState = String
"AssociatingState"
  show ZooState
ZooConnectedState   = String
"ConnectedState"
  show (ZooState CInt
x)        = String
"ZooState " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
x

pattern
    ZooExpiredSession, ZooAuthFailed
  , ZooConnectingState, ZooAssociatingState, ZooConnectedState :: ZooState
pattern $bZooExpiredSession :: ZooState
$mZooExpiredSession :: forall r. ZooState -> (Void# -> r) -> (Void# -> r) -> r
ZooExpiredSession   = ZooState (-112)
{-# LINE 184 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooAuthFailed       = ZooState (-113)
{-# LINE 185 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooConnectingState  = ZooState (1)
{-# LINE 186 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooAssociatingState = ZooState (2)
{-# LINE 187 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooConnectedState   = ZooState (3)
{-# LINE 188 "src/ZooKeeper/Internal/Types.hsc" #-}

-- TODO
-- pattern ZOO_READONLY_STATE :: ZooState
-- pattern ZOO_READONLY_STATE = ZooState (#const ZOO_READONLY_STATE)
-- pattern ZOO_NOTCONNECTED_STATE :: ZooState
-- pattern ZOO_NOTCONNECTED_STATE = ZooState (#const ZOO_NOTCONNECTED_STATE)

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

-- | Watch Types
--
-- These constants indicate the event that caused the watch event. They are
-- possible values of the first parameter of the watcher callback.
newtype ZooEvent = ZooEvent CInt
  deriving (ZooEvent -> ZooEvent -> Bool
(ZooEvent -> ZooEvent -> Bool)
-> (ZooEvent -> ZooEvent -> Bool) -> Eq ZooEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZooEvent -> ZooEvent -> Bool
$c/= :: ZooEvent -> ZooEvent -> Bool
== :: ZooEvent -> ZooEvent -> Bool
$c== :: ZooEvent -> ZooEvent -> Bool
Eq, Ptr b -> Int -> IO ZooEvent
Ptr b -> Int -> ZooEvent -> IO ()
Ptr ZooEvent -> IO ZooEvent
Ptr ZooEvent -> Int -> IO ZooEvent
Ptr ZooEvent -> Int -> ZooEvent -> IO ()
Ptr ZooEvent -> ZooEvent -> IO ()
ZooEvent -> Int
(ZooEvent -> Int)
-> (ZooEvent -> Int)
-> (Ptr ZooEvent -> Int -> IO ZooEvent)
-> (Ptr ZooEvent -> Int -> ZooEvent -> IO ())
-> (forall b. Ptr b -> Int -> IO ZooEvent)
-> (forall b. Ptr b -> Int -> ZooEvent -> IO ())
-> (Ptr ZooEvent -> IO ZooEvent)
-> (Ptr ZooEvent -> ZooEvent -> IO ())
-> Storable ZooEvent
forall b. Ptr b -> Int -> IO ZooEvent
forall b. Ptr b -> Int -> ZooEvent -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ZooEvent -> ZooEvent -> IO ()
$cpoke :: Ptr ZooEvent -> ZooEvent -> IO ()
peek :: Ptr ZooEvent -> IO ZooEvent
$cpeek :: Ptr ZooEvent -> IO ZooEvent
pokeByteOff :: Ptr b -> Int -> ZooEvent -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooEvent -> IO ()
peekByteOff :: Ptr b -> Int -> IO ZooEvent
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooEvent
pokeElemOff :: Ptr ZooEvent -> Int -> ZooEvent -> IO ()
$cpokeElemOff :: Ptr ZooEvent -> Int -> ZooEvent -> IO ()
peekElemOff :: Ptr ZooEvent -> Int -> IO ZooEvent
$cpeekElemOff :: Ptr ZooEvent -> Int -> IO ZooEvent
alignment :: ZooEvent -> Int
$calignment :: ZooEvent -> Int
sizeOf :: ZooEvent -> Int
$csizeOf :: ZooEvent -> Int
Storable)

instance Show ZooEvent where
  show :: ZooEvent -> String
show ZooEvent
ZooCreateEvent     = String
"CreateEvent"
  show ZooEvent
ZooDeleteEvent     = String
"DeleteEvent"
  show ZooEvent
ZooChangedEvent    = String
"ChangedEvent"
  show ZooEvent
ZooChildEvent      = String
"ChildEvent"
  show ZooEvent
ZooSessionEvent    = String
"SessionEvent"
  show ZooEvent
ZooNoWatchingEvent = String
"NoWatchingEvent"
  show (ZooEvent CInt
x)       = String
"ZooEvent " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
x

-- | A node has been created.
--
-- This is only generated by watches on non-existent nodes. These watches
-- are set using 'ZooKeeper.zooWatchExists'.
pattern ZooCreateEvent :: ZooEvent
pattern $bZooCreateEvent :: ZooEvent
$mZooCreateEvent :: forall r. ZooEvent -> (Void# -> r) -> (Void# -> r) -> r
ZooCreateEvent = ZooEvent (1)
{-# LINE 219 "src/ZooKeeper/Internal/Types.hsc" #-}

-- | A node has been deleted.
--
-- This is only generated by watches on nodes. These watches
-- are set using 'ZooKeeper.zooWatchExists' and 'ZooKeeper.zooWatchGet'.
pattern ZooDeleteEvent :: ZooEvent
pattern $bZooDeleteEvent :: ZooEvent
$mZooDeleteEvent :: forall r. ZooEvent -> (Void# -> r) -> (Void# -> r) -> r
ZooDeleteEvent = ZooEvent (2)
{-# LINE 226 "src/ZooKeeper/Internal/Types.hsc" #-}

-- | A node has changed.
--
-- This is only generated by watches on nodes. These watches
-- are set using 'ZooKeeper.zooWatchExists' and 'ZooKeeper.zooWatchGet'.
pattern ZooChangedEvent :: ZooEvent
pattern $bZooChangedEvent :: ZooEvent
$mZooChangedEvent :: forall r. ZooEvent -> (Void# -> r) -> (Void# -> r) -> r
ZooChangedEvent = ZooEvent (3)
{-# LINE 233 "src/ZooKeeper/Internal/Types.hsc" #-}

-- A change as occurred in the list of children.
--
-- This is only generated by watches on the child list of a node. These watches
-- are set using 'ZooKeeper.zooWatchGetChildren' or 'ZooKeeper.zooWatchGetChildren2'.
pattern ZooChildEvent :: ZooEvent
pattern $bZooChildEvent :: ZooEvent
$mZooChildEvent :: forall r. ZooEvent -> (Void# -> r) -> (Void# -> r) -> r
ZooChildEvent = ZooEvent (4)
{-# LINE 240 "src/ZooKeeper/Internal/Types.hsc" #-}

-- | A session has been lost.
--
-- This is generated when a client loses contact or reconnects with a server.
pattern ZooSessionEvent :: ZooEvent
pattern $bZooSessionEvent :: ZooEvent
$mZooSessionEvent :: forall r. ZooEvent -> (Void# -> r) -> (Void# -> r) -> r
ZooSessionEvent = ZooEvent (-1)
{-# LINE 246 "src/ZooKeeper/Internal/Types.hsc" #-}

-- | A watch has been removed.
--
-- This is generated when the server for some reason, probably a resource
-- constraint, will no longer watch a node for a client.
pattern ZooNoWatchingEvent :: ZooEvent
pattern $bZooNoWatchingEvent :: ZooEvent
$mZooNoWatchingEvent :: forall r. ZooEvent -> (Void# -> r) -> (Void# -> r) -> r
ZooNoWatchingEvent = ZooEvent (-2)
{-# LINE 253 "src/ZooKeeper/Internal/Types.hsc" #-}

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

-- | These modes are used by zoo_create to affect node create.
newtype CreateMode = CreateMode { CreateMode -> CInt
unCreateMode :: CInt }
  deriving (Int -> CreateMode -> ShowS
[CreateMode] -> ShowS
CreateMode -> String
(Int -> CreateMode -> ShowS)
-> (CreateMode -> String)
-> ([CreateMode] -> ShowS)
-> Show CreateMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMode] -> ShowS
$cshowList :: [CreateMode] -> ShowS
show :: CreateMode -> String
$cshow :: CreateMode -> String
showsPrec :: Int -> CreateMode -> ShowS
$cshowsPrec :: Int -> CreateMode -> ShowS
Show, CreateMode -> CreateMode -> Bool
(CreateMode -> CreateMode -> Bool)
-> (CreateMode -> CreateMode -> Bool) -> Eq CreateMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMode -> CreateMode -> Bool
$c/= :: CreateMode -> CreateMode -> Bool
== :: CreateMode -> CreateMode -> Bool
$c== :: CreateMode -> CreateMode -> Bool
Eq, Ptr b -> Int -> IO CreateMode
Ptr b -> Int -> CreateMode -> IO ()
Ptr CreateMode -> IO CreateMode
Ptr CreateMode -> Int -> IO CreateMode
Ptr CreateMode -> Int -> CreateMode -> IO ()
Ptr CreateMode -> CreateMode -> IO ()
CreateMode -> Int
(CreateMode -> Int)
-> (CreateMode -> Int)
-> (Ptr CreateMode -> Int -> IO CreateMode)
-> (Ptr CreateMode -> Int -> CreateMode -> IO ())
-> (forall b. Ptr b -> Int -> IO CreateMode)
-> (forall b. Ptr b -> Int -> CreateMode -> IO ())
-> (Ptr CreateMode -> IO CreateMode)
-> (Ptr CreateMode -> CreateMode -> IO ())
-> Storable CreateMode
forall b. Ptr b -> Int -> IO CreateMode
forall b. Ptr b -> Int -> CreateMode -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr CreateMode -> CreateMode -> IO ()
$cpoke :: Ptr CreateMode -> CreateMode -> IO ()
peek :: Ptr CreateMode -> IO CreateMode
$cpeek :: Ptr CreateMode -> IO CreateMode
pokeByteOff :: Ptr b -> Int -> CreateMode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CreateMode -> IO ()
peekByteOff :: Ptr b -> Int -> IO CreateMode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CreateMode
pokeElemOff :: Ptr CreateMode -> Int -> CreateMode -> IO ()
$cpokeElemOff :: Ptr CreateMode -> Int -> CreateMode -> IO ()
peekElemOff :: Ptr CreateMode -> Int -> IO CreateMode
$cpeekElemOff :: Ptr CreateMode -> Int -> IO CreateMode
alignment :: CreateMode -> Int
$calignment :: CreateMode -> Int
sizeOf :: CreateMode -> Int
$csizeOf :: CreateMode -> Int
Storable)

pattern ZooPersistent :: CreateMode
pattern $bZooPersistent :: CreateMode
$mZooPersistent :: forall r. CreateMode -> (Void# -> r) -> (Void# -> r) -> r
ZooPersistent = CreateMode 0

-- | The znode will be deleted upon the client's disconnect.
pattern ZooEphemeral :: CreateMode
pattern $bZooEphemeral :: CreateMode
$mZooEphemeral :: forall r. CreateMode -> (Void# -> r) -> (Void# -> r) -> r
ZooEphemeral = CreateMode (1)
{-# LINE 266 "src/ZooKeeper/Internal/Types.hsc" #-}

pattern ZooSequence :: CreateMode
pattern $bZooSequence :: CreateMode
$mZooSequence :: forall r. CreateMode -> (Void# -> r) -> (Void# -> r) -> r
ZooSequence = CreateMode (2)
{-# LINE 269 "src/ZooKeeper/Internal/Types.hsc" #-}

-- TODO
--pattern ZooPersistent :: CreateMode
--pattern ZooPersistent = CreateMode (#const ZOO_PERSISTENT)
--
--pattern ZooPersistentSequential :: CreateMode
--pattern ZooPersistentSequential = CreateMode (#const ZOO_PERSISTENT_SEQUENTIAL)
--
--pattern ZooEphemeralSequential :: CreateMode
--pattern ZooEphemeralSequential = CreateMode (#const ZOO_EPHEMERAL_SEQUENTIAL)
--
--pattern ZooContainer :: CreateMode
--pattern ZooContainer = CreateMode (#const ZOO_CONTAINER)
--
--pattern ZooPersistentWithTTL :: CreateMode
--pattern ZooPersistentWithTTL = CreateMode (#const ZOO_PERSISTENT_WITH_TTL)
--
--pattern ZooPersistentSequentialWithTTL :: CreateMode
--pattern ZooPersistentSequentialWithTTL = CreateMode (#const ZOO_PERSISTENT_SEQUENTIAL_WITH_TTL)

data Stat = Stat
  { Stat -> Int64
statCzxid          :: {-# UNPACK #-} !Int64
  , Stat -> Int64
statMzxid          :: {-# UNPACK #-} !Int64
  , Stat -> Int64
statCtime          :: {-# UNPACK #-} !Int64
  , Stat -> Int64
statMtime          :: {-# UNPACK #-} !Int64
  , Stat -> Int32
statVersion        :: {-# UNPACK #-} !Int32
  , Stat -> Int32
statCversion       :: {-# UNPACK #-} !Int32
  , Stat -> Int32
statAversion       :: {-# UNPACK #-} !Int32
  , Stat -> Int64
statEphemeralOwner :: {-# UNPACK #-} !Int64
  , Stat -> Int32
statDataLength     :: {-# UNPACK #-} !Int32
  , Stat -> Int32
statNumChildren    :: {-# UNPACK #-} !Int32
  , Stat -> Int64
statPzxid          :: {-# UNPACK #-} !Int64
  } deriving (Int -> Stat -> ShowS
[Stat] -> ShowS
Stat -> String
(Int -> Stat -> ShowS)
-> (Stat -> String) -> ([Stat] -> ShowS) -> Show Stat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stat] -> ShowS
$cshowList :: [Stat] -> ShowS
show :: Stat -> String
$cshow :: Stat -> String
showsPrec :: Int -> Stat -> ShowS
$cshowsPrec :: Int -> Stat -> ShowS
Show, Stat -> Stat -> Bool
(Stat -> Stat -> Bool) -> (Stat -> Stat -> Bool) -> Eq Stat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stat -> Stat -> Bool
$c/= :: Stat -> Stat -> Bool
== :: Stat -> Stat -> Bool
$c== :: Stat -> Stat -> Bool
Eq)

statSize :: Int
statSize :: Int
statSize = ((Int
72))
{-# LINE 305 "src/ZooKeeper/Internal/Types.hsc" #-}

peekStat' :: Ptr Stat -> IO Stat
peekStat' :: Ptr Stat -> IO Stat
peekStat' Ptr Stat
ptr = Int64
-> Int64
-> Int64
-> Int64
-> Int32
-> Int32
-> Int32
-> Int64
-> Int32
-> Int32
-> Int64
-> Stat
Stat
  (Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int32
 -> Int32
 -> Int32
 -> Int64
 -> Int32
 -> Int32
 -> Int64
 -> Stat)
-> IO Int64
-> IO
     (Int64
      -> Int64
      -> Int64
      -> Int32
      -> Int32
      -> Int32
      -> Int64
      -> Int32
      -> Int32
      -> Int64
      -> Stat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr Stat
hsc_ptr -> Ptr Stat -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Stat
hsc_ptr Int
0)) Ptr Stat
ptr
{-# LINE 309 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 310 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 311 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 312 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 313 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
{-# LINE 314 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 315 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 316 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
{-# LINE 317 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 60)) ptr
{-# LINE 318 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
{-# LINE 319 "src/ZooKeeper/Internal/Types.hsc" #-}

peekStat :: Ptr Stat -> IO Stat
peekStat :: Ptr Stat -> IO Stat
peekStat Ptr Stat
ptr = Ptr Stat -> IO Stat
peekStat' Ptr Stat
ptr IO Stat -> IO () -> IO Stat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Ptr Stat -> IO ()
forall a. Ptr a -> IO ()
free Ptr Stat
ptr

newtype StringVector = StringVector { StringVector -> [CBytes]
unStrVec :: [CBytes] }
  deriving Int -> StringVector -> ShowS
[StringVector] -> ShowS
StringVector -> String
(Int -> StringVector -> ShowS)
-> (StringVector -> String)
-> ([StringVector] -> ShowS)
-> Show StringVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringVector] -> ShowS
$cshowList :: [StringVector] -> ShowS
show :: StringVector -> String
$cshow :: StringVector -> String
showsPrec :: Int -> StringVector -> ShowS
$cshowsPrec :: Int -> StringVector -> ShowS
Show

peekStringVector :: Ptr StringVector -> IO StringVector
peekStringVector :: Ptr StringVector -> IO StringVector
peekStringVector Ptr StringVector
ptr = IO () -> IO () -> IO StringVector -> IO StringVector
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Ptr StringVector -> IO ()
forall a. Ptr a -> IO ()
free Ptr StringVector
ptr) (IO StringVector -> IO StringVector)
-> IO StringVector -> IO StringVector
forall a b. (a -> b) -> a -> b
$ do
  -- NOTE: Int32 is necessary, since count is int32_t in c
  Int
count <- forall b. (Integral Int32, Num b) => Int32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 (Int32 -> Int) -> IO Int32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr StringVector
hsc_ptr -> Ptr StringVector -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StringVector
hsc_ptr Int
0)) Ptr StringVector
ptr
{-# LINE 330 "src/ZooKeeper/Internal/Types.hsc" #-}
  StringVector <$> forM [0..count-1] (peekStringVectorIdx ptr)

peekStringVectorIdx :: Ptr StringVector -> Int -> IO CBytes
peekStringVectorIdx :: Ptr StringVector -> Int -> IO CBytes
peekStringVectorIdx Ptr StringVector
ptr Int
offset = do
  Ptr Any
ptr' <- ((\Ptr StringVector
hsc_ptr -> Ptr StringVector -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StringVector
hsc_ptr Int
8)) Ptr StringVector
ptr
{-# LINE 335 "src/ZooKeeper/Internal/Types.hsc" #-}
  data_ptr <- peek $ ptr' `plusPtr` (offset * (sizeOf ptr'))
  CString -> IO CBytes
CBytes.fromCString CString
data_ptr IO CBytes -> IO () -> IO CBytes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
data_ptr

-------------------------------------------------------------------------------
-- Callback datas

data HsWatcherCtx = HsWatcherCtx
  { HsWatcherCtx -> ZHandle
watcherCtxZHandle :: ZHandle
  , HsWatcherCtx -> ZooEvent
watcherCtxType    :: ZooEvent
  , HsWatcherCtx -> ZooState
watcherCtxState   :: ZooState
  , HsWatcherCtx -> Maybe CBytes
watcherCtxPath    :: Maybe CBytes
  } deriving Int -> HsWatcherCtx -> ShowS
[HsWatcherCtx] -> ShowS
HsWatcherCtx -> String
(Int -> HsWatcherCtx -> ShowS)
-> (HsWatcherCtx -> String)
-> ([HsWatcherCtx] -> ShowS)
-> Show HsWatcherCtx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsWatcherCtx] -> ShowS
$cshowList :: [HsWatcherCtx] -> ShowS
show :: HsWatcherCtx -> String
$cshow :: HsWatcherCtx -> String
showsPrec :: Int -> HsWatcherCtx -> ShowS
$cshowsPrec :: Int -> HsWatcherCtx -> ShowS
Show

hsWatcherCtxSize :: Int
hsWatcherCtxSize :: Int
hsWatcherCtxSize = ((Int
40))
{-# LINE 350 "src/ZooKeeper/Internal/Types.hsc" #-}

peekHsWatcherCtx :: Ptr HsWatcherCtx -> IO HsWatcherCtx
peekHsWatcherCtx :: Ptr HsWatcherCtx -> IO HsWatcherCtx
peekHsWatcherCtx Ptr HsWatcherCtx
ptr = do
  Ptr ()
zh_ptr <- ((\Ptr HsWatcherCtx
hsc_ptr -> Ptr HsWatcherCtx -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr HsWatcherCtx
hsc_ptr Int
16)) Ptr HsWatcherCtx
ptr
{-# LINE 354 "src/ZooKeeper/Internal/Types.hsc" #-}
  event_type <-((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 355 "src/ZooKeeper/Internal/Types.hsc" #-}
  connect_state <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 356 "src/ZooKeeper/Internal/Types.hsc" #-}
  path_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 357 "src/ZooKeeper/Internal/Types.hsc" #-}
  path <- if path_ptr == nullPtr
             then return Nothing
             else Just <$> CBytes.fromCString path_ptr <* free path_ptr
  HsWatcherCtx -> IO HsWatcherCtx
forall (m :: * -> *) a. Monad m => a -> m a
return (HsWatcherCtx -> IO HsWatcherCtx)
-> HsWatcherCtx -> IO HsWatcherCtx
forall a b. (a -> b) -> a -> b
$ ZHandle -> ZooEvent -> ZooState -> Maybe CBytes -> HsWatcherCtx
HsWatcherCtx (Ptr () -> ZHandle
ZHandle Ptr ()
zh_ptr) ZooEvent
event_type ZooState
connect_state Maybe CBytes
path

class Completion a where
  {-# MINIMAL csize, peekRet, peekData #-}
  csize :: Int
  peekRet :: Ptr a -> IO CInt
  peekData :: Ptr a -> IO a

newtype StringCompletion = StringCompletion { StringCompletion -> CBytes
strCompletionValue :: CBytes }
  deriving Int -> StringCompletion -> ShowS
[StringCompletion] -> ShowS
StringCompletion -> String
(Int -> StringCompletion -> ShowS)
-> (StringCompletion -> String)
-> ([StringCompletion] -> ShowS)
-> Show StringCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringCompletion] -> ShowS
$cshowList :: [StringCompletion] -> ShowS
show :: StringCompletion -> String
$cshow :: StringCompletion -> String
showsPrec :: Int -> StringCompletion -> ShowS
$cshowsPrec :: Int -> StringCompletion -> ShowS
Show

instance Completion StringCompletion where
  csize :: Int
csize = ((Int
32))
{-# LINE 373 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 374 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    value_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 376 "src/ZooKeeper/Internal/Types.hsc" #-}
    value <- CBytes.fromCString value_ptr <* free value_ptr
    return $ StringCompletion value

data DataCompletion = DataCompletion
  { DataCompletion -> Maybe Bytes
dataCompletionValue :: Maybe Bytes
  , DataCompletion -> Stat
dataCompletionStat  :: Stat
  } deriving (Int -> DataCompletion -> ShowS
[DataCompletion] -> ShowS
DataCompletion -> String
(Int -> DataCompletion -> ShowS)
-> (DataCompletion -> String)
-> ([DataCompletion] -> ShowS)
-> Show DataCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataCompletion] -> ShowS
$cshowList :: [DataCompletion] -> ShowS
show :: DataCompletion -> String
$cshow :: DataCompletion -> String
showsPrec :: Int -> DataCompletion -> ShowS
$cshowsPrec :: Int -> DataCompletion -> ShowS
Show, DataCompletion -> DataCompletion -> Bool
(DataCompletion -> DataCompletion -> Bool)
-> (DataCompletion -> DataCompletion -> Bool) -> Eq DataCompletion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataCompletion -> DataCompletion -> Bool
$c/= :: DataCompletion -> DataCompletion -> Bool
== :: DataCompletion -> DataCompletion -> Bool
$c== :: DataCompletion -> DataCompletion -> Bool
Eq)

instance Completion DataCompletion where
  csize :: Int
csize = ((Int
48))
{-# LINE 386 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 387 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    val_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 389 "src/ZooKeeper/Internal/Types.hsc" #-}
    val_len :: CInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 390 "src/ZooKeeper/Internal/Types.hsc" #-}
    val <- if val_len >= 0
              then Just <$> Z.fromPtr val_ptr (fromIntegral val_len) <* free val_ptr
              else return Nothing
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 394 "src/ZooKeeper/Internal/Types.hsc" #-}
    stat <- peekStat stat_ptr
    return $ DataCompletion val stat

newtype StatCompletion = StatCompletion { StatCompletion -> Stat
statCompletionStat :: Stat }
  deriving (Int -> StatCompletion -> ShowS
[StatCompletion] -> ShowS
StatCompletion -> String
(Int -> StatCompletion -> ShowS)
-> (StatCompletion -> String)
-> ([StatCompletion] -> ShowS)
-> Show StatCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatCompletion] -> ShowS
$cshowList :: [StatCompletion] -> ShowS
show :: StatCompletion -> String
$cshow :: StatCompletion -> String
showsPrec :: Int -> StatCompletion -> ShowS
$cshowsPrec :: Int -> StatCompletion -> ShowS
Show, StatCompletion -> StatCompletion -> Bool
(StatCompletion -> StatCompletion -> Bool)
-> (StatCompletion -> StatCompletion -> Bool) -> Eq StatCompletion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatCompletion -> StatCompletion -> Bool
$c/= :: StatCompletion -> StatCompletion -> Bool
== :: StatCompletion -> StatCompletion -> Bool
$c== :: StatCompletion -> StatCompletion -> Bool
Eq)

instance Completion StatCompletion where
  csize :: Int
csize = ((Int
32))
{-# LINE 402 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 403 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 405 "src/ZooKeeper/Internal/Types.hsc" #-}
    stat <- peekStat stat_ptr
    return $ StatCompletion stat

newtype VoidCompletion = VoidCompletion ()

instance Completion VoidCompletion where
  csize :: Int
csize = ((Int
24))
{-# LINE 412 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 413 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData _ = return $ VoidCompletion ()

newtype StringsCompletion = StringsCompletion
  { StringsCompletion -> StringVector
strsCompletionValues :: StringVector }
  deriving Int -> StringsCompletion -> ShowS
[StringsCompletion] -> ShowS
StringsCompletion -> String
(Int -> StringsCompletion -> ShowS)
-> (StringsCompletion -> String)
-> ([StringsCompletion] -> ShowS)
-> Show StringsCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringsCompletion] -> ShowS
$cshowList :: [StringsCompletion] -> ShowS
show :: StringsCompletion -> String
$cshow :: StringsCompletion -> String
showsPrec :: Int -> StringsCompletion -> ShowS
$cshowsPrec :: Int -> StringsCompletion -> ShowS
Show

instance Completion StringsCompletion where
  csize :: Int
csize = ((Int
32))
{-# LINE 421 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 422 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    strs_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 424 "src/ZooKeeper/Internal/Types.hsc" #-}
    vals <- peekStringVector strs_ptr
    return $ StringsCompletion vals

data StringsStatCompletion = StringsStatCompletion
  { StringsStatCompletion -> StringVector
strsStatCompletionStrs :: StringVector
  , StringsStatCompletion -> Stat
strsStatCompletionStat :: Stat
  } deriving Int -> StringsStatCompletion -> ShowS
[StringsStatCompletion] -> ShowS
StringsStatCompletion -> String
(Int -> StringsStatCompletion -> ShowS)
-> (StringsStatCompletion -> String)
-> ([StringsStatCompletion] -> ShowS)
-> Show StringsStatCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringsStatCompletion] -> ShowS
$cshowList :: [StringsStatCompletion] -> ShowS
show :: StringsStatCompletion -> String
$cshow :: StringsStatCompletion -> String
showsPrec :: Int -> StringsStatCompletion -> ShowS
$cshowsPrec :: Int -> StringsStatCompletion -> ShowS
Show

instance Completion StringsStatCompletion where
  csize :: Int
csize = ((Int
40))
{-# LINE 434 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 435 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    strs_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 437 "src/ZooKeeper/Internal/Types.hsc" #-}
    vals <- peekStringVector strs_ptr
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 439 "src/ZooKeeper/Internal/Types.hsc" #-}
    stat <- peekStat stat_ptr
    return $ StringsStatCompletion vals stat

data AclCompletion = AclCompletion
  { AclCompletion -> [ZooAcl]
aclCompletionAcls :: [ZooAcl]
  , AclCompletion -> Stat
aclCompletionStat :: Stat
  } deriving Int -> AclCompletion -> ShowS
[AclCompletion] -> ShowS
AclCompletion -> String
(Int -> AclCompletion -> ShowS)
-> (AclCompletion -> String)
-> ([AclCompletion] -> ShowS)
-> Show AclCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AclCompletion] -> ShowS
$cshowList :: [AclCompletion] -> ShowS
show :: AclCompletion -> String
$cshow :: AclCompletion -> String
showsPrec :: Int -> AclCompletion -> ShowS
$cshowsPrec :: Int -> AclCompletion -> ShowS
Show

instance Completion AclCompletion where
  csize :: Int
csize = ((Int
40))
{-# LINE 449 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 450 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    acls <- toAclList . AclVector =<< ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 452 "src/ZooKeeper/Internal/Types.hsc" #-}
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 453 "src/ZooKeeper/Internal/Types.hsc" #-}
    stat <- peekStat stat_ptr
    return $ AclCompletion acls stat

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

data CZooOp
data CZooOpResult

zooOpSize :: Int
zooOpSize :: Int
zooOpSize = ((Int
64))
{-# LINE 463 "src/ZooKeeper/Internal/Types.hsc" #-}

zooOpResultSize :: Int
zooOpResultSize :: Int
zooOpResultSize = ((Int
32))
{-# LINE 466 "src/ZooKeeper/Internal/Types.hsc" #-}

-- only safe on /pinned/ byte array
type ResultBytes = Z.MutableByteArray Z.RealWorld
type TouchListBytes = [Z.MutableByteArray Z.RealWorld]

-- | This structure holds all the arguments necessary for one op as part of a
-- containing multi_op via 'ZooKeeper.zooMulti'.
data ZooOp
  = ZooCreateOp (Ptr CZooOp -> IO (ResultBytes, TouchListBytes))
  | ZooDeleteOp (Ptr CZooOp -> IO ((), TouchListBytes))
  | ZooSetOp    (Ptr CZooOp -> IO (ResultBytes, TouchListBytes))
  | ZooCheckOp  (Ptr CZooOp -> IO ((), TouchListBytes))

data ZooOpResult
  = ZooCreateOpResult CInt CBytes
  | ZooDeleteOpResult CInt
  | ZooSetOpResult    CInt Stat
  | ZooCheckOpResult  CInt
  deriving (Int -> ZooOpResult -> ShowS
[ZooOpResult] -> ShowS
ZooOpResult -> String
(Int -> ZooOpResult -> ShowS)
-> (ZooOpResult -> String)
-> ([ZooOpResult] -> ShowS)
-> Show ZooOpResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZooOpResult] -> ShowS
$cshowList :: [ZooOpResult] -> ShowS
show :: ZooOpResult -> String
$cshow :: ZooOpResult -> String
showsPrec :: Int -> ZooOpResult -> ShowS
$cshowsPrec :: Int -> ZooOpResult -> ShowS
Show, ZooOpResult -> ZooOpResult -> Bool
(ZooOpResult -> ZooOpResult -> Bool)
-> (ZooOpResult -> ZooOpResult -> Bool) -> Eq ZooOpResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZooOpResult -> ZooOpResult -> Bool
$c/= :: ZooOpResult -> ZooOpResult -> Bool
== :: ZooOpResult -> ZooOpResult -> Bool
$c== :: ZooOpResult -> ZooOpResult -> Bool
Eq)

peekZooCreateOpResult :: ResultBytes -> Ptr CZooOpResult -> IO ZooOpResult
peekZooCreateOpResult :: ResultBytes -> Ptr CZooOpResult -> IO ZooOpResult
peekZooCreateOpResult (Z.MutableByteArray MutableByteArray# RealWorld
ba#) Ptr CZooOpResult
ptr = do
  CInt
ret <- ((\Ptr CZooOpResult
hsc_ptr -> Ptr CZooOpResult -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 489 "src/ZooKeeper/Internal/Types.hsc" #-}
  value <- CBytes.fromMutablePrimArray $ Z.MutablePrimArray ba#
  ZooOpResult -> IO ZooOpResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ZooOpResult -> IO ZooOpResult) -> ZooOpResult -> IO ZooOpResult
forall a b. (a -> b) -> a -> b
$ CInt -> CBytes -> ZooOpResult
ZooCreateOpResult CInt
ret CBytes
value

peekZooDeleteOpResult :: Ptr CZooOpResult -> IO ZooOpResult
peekZooDeleteOpResult :: Ptr CZooOpResult -> IO ZooOpResult
peekZooDeleteOpResult Ptr CZooOpResult
ptr = CInt -> ZooOpResult
ZooDeleteOpResult (CInt -> ZooOpResult) -> IO CInt -> IO ZooOpResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr CZooOpResult
hsc_ptr -> Ptr CZooOpResult -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 494 "src/ZooKeeper/Internal/Types.hsc" #-}

peekZooSetOpResult :: ResultBytes -> Ptr CZooOpResult -> IO ZooOpResult
peekZooSetOpResult :: ResultBytes -> Ptr CZooOpResult -> IO ZooOpResult
peekZooSetOpResult ResultBytes
mba Ptr CZooOpResult
ptr = do
  CInt
ret <- ((\Ptr CZooOpResult
hsc_ptr -> Ptr CZooOpResult -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 498 "src/ZooKeeper/Internal/Types.hsc" #-}
  ba <- Z.unsafeFreezeByteArray mba
  Stat
stat <- Ptr Stat -> IO Stat
peekStat' (Ptr Stat -> IO Stat) -> Ptr Stat -> IO Stat
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Stat
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Stat) -> Ptr Word8 -> Ptr Stat
forall a b. (a -> b) -> a -> b
$ ByteArray -> Ptr Word8
Z.byteArrayContents ByteArray
ba
  ZooOpResult -> IO ZooOpResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ZooOpResult -> IO ZooOpResult) -> ZooOpResult -> IO ZooOpResult
forall a b. (a -> b) -> a -> b
$ CInt -> Stat -> ZooOpResult
ZooSetOpResult CInt
ret Stat
stat

peekZooCheckOpResult :: Ptr CZooOpResult -> IO ZooOpResult
peekZooCheckOpResult :: Ptr CZooOpResult -> IO ZooOpResult
peekZooCheckOpResult Ptr CZooOpResult
ptr = CInt -> ZooOpResult
ZooCheckOpResult (CInt -> ZooOpResult) -> IO CInt -> IO ZooOpResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr CZooOpResult
hsc_ptr -> Ptr CZooOpResult -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 504 "src/ZooKeeper/Internal/Types.hsc" #-}