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

module ZooKeeper.Internal.Types where

import           Control.Exception     (finally)
import           Control.Monad         (forM)
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BShort (packCStringLen)
import           Data.Int
import           Foreign
import           Foreign.C
import           Numeric               (showHex)
import qualified Z.Data.CBytes         as CBytes
import           Z.Data.CBytes         (CBytes)
import qualified Z.Data.Text           as Text
import           Z.Data.Vector         (Bytes)
import qualified Z.Foreign             as Z



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

type CWatcherFn = ZHandle -> CInt     -> CInt     -> CString -> Ptr () -> IO ()
type WatcherFn  = ZHandle -> ZooEvent -> ZooState -> CBytes            -> IO ()

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
$cshowsPrec :: Int -> ZHandle -> ShowS
showsPrec :: Int -> ZHandle -> ShowS
$cshow :: ZHandle -> String
show :: ZHandle -> String
$cshowList :: [ZHandle] -> ShowS
showList :: [ZHandle] -> ShowS
Show, ZHandle -> ZHandle -> Bool
(ZHandle -> ZHandle -> Bool)
-> (ZHandle -> ZHandle -> Bool) -> Eq ZHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZHandle -> ZHandle -> Bool
== :: ZHandle -> ZHandle -> Bool
$c/= :: ZHandle -> ZHandle -> Bool
/= :: ZHandle -> ZHandle -> Bool
Eq)

-- | This structure holds the id and password for the session. This structure
-- should be treated as opaque. It is received from the server when a session
-- is established and needs to be sent back as-is when reconnecting a session.
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
$cshowsPrec :: Int -> ClientID -> ShowS
showsPrec :: Int -> ClientID -> ShowS
$cshow :: ClientID -> String
show :: ClientID -> String
$cshowList :: [ClientID] -> ShowS
showList :: [ClientID] -> ShowS
Show, ClientID -> ClientID -> Bool
(ClientID -> ClientID -> Bool)
-> (ClientID -> ClientID -> Bool) -> Eq ClientID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientID -> ClientID -> Bool
== :: ClientID -> ClientID -> Bool
$c/= :: ClientID -> ClientID -> Bool
/= :: ClientID -> ClientID -> Bool
Eq)

