api: add zooSetAcl

cbits/hs_zk.c

@@ -370,6 +370,15 @@ int hs_zoo_aget_acl(zhandle_t* zh, const char* path, HsStablePtr mvar,
   return zoo_aget_acl(zh, path, hs_acl_completion_fn, completion);
 }
 
+int hs_zoo_aset_acl(zhandle_t* zh, const char* path, int version,
+                    struct ACL_vector* acl, HsStablePtr mvar,
+                    HsInt cap, hs_void_completion_t* completion) {
+  completion->mvar = mvar;
+  completion->cap = cap;
+  return zoo_aset_acl(zh, path, version, acl, hs_void_completion_fn,
+                      completion);
+}
+
 int hs_zoo_amulti(zhandle_t* zh, int count, const zoo_op_t* ops,
                   zoo_op_result_t* results, HsStablePtr mvar, HsInt cap,
                   hs_void_completion_t* void_completion) {

include/hs_zk.h

@@ -126,6 +126,10 @@ zhandle_t* hs_zookeeper_init(HsStablePtr mvar, HsInt cap,
 int hs_zoo_aget_acl(zhandle_t* zh, const char* path, HsStablePtr mvar,
                     HsInt cap, hs_acl_completion_t* completion);
 
+int hs_zoo_aset_acl(zhandle_t* zh, const char* path, int version,
+                    struct ACL_vector* acl, HsStablePtr mvar, HsInt cap,
+                    hs_void_completion_t* completion);
+
 int hs_zoo_acreate(zhandle_t* zh, const char* path, const char* value,
                    HsInt offset, HsInt valuelen, const struct ACL_vector* acl,
                    int mode, HsStablePtr mvar, HsInt cap,

src/ZooKeeper.hs

@@ -18,6 +18,9 @@ module ZooKeeper
   , zooExists
   , zooWatchExists
   , zooGetAcl
+  , zooSetAcl
+  , unsafeAllocaZooAcl
+  , fromAclList
 
   , zooMulti
   , zooCreateOpInit
@@ -37,13 +40,14 @@ module ZooKeeper
 import           Control.Concurrent       (forkIO, myThreadId, newEmptyMVar,
                                            takeMVar, threadCapability)
 import           Control.Exception        (mask_, onException)
-import           Control.Monad            (void, when, zipWithM, (<=<))
+import           Control.Monad            (void, when, zipWithM, (<=<), forM_)
 import           Data.Bifunctor           (first)
 import           Data.Maybe               (fromMaybe)
 import           Foreign.C                (CInt)
 import           Foreign.ForeignPtr       (mallocForeignPtrBytes,
                                            touchForeignPtr, withForeignPtr)
 import           Foreign.Ptr              (Ptr, nullPtr, plusPtr)
+import           Foreign                  (Storable(sizeOf))
 import           GHC.Conc                 (newStablePtrPrimMVar)
 import           GHC.Stack                (HasCallStack, callStack)
 import           Z.Data.CBytes            (CBytes)
@@ -488,6 +492,75 @@ zooGetAcl zh path = CBytes.withCBytesUnsafe path $ \path' -> do
       cfunc = I.c_hs_zoo_aget_acl zh path'
    in E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc
 
+-- | Sets the acl associated with a node.
+--
+-- Throw one of the following exceptions on failure:
+--
+-- ZBADARGUMENTS - invalid input parameters
+-- ZINVALIDSTATE - zhandle state is either ZOO_SESSION_EXPIRED_STATE or ZOO_AUTH_FAILED_STATE
+-- ZMARSHALLINGERROR - failed to marshall a request; possibly, out of memory
+zooSetAcl
+  :: HasCallStack
+  => T.ZHandle
+  -- ^ The zookeeper handle obtained by a call to 'zookeeperResInit'
+  -> CBytes
+  -- ^ The name of the node. Expressed as a file name with slashes
+  -- separating ancestors of the node.
+  -> Maybe T.AclVector
+  -- ^ The acl to be set on the path
+  -> Maybe CInt
+  -- ^ The expected version of the path
+  -> IO T.VoidCompletion
+  -- ^ The result when the request completes
+  --
+  -- Throw one of the following exceptions if the request completes failed:
+  --
+  -- * ZNONODE the node does not exist.
+  -- * ZNOAUTH the client does not have permission.
+  -- * ZINVALIDACL invalid ACL specified
+  -- * ZBADVERSION expected version does not match actual version.
+zooSetAcl zh path m_acl m_version = CBytes.withCBytesUnsafe path $ \path' -> do
+  let csize = I.csize @T.VoidCompletion
+      version = fromMaybe (-1) m_version
+  case m_acl of
+    Just acl -> do
+      let cfunc = I.c_hs_zoo_aset_acl zh path' version acl
+      E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc
+    Nothing -> do
+      let cfunc = I.c_hs_zoo_aset_acl' zh path' version nullPtr
+      E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc
+
+unsafeAllocaZooAcl :: I.ZooAcl -> IO Z.ByteArray
+unsafeAllocaZooAcl (I.ZooAcl acl_perms acl_scheme acl_id) = do
+  mba <- Z.newPinnedByteArray I.sizeOfZooAcl
+  mba_scheme@(Z.MutableByteArray mba_scheme#) <- Z.newPinnedByteArray (CBytes.length acl_scheme)
+  mba_id@(Z.MutableByteArray mba_id#) <- Z.newPinnedByteArray (CBytes.length acl_id)
+  let ptr_scheme = Z.mutableByteArrayContents mba_scheme
+      ptr_id = Z.mutableByteArrayContents mba_id
+  CBytes.pokeMBACBytes mba_scheme# 0 acl_scheme
+  CBytes.pokeMBACBytes mba_id# 0 acl_id
+  Z.writeByteArray mba 0 $ I.fromZooPerms acl_perms
+  Z.writeByteArray mba 1 ptr_scheme
+  Z.writeByteArray mba 2 ptr_id
+  Z.freezeByteArray mba 0 I.sizeOfZooAcl
+
+fromAclList :: [I.ZooAcl] -> IO I.AclVector
+fromAclList acls = do
+  let len = length acls
+  mba_data <- Z.newPinnedByteArray (I.sizeOfZooAcl * len)
+  forM_ (zip [0..] acls) $ \(idx, acl) -> do
+    ba_acl <- unsafeAllocaZooAcl acl
+    Z.copyByteArray mba_data (idx * I.sizeOfZooAcl) ba_acl 0 I.sizeOfZooAcl
+  let ptr_data = Z.mutableByteArrayContents mba_data
+  -- sizeOf len = 8 and sizeOf ptr_data = 8
+  mba <- Z.newPinnedByteArray (sizeOf len + sizeOf ptr_data)
+  Z.writeByteArray mba 0 len
+  -- writeByteArray calculates the offset based on the type of the elements to
+  -- write instead of bytes. So we rely on the fact that pointers and integers
+  -- have the same length
+  Z.writeByteArray mba 1 ptr_data
+  return . I.AclVector . Z.castPtr . Z.mutableByteArrayContents $ mba
+
 -------------------------------------------------------------------------------
 
 -- | Atomically commits multiple zookeeper operations.
@@ -499,7 +572,7 @@ zooMulti
   => T.ZHandle
   -- ^ The zookeeper handle obtained by a call to 'zookeeperResInit'
   -> [T.ZooOp]
-  -- ^ An list of operations to commit
+  -- ^ A list of operations to commit
   -> IO [T.ZooOpResult]
 zooMulti zh ops = do
   let len = length ops

src/ZooKeeper/Internal/FFI.hsc

@@ -71,6 +71,24 @@ foreign import ccall unsafe "hs_zk.h hs_zoo_aget_acl"
     -> StablePtr PrimMVar -> Int -> Ptr AclCompletion
     -> IO CInt
 
+foreign import ccall unsafe "hs_zk.h hs_zoo_aset_acl"
+  c_hs_zoo_aset_acl
+    :: ZHandle
+    -> BA## Word8
+    -> CInt
+    -> AclVector
+    -> StablePtr PrimMVar -> Int -> Ptr VoidCompletion
+    -> IO CInt
+
+foreign import ccall unsafe "hs_zk.h hs_zoo_aset_acl"
+  c_hs_zoo_aset_acl'
+    :: ZHandle
+    -> BA## Word8
+    -> CInt
+    -> Ptr CChar
+    -> StablePtr PrimMVar -> Int -> Ptr VoidCompletion
+    -> IO CInt
+
 foreign import ccall unsafe "hs_zk.h hs_zoo_acreate"
   c_hs_zoo_acreate
     :: ZHandle

src/ZooKeeper/Internal/Types.hsc

@@ -88,7 +88,7 @@ data ZooAcl = ZooAcl
   { aclPerms    :: [ZooPerm]
   , aclIdScheme :: CBytes
   , aclId       :: CBytes
-  } deriving Show
+  } deriving (Show, Eq)
 
 {-# INLINE sizeOfZooAcl #-}
 sizeOfZooAcl :: Int
@@ -99,13 +99,16 @@ peekZooAcl ptr = do
   perms <- toZooPerms <$> (#peek acl_t, perms) ptr
   scheme_ptr <- (#peek acl_t, id.scheme) ptr
   id_ptr <- (#peek acl_t, id.id) ptr
-  scheme <- CBytes.fromCString scheme_ptr <* free scheme_ptr
-  acl_id <- CBytes.fromCString id_ptr <* free id_ptr
+  -- scheme <- CBytes.fromCString scheme_ptr <* free scheme_ptr
+  -- acl_id <- CBytes.fromCString id_ptr <* free id_ptr
+  -- we can't do the free for some reason I don't know
+  scheme <- CBytes.fromCString scheme_ptr
+  acl_id <- CBytes.fromCString id_ptr
   return $ ZooAcl perms scheme acl_id
 
 -- TODO
-unsafeAllocaZooAcl :: ZooAcl -> IO Z.ByteArray
-unsafeAllocaZooAcl = undefined
+-- unsafeAllocaZooAcl :: ZooAcl -> IO Z.ByteArray
+-- unsafeAllocaZooAcl = undefined
 
 -- FIXME: consider this
 -- data AclVector = AclVector (Ptr ()) | AclList [ZooAcl]
@@ -133,8 +136,8 @@ toAclList (AclVector ptr) = do
     peekZooAcl data_ptr'
 
 -- TODO
-fromAclList :: [ZooAcl] -> IO AclVector
-fromAclList = undefined
+-- fromAclList :: [ZooAcl] -> IO AclVector
+-- fromAclList = undefined
 
 -------------------------------------------------------------------------------
 

src/ZooKeeper/Types.hs

@@ -10,6 +10,8 @@ module ZooKeeper.Types
   , I.zooReadAclUnsafe
   , I.zooCreatorAllAcl
   , I.ZooAcl (..)
+  , I.toAclList
+  , I.peekZooAcl
 
   , I.HsWatcherCtx (..)
 

test/Spec.hs

@@ -22,6 +22,17 @@ main = withResource client $ \zh -> do
   hspec $ opSpec zh
   hspec $ multiOpSpec zh
   hspec $ propSpec zh
+  hspec aclSpec
+
+aclSpec :: Spec
+aclSpec = do
+  describe "test acl memory allocation" $
+    it "copy ZooAcl back and forth" $ do
+      let acl1 = ZooAcl [ZooPermRead, ZooPermWrite] "scheme1" "id1"
+          acl2 = ZooAcl [ZooPermCreate, ZooPermDelete] "scheme2" "id2"
+          acls = [acl1, acl2]
+      ptr <- fromAclList acls
+      toAclList ptr `shouldReturn` acls
 
 opSpec :: ZHandle -> Spec
 opSpec zh = do
@@ -86,6 +97,13 @@ opSpec zh = do
       compactZooPerms . aclPerms . head . aclCompletionAcls <$> zooGetAcl zh "/acl2"
         `shouldReturn` ZooPermAll
 
+  describe "ZooKeeper.zooSetAcl" $ do
+    it "set acl permission" $ do
+      void $ zooCreate zh "/acl3" Nothing zooOpenAclUnsafe ZooEphemeral
+      void $ zooSetAcl zh "/acl3" (Just zooReadAclUnsafe) Nothing
+      compactZooPerms . aclPerms . head . aclCompletionAcls <$> zooGetAcl zh "/acl3"
+        `shouldReturn` ZooPermRead
+
 propSpec :: ZHandle -> Spec
 propSpec zh = do
   describe "ZooKeeper.zooState" $ do