data HsClientID = HsClientID
  { HsClientID -> Int64
clientId     :: {-# UNPACK #-} !Int64
  , HsClientID -> ShortByteString
clientPasswd :: {-# UNPACK #-} !ShortByteString
  } deriving (Int -> HsClientID -> ShowS
[HsClientID] -> ShowS
HsClientID -> String
(Int -> HsClientID -> ShowS)
-> (HsClientID -> String)
-> ([HsClientID] -> ShowS)
-> Show HsClientID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsClientID -> ShowS
showsPrec :: Int -> HsClientID -> ShowS
$cshow :: HsClientID -> String
show :: HsClientID -> String
$cshowList :: [HsClientID] -> ShowS
showList :: [HsClientID] -> ShowS
Show, HsClientID -> HsClientID -> Bool
(HsClientID -> HsClientID -> Bool)
-> (HsClientID -> HsClientID -> Bool) -> Eq HsClientID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HsClientID -> HsClientID -> Bool
== :: HsClientID -> HsClientID -> Bool
$c/= :: HsClientID -> HsClientID -> Bool
/= :: HsClientID -> HsClientID -> Bool
Eq)

peekClientId :: ClientID -> IO HsClientID
peekClientId :: ClientID -> IO HsClientID
peekClientId (ClientID Ptr ()
ptr) = do
  Int64
client_id <- ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
0)) Ptr ()
ptr
{-# LINE 44 "src/ZooKeeper/Internal/Types.hsc" #-}
  -- definition in c: char passwd[16];
  let passwd_ptr :: Ptr b
passwd_ptr = ((\Ptr ()
hsc_ptr -> Ptr ()
hsc_ptr Ptr () -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)) Ptr ()
ptr
{-# LINE 46 "src/ZooKeeper/Internal/Types.hsc" #-}
      passwd_len = ((16))
{-# LINE 47 "src/ZooKeeper/Internal/Types.hsc" #-}
  -- the pointer is getting from zhandle, so here we don't need to free it
  ShortByteString
passwd <- CStringLen -> IO ShortByteString
BShort.packCStringLen (Ptr CChar
forall {b}. Ptr b
passwd_ptr, Int
passwd_len)
  HsClientID -> IO HsClientID
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsClientID -> IO HsClientID) -> HsClientID -> IO HsClientID
forall a b. (a -> b) -> a -> b
$ HsClientID{clientId :: Int64
clientId=Int64
client_id, clientPasswd :: ShortByteString
clientPasswd=ShortByteString
passwd}

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
$c== :: ZooLogLevel -> ZooLogLevel -> Bool
== :: ZooLogLevel -> ZooLogLevel -> Bool
$c/= :: ZooLogLevel -> ZooLogLevel -> Bool
/= :: ZooLogLevel -> ZooLogLevel -> Bool
Eq, 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
$csizeOf :: ZooLogLevel -> Int
sizeOf :: ZooLogLevel -> Int
$calignment :: ZooLogLevel -> Int
alignment :: ZooLogLevel -> Int
$cpeekElemOff :: Ptr ZooLogLevel -> Int -> IO ZooLogLevel
peekElemOff :: Ptr ZooLogLevel -> Int -> IO ZooLogLevel
$cpokeElemOff :: Ptr ZooLogLevel -> Int -> ZooLogLevel -> IO ()
pokeElemOff :: Ptr ZooLogLevel -> Int -> ZooLogLevel -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooLogLevel
peekByteOff :: forall b. Ptr b -> Int -> IO ZooLogLevel
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooLogLevel -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ZooLogLevel -> IO ()
$cpeek :: Ptr ZooLogLevel -> IO ZooLogLevel
peek :: Ptr ZooLogLevel -> IO ZooLogLevel
$cpoke :: Ptr ZooLogLevel -> ZooLogLevel -> IO ()
poke :: Ptr ZooLogLevel -> ZooLogLevel -> IO ()
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 $mZooLogError :: forall {r}. ZooLogLevel -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooLogError :: ZooLogLevel
ZooLogError = ZooLogLevel (1)
{-# LINE 63 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooLogWarn  = ZooLogLevel (2)
{-# LINE 64 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooLogInfo  = ZooLogLevel (3)
{-# LINE 65 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooLogDebug = ZooLogLevel (4)
{-# LINE 66 "src/ZooKeeper/Internal/Types.hsc" #-}

-- | Disable logging
pattern ZooLogSilence :: ZooLogLevel
pattern $mZooLogSilence :: forall {r}. ZooLogLevel -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooLogSilence :: ZooLogLevel
ZooLogSilence = ZooLogLevel 0

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

-- | 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
$c== :: ZooPerm -> ZooPerm -> Bool
== :: ZooPerm -> ZooPerm -> Bool
$c/= :: ZooPerm -> ZooPerm -> Bool
/= :: 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
$c.&. :: ZooPerm -> ZooPerm -> ZooPerm
.&. :: ZooPerm -> ZooPerm -> ZooPerm
$c.|. :: ZooPerm -> ZooPerm -> ZooPerm
.|. :: ZooPerm -> ZooPerm -> ZooPerm
$cxor :: ZooPerm -> ZooPerm -> ZooPerm
xor :: ZooPerm -> ZooPerm -> ZooPerm
$ccomplement :: ZooPerm -> ZooPerm
complement :: ZooPerm -> ZooPerm
$cshift :: ZooPerm -> Int -> ZooPerm
shift :: ZooPerm -> Int -> ZooPerm
$crotate :: ZooPerm -> Int -> ZooPerm
rotate :: ZooPerm -> Int -> ZooPerm
$czeroBits :: ZooPerm
zeroBits :: ZooPerm
$cbit :: Int -> ZooPerm
bit :: Int -> ZooPerm
$csetBit :: ZooPerm -> Int -> ZooPerm
setBit :: ZooPerm -> Int -> ZooPerm
$cclearBit :: ZooPerm -> Int -> ZooPerm
clearBit :: ZooPerm -> Int -> ZooPerm
$ccomplementBit :: ZooPerm -> Int -> ZooPerm
complementBit :: ZooPerm -> Int -> ZooPerm
$ctestBit :: ZooPerm -> Int -> Bool
testBit :: ZooPerm -> Int -> Bool
$cbitSizeMaybe :: ZooPerm -> Maybe Int
bitSizeMaybe :: ZooPerm -> Maybe Int
$cbitSize :: ZooPerm -> Int
bitSize :: ZooPerm -> Int
$cisSigned :: ZooPerm -> Bool
isSigned :: ZooPerm -> Bool
$cshiftL :: ZooPerm -> Int -> ZooPerm
shiftL :: ZooPerm -> Int -> ZooPerm
$cunsafeShiftL :: ZooPerm -> Int -> ZooPerm
unsafeShiftL :: ZooPerm -> Int -> ZooPerm
$cshiftR :: ZooPerm -> Int -> ZooPerm
shiftR :: ZooPerm -> Int -> ZooPerm
$cunsafeShiftR :: ZooPerm -> Int -> ZooPerm
unsafeShiftR :: ZooPerm -> Int -> ZooPerm
$crotateL :: ZooPerm -> Int -> ZooPerm
rotateL :: ZooPerm -> Int -> ZooPerm
$crotateR :: ZooPerm -> Int -> ZooPerm
rotateR :: ZooPerm -> Int -> ZooPerm
$cpopCount :: ZooPerm -> Int
popCount :: ZooPerm -> Int
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 => a -> ShowS
showHex CInt
x String
""

pattern ZooPermRead, ZooPermWrite, ZooPermCreate, ZooPermDelete, ZooPermAdmin :: ZooPerm
pattern $mZooPermRead :: forall {r}. ZooPerm -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooPermRead :: ZooPerm
ZooPermRead   = ZooPerm (1)
{-# LINE 88 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermWrite  = ZooPerm (2)
{-# LINE 89 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermCreate = ZooPerm (4)
{-# LINE 90 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermDelete = ZooPerm (8)
{-# LINE 91 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooPermAdmin  = ZooPerm (16)
{-# LINE 92 "src/ZooKeeper/Internal/Types.hsc" #-}

pattern ZooPermAll :: ZooPerm
pattern $mZooPermAll :: forall {r}. ZooPerm -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooPermAll :: ZooPerm
ZooPermAll = ZooPerm (31)
{-# LINE 95 "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 a b. (a -> b -> b) -> b -> [a] -> b
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
$cshowsPrec :: Int -> ZooAcl -> ShowS
showsPrec :: Int -> ZooAcl -> ShowS
$cshow :: ZooAcl -> String
show :: ZooAcl -> String
$cshowList :: [ZooAcl] -> ShowS
showList :: [ZooAcl] -> ShowS
Show, ZooAcl -> ZooAcl -> Bool
(ZooAcl -> ZooAcl -> Bool)
-> (ZooAcl -> ZooAcl -> Bool) -> Eq ZooAcl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZooAcl -> ZooAcl -> Bool
== :: ZooAcl -> ZooAcl -> Bool
$c/= :: ZooAcl -> ZooAcl -> Bool
/= :: ZooAcl -> ZooAcl -> Bool
Eq)

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

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
$cshowsPrec :: Int -> AclVector -> ShowS
showsPrec :: Int -> AclVector -> ShowS
$cshow :: AclVector -> String
show :: AclVector -> String
$cshowList :: [AclVector] -> ShowS
showList :: [AclVector] -> ShowS
Show, AclVector -> AclVector -> Bool
(AclVector -> AclVector -> Bool)
-> (AclVector -> AclVector -> Bool) -> Eq AclVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AclVector -> AclVector -> Bool
== :: AclVector -> AclVector -> Bool
$c/= :: AclVector -> AclVector -> Bool
/= :: AclVector -> AclVector -> Bool
Eq)

peekAclVector :: AclVector -> IO [ZooAcl]
peekAclVector :: AclVector -> IO [ZooAcl]
peekAclVector p :: AclVector
p@(AclVector Ptr ()
ptr) = (IO [ZooAcl] -> IO () -> IO [ZooAcl])
-> IO () -> IO [ZooAcl] -> IO [ZooAcl]
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO [ZooAcl] -> IO () -> IO [ZooAcl]
forall a b. IO a -> IO b -> IO a
finally (AclVector -> IO ()
free_acl_vector AclVector
p) (IO [ZooAcl] -> IO [ZooAcl]) -> IO [ZooAcl] -> IO [ZooAcl]
forall a b. (a -> b) -> a -> b
$ do
  Int
count <- 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 b. Ptr b -> 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] $ peekAclVectorIdx data_ptr

peekAclVectorIdx :: Ptr ZooAcl -> Int -> IO ZooAcl
peekAclVectorIdx :: Ptr ZooAcl -> Int -> IO ZooAcl
peekAclVectorIdx Ptr ZooAcl
ptr Int
offset = do
  let ptr' :: Ptr b
ptr' = Ptr ZooAcl
ptr Ptr ZooAcl -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeOfZooAcl)
  [ZooPerm]
perms <- CInt -> [ZooPerm]
toZooPerms (CInt -> [ZooPerm]) -> IO CInt -> IO [ZooPerm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
0)) Ptr Any
forall {b}. Ptr b
ptr'
{-# LINE 137 "src/ZooKeeper/Internal/Types.hsc" #-}
  scheme_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr'
{-# LINE 138 "src/ZooKeeper/Internal/Types.hsc" #-}
  id_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr'
{-# LINE 139 "src/ZooKeeper/Internal/Types.hsc" #-}
  scheme <- CBytes.fromCString scheme_ptr
  CBytes
acl_id <- Ptr CChar -> IO CBytes
CBytes.fromCString Ptr CChar
id_ptr
  ZooAcl -> IO ZooAcl
forall a. a -> IO a
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

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

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

foreign import ccall unsafe "free_acl_vector"
  free_acl_vector :: AclVector -> IO ()

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

-- | 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
$c== :: ZooInterest -> ZooInterest -> Bool
== :: ZooInterest -> ZooInterest -> Bool
$c/= :: ZooInterest -> ZooInterest -> Bool
/= :: ZooInterest -> ZooInterest -> Bool
Eq, 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
$csizeOf :: ZooInterest -> Int
sizeOf :: ZooInterest -> Int
$calignment :: ZooInterest -> Int
alignment :: ZooInterest -> Int
$cpeekElemOff :: Ptr ZooInterest -> Int -> IO ZooInterest
peekElemOff :: Ptr ZooInterest -> Int -> IO ZooInterest
$cpokeElemOff :: Ptr ZooInterest -> Int -> ZooInterest -> IO ()
pokeElemOff :: Ptr ZooInterest -> Int -> ZooInterest -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooInterest
peekByteOff :: forall b. Ptr b -> Int -> IO ZooInterest
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooInterest -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ZooInterest -> IO ()
$cpeek :: Ptr ZooInterest -> IO ZooInterest
peek :: Ptr ZooInterest -> IO ZooInterest
$cpoke :: Ptr ZooInterest -> ZooInterest -> IO ()
poke :: Ptr ZooInterest -> ZooInterest -> IO ()
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 $mZookeeperWrite :: forall {r}. ZooInterest -> ((# #) -> r) -> ((# #) -> r) -> r
$bZookeeperWrite :: ZooInterest
ZookeeperWrite = ZooInterest (1)
{-# LINE 185 "src/ZooKeeper/Internal/Types.hsc" #-}

pattern ZookeeperRead :: ZooInterest
pattern $mZookeeperRead :: forall {r}. ZooInterest -> ((# #) -> r) -> ((# #) -> r) -> r
$bZookeeperRead :: ZooInterest
ZookeeperRead = ZooInterest (2)
{-# LINE 188 "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
$c== :: ZooState -> ZooState -> Bool
== :: ZooState -> ZooState -> Bool
$c/= :: ZooState -> ZooState -> Bool
/= :: ZooState -> ZooState -> Bool
Eq, 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
$csizeOf :: ZooState -> Int
sizeOf :: ZooState -> Int
$calignment :: ZooState -> Int
alignment :: ZooState -> Int
$cpeekElemOff :: Ptr ZooState -> Int -> IO ZooState
peekElemOff :: Ptr ZooState -> Int -> IO ZooState
$cpokeElemOff :: Ptr ZooState -> Int -> ZooState -> IO ()
pokeElemOff :: Ptr ZooState -> Int -> ZooState -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooState
peekByteOff :: forall b. Ptr b -> Int -> IO ZooState
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooState -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ZooState -> IO ()
$cpeek :: Ptr ZooState -> IO ZooState
peek :: Ptr ZooState -> IO ZooState
$cpoke :: Ptr ZooState -> ZooState -> IO ()
poke :: Ptr ZooState -> ZooState -> IO ()
Storable)
  deriving newtype (Int -> ZooState -> Builder ()
(Int -> ZooState -> Builder ()) -> Print ZooState
forall a. (Int -> a -> Builder ()) -> Print a
$ctoUTF8BuilderP :: Int -> ZooState -> Builder ()
toUTF8BuilderP :: 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
ZooReadonlyState     = String
"ReadonlyState"
  show ZooState
ZooNotconnectedState = String
"NotconnectedState"
  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 $mZooExpiredSession :: forall {r}. ZooState -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooExpiredSession :: ZooState
ZooExpiredSession   = ZooState (-112)
{-# LINE 213 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooAuthFailed       = ZooState (-113)
{-# LINE 214 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooConnectingState  = ZooState (1)
{-# LINE 215 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooAssociatingState = ZooState (2)
{-# LINE 216 "src/ZooKeeper/Internal/Types.hsc" #-}
pattern ZooConnectedState   = ZooState (3)
{-# LINE 217 "src/ZooKeeper/Internal/Types.hsc" #-}

-- This a trick to determine whether the C library expose the following apis.
--
-- ZOO_VERSION was introduced by ZOOKEEPER-3635 (3.6.0-pre). Also version after
-- 3.6 exports the following states.

{-# LINE 231 "src/ZooKeeper/Internal/Types.hsc" #-}
-- Hardcode for zookeeper-3.4

pattern ZooReadonlyState :: ZooState
pattern $mZooReadonlyState :: forall {r}. ZooState -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooReadonlyState :: ZooState
ZooReadonlyState = ZooState 5

pattern ZooNotconnectedState :: ZooState
pattern $mZooNotconnectedState :: forall {r}. ZooState -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooNotconnectedState :: ZooState
ZooNotconnectedState = ZooState 999


{-# LINE 240 "src/ZooKeeper/Internal/Types.hsc" #-}

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

-- | 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
$c== :: ZooEvent -> ZooEvent -> Bool
== :: ZooEvent -> ZooEvent -> Bool
$c/= :: ZooEvent -> ZooEvent -> Bool
/= :: ZooEvent -> ZooEvent -> Bool
Eq, 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
$csizeOf :: ZooEvent -> Int
sizeOf :: ZooEvent -> Int
$calignment :: ZooEvent -> Int
alignment :: ZooEvent -> Int
$cpeekElemOff :: Ptr ZooEvent -> Int -> IO ZooEvent
peekElemOff :: Ptr ZooEvent -> Int -> IO ZooEvent
$cpokeElemOff :: Ptr ZooEvent -> Int -> ZooEvent -> IO ()
pokeElemOff :: Ptr ZooEvent -> Int -> ZooEvent -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ZooEvent
peekByteOff :: forall b. Ptr b -> Int -> IO ZooEvent
$cpokeByteOff :: forall b. Ptr b -> Int -> ZooEvent -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ZooEvent -> IO ()
$cpeek :: Ptr ZooEvent -> IO ZooEvent
peek :: Ptr ZooEvent -> IO ZooEvent
$cpoke :: Ptr ZooEvent -> ZooEvent -> IO ()
poke :: Ptr ZooEvent -> ZooEvent -> IO ()
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 $mZooCreateEvent :: forall {r}. ZooEvent -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooCreateEvent :: ZooEvent
ZooCreateEvent = ZooEvent (1)
{-# LINE 265 "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 $mZooDeleteEvent :: forall {r}. ZooEvent -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooDeleteEvent :: ZooEvent
ZooDeleteEvent = ZooEvent (2)
{-# LINE 272 "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 $mZooChangedEvent :: forall {r}. ZooEvent -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooChangedEvent :: ZooEvent
ZooChangedEvent = ZooEvent (3)
{-# LINE 279 "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 $mZooChildEvent :: forall {r}. ZooEvent -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooChildEvent :: ZooEvent
ZooChildEvent = ZooEvent (4)
{-# LINE 286 "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 $mZooSessionEvent :: forall {r}. ZooEvent -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooSessionEvent :: ZooEvent
ZooSessionEvent = ZooEvent (-1)
{-# LINE 292 "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 $mZooNoWatchingEvent :: forall {r}. ZooEvent -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooNoWatchingEvent :: ZooEvent
ZooNoWatchingEvent = ZooEvent (-2)
{-# LINE 299 "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
$cshowsPrec :: Int -> CreateMode -> ShowS
showsPrec :: Int -> CreateMode -> ShowS
$cshow :: CreateMode -> String
show :: CreateMode -> String
$cshowList :: [CreateMode] -> ShowS
showList :: [CreateMode] -> ShowS
Show, CreateMode -> CreateMode -> Bool
(CreateMode -> CreateMode -> Bool)
-> (CreateMode -> CreateMode -> Bool) -> Eq CreateMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateMode -> CreateMode -> Bool
== :: CreateMode -> CreateMode -> Bool
$c/= :: CreateMode -> CreateMode -> Bool
/= :: CreateMode -> CreateMode -> Bool
Eq, 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
$csizeOf :: CreateMode -> Int
sizeOf :: CreateMode -> Int
$calignment :: CreateMode -> Int
alignment :: CreateMode -> Int
$cpeekElemOff :: Ptr CreateMode -> Int -> IO CreateMode
peekElemOff :: Ptr CreateMode -> Int -> IO CreateMode
$cpokeElemOff :: Ptr CreateMode -> Int -> CreateMode -> IO ()
pokeElemOff :: Ptr CreateMode -> Int -> CreateMode -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CreateMode
peekByteOff :: forall b. Ptr b -> Int -> IO CreateMode
$cpokeByteOff :: forall b. Ptr b -> Int -> CreateMode -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> CreateMode -> IO ()
$cpeek :: Ptr CreateMode -> IO CreateMode
peek :: Ptr CreateMode -> IO CreateMode
$cpoke :: Ptr CreateMode -> CreateMode -> IO ()
poke :: Ptr CreateMode -> CreateMode -> IO ()
Storable)

-- This a trick to determine whether the C library expose the following apis.
--
-- ZOO_VERSION was introduced by ZOOKEEPER-3635 (3.6.0-pre).
--
-- The following C constants (such as ZOO_PERSISTENT, ZOO_PERSISTENT_SEQUENTIAL
-- and ZOO_EPTHMERAL_SEQUENTIAL) are not defined on clients <= 3.4.x.

{-# LINE 333 "src/ZooKeeper/Internal/Types.hsc" #-}

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

pattern ZooPersistentSequential :: CreateMode
pattern $mZooPersistentSequential :: forall {r}. CreateMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooPersistentSequential :: CreateMode
ZooPersistentSequential = CreateMode 2

pattern ZooEphemeralSequential :: CreateMode
pattern $mZooEphemeralSequential :: forall {r}. CreateMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooEphemeralSequential :: CreateMode
ZooEphemeralSequential = CreateMode 3

pattern ZooContainer :: CreateMode
pattern $mZooContainer :: forall {r}. CreateMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooContainer :: CreateMode
ZooContainer = CreateMode 4

pattern ZooPersistentWithTTL :: CreateMode
pattern $mZooPersistentWithTTL :: forall {r}. CreateMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooPersistentWithTTL :: CreateMode
ZooPersistentWithTTL = CreateMode 5

pattern ZooPersistentSequentialWithTTL :: CreateMode
pattern $mZooPersistentSequentialWithTTL :: forall {r}. CreateMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bZooPersistentSequentialWithTTL :: CreateMode
ZooPersistentSequentialWithTTL = CreateMode 6


{-# LINE 353 "src/ZooKeeper/Internal/Types.hsc" #-}

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

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

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
$cshowsPrec :: Int -> Stat -> ShowS
showsPrec :: Int -> Stat -> ShowS
$cshow :: Stat -> String
show :: Stat -> String
$cshowList :: [Stat] -> ShowS
showList :: [Stat] -> ShowS
Show, Stat -> Stat -> Bool
(Stat -> Stat -> Bool) -> (Stat -> Stat -> Bool) -> Eq Stat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stat -> Stat -> Bool
== :: Stat -> Stat -> Bool
$c/= :: Stat -> Stat -> Bool
/= :: Stat -> Stat -> Bool
Eq)

statSize :: Int
statSize :: Int
statSize = ((Int
72))
{-# LINE 377 "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 b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Stat
hsc_ptr Int
0)) Ptr Stat
ptr
{-# LINE 381 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 382 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 383 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 384 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 385 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
{-# LINE 386 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 387 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 388 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
{-# LINE 389 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 60)) ptr
{-# LINE 390 "src/ZooKeeper/Internal/Types.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
{-# LINE 391 "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 a b. IO a -> IO b -> IO a
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
$cshowsPrec :: Int -> StringVector -> ShowS
showsPrec :: Int -> StringVector -> ShowS
$cshow :: StringVector -> String
show :: StringVector -> String
$cshowList :: [StringVector] -> ShowS
showList :: [StringVector] -> ShowS
Show

-- Peek a StringVector from point and then free the pointer
peekStringVector :: Ptr StringVector -> IO StringVector
peekStringVector :: Ptr StringVector -> IO StringVector
peekStringVector Ptr StringVector
ptr = (IO StringVector -> IO () -> IO StringVector)
-> IO () -> IO StringVector -> IO StringVector
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO StringVector -> IO () -> IO StringVector
forall a b. IO a -> IO b -> IO a
finally (Ptr StringVector -> IO ()
free_string_vector 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 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 b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StringVector
hsc_ptr Int
0)) Ptr StringVector
ptr
{-# LINE 403 "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 b. Ptr b -> 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 408 "src/ZooKeeper/Internal/Types.hsc" #-}
  data_ptr <- peek $ ptr' `plusPtr` (offset * (sizeOf ptr'))
  Ptr CChar -> IO CBytes
CBytes.fromCString Ptr CChar
data_ptr  -- this will do a copy

foreign import ccall unsafe "free_string_vector"
  free_string_vector :: Ptr StringVector -> IO ()

-------------------------------------------------------------------------------
-- 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
$cshowsPrec :: Int -> HsWatcherCtx -> ShowS
showsPrec :: Int -> HsWatcherCtx -> ShowS
$cshow :: HsWatcherCtx -> String
show :: HsWatcherCtx -> String
$cshowList :: [HsWatcherCtx] -> ShowS
showList :: [HsWatcherCtx] -> ShowS
Show

hsWatcherCtxSize :: Int
hsWatcherCtxSize :: Int
hsWatcherCtxSize = ((Int
40))
{-# LINE 426 "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 b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr HsWatcherCtx
hsc_ptr Int
16)) Ptr HsWatcherCtx
ptr
{-# LINE 430 "src/ZooKeeper/Internal/Types.hsc" #-}
  event_type <-((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 431 "src/ZooKeeper/Internal/Types.hsc" #-}
  connect_state <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 432 "src/ZooKeeper/Internal/Types.hsc" #-}
  path_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 433 "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 a. a -> IO a
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
$cshowsPrec :: Int -> StringCompletion -> ShowS
showsPrec :: Int -> StringCompletion -> ShowS
$cshow :: StringCompletion -> String
show :: StringCompletion -> String
$cshowList :: [StringCompletion] -> ShowS
showList :: [StringCompletion] -> ShowS
Show

instance Completion StringCompletion where
  csize :: Int
csize = ((Int
32))
{-# 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
    value_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 452 "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
$cshowsPrec :: Int -> DataCompletion -> ShowS
showsPrec :: Int -> DataCompletion -> ShowS
$cshow :: DataCompletion -> String
show :: DataCompletion -> String
$cshowList :: [DataCompletion] -> ShowS
showList :: [DataCompletion] -> ShowS
Show, DataCompletion -> DataCompletion -> Bool
(DataCompletion -> DataCompletion -> Bool)
-> (DataCompletion -> DataCompletion -> Bool) -> Eq DataCompletion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataCompletion -> DataCompletion -> Bool
== :: DataCompletion -> DataCompletion -> Bool
$c/= :: DataCompletion -> DataCompletion -> Bool
/= :: DataCompletion -> DataCompletion -> Bool
Eq)

instance Completion DataCompletion where
  csize :: Int
csize = ((Int
48))
{-# LINE 462 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 463 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    val_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 465 "src/ZooKeeper/Internal/Types.hsc" #-}
    val_len :: CInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 466 "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 470 "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
$cshowsPrec :: Int -> StatCompletion -> ShowS
showsPrec :: Int -> StatCompletion -> ShowS
$cshow :: StatCompletion -> String
show :: StatCompletion -> String
$cshowList :: [StatCompletion] -> ShowS
showList :: [StatCompletion] -> ShowS
Show, StatCompletion -> StatCompletion -> Bool
(StatCompletion -> StatCompletion -> Bool)
-> (StatCompletion -> StatCompletion -> Bool) -> Eq StatCompletion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatCompletion -> StatCompletion -> Bool
== :: StatCompletion -> StatCompletion -> Bool
$c/= :: StatCompletion -> StatCompletion -> Bool
/= :: StatCompletion -> StatCompletion -> Bool
Eq)

instance Completion StatCompletion where
  csize :: Int
csize = ((Int
32))
{-# LINE 478 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 479 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 481 "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 488 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 489 "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
$cshowsPrec :: Int -> StringsCompletion -> ShowS
showsPrec :: Int -> StringsCompletion -> ShowS
$cshow :: StringsCompletion -> String
show :: StringsCompletion -> String
$cshowList :: [StringsCompletion] -> ShowS
showList :: [StringsCompletion] -> ShowS
Show

instance Completion StringsCompletion where
  csize :: Int
csize = ((Int
32))
{-# LINE 497 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 498 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    strs_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 500 "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
$cshowsPrec :: Int -> StringsStatCompletion -> ShowS
showsPrec :: Int -> StringsStatCompletion -> ShowS
$cshow :: StringsStatCompletion -> String
show :: StringsStatCompletion -> String
$cshowList :: [StringsStatCompletion] -> ShowS
showList :: [StringsStatCompletion] -> ShowS
Show

instance Completion StringsStatCompletion where
  csize :: Int
csize = ((Int
40))
{-# LINE 510 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 511 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    strs_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 513 "src/ZooKeeper/Internal/Types.hsc" #-}
    vals <- peekStringVector strs_ptr
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 515 "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
$cshowsPrec :: Int -> AclCompletion -> ShowS
showsPrec :: Int -> AclCompletion -> ShowS
$cshow :: AclCompletion -> String
show :: AclCompletion -> String
$cshowList :: [AclCompletion] -> ShowS
showList :: [AclCompletion] -> ShowS
Show

instance Completion AclCompletion where
  csize :: Int
csize = ((Int
40))
{-# LINE 525 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekRet ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 526 "src/ZooKeeper/Internal/Types.hsc" #-}
  peekData ptr = do
    acls <- peekAclVector . AclVector =<< ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 528 "src/ZooKeeper/Internal/Types.hsc" #-}
    stat_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 529 "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 539 "src/ZooKeeper/Internal/Types.hsc" #-}

zooOpResultSize :: Int
zooOpResultSize :: Int
zooOpResultSize = ((Int
32))
{-# LINE 542 "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
$cshowsPrec :: Int -> ZooOpResult -> ShowS
showsPrec :: Int -> ZooOpResult -> ShowS
$cshow :: ZooOpResult -> String
show :: ZooOpResult -> String
$cshowList :: [ZooOpResult] -> ShowS
showList :: [ZooOpResult] -> ShowS
Show, ZooOpResult -> ZooOpResult -> Bool
(ZooOpResult -> ZooOpResult -> Bool)
-> (ZooOpResult -> ZooOpResult -> Bool) -> Eq ZooOpResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZooOpResult -> ZooOpResult -> Bool
== :: ZooOpResult -> ZooOpResult -> Bool
$c/= :: ZooOpResult -> ZooOpResult -> Bool
/= :: 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 b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 565 "src/ZooKeeper/Internal/Types.hsc" #-}
  value <- CBytes.fromMutablePrimArray $ Z.MutablePrimArray ba#
  ZooOpResult -> IO ZooOpResult
forall a. a -> IO a
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 b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 570 "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 b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 574 "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 a. a -> IO a
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 b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CZooOpResult
hsc_ptr Int
0)) Ptr CZooOpResult
ptr
{-# LINE 580 "src/ZooKeeper/Internal/Types.hsc" #-}