zoovisitor (empty) → 0.1.0.0
raw patch · 14 files changed
+2697/−0 lines, 14 filesdep +Z-Datadep +Z-IOdep +basesetup-changed
Dependencies added: Z-Data, Z-IO, base, hspec, zoovisitor
Files
- ChangeLog.md +3/−0
- LICENSE +32/−0
- LICENSE_ZOOKEEPER +202/−0
- README.md +24/−0
- Setup.hs +2/−0
- cbits/hs_zk.c +352/−0
- include/hs_zk.h +152/−0
- src/ZooKeeper.hs +654/−0
- src/ZooKeeper/Exception.hs +330/−0
- src/ZooKeeper/Internal/FFI.hsc +267/−0
- src/ZooKeeper/Internal/Types.hsc +442/−0
- src/ZooKeeper/Types.hs +51/−0
- test/Spec.hs +97/−0
- zoovisitor.cabal +89/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for zoovisitor++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,32 @@+BSD 3-Clause License++Copyright (c)++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of mu nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ LICENSE_ZOOKEEPER view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,24 @@+ZooVisitor+==========++An Apache [zookeeper](https://zookeeper.apache.org/) client for Haskell.++Tested on zookeeper 3.4, a higher version should work but not guaranteed.++**NOTE: this library is still in development.**+++## Features++- Simple+ + Does not require knowledge of the C APIs+ + Does not require malloc and free memory manually+ + High-level api written in Haskell++- Safe+ + Type safe+ + A failure action should throw an exception++- Fast+ + All underlying calls are non-blocking, you can use Haskell lightweight threads to speed up your tasks.+ + The speed should be compatible to C implementation
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/hs_zk.c view
@@ -0,0 +1,352 @@+#include "hs_zk.h"++// ----------------------------------------------------------------------------+// Callback Functions+// ----------------------------------------------------------------------------++void hs_zookeeper_watcher_fn(zhandle_t* zh, int type, int state,+ const char* path, void* watcherCtx) {+ hs_watcher_ctx_t* watcher_ctx = (hs_watcher_ctx_t*)watcherCtx;+ watcher_ctx->zh = zh;+ watcher_ctx->type = type;+ watcher_ctx->state = state;+ watcher_ctx->path = strdup(path);+ hs_try_putmvar(watcher_ctx->cap, watcher_ctx->mvar);+ hs_thread_done();+}++/**+ * \brief signature of a completion function that returns a list of strings.+ *+ * This method will be invoked at the end of a asynchronous call and also as+ * a result of connection loss or timeout.+ * \param rc the error code of the call. Connection loss/timeout triggers+ * the completion with one of the following error codes:+ * ZCONNECTIONLOSS -- lost connection to the server+ * ZOPERATIONTIMEOUT -- connection timed out+ * Data related events trigger the completion with error codes listed the+ * Exceptions section of the documentation of the function that initiated the+ * call. (Zero indicates call was successful.)+ * \param value the value of the string returned.+ * \param data the pointer that was passed by the caller when the function+ * that this completion corresponds to was invoked. The programmer+ * is responsible for any memory freeing associated with the data+ * pointer.+ */+void hs_string_completion_fn(int rc, const char* value, const void* data) {+ hs_string_completion_t* string_completion = (hs_string_completion_t*)data;+ string_completion->rc = rc;+ if (!rc) {+ string_completion->value = strdup(value);+ }+ hs_try_putmvar(string_completion->cap, string_completion->mvar);+ hs_thread_done();+}++/**+ * \brief signature of a completion function that returns data.+ *+ * This method will be invoked at the end of a asynchronous call and also as+ * a result of connection loss or timeout.+ * \param rc the error code of the call. Connection loss/timeout triggers+ * the completion with one of the following error codes:+ * ZCONNECTIONLOSS -- lost connection to the server+ * ZOPERATIONTIMEOUT -- connection timed out+ * Data related events trigger the completion with error codes listed the+ * Exceptions section of the documentation of the function that initiated the+ * call. (Zero indicates call was successful.)+ * \param value the value of the information returned by the asynchronous call.+ * If a non zero error code is returned, the content of value is undefined.+ * The programmer is NOT responsible for freeing value.+ * \param value_len the number of bytes in value.+ * \param stat a pointer to the stat information for the node involved in+ * this function. If a non zero error code is returned, the content of+ * stat is undefined. The programmer is NOT responsible for freeing stat.+ * \param data the pointer that was passed by the caller when the function+ * that this completion corresponds to was invoked. The programmer+ * is responsible for any memory freeing associated with the data+ * pointer.+ */+void hs_data_completion_fn(int rc, const char* value, int value_len,+ const struct Stat* stat, const void* data) {+ hs_data_completion_t* data_completion = (hs_data_completion_t*)data;+ data_completion->rc = rc;+ if (!rc) {+ data_completion->value_len = value_len;+ if (value_len >= 0) {+ data_completion->value = strndup(value, value_len);+ }+ data_completion->stat = dup_stat(stat);+ }+ hs_try_putmvar(data_completion->cap, data_completion->mvar);+ hs_thread_done();+}++/**+ * \brief signature of a completion function that returns a Stat structure.+ *+ * This method will be invoked at the end of a asynchronous call and also as+ * a result of connection loss or timeout.+ * \param rc the error code of the call. Connection loss/timeout triggers+ * the completion with one of the following error codes:+ * ZCONNECTIONLOSS -- lost connection to the server+ * ZOPERATIONTIMEOUT -- connection timed out+ * Data related events trigger the completion with error codes listed the+ * Exceptions section of the documentation of the function that initiated the+ * call. (Zero indicates call was successful.)+ * \param stat a pointer to the stat information for the node involved in+ * this function. If a non zero error code is returned, the content of+ * stat is undefined. The programmer is NOT responsible for freeing stat.+ * \param data the pointer that was passed by the caller when the function+ * that this completion corresponds to was invoked. The programmer+ * is responsible for any memory freeing associated with the data+ * pointer.+ */+void hs_stat_completion_fn(int rc, const struct Stat* stat, const void* data) {+ hs_stat_completion_t* stat_completion = (hs_stat_completion_t*)data;+ stat_completion->rc = rc;+ if (!rc) {+ stat_completion->stat = dup_stat(stat);+ }+ hs_try_putmvar(stat_completion->cap, stat_completion->mvar);+ hs_thread_done();+}++/**+ * \brief signature of a completion function for a call that returns void.+ *+ * This method will be invoked at the end of a asynchronous call and also as+ * a result of connection loss or timeout.+ * \param rc the error code of the call. Connection loss/timeout triggers+ * the completion with one of the following error codes:+ * ZCONNECTIONLOSS -- lost connection to the server+ * ZOPERATIONTIMEOUT -- connection timed out+ * Data related events trigger the completion with error codes listed the+ * Exceptions section of the documentation of the function that initiated the+ * call. (Zero indicates call was successful.)+ * \param data the pointer that was passed by the caller when the function+ * that this completion corresponds to was invoked. The programmer+ * is responsible for any memory freeing associated with the data+ * pointer.+ */+void hs_void_completion_fn(int rc, const void* data) {+ hs_void_completion_t* void_completion = (hs_void_completion_t*)data;+ void_completion->rc = rc;+ hs_try_putmvar(void_completion->cap, void_completion->mvar);+ hs_thread_done();+}++/**+ * \brief signature of a completion function that returns a list of strings.+ *+ * This method will be invoked at the end of a asynchronous call and also as+ * a result of connection loss or timeout.+ * \param rc the error code of the call. Connection loss/timeout triggers+ * the completion with one of the following error codes:+ * ZCONNECTIONLOSS -- lost connection to the server+ * ZOPERATIONTIMEOUT -- connection timed out+ * Data related events trigger the completion with error codes listed the+ * Exceptions section of the documentation of the function that initiated the+ * call. (Zero indicates call was successful.)+ * \param strings a pointer to the structure containng the list of strings of+ * the names of the children of a node. If a non zero error code is returned,+ * the content of strings is undefined. The programmer is NOT responsible+ * for freeing strings.+ * \param data the pointer that was passed by the caller when the function+ * that this completion corresponds to was invoked. The programmer+ * is responsible for any memory freeing associated with the data+ * pointer.+ */+void hs_strings_completion_fn(int rc, const string_vector_t* strings,+ const void* data) {+ hs_strings_completion_t* strings_completion = (hs_strings_completion_t*)data;+ strings_completion->rc = rc;+ if (!rc) {+ strings_completion->strings = dup_string_vector(strings);+ }+ hs_try_putmvar(strings_completion->cap, strings_completion->mvar);+ hs_thread_done();+}++/**+ * \brief signature of a completion function that returns a list of strings and+ * stat.+ * .+ *+ * This method will be invoked at the end of a asynchronous call and also as+ * a result of connection loss or timeout.+ * \param rc the error code of the call. Connection loss/timeout triggers+ * the completion with one of the following error codes:+ * ZCONNECTIONLOSS -- lost connection to the server+ * ZOPERATIONTIMEOUT -- connection timed out+ * Data related events trigger the completion with error codes listed the+ * Exceptions section of the documentation of the function that initiated the+ * call. (Zero indicates call was successful.)+ * \param strings a pointer to the structure containng the list of strings of+ * the names of the children of a node. If a non zero error code is returned,+ * the content of strings is undefined. The programmer is NOT responsible+ * for freeing strings.+ * \param stat a pointer to the stat information for the node involved in+ * this function. If a non zero error code is returned, the content of+ * stat is undefined. The programmer is NOT responsible for freeing stat.+ * \param data the pointer that was passed by the caller when the function+ * that this completion corresponds to was invoked. The programmer+ * is responsible for any memory freeing associated with the data+ * pointer.+ */+void hs_strings_stat_completion_fn(int rc, const string_vector_t* strings,+ const struct Stat* stat, const void* data) {+ hs_strings_stat_completion_t* strings_stat =+ (hs_strings_stat_completion_t*)data;+ strings_stat->rc = rc;+ if (!rc) {+ strings_stat->strings = dup_string_vector(strings);+ strings_stat->stat = dup_stat(stat);+ }+ hs_try_putmvar(strings_stat->cap, strings_stat->mvar);+ hs_thread_done();+}++// ----------------------------------------------------------------------------++zhandle_t* hs_zookeeper_init(HsStablePtr mvar, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx, const char* host,+ int recv_timeout, const clientid_t* clientid,+ int flags) {+ watcher_ctx->mvar = mvar;+ watcher_ctx->cap = cap;+ zhandle_t* zh = zookeeper_init(host, hs_zookeeper_watcher_fn, recv_timeout,+ clientid, watcher_ctx, flags);+ return zh;+}++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,+ hs_string_completion_t* string_completion) {+ string_completion->mvar = mvar;+ string_completion->cap = cap;+ return zoo_acreate(zh, path, value + offset, valuelen, acl, mode,+ hs_string_completion_fn, string_completion);+}++int hs_zoo_aget(zhandle_t* zh, const char* path, int watch, HsStablePtr mvar,+ HsInt cap, hs_data_completion_t* data_completion) {+ data_completion->mvar = mvar;+ data_completion->cap = cap;+ return zoo_aget(zh, path, watch, hs_data_completion_fn, data_completion);+}++int hs_zoo_awget(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap, hs_watcher_ctx_t* watcher_ctx,+ hs_data_completion_t* data_completion) {+ watcher_ctx->mvar = mvar_w;+ watcher_ctx->cap = cap;+ data_completion->mvar = mvar_f;+ data_completion->cap = cap;+ return zoo_awget(zh, path, hs_zookeeper_watcher_fn, watcher_ctx,+ hs_data_completion_fn, data_completion);+}++int hs_zoo_aset(zhandle_t* zh, const char* path, const char* buffer,+ HsInt offset, HsInt buflen, int version, HsStablePtr mvar,+ HsInt cap, hs_stat_completion_t* stat_completion) {+ stat_completion->mvar = mvar;+ stat_completion->cap = cap;+ return zoo_aset(zh, path, buffer + offset, buflen, version,+ hs_stat_completion_fn, stat_completion);+}++int hs_zoo_adelete(zhandle_t* zh, const char* path, int version,+ HsStablePtr mvar, HsInt cap,+ hs_void_completion_t* void_completion) {+ void_completion->mvar = mvar;+ void_completion->cap = cap;+ return zoo_adelete(zh, path, version, hs_void_completion_fn, void_completion);+}++int hs_zoo_aexists(zhandle_t* zh, const char* path, int watch, HsStablePtr mvar,+ HsInt cap, hs_stat_completion_t* stat_completion) {+ stat_completion->mvar = mvar;+ stat_completion->cap = cap;+ return zoo_aexists(zh, path, watch, hs_stat_completion_fn, stat_completion);+}++int hs_zoo_awexists(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx,+ hs_stat_completion_t* stat_completion) {+ watcher_ctx->mvar = mvar_w;+ watcher_ctx->cap = cap;+ stat_completion->mvar = mvar_f;+ stat_completion->cap = cap;+ return zoo_awexists(zh, path, hs_zookeeper_watcher_fn, watcher_ctx,+ hs_stat_completion_fn, stat_completion);+}++int hs_zoo_aget_children(zhandle_t* zh, const char* path, int watch,+ HsStablePtr mvar, HsInt cap,+ hs_strings_completion_t* strings_completion) {+ strings_completion->mvar = mvar;+ strings_completion->cap = cap;+ return zoo_aget_children(zh, path, watch, hs_strings_completion_fn,+ strings_completion);+}++int hs_zoo_awget_children(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx,+ hs_strings_completion_t* strings_completion) {+ watcher_ctx->mvar = mvar_w;+ watcher_ctx->cap = cap;+ strings_completion->mvar = mvar_f;+ strings_completion->cap = cap;+ return zoo_awget_children(zh, path, hs_zookeeper_watcher_fn, watcher_ctx,+ hs_strings_completion_fn, strings_completion);+}++int hs_zoo_aget_children2(zhandle_t* zh, const char* path, int watch,+ HsStablePtr mvar, HsInt cap,+ hs_strings_stat_completion_t* strings_stat) {+ strings_stat->mvar = mvar;+ strings_stat->cap = cap;+ return zoo_aget_children2(zh, path, watch, hs_strings_stat_completion_fn,+ strings_stat);+}++int hs_zoo_awget_children2(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx,+ hs_strings_stat_completion_t* strings_stat) {+ watcher_ctx->mvar = mvar_w;+ watcher_ctx->cap = cap;+ strings_stat->mvar = mvar_f;+ strings_stat->cap = cap;+ return zoo_awget_children2(zh, path, hs_zookeeper_watcher_fn, watcher_ctx,+ hs_strings_stat_completion_fn, strings_stat);+}++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) {+ void_completion->mvar = mvar;+ void_completion->cap = cap;+ return zoo_amulti(zh, count, ops, results, hs_void_completion_fn,+ void_completion);+}++void hs_zoo_create_op_init(zoo_op_t* op, const char* path, const char* value,+ HsInt valoffset, HsInt valuelen,+ const struct ACL_vector* acl, int flags,+ char* path_buffer, int path_buffer_len) {+ zoo_create_op_init(op, path, value + valoffset, valuelen, acl, flags,+ path_buffer, path_buffer_len);+}++void hs_zoo_set_op_init(zoo_op_t* op, const char* path, const char* value,+ HsInt valoffset, HsInt valuelen, int version,+ stat_t* stat) {+ zoo_set_op_init(op, path, value + valoffset, valuelen, version, stat);+}++// ----------------------------------------------------------------------------
+ include/hs_zk.h view
@@ -0,0 +1,152 @@+#ifndef HS_ZK+#define HS_ZK++#include <HsFFI.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <zookeeper/zookeeper.h>++typedef struct Stat stat_t;+typedef struct String_vector string_vector_t;++const stat_t* dup_stat(const stat_t* old_stat) {+ stat_t* new_stat = (stat_t*)malloc(sizeof(stat_t));+ new_stat = memcpy(new_stat, old_stat, sizeof(stat_t));+ return new_stat;+}++const string_vector_t* dup_string_vector(const string_vector_t* old_strings) {+ string_vector_t* new_strings =+ (string_vector_t*)malloc(sizeof(string_vector_t));+ int count = old_strings->count;+ char** vals = malloc(count * sizeof(char*));+ for (int i = 0; i < count; ++i) {+ vals[i] = strdup(old_strings->data[i]);+ }+ new_strings->count = count;+ new_strings->data = vals;+ return new_strings;+}++typedef struct hs_watcher_ctx_t {+ HsStablePtr mvar;+ HsInt cap;+ zhandle_t* zh;+ int type;+ int state;+ const char* path;+} hs_watcher_ctx_t;++typedef struct hs_string_completion_t {+ HsStablePtr mvar;+ HsInt cap;+ int rc;+ const char* value;+} hs_string_completion_t;++typedef struct hs_data_completion_t {+ HsStablePtr mvar;+ HsInt cap;+ int rc;+ const char* value;+ int value_len;+ const struct Stat* stat;+} hs_data_completion_t;++typedef struct hs_stat_completion_t {+ HsStablePtr mvar;+ HsInt cap;+ int rc;+ const struct Stat* stat;+} hs_stat_completion_t;++typedef struct hs_void_completion_t {+ HsStablePtr mvar;+ HsInt cap;+ int rc;+} hs_void_completion_t;++typedef struct hs_strings_completion_t {+ HsStablePtr mvar;+ HsInt cap;+ int rc;+ const string_vector_t* strings;+} hs_strings_completion_t;++typedef struct hs_strings_stat_completion_t {+ HsStablePtr mvar;+ HsInt cap;+ int rc;+ const string_vector_t* strings;+ const stat_t* stat;+} hs_strings_stat_completion_t;++// ----------------------------------------------------------------------------++zhandle_t* hs_zookeeper_init(HsStablePtr mvar, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx, const char* host,+ int recv_timeout, const clientid_t* clientid,+ int flags);++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,+ hs_string_completion_t* string_completion);++int hs_zoo_aget(zhandle_t* zh, const char* path, int watch, HsStablePtr mvar,+ HsInt cap, hs_data_completion_t* data_completion);++int hs_zoo_awget(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap, hs_watcher_ctx_t* watcher_ctx,+ hs_data_completion_t* data_completion);++int hs_zoo_aset(zhandle_t* zh, const char* path, const char* buffer,+ HsInt offset, HsInt buflen, int version, HsStablePtr mvar,+ HsInt cap, hs_stat_completion_t* stat_completion);++int hs_zoo_adelete(zhandle_t* zh, const char* path, int version,+ HsStablePtr mvar, HsInt cap,+ hs_void_completion_t* void_completion);++int hs_zoo_aexists(zhandle_t* zh, const char* path, int watch, HsStablePtr mvar,+ HsInt cap, hs_stat_completion_t* stat_completion);++int hs_zoo_awexists(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx,+ hs_stat_completion_t* stat_completion);++int hs_zoo_aget_children(zhandle_t* zh, const char* path, int watch,+ HsStablePtr mvar, HsInt cap,+ hs_strings_completion_t* strings_completion);++int hs_zoo_awget_children(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx,+ hs_strings_completion_t* strings_completion);++int hs_zoo_aget_children2(zhandle_t* zh, const char* path, int watch,+ HsStablePtr mvar, HsInt cap,+ hs_strings_stat_completion_t* strings_stat);++int hs_zoo_awget_children2(zhandle_t* zh, const char* path, HsStablePtr mvar_w,+ HsStablePtr mvar_f, HsInt cap,+ hs_watcher_ctx_t* watcher_ctx,+ hs_strings_stat_completion_t* strings_stat);++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);++void hs_zoo_create_op_init(zoo_op_t* op, const char* path, const char* value,+ HsInt valoffset, HsInt valuelen,+ const struct ACL_vector* acl, int flags,+ char* path_buffer, int path_buffer_len);++void hs_zoo_set_op_init(zoo_op_t* op, const char* path, const char* value,+ HsInt valoffset, HsInt valuelen, int version,+ stat_t* stat);++// End define HS_ZK+#endif
+ src/ZooKeeper.hs view
@@ -0,0 +1,654 @@+module ZooKeeper+ ( I.zooVersion+ , I.zooSetDebugLevel++ , zookeeperResInit+ , Res.withResource+ , Res.Resource++ , zooGetClientID++ , zooCreate+ , zooSet+ , zooGet+ , zooWatchGet+ , zooGetChildren+ , zooWatchGetChildren+ , zooGetChildren2+ , zooWatchGetChildren2+ , zooDelete+ , zooExists+ , zooWatchExists++ , zooMulti+ , zooCreateOpInit+ , zooDeleteOpInit+ , zooSetOpInit+ , zooCheckOpInit++ , zookeeperInit+ , zookeeperClose+ ) where++import Control.Concurrent (forkIO, myThreadId, newEmptyMVar,+ takeMVar, threadCapability)+import Control.Exception (mask_, onException)+import Control.Monad (void, when, zipWithM, (<=<))+import Data.Bifunctor (first)+import Data.Maybe (fromMaybe)+import Data.Proxy (Proxy (..))+import Foreign.C (CInt)+import Foreign.ForeignPtr (mallocForeignPtrBytes,+ touchForeignPtr, withForeignPtr)+import Foreign.Ptr (Ptr, nullPtr, plusPtr)+import GHC.Conc (newStablePtrPrimMVar)+import GHC.Stack (HasCallStack, callStack)+import Z.Data.CBytes (CBytes)+import qualified Z.Data.CBytes as CBytes+import qualified Z.Data.Text.Print as Text+import Z.Data.Vector (Bytes)+import qualified Z.Foreign as Z+import qualified Z.IO.Resource as Res++import qualified ZooKeeper.Exception as E+import qualified ZooKeeper.Internal.FFI as I+import qualified ZooKeeper.Internal.Types as I+import qualified ZooKeeper.Types as T++-------------------------------------------------------------------------------++-- | Create a resource of handle to used communicate with zookeeper.+zookeeperResInit+ :: HasCallStack+ => CBytes+ -- ^ host, comma separated host:port pairs, each corresponding to a zk+ -- server. e.g. "127.0.0.1:3000,127.0.0.1:3001,127.0.0.1:3002"+ -> CInt+ -- ^ timeout+ -> Maybe T.ClientID+ -- ^ The id of a previously established session that this client will be+ -- reconnecting to. Pass 'Nothing' if not reconnecting to a previous+ -- session. Clients can access the session id of an established, valid,+ -- connection by calling 'zooGetClientID'. If the session corresponding to+ -- the specified clientid has expired, or if the clientid is invalid for+ -- any reason, the returned 'T.ZHandle' will be invalid -- the 'T.ZHandle'+ -- state will indicate the reason for failure (typically 'T.ZooExpiredSession').+ -> CInt+ -- ^ flags, reserved for future use. Should be set to zero.+ -> Res.Resource T.ZHandle+zookeeperResInit host timeout mclientid flags =+ Res.initResource (zookeeperInit host timeout mclientid flags) zookeeperClose++-- | Create a node.+--+-- This method will create a node in ZooKeeper. A node can only be created if+-- it does not already exist. The Create Flags affect the creation of nodes.+-- If 'T.ZooEphemeral' flag is set, the node will automatically get removed if+-- the client session goes away. If the 'T.ZooSequence' flag is set, a unique+-- monotonically increasing sequence number is appended to the path name. The+-- sequence number is always fixed length of 10 digits, 0 padded.+--+-- 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+zooCreate :: 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 Bytes+ -- ^ The data to be stored in the node.+ -> T.AclVector+ -- ^ The initial ACL of the node. The ACL must not be null or empty.+ -> T.CreateMode+ -- ^ This parameter can be set to 'T.ZooPersistent' for normal create+ -- or an OR of the Create Flags+ -> IO T.StringCompletion+ -- ^ The result when the request completes. One of the+ -- following exceptions will be thrown if error happens:+ --+ -- * ZNONODE the parent node does not exist.+ -- * ZNODEEXISTS the node already exists+ -- * ZNOAUTH the client does not have permission.+ -- * ZNOCHILDRENFOREPHEMERALS cannot create children of ephemeral nodes.+zooCreate zh path m_value acl mode =+ CBytes.withCBytesUnsafe path $ \path' ->+ case m_value of+ Just value -> Z.withPrimVectorUnsafe value $ \val' offset len -> do+ let cfun = I.c_hs_zoo_acreate zh path' val' offset len acl mode+ E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfun+ Nothing -> do+ let cfun = I.c_hs_zoo_acreate' zh path' nullPtr 0 (-1) acl mode+ E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfun+ where+ csize = I.csize (Proxy :: Proxy T.StringCompletion)++-- | Sets the data 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+zooSet :: 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 Bytes+ -- ^ Data to be written to the node.+ -> Maybe CInt+ -- ^ The expected version of the node. The function will fail+ -- if the actual version of the node does not match the expected version.+ -- If Nothing is used the version check will not take place.+ -> IO T.StatCompletion+ -- ^ The result when the request completes. One of the+ -- following exceptions will be thrown if error happens:+ --+ -- * ZOK operation completed successfully+ -- * ZNONODE the node does not exist.+ -- * ZNOAUTH the client does not have permission.+ -- * ZBADVERSION expected version does not match actual version.+zooSet zh path m_value m_version = CBytes.withCBytesUnsafe path $ \path' -> do+ let csize = I.csize (Proxy :: Proxy T.StatCompletion)+ version = fromMaybe (-1) m_version+ case m_value of+ Just value -> Z.withPrimVectorUnsafe value $ \val' offset len -> do+ let cfunc = I.c_hs_zoo_aset zh path' val' offset len version+ E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc+ Nothing -> do+ let cfunc = I.c_hs_zoo_aset' zh path' nullPtr 0 (-1) version+ E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc++-- | Gets the data associated with a node.+--+-- Throw one of the following exceptions on failure:+--+-- * ZBADARGUMENTS - invalid input parameters+-- * ZINVALIDSTATE - zhandle state is either in ZOO_SESSION_EXPIRED_STATE or ZOO_AUTH_FAILED_STATE+-- * ZMARSHALLINGERROR - failed to marshall a request; possibly, out of memory+zooGet :: 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.+ -> IO T.DataCompletion+ -- ^ The result when the request completes. One of the+ -- following exceptions will be thrown if:+ --+ -- * ZNONODE the node does not exist.+ -- * ZNOAUTH the client does not have permission.+zooGet zh path = CBytes.withCBytesUnsafe path $ \path' ->+ let csize = I.csize (Proxy :: Proxy T.DataCompletion)+ cfunc = I.c_hs_zoo_aget zh path' 0+ in E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc++-- | Gets the data associated with a node.+--+-- Throw one of the following exceptions on failure:+--+-- * ZBADARGUMENTS - invalid input parameters+-- * ZINVALIDSTATE - zhandle state is either in ZOO_SESSION_EXPIRED_STATE or ZOO_AUTH_FAILED_STATE+-- * ZMARSHALLINGERROR - failed to marshall a request; possibly, out of memory+zooWatchGet+ :: HasCallStack+ => T.ZHandle+ -> CBytes+ -> (T.HsWatcherCtx -> IO ())+ -- ^ The watcher callback.+ --+ -- A watch will be set at the server to notify the client if the node changes.+ -> (T.DataCompletion -> IO ())+ -- ^ The result callback when the request completes.+ --+ -- One of the following exceptions will be thrown if:+ --+ -- * ZNONODE the node does not exist.+ -- * ZNOAUTH the client does not have permission.+ -> IO ()+zooWatchGet zh path watchfn datafn = CBytes.withCBytesUnsafe path $ \path' ->+ let csize = I.csize (Proxy :: Proxy T.DataCompletion)+ watchfn' = watchfn <=< E.throwZooErrorIfLeft+ datafn' = datafn <=< E.throwZooErrorIfLeft+ in I.withZKAsync2+ I.hsWatcherCtxSize (\_ -> return E.CZOK) I.peekHsWatcherCtx watchfn'+ csize I.peekRet I.peekData datafn'+ (I.c_hs_zoo_awget zh path')++-- | Delete a node in zookeeper.+--+-- Throw one of the following exceptions on failure:+--+-- * 'E.ZBADARGUMENTS' - invalid input parameters+-- * 'E.ZINVALIDSTATE' - zhandle state is either ZOO_SESSION_EXPIRED_STATE or ZOO_AUTH_FAILED_STATE+-- * 'E.ZMARSHALLINGERROR' - failed to marshall a request; possibly, out of memory+--+-- Throw one of the following exceptions if the request completes failed:+--+-- * ZNONODE the node does not exist.+-- * ZNOAUTH the client does not have permission.+-- * ZBADVERSION expected version does not match actual version.+-- * ZNOTEMPTY children are present; node cannot be deleted.+zooDelete :: 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 CInt+ -- ^ The expected version of the node. The function will fail+ -- if the actual version of the node does not match the expected version.+ -- If Nothing is used the version check will not take place.+ -> IO ()+zooDelete zh path m_version = CBytes.withCBytesUnsafe path $ \path' ->+ let csize = I.csize (Proxy :: Proxy T.VoidCompletion)+ cfunc = I.c_hs_zoo_adelete zh path' version+ version = fromMaybe (-1) m_version+ in void $ E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc++-- | Checks the existence of a node in zookeeper.+--+-- 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+zooExists :: 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.+ -> IO (Maybe T.StatCompletion)+ -- ^ The result when the request completes. Nothing means+ -- the node does not exist.+ --+ -- One of the following exceptions will be thrown if error happens:+ --+ -- * ZNOAUTH the client does not have permission.+zooExists zh path =+ CBytes.withCBytesUnsafe path $ \path' ->+ let csize = I.csize (Proxy :: Proxy T.StatCompletion)+ cfunc = I.c_hs_zoo_aexists zh path' 0+ in E.throwZooErrorIfLeft' (== E.CZNONODE) =<< I.withZKAsync csize I.peekRet I.peekData cfunc++-- | Checks the existence of a node in zookeeper.+--+-- This function is similar to 'zooExists' except it allows one specify+-- a watcher object. The function will be called once the watch has fired.+--+-- Note that the watch will fire both when the node is created and its associated+-- data is set.+--+-- Note that there is only one thread for triggering callbacks. Which means this+-- function will first block on the completion, and then wating on the watcher.+--+-- 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+zooWatchExists+ :: 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.+ -> (T.HsWatcherCtx -> IO ())+ -- ^ The watcher callback.+ --+ -- A watch will set on the specified znode on the server. The watch will be+ -- set even if the node does not exist. This allows clients to watch for+ -- nodes to appear.+ -> (Maybe T.StatCompletion -> IO ())+ -- ^ The result callback when the request completes. Nothing means+ -- the node does not exist.+ --+ -- One of the following exceptions will be thrown if error happens:+ --+ -- * ZNOAUTH the client does not have permission.+ -> IO ()+zooWatchExists zh path watchfn statfn =+ let csize = I.csize (Proxy :: Proxy T.StatCompletion)+ watchfn' = watchfn <=< E.throwZooErrorIfLeft+ statfn' = statfn <=< E.throwZooErrorIfLeft' (== E.CZNONODE)+ in CBytes.withCBytesUnsafe path $ \path' ->+ I.withZKAsync2+ I.hsWatcherCtxSize (\_ -> return E.CZOK) I.peekHsWatcherCtx watchfn'+ csize I.peekRet I.peekData statfn'+ (I.c_hs_zoo_awexists zh path')++-- | Lists the children of 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+zooGetChildren+ :: 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.+ -> IO T.StringsCompletion+ -- ^ 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.+zooGetChildren zh path = CBytes.withCBytesUnsafe path $ \path' -> do+ let csize = I.csize (Proxy :: Proxy T.StringsCompletion)+ cfunc = I.c_hs_zoo_aget_children zh path' 0+ in E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc++-- | Lists the children of a node.+--+-- This function is similar to 'zooGetChildren' except it allows one specify+-- a watcher object.+--+-- Note that there is only one thread for triggering callbacks. Which means this+-- function will first block on the completion, and then wating on the watcher.+--+-- 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+zooWatchGetChildren+ :: 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.+ -> (T.HsWatcherCtx -> IO ())+ -- ^ The watcher callback. A watch will be set at the server to notify+ -- the client if the node changes.+ -> (T.StringsCompletion -> IO ())+ -- ^ The result callback when the request completes.+ --+ -- One of the following exceptions will be thrown if error happens:+ --+ -- * ZNONODE the node does not exist.+ -- * ZNOAUTH the client does not have permission.+ -> IO ()+zooWatchGetChildren zh path watchfn stringsfn =+ let csize = I.csize (Proxy :: Proxy T.StringsCompletion)+ watchfn' = watchfn <=< E.throwZooErrorIfLeft+ stringsfn' = stringsfn <=< E.throwZooErrorIfLeft+ in CBytes.withCBytesUnsafe path $ \path' ->+ I.withZKAsync2+ I.hsWatcherCtxSize (\_ -> return E.CZOK) I.peekHsWatcherCtx watchfn'+ csize I.peekRet I.peekData stringsfn'+ (I.c_hs_zoo_awget_children zh path')++-- | Lists the children of a node, and get the parent stat.+--+-- This function is new in version 3.3.0+--+-- Throw one of the following exceptions on failure:+--+-- * 'E.ZBADARGUMENTS' - invalid input parameters+-- * 'E.ZINVALIDSTATE' - zhandle state is either ZOO_SESSION_EXPIRED_STATE or ZOO_AUTH_FAILED_STATE+-- * 'E.ZMARSHALLINGERROR' - failed to marshall a request; possibly, out of memory+zooGetChildren2+ :: 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.+ -> IO T.StringsStatCompletion+ -- ^ 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.+zooGetChildren2 zh path = CBytes.withCBytesUnsafe path $ \path' -> do+ let csize = I.csize (Proxy :: Proxy T.StringsStatCompletion)+ cfunc = I.c_hs_zoo_aget_children2 zh path' 0+ in E.throwZooErrorIfLeft =<< I.withZKAsync csize I.peekRet I.peekData cfunc++-- | Lists the children of a node, and get the parent stat.+--+-- This function is new in version 3.3.0+--+-- Note that there is only one thread for triggering callbacks. Which means this+-- function will first block on the completion, and then wating on the watcher.+--+-- Throw one of the following exceptions on failure:+--+-- * 'E.ZBADARGUMENTS' - invalid input parameters+-- * 'E.ZINVALIDSTATE' - zhandle state is either ZOO_SESSION_EXPIRED_STATE or ZOO_AUTH_FAILED_STATE+-- * 'E.ZMARSHALLINGERROR' - failed to marshall a request; possibly, out of memory+zooWatchGetChildren2+ :: 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.+ -> (T.HsWatcherCtx -> IO ())+ -- ^ The watcher callback. A watch will be set at the server to notify+ -- the client if the node changes.+ -> (T.StringsStatCompletion -> IO ())+ -- ^ The result callback when the request completes.+ --+ -- One of the following exceptions will be thrown if error happens:+ --+ -- * ZNONODE the node does not exist.+ -- * ZNOAUTH the client does not have permission.+ -> IO ()+zooWatchGetChildren2 zh path watchfn strsStatfn =+ let csize = I.csize (Proxy :: Proxy T.StringsStatCompletion)+ watchfn' = watchfn <=< E.throwZooErrorIfLeft+ stringsfn' = strsStatfn <=< E.throwZooErrorIfLeft+ in CBytes.withCBytesUnsafe path $ \path' ->+ I.withZKAsync2+ I.hsWatcherCtxSize (\_ -> return E.CZOK) I.peekHsWatcherCtx watchfn'+ csize I.peekRet I.peekData stringsfn'+ (I.c_hs_zoo_awget_children2 zh path')++-- | Return the client session id, only valid if the connections+-- is currently connected (ie. last watcher state is 'T.ZooConnectedState')+zooGetClientID :: T.ZHandle -> IO T.ClientID+zooGetClientID = I.c_zoo_client_id++-------------------------------------------------------------------------------++-- | Atomically commits multiple zookeeper operations.+--+-- Throw exceptions if error happened, the exception will be any of the operations+-- supported by a multi op, see 'zooCreate', 'zooDelete' and 'zooSet'.+zooMulti+ :: HasCallStack+ => T.ZHandle+ -- ^ The zookeeper handle obtained by a call to 'zookeeperResInit'+ -> [T.ZooOp]+ -- ^ An list of operations to commit+ -> IO [T.ZooOpResult]+zooMulti zh ops = do+ let len = length ops+ completionSize = I.csize (Proxy :: Proxy T.VoidCompletion)+ chunkPtr ptr size = map (\i -> ptr `plusPtr` (i * size)) [0..len-1]++ mbai@(Z.MutableByteArray mbai#) <- Z.newPinnedByteArray (I.zooOpSize * len)+ mbar@(Z.MutableByteArray mbar#) <- Z.newPinnedByteArray (I.zooOpResultSize * len)+ let ptr = Z.mutableByteArrayContents mbai+ ptr_result = Z.mutableByteArrayContents mbar++ res <- mapM initOp $ zip ops (chunkPtr ptr I.zooOpSize)+ E.throwZooErrorIfLeft =<<+ I.withZKAsync' (concatMap snd res) completionSize I.peekRet I.peekData+ (I.c_hs_zoo_amulti zh (fromIntegral len) mbai# mbar#)+ zipWithM ($) (map fst res) (chunkPtr ptr_result I.zooOpResultSize)++-- | Internal helper function to set zoo op.+initOp :: (I.ZooOp, Ptr I.CZooOp)+ -> IO (Ptr I.CZooOpResult -> IO T.ZooOpResult, I.TouchListBytes)+-- we know that the size of this list is larger than one+initOp (I.ZooCreateOp f, p) = first I.peekZooCreateOpResult `fmap` f p+initOp (I.ZooDeleteOp f, p) = first (const I.peekZooDeleteOpResult) `fmap` f p+initOp (I.ZooSetOp f, p) = first I.peekZooSetOpResult `fmap` f p+initOp (I.ZooCheckOp f, p) = first (const I.peekZooCheckOpResult) `fmap` f p+{-# INLINE initOp #-}++-- | Init create op.+--+-- This function initializes a 'T.ZooOp' with the arguments for a ZOO_CREATE_OP.+zooCreateOpInit+ :: CBytes+ -- ^ The name of the node. Expressed as a file name with slashes+ -- separating ancestors of the node.+ -> Maybe Bytes+ -- ^ The data to be stored in the node.+ -> CInt+ -- ^ The max buffer size of the created new node path (this might be+ -- different than the supplied path because of the 'T.ZooSequence' flag).+ -- If this size is 0,+ --+ -- Note: we do NOT check if the size is non-negative.+ --+ -- If the path of the new node exceeds the buffer size, the path string will+ -- be truncated to fit. The actual path of the new node in the server will+ -- not be affected by the truncation.+ -> T.AclVector+ -- ^ The initial ACL of the node. The ACL must not be null or empty.+ -> T.CreateMode+ -- ^ This parameter can be set to 'T.ZooPersistent' for normal create+ -- or an OR of the Create Flags+ -> T.ZooOp+zooCreateOpInit path m_value buflen acl mode = I.ZooCreateOp $ \op -> do+ let buflen' = buflen + 1 -- including space for the null terminator+ CBytes.withCBytesUnsafe path $ \path' -> do+ mba@(Z.MutableByteArray mba#) <- Z.newPinnedByteArray (fromIntegral buflen')+ case m_value of+ Just value -> Z.withPrimVectorUnsafe value $ \val' offset len ->+ I.c_hs_zoo_create_op_init op path' val' offset len acl mode mba# buflen'+ Nothing ->+ I.c_hs_zoo_create_op_init' op path' nullPtr 0 (-1) acl mode mba# buflen'+ mba_path <- Z.unsafeThawByteArray $ Z.ByteArray path'+ return (mba, [mba_path, mba])++-- | Init delete op.+--+-- This function initializes a 'T.ZooOp' with the arguments for a ZOO_DELETE_OP.+zooDeleteOpInit+ :: CBytes+ -- ^ The name of the node. Expressed as a file name with slashes+ -- separating ancestors of the node.+ -> Maybe CInt+ -- ^ The expected version of the node. The function will fail+ -- if the actual version of the node does not match the expected version.+ -- If Nothing is used the version check will not take place.+ -> T.ZooOp+zooDeleteOpInit path m_version = I.ZooDeleteOp $ \op -> do+ CBytes.withCBytesUnsafe path $ \path' -> do+ I.c_zoo_delete_op_init op path' (fromMaybe (-1) m_version)+ mba_path <- Z.unsafeThawByteArray $ Z.ByteArray path'+ return ((), [mba_path])++-- | Init set op.+--+-- This function initializes an 'T.ZooOp' with the arguments for a ZOO_SETDATA_OP.+zooSetOpInit+ :: CBytes+ -- ^ The name of the node. Expressed as a file name with slashes+ -- separating ancestors of the node.+ -> Maybe Bytes+ -- ^ Data to be written to the node.+ --+ -- To set NULL as data use this parameter as Nothing.+ -> Maybe CInt+ -- ^ The expected version of the node. The function will fail+ -- if the actual version of the node does not match the expected version.+ -- If Nothing is used the version check will not take place.+ -> T.ZooOp+zooSetOpInit path m_value m_version = I.ZooSetOp $ \op -> do+ CBytes.withCBytesUnsafe path $ \path' -> do+ mba@(Z.MutableByteArray mba#) <- Z.newPinnedByteArray I.statSize+ let version = fromMaybe (-1) m_version+ case m_value of+ Just value -> Z.withPrimVectorUnsafe value $ \val' offset len ->+ I.c_hs_zoo_set_op_init op path' val' offset len version mba#+ Nothing -> I.c_hs_zoo_set_op_init' op path' nullPtr 0 (-1) version mba#+ mba_path <- Z.unsafeThawByteArray $ Z.ByteArray path'+ return (mba, [mba_path, mba])++-- | Init check op.+--+-- This function initializes an 'T.ZooOp' with the arguments for a ZOO_CHECK_OP.+zooCheckOpInit+ :: CBytes+ -- ^ The name of the node. Expressed as a file name with slashes+ -- separating ancestors of the node.+ -> CInt -- FIXME: does this can set to -1 ?+ -- ^ The expected version of the node. The function will fail+ -- if the actual version of the node does not match the expected version.+ -> T.ZooOp+zooCheckOpInit path version = I.ZooCheckOp $ \op -> do+ CBytes.withCBytesUnsafe path $ \path' -> do+ I.c_zoo_check_op_init op path' version+ mba_path <- Z.unsafeThawByteArray $ Z.ByteArray path'+ return ((), [mba_path])++-------------------------------------------------------------------------------++-- | Create a handle to used communicate with zookeeper.+--+-- This function creates a new handle and a zookeeper session that corresponds+-- to that handle. At the underlying c side, session establishment is asynchronous,+-- meaning that the session should not be considered established until (and unless)+-- an event of state ZOO_CONNECTED_STATE is received. In haskell, this will block+-- until state received.+--+-- If it fails to create a new zhandle or not connected, an exception will be+-- throwed.+zookeeperInit+ :: HasCallStack+ => CBytes+ -- ^ host, comma separated host:port pairs, each corresponding to a zk+ -- server. e.g. "127.0.0.1:3000,127.0.0.1:3001,127.0.0.1:3002"+ -> CInt+ -- ^ timeout+ -> Maybe T.ClientID+ -- ^ The id of a previously established session that this client will be+ -- reconnecting to. Pass 'Nothing' if not reconnecting to a previous+ -- session. Clients can access the session id of an established, valid,+ -- connection by calling 'zooGetClientID'. If the session corresponding to+ -- the specified clientid has expired, or if the clientid is invalid for+ -- any reason, the returned 'T.ZHandle' will be invalid -- the 'T.ZHandle'+ -- state will indicate the reason for failure (typically 'T.ZooExpiredSession').+ -> CInt+ -- ^ flags, reserved for future use. Should be set to zero.+ -> IO T.ZHandle+zookeeperInit host timeout mclientid flags = do+ let clientid = fromMaybe (I.ClientID nullPtr) mclientid+ CBytes.withCBytesUnsafe host $ \host' -> mask_ $ do+ mvar <- newEmptyMVar+ sp <- newStablePtrPrimMVar mvar -- freed by hs_try_takemvar()+ ctx <- mallocForeignPtrBytes I.hsWatcherCtxSize+ (ctxResult, zhResult) <- withForeignPtr ctx $ \ctx' -> do+ (cap, _) <- threadCapability =<< myThreadId+ zh <- I.c_hs_zookeeper_init sp cap ctx' host' timeout clientid flags+ when (zh == I.ZHandle nullPtr) $ E.getCErrNum >>= flip E.throwZooError callStack+ takeMVar mvar `onException` forkIO (do takeMVar mvar; touchForeignPtr ctx)+ ctxData <- I.peekHsWatcherCtx ctx'+ return (ctxData, zh)+ case I.watcherCtxState ctxResult of+ I.ZooConnectedState -> return zhResult+ state -> E.throwIO $ E.ZINVALIDSTATE $ E.ZooExInfo (Text.toText state) callStack++{-# INLINABLE zookeeperClose #-}+zookeeperClose :: T.ZHandle -> IO ()+zookeeperClose = void . E.throwZooErrorIfNotOK <=< I.c_zookeeper_close_safe
+ src/ZooKeeper/Exception.hs view
@@ -0,0 +1,330 @@+{-# LANGUAGE CPP #-}++module ZooKeeper.Exception+ ( ZooException+ , zooExceptionToException+ , zooExceptionFromException+ , ZooExInfo (..)++ -- * System and server-side errors+ --+ -- $serverSideErrors+ , ZSYSTEMERROR (..)+ , ZRUNTIMEINCONSISTENCY (..)+ , ZDATAINCONSISTENCY (..)+ , ZCONNECTIONLOSS (..)+ , ZMARSHALLINGERROR (..)+ , ZUNIMPLEMENTED (..)+ , ZOPERATIONTIMEOUT (..)+ , ZBADARGUMENTS (..)+ , ZINVALIDSTATE (..)+ , ZNEWCONFIGNOQUORUM (..)+ , ZRECONFIGINPROGRESS (..)+ , ZSSLCONNECTIONERROR (..)++ -- * API Errors+ --+ -- $apiErrors+ , ZAPIERROR (..)+ , ZNONODE (..)+ , ZNOAUTH (..)+ , ZBADVERSION (..)+ , ZNOCHILDRENFOREPHEMERALS (..)+ , ZNODEEXISTS (..)+ , ZNOTEMPTY (..)+ , ZSESSIONEXPIRED (..)+ , ZINVALIDCALLBACK (..)+ , ZINVALIDACL (..)+ , ZAUTHFAILED (..)+ , ZCLOSING (..)+ , ZNOTHING (..)+ , ZSESSIONMOVED (..)+ , ZNOTREADONLY (..)+ , ZEPHEMERALONLOCALSESSION (..)+ , ZNOWATCHER (..)+ , ZRECONFIGDISABLED (..)+ , ZSESSIONCLOSEDREQUIRESASLAUTH (..)+ , ZTHROTTLEDOP (..)++ -- * Other Errors+ , SYSERRNO+ , UNKNOWN_ERR++ , throwZooError+ , throwZooErrorIfNotOK+ , throwZooErrorIfLeft+ , throwZooErrorIfLeft'++ -- * Error number patterns+ , pattern CZOK+ , pattern CZSYSTEMERROR+ , pattern CZRUNTIMEINCONSISTENCY+ , pattern CZDATAINCONSISTENCY+ , pattern CZCONNECTIONLOSS+ , pattern CZMARSHALLINGERROR+ , pattern CZUNIMPLEMENTED+ , pattern CZOPERATIONTIMEOUT+ , pattern CZBADARGUMENTS+ , pattern CZINVALIDSTATE+ , pattern CZNEWCONFIGNOQUORUM+ , pattern CZRECONFIGINPROGRESS+ , pattern CZSSLCONNECTIONERROR+ , pattern CZAPIERROR+ , pattern CZNONODE+ , pattern CZNOAUTH+ , pattern CZBADVERSION+ , pattern CZNOCHILDRENFOREPHEMERALS+ , pattern CZNODEEXISTS+ , pattern CZNOTEMPTY+ , pattern CZSESSIONEXPIRED+ , pattern CZINVALIDCALLBACK+ , pattern CZINVALIDACL+ , pattern CZAUTHFAILED+ , pattern CZCLOSING+ , pattern CZNOTHING+ , pattern CZSESSIONMOVED+ , pattern CZNOTREADONLY+ , pattern CZEPHEMERALONLOCALSESSION+ , pattern CZNOWATCHER+ , pattern CZRECONFIGDISABLED+ , pattern CZSESSIONCLOSEDREQUIRESASLAUTH+ , pattern CZTHROTTLEDOP++ -- * Helpers+ , E.throwIO+ , getCErrNum+ ) where++import Control.Exception (Exception (..))+import qualified Control.Exception as E+import Data.Typeable (cast)+import Foreign.C (CInt, CString)+import GHC.Stack (CallStack, HasCallStack, callStack,+ prettyCallStack)+import qualified Z.Data.Text as T+import qualified Z.Data.Text.Print as T+import qualified Z.Foreign as Z++-------------------------------------------------------------------------------++-- | The root exception type of ZooKeeper.+data ZooException = forall e . E.Exception e => ZooException e++instance Show ZooException where+ show (ZooException e) = show e++instance E.Exception ZooException++zooExceptionToException :: E.Exception e => e -> E.SomeException+zooExceptionToException = E.toException . ZooException++zooExceptionFromException :: E.Exception e => E.SomeException -> Maybe e+zooExceptionFromException x = do+ ZooException a <- E.fromException x+ cast a++-- | Zookeeper error informations.+data ZooExInfo = ZooExInfo+ { errDescription :: T.Text -- ^ description for this zoo error+ , errCallStack :: CallStack -- ^ lightweight partial call-stack+ }++instance T.Print ZooExInfo where+ toUTF8BuilderP _ (ZooExInfo desc cstack) = do+ "description: "+ T.text desc+ ", callstack: "+ T.stringUTF8 (prettyCallStack cstack)++instance Show ZooExInfo where+ show = T.toString++pattern+ CZOK+ , CZSYSTEMERROR+ , CZRUNTIMEINCONSISTENCY+ , CZDATAINCONSISTENCY+ , CZCONNECTIONLOSS+ , CZMARSHALLINGERROR+ , CZUNIMPLEMENTED+ , CZOPERATIONTIMEOUT+ , CZBADARGUMENTS+ , CZINVALIDSTATE+ , CZNEWCONFIGNOQUORUM+ , CZRECONFIGINPROGRESS+ , CZSSLCONNECTIONERROR+ , CZAPIERROR+ , CZNONODE+ , CZNOAUTH+ , CZBADVERSION+ , CZNOCHILDRENFOREPHEMERALS+ , CZNODEEXISTS+ , CZNOTEMPTY+ , CZSESSIONEXPIRED+ , CZINVALIDCALLBACK+ , CZINVALIDACL+ , CZAUTHFAILED+ , CZCLOSING+ , CZNOTHING+ , CZSESSIONMOVED+ , CZNOTREADONLY+ , CZEPHEMERALONLOCALSESSION+ , CZNOWATCHER+ , CZRECONFIGDISABLED+ , CZSESSIONCLOSEDREQUIRESASLAUTH+ , CZTHROTTLEDOP+ :: CInt+pattern CZOK = 0+pattern CZSYSTEMERROR = (- 1)+pattern CZRUNTIMEINCONSISTENCY = (- 2)+pattern CZDATAINCONSISTENCY = (- 3)+pattern CZCONNECTIONLOSS = (- 4)+pattern CZMARSHALLINGERROR = (- 5)+pattern CZUNIMPLEMENTED = (- 6)+pattern CZOPERATIONTIMEOUT = (- 7)+pattern CZBADARGUMENTS = (- 8)+pattern CZINVALIDSTATE = (- 9)+pattern CZNEWCONFIGNOQUORUM = (-13)+pattern CZRECONFIGINPROGRESS = (-14)+pattern CZSSLCONNECTIONERROR = (-15)+pattern CZAPIERROR = (-100)+pattern CZNONODE = (-101)+pattern CZNOAUTH = (-102)+pattern CZBADVERSION = (-103)+pattern CZNOCHILDRENFOREPHEMERALS = (-108)+pattern CZNODEEXISTS = (-110)+pattern CZNOTEMPTY = (-111)+pattern CZSESSIONEXPIRED = (-112)+pattern CZINVALIDCALLBACK = (-113)+pattern CZINVALIDACL = (-114)+pattern CZAUTHFAILED = (-115)+pattern CZCLOSING = (-116)+pattern CZNOTHING = (-117)+pattern CZSESSIONMOVED = (-118)+pattern CZNOTREADONLY = (-119)+pattern CZEPHEMERALONLOCALSESSION = (-120)+pattern CZNOWATCHER = (-121)+pattern CZRECONFIGDISABLED = (-123)+pattern CZSESSIONCLOSEDREQUIRESASLAUTH = (-124)+pattern CZTHROTTLEDOP = (-127)++#define MAKE_EX(e) \+newtype e = e ZooExInfo deriving (Show); \+instance Exception e where \+{ toException = zooExceptionToException; \+ fromException = zooExceptionFromException } \++-- $serverSideErrors+--+-- This is never thrown by the server, it shouldn't be used other than+-- to indicate a range. Specifically error codes greater than this+-- value, but lesser than 'ZAPIERROR', are system errors.+MAKE_EX(ZSYSTEMERROR )+MAKE_EX(ZRUNTIMEINCONSISTENCY)+MAKE_EX(ZDATAINCONSISTENCY )+MAKE_EX(ZCONNECTIONLOSS )+MAKE_EX(ZMARSHALLINGERROR )+MAKE_EX(ZUNIMPLEMENTED )+MAKE_EX(ZOPERATIONTIMEOUT )+MAKE_EX(ZBADARGUMENTS )+MAKE_EX(ZINVALIDSTATE )+MAKE_EX(ZNEWCONFIGNOQUORUM )+MAKE_EX(ZRECONFIGINPROGRESS )+MAKE_EX(ZSSLCONNECTIONERROR )++-- $apiErrors+--+-- This is never thrown by the server, it shouldn't be used other than+-- to indicate a range. Specifically error codes greater than this+-- value are API errors (while values less than this indicate a+-- 'ZSYSTEMERROR').+MAKE_EX(ZAPIERROR )+MAKE_EX(ZNONODE )+MAKE_EX(ZNOAUTH )+MAKE_EX(ZBADVERSION )+MAKE_EX(ZNOCHILDRENFOREPHEMERALS )+MAKE_EX(ZNODEEXISTS )+MAKE_EX(ZNOTEMPTY )+MAKE_EX(ZSESSIONEXPIRED )+MAKE_EX(ZINVALIDCALLBACK )+MAKE_EX(ZINVALIDACL )+MAKE_EX(ZAUTHFAILED )+MAKE_EX(ZCLOSING )+MAKE_EX(ZNOTHING )+MAKE_EX(ZSESSIONMOVED )+MAKE_EX(ZNOTREADONLY )+MAKE_EX(ZEPHEMERALONLOCALSESSION )+MAKE_EX(ZNOWATCHER )+MAKE_EX(ZRECONFIGDISABLED )+MAKE_EX(ZSESSIONCLOSEDREQUIRESASLAUTH)+MAKE_EX(ZTHROTTLEDOP )++MAKE_EX(SYSERRNO)+MAKE_EX(UNKNOWN_ERR)++#define MAKE_THROW_EX(c, e) \+throwZooError c stack = do \+ desc <- T.validate <$> (Z.fromNullTerminated =<< c_zerror c); \+ E.throwIO $ e (ZooExInfo desc stack)++throwZooError :: CInt -> CallStack -> IO a+MAKE_THROW_EX(CZSYSTEMERROR , ZSYSTEMERROR )+MAKE_THROW_EX(CZRUNTIMEINCONSISTENCY, ZRUNTIMEINCONSISTENCY)+MAKE_THROW_EX(CZDATAINCONSISTENCY , ZDATAINCONSISTENCY )+MAKE_THROW_EX(CZCONNECTIONLOSS , ZCONNECTIONLOSS )+MAKE_THROW_EX(CZMARSHALLINGERROR , ZMARSHALLINGERROR )+MAKE_THROW_EX(CZUNIMPLEMENTED , ZUNIMPLEMENTED )+MAKE_THROW_EX(CZOPERATIONTIMEOUT , ZOPERATIONTIMEOUT )+MAKE_THROW_EX(CZBADARGUMENTS , ZBADARGUMENTS )+MAKE_THROW_EX(CZINVALIDSTATE , ZINVALIDSTATE )+MAKE_THROW_EX(CZNEWCONFIGNOQUORUM , ZNEWCONFIGNOQUORUM )+MAKE_THROW_EX(CZRECONFIGINPROGRESS , ZRECONFIGINPROGRESS )+MAKE_THROW_EX(CZSSLCONNECTIONERROR , ZSSLCONNECTIONERROR )+MAKE_THROW_EX(CZAPIERROR , ZAPIERROR )+MAKE_THROW_EX(CZNONODE , ZNONODE )+MAKE_THROW_EX(CZNOAUTH , ZNOAUTH )+MAKE_THROW_EX(CZBADVERSION , ZBADVERSION )+MAKE_THROW_EX(CZNOCHILDRENFOREPHEMERALS , ZNOCHILDRENFOREPHEMERALS )+MAKE_THROW_EX(CZNODEEXISTS , ZNODEEXISTS )+MAKE_THROW_EX(CZNOTEMPTY , ZNOTEMPTY )+MAKE_THROW_EX(CZSESSIONEXPIRED , ZSESSIONEXPIRED )+MAKE_THROW_EX(CZINVALIDCALLBACK , ZINVALIDCALLBACK )+MAKE_THROW_EX(CZINVALIDACL , ZINVALIDACL )+MAKE_THROW_EX(CZAUTHFAILED , ZAUTHFAILED )+MAKE_THROW_EX(CZCLOSING , ZCLOSING )+MAKE_THROW_EX(CZNOTHING , ZNOTHING )+MAKE_THROW_EX(CZSESSIONMOVED , ZSESSIONMOVED )+MAKE_THROW_EX(CZNOTREADONLY , ZNOTREADONLY )+MAKE_THROW_EX(CZEPHEMERALONLOCALSESSION , ZEPHEMERALONLOCALSESSION )+MAKE_THROW_EX(CZNOWATCHER , ZNOWATCHER )+MAKE_THROW_EX(CZRECONFIGDISABLED , ZRECONFIGDISABLED )+MAKE_THROW_EX(CZSESSIONCLOSEDREQUIRESASLAUTH, ZSESSIONCLOSEDREQUIRESASLAUTH)+MAKE_THROW_EX(CZTHROTTLEDOP , ZTHROTTLEDOP )+throwZooError code stack+ | code > 0 = do+ desc <- T.validate <$> (Z.fromNullTerminated =<< c_zerror code)+ E.throwIO $ SYSERRNO (ZooExInfo desc stack)+ | otherwise =+ let codeBS = "UNKNOWN_ERR: " <> T.validate (T.toUTF8Bytes code)+ in E.throwIO $ UNKNOWN_ERR (ZooExInfo codeBS stack)++throwZooErrorIfNotOK :: HasCallStack => CInt -> IO CInt+throwZooErrorIfNotOK code+ | code == 0 = return 0+ | otherwise = throwZooError code callStack++throwZooErrorIfLeft :: HasCallStack => Either CInt a -> IO a+throwZooErrorIfLeft (Left rc) = throwZooError rc callStack+throwZooErrorIfLeft (Right x) = return x++throwZooErrorIfLeft' :: HasCallStack => (CInt -> Bool) -> Either CInt a -> IO (Maybe a)+throwZooErrorIfLeft' cond (Left rc) = if cond rc then return Nothing else throwZooError rc callStack+throwZooErrorIfLeft' _ (Right x) = return $ Just x++-------------------------------------------------------------------------------++foreign import ccall unsafe "hs_zk.h zerror"+ c_zerror :: CInt -> IO CString++foreign import ccall unsafe "HsBase.h __hscore_get_errno"+ getCErrNum :: IO CInt
+ src/ZooKeeper/Internal/FFI.hsc view
@@ -0,0 +1,267 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnliftedFFITypes #-}++module ZooKeeper.Internal.FFI where++import Control.Concurrent+import Control.Exception+import Control.Monad (void)+import Data.Version (Version, makeVersion)+import Data.Word+import Foreign.C+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.StablePtr+import GHC.Conc+import GHC.Stack (HasCallStack)+import Z.Foreign++import ZooKeeper.Exception+import ZooKeeper.Internal.Types++#include "hs_zk.h"++-------------------------------------------------------------------------------++zooVersion :: Version+#ifdef ZOO_MAJOR_VERSION+zooVersion = makeVersion [ (#const ZOO_MAJOR_VERSION)+ , (#const ZOO_MINOR_VERSION)+ , (#const ZOO_PATCH_VERSION)+ ]+#else+zooVersion = [0, 0, 0] -- unsupported+#endif++foreign import ccall unsafe "hs_zk.h &logLevel"+ c_log_level :: Ptr ZooLogLevel++-- | Sets the debugging level for the zookeeper library+foreign import ccall unsafe "hs_zk.h zoo_set_debug_level"+ zooSetDebugLevel :: ZooLogLevel -> IO ()++foreign import ccall unsafe "hs_zk.h hs_zookeeper_init"+ c_hs_zookeeper_init+ :: StablePtr PrimMVar -> Int -> Ptr HsWatcherCtx+ -> BA## Word8+ -> CInt+ -> ClientID+ -> CInt+ -> IO ZHandle++foreign import ccall safe "hs_zk.h zookeeper_close"+ c_zookeeper_close_safe :: ZHandle -> IO CInt++foreign import ccall unsafe "hs_zk.h zoo_client_id"+ c_zoo_client_id :: ZHandle -> IO ClientID++foreign import ccall unsafe "hs_zk.h hs_zoo_acreate"+ c_hs_zoo_acreate+ :: ZHandle+ -> BA## Word8+ -> BA## Word8 -> Int -> Int+ -> AclVector+ -> CreateMode+ -> StablePtr PrimMVar -> Int -> Ptr StringCompletion+ -> IO CInt+foreign import ccall unsafe "hs_zk.h hs_zoo_acreate"+ c_hs_zoo_acreate'+ :: ZHandle+ -> BA## Word8+ -> Ptr CChar -> Int -> Int+ -> AclVector+ -> CreateMode+ -> StablePtr PrimMVar -> Int -> Ptr StringCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_aset"+ c_hs_zoo_aset+ :: ZHandle+ -> BA## Word8+ -> BA## Word8 -> Int -> Int+ -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr StatCompletion+ -> IO CInt+foreign import ccall unsafe "hs_zk.h hs_zoo_aset"+ c_hs_zoo_aset'+ :: ZHandle+ -> BA## Word8+ -> Ptr Word8 -> Int -> Int+ -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr StatCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_aget"+ c_hs_zoo_aget+ :: ZHandle+ -> BA## Word8+ -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr DataCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_awget"+ c_hs_zoo_awget+ :: ZHandle -> BA## Word8+ -> StablePtr PrimMVar -> StablePtr PrimMVar -> Int+ -> Ptr HsWatcherCtx -> Ptr DataCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_adelete"+ c_hs_zoo_adelete+ :: ZHandle+ -> BA## Word8 -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr VoidCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_aexists"+ c_hs_zoo_aexists+ :: ZHandle -> BA## Word8 -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr StatCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_awexists"+ c_hs_zoo_awexists+ :: ZHandle -> BA## Word8+ -> StablePtr PrimMVar -> StablePtr PrimMVar -> Int+ -> Ptr HsWatcherCtx -> Ptr StatCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_aget_children"+ c_hs_zoo_aget_children+ :: ZHandle -> BA## Word8 -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr StringsCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_awget_children"+ c_hs_zoo_awget_children+ :: ZHandle -> BA## Word8+ -> StablePtr PrimMVar -> StablePtr PrimMVar -> Int+ -> Ptr HsWatcherCtx -> Ptr StringsCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_aget_children2"+ c_hs_zoo_aget_children2+ :: ZHandle -> BA## Word8 -> CInt+ -> StablePtr PrimMVar -> Int -> Ptr StringsStatCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_awget_children2"+ c_hs_zoo_awget_children2+ :: ZHandle -> BA## Word8+ -> StablePtr PrimMVar -> StablePtr PrimMVar -> Int+ -> Ptr HsWatcherCtx -> Ptr StringsStatCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_amulti"+ c_hs_zoo_amulti+ :: ZHandle -> CInt+ -> MBA## CZooOp -- Ptr CZooOp+ -> MBA## CZooOpResult -- Ptr CZooOpResult+ -> StablePtr PrimMVar -> Int -> Ptr VoidCompletion+ -> IO CInt++foreign import ccall unsafe "hs_zk.h hs_zoo_create_op_init"+ c_hs_zoo_create_op_init+ :: Ptr CZooOp+ -> BA## Word8 -- ^ path+ -> BA## Word8 -> Int -> Int+ -> AclVector+ -> CreateMode+ -> MBA## Word8 -> CInt -- ^ (path_buffer, path_buffer_len)+ -> IO ()+foreign import ccall unsafe "hs_zk.h hs_zoo_create_op_init"+ c_hs_zoo_create_op_init'+ :: Ptr CZooOp+ -> BA## Word8+ -> Ptr CChar -> Int -> Int+ -> AclVector+ -> CreateMode+ -> MBA## Word8 -> CInt+ -> IO ()++foreign import ccall unsafe "hs_zk.h zoo_delete_op_init"+ c_zoo_delete_op_init :: Ptr CZooOp -> BA## Word8 -> CInt -> IO ()++foreign import ccall unsafe "hs_zk.h hs_zoo_set_op_init"+ c_hs_zoo_set_op_init+ :: Ptr CZooOp+ -> BA## Word8+ -> BA## Word8 -> Int -> Int+ -> CInt+ -> MBA## Word8 -- pointer to Stat+ -> IO ()+foreign import ccall unsafe "hs_zk.h hs_zoo_set_op_init"+ c_hs_zoo_set_op_init'+ :: Ptr CZooOp+ -> BA## Word8+ -> Ptr Word8 -> Int -> Int+ -> CInt+ -> MBA## Word8 -- pointer to Stat+ -> IO ()++foreign import ccall unsafe "hs_zk.h zoo_check_op_init"+ c_zoo_check_op_init :: Ptr CZooOp -> BA## Word8 -> CInt -> IO ()++-------------------------------------------------------------------------------+-- Helpers++withZKAsync :: HasCallStack+ => Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)+ -> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)+ -> IO (Either CInt a)+withZKAsync = withZKAsync' []+{-# INLINE withZKAsync #-}++withZKAsync' :: HasCallStack+ => TouchListBytes+ -> Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)+ -> (StablePtr PrimMVar -> Int -> Ptr a -> IO CInt)+ -> IO (Either CInt a)+withZKAsync' bas size peek_result peek_data f = mask_ $ do+ mvar <- newEmptyMVar+ sp <- newStablePtrPrimMVar mvar+ fp <- mallocForeignPtrBytes size+ withForeignPtr fp $ \data' -> do+ (cap, _) <- threadCapability =<< myThreadId+ void $ throwZooErrorIfNotOK =<< f sp cap data'+ takeMVar mvar `onException` forkIO (do takeMVar mvar; touchForeignPtr fp; touch bas)+ rc <- peek_result data'+ case rc of+ CZOK -> Right <$> peek_data data'+ _ -> return $ Left rc+{-# INLINE withZKAsync' #-}++withZKAsync2+ :: HasCallStack+ => Int -> (Ptr a -> IO CInt) -> (Ptr a -> IO a)+ -> (Either CInt a -> IO ())+ -> Int -> (Ptr b -> IO CInt) -> (Ptr b -> IO b)+ -> (Either CInt b -> IO ())+ -> (StablePtr PrimMVar -> StablePtr PrimMVar -> Int -> Ptr a -> Ptr b -> IO CInt)+ -> IO ()+withZKAsync2 size1 peekRet1 peekData1 f1 size2 peekRet2 peekData2 f2 g = mask_ $ do+ mvar1 <- newEmptyMVar+ sp1 <- newStablePtrPrimMVar mvar1+ fp1 <- mallocForeignPtrBytes size1++ mvar2 <- newEmptyMVar+ sp2 <- newStablePtrPrimMVar mvar2+ fp2 <- mallocForeignPtrBytes size2++ withForeignPtr fp1 $ \data1' ->+ withForeignPtr fp2 $ \data2' -> do+ (cap, _) <- threadCapability =<< myThreadId+ void $ throwZooErrorIfNotOK =<< g sp1 sp2 cap data1' data2'++ takeMVar mvar2 `onException` forkIO (do takeMVar mvar2; touchForeignPtr fp2; touchForeignPtr fp1)+ rc2 <- peekRet2 data2'+ case rc2 of+ CZOK -> f2 =<< Right <$> peekData2 data2'+ _ -> f2 $ Left rc2++ takeMVar mvar1 `onException` forkIO (do takeMVar mvar1; touchForeignPtr fp1)+ rc1 <- peekRet1 data1'+ case rc1 of+ CZOK -> f1 =<< Right <$> peekData1 data1'+ _ -> f1 $ Left rc1+{-# INLINE withZKAsync2 #-}
+ src/ZooKeeper/Internal/Types.hsc view
@@ -0,0 +1,442 @@+{-# LANGUAGE CPP #-}++module ZooKeeper.Internal.Types where++import Control.Exception (bracket_)+import Control.Monad (forM)+import Data.Int+import Data.Proxy (Proxy (..))+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++#include "hs_zk.h"++-------------------------------------------------------------------------------++newtype ZHandle = ZHandle { unZHandle :: Ptr () }+ deriving (Show, Eq)++newtype ClientID = ClientID { unClientID :: Ptr () }+ deriving (Show, Eq)++newtype ZooLogLevel = ZooLogLevel CInt+ deriving (Eq, Storable)++instance Show ZooLogLevel where+ show ZooLogError = "ERROR"+ show ZooLogWarn = "WARN"+ show ZooLogInfo = "INFO"+ show ZooLogDebug = "DEBUG"+ show (ZooLogLevel x) = "ZooLogLevel " ++ show x++pattern ZooLogError, ZooLogWarn, ZooLogInfo, ZooLogDebug :: ZooLogLevel+pattern ZooLogError = ZooLogLevel (#const ZOO_LOG_LEVEL_ERROR)+pattern ZooLogWarn = ZooLogLevel (#const ZOO_LOG_LEVEL_WARN)+pattern ZooLogInfo = ZooLogLevel (#const ZOO_LOG_LEVEL_INFO)+pattern ZooLogDebug = ZooLogLevel (#const ZOO_LOG_LEVEL_DEBUG)++-------------------------------------------------------------------------------++-- | ACL permissions.+newtype ZooPerm = ZooPerm { unAcl :: CInt }+ deriving Eq++instance Show ZooPerm where+ show ZooPermRead = "ZooPermRead"+ show ZooPermWrite = "ZooPermWrite"+ show ZooPermCreate = "ZooPermCreate"+ show ZooPermDelete = "ZooPermDelete"+ show ZooPermAdmin = "ZooPermAdmin"+ show ZooPermAll = "ZooPermAll"+ show (ZooPerm x) = "ZooPerm: 0x" ++ showHex x ""++pattern ZooPermRead :: ZooPerm+pattern ZooPermRead = ZooPerm (#const ZOO_PERM_READ)++pattern ZooPermWrite :: ZooPerm+pattern ZooPermWrite = ZooPerm (#const ZOO_PERM_WRITE)++pattern ZooPermCreate :: ZooPerm+pattern ZooPermCreate = ZooPerm (#const ZOO_PERM_CREATE)++pattern ZooPermDelete :: ZooPerm+pattern ZooPermDelete = ZooPerm (#const ZOO_PERM_DELETE)++pattern ZooPermAdmin :: ZooPerm+pattern ZooPermAdmin = ZooPerm (#const ZOO_PERM_ADMIN)++pattern ZooPermAll :: ZooPerm+pattern ZooPermAll = ZooPerm (#const ZOO_PERM_ALL)++newtype AclVector = AclVector { unAclVector :: Ptr () }+ deriving (Show, 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++-------------------------------------------------------------------------------++-- | 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 (Eq, Storable)++instance Show ZooInterest where+ show ZookeeperWrite = "ZookeeperWrite"+ show ZookeeperRead = "ZookeeperRead"+ show (ZooInterest x) = "ZooInterest: " <> show x++pattern ZookeeperWrite :: ZooInterest+pattern ZookeeperWrite = ZooInterest (#const ZOOKEEPER_WRITE)++pattern ZookeeperRead :: ZooInterest+pattern ZookeeperRead = ZooInterest (#const ZOOKEEPER_READ)++-------------------------------------------------------------------------------++-- | State Consts+--+-- These constants represent the states of a zookeeper connection. They are+-- possible parameters of the watcher callback.+newtype ZooState = ZooState CInt+ deriving (Eq, Storable)+ deriving newtype (Text.Print)++instance Show ZooState where+ show ZooExpiredSession = "ExpiredSession"+ show ZooAuthFailed = "AuthFailed"+ show ZooConnectingState = "ConnectingState"+ show ZooAssociatingState = "AssociatingState"+ show ZooConnectedState = "ConnectedState"+ show (ZooState x) = "ZooState " <> show x++pattern+ ZooExpiredSession, ZooAuthFailed+ , ZooConnectingState, ZooAssociatingState, ZooConnectedState :: ZooState+pattern ZooExpiredSession = ZooState (#const ZOO_EXPIRED_SESSION_STATE)+pattern ZooAuthFailed = ZooState (#const ZOO_AUTH_FAILED_STATE)+pattern ZooConnectingState = ZooState (#const ZOO_CONNECTING_STATE)+pattern ZooAssociatingState = ZooState (#const ZOO_ASSOCIATING_STATE)+pattern ZooConnectedState = ZooState (#const ZOO_CONNECTED_STATE)++-- 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 (Eq, Storable)++instance Show ZooEvent where+ show ZooCreateEvent = "CreateEvent"+ show ZooDeleteEvent = "DeleteEvent"+ show ZooChangedEvent = "ChangedEvent"+ show ZooChildEvent = "ChildEvent"+ show ZooSessionEvent = "SessionEvent"+ show ZooNoWatchingEvent = "NoWatchingEvent"+ show (ZooEvent x) = "ZooEvent " <> show 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 ZooCreateEvent = ZooEvent (#const ZOO_CREATED_EVENT)++-- | 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 ZooDeleteEvent = ZooEvent (#const ZOO_DELETED_EVENT)++-- | 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 ZooChangedEvent = ZooEvent (#const ZOO_CHANGED_EVENT)++-- 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 ZooChildEvent = ZooEvent (#const ZOO_CHILD_EVENT)++-- | A session has been lost.+--+-- This is generated when a client loses contact or reconnects with a server.+pattern ZooSessionEvent :: ZooEvent+pattern ZooSessionEvent = ZooEvent (#const ZOO_SESSION_EVENT)++-- | 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 ZooNoWatchingEvent = ZooEvent (#const ZOO_NOTWATCHING_EVENT)++-------------------------------------------------------------------------------++-- | These modes are used by zoo_create to affect node create.+newtype CreateMode = CreateMode { unCreateMode :: CInt }+ deriving (Show, Eq, Storable)++pattern ZooPersistent :: CreateMode+pattern ZooPersistent = CreateMode 0++-- | The znode will be deleted upon the client's disconnect.+pattern ZooEphemeral :: CreateMode+pattern ZooEphemeral = CreateMode (#const ZOO_EPHEMERAL)++pattern ZooSequence :: CreateMode+pattern ZooSequence = CreateMode (#const ZOO_SEQUENCE)++-- 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+ { statCzxid :: Int64+ , statMzxid :: Int64+ , statCtime :: Int64+ , statMtime :: Int64+ , statVersion :: Int32+ , statCversion :: Int32+ , statAversion :: Int32+ , statEphemeralOwner :: Int64+ , statDataLength :: Int32+ , statNumChildren :: Int32+ , statPzxid :: Int64+ } deriving (Show, Eq)++statSize :: Int+statSize = (#size stat_t)++peekStat' :: Ptr Stat -> IO Stat+peekStat' ptr = Stat+ <$> (#peek stat_t, czxid) ptr+ <*> (#peek stat_t, mzxid) ptr+ <*> (#peek stat_t, ctime) ptr+ <*> (#peek stat_t, mtime) ptr+ <*> (#peek stat_t, version) ptr+ <*> (#peek stat_t, cversion) ptr+ <*> (#peek stat_t, aversion) ptr+ <*> (#peek stat_t, ephemeralOwner) ptr+ <*> (#peek stat_t, dataLength) ptr+ <*> (#peek stat_t, numChildren) ptr+ <*> (#peek stat_t, pzxid) ptr++peekStat :: Ptr Stat -> IO Stat+peekStat ptr = peekStat' ptr <* free ptr++newtype StringVector = StringVector { unStrVec :: [CBytes] }+ deriving Show++peekStringVector :: Ptr StringVector -> IO StringVector+peekStringVector ptr = bracket_ (return ()) (free ptr) $ do+ -- NOTE: Int32 is necessary, since count is int32_t in c+ count <- fromIntegral @Int32 <$> (#peek string_vector_t, count) ptr+ StringVector <$> forM [0..count-1] (peekStringVectorIdx ptr)++peekStringVectorIdx :: Ptr StringVector -> Int -> IO CBytes+peekStringVectorIdx ptr offset = do+ ptr' <- (#peek string_vector_t, data) ptr+ data_ptr <- peek $ ptr' `plusPtr` (offset * (sizeOf ptr'))+ CBytes.fromCString data_ptr <* free data_ptr++-------------------------------------------------------------------------------+-- Callback datas++data HsWatcherCtx = HsWatcherCtx+ { watcherCtxZHandle :: ZHandle+ , watcherCtxType :: ZooEvent+ , watcherCtxState :: ZooState+ , watcherCtxPath :: Maybe CBytes+ } deriving Show++hsWatcherCtxSize :: Int+hsWatcherCtxSize = (#size hs_watcher_ctx_t)++peekHsWatcherCtx :: Ptr HsWatcherCtx -> IO HsWatcherCtx+peekHsWatcherCtx ptr = do+ zh_ptr <- (#peek hs_watcher_ctx_t, zh) ptr+ event_type <-(#peek hs_watcher_ctx_t, type) ptr+ connect_state <- (#peek hs_watcher_ctx_t, state) ptr+ path_ptr <- (#peek hs_watcher_ctx_t, path) ptr+ path <- if path_ptr == nullPtr+ then return Nothing+ else Just <$> CBytes.fromCString path_ptr <* free path_ptr+ return $ HsWatcherCtx (ZHandle zh_ptr) event_type connect_state path++class Completion a where+ {-# MINIMAL csize, peekRet, peekData #-}+ csize :: Proxy a -> Int+ peekRet :: Ptr a -> IO CInt+ peekData :: Ptr a -> IO a++newtype StringCompletion = StringCompletion { strCompletionValue :: CBytes }+ deriving Show++instance Completion StringCompletion where+ csize _ = (#size hs_string_completion_t)+ peekRet ptr = (#peek hs_string_completion_t, rc) ptr+ peekData ptr = do+ value_ptr <- (#peek hs_string_completion_t, value) ptr+ value <- CBytes.fromCString value_ptr <* free value_ptr+ return $ StringCompletion value++data DataCompletion = DataCompletion+ { dataCompletionValue :: Maybe Bytes+ , dataCompletionStat :: Stat+ } deriving (Show, Eq)++instance Completion DataCompletion where+ csize _ = (#size hs_data_completion_t)+ peekRet ptr = (#peek hs_data_completion_t, rc) ptr+ peekData ptr = do+ val_ptr <- (#peek hs_data_completion_t, value) ptr+ val_len :: CInt <- (#peek hs_data_completion_t, value_len) ptr+ val <- if val_len >= 0+ then Just <$> Z.fromPtr val_ptr (fromIntegral val_len) <* free val_ptr+ else return Nothing+ stat_ptr <- (#peek hs_data_completion_t, stat) ptr+ stat <- peekStat stat_ptr+ return $ DataCompletion val stat++newtype StatCompletion = StatCompletion { statCompletionStat :: Stat }+ deriving (Show, Eq)++instance Completion StatCompletion where+ csize _ = (#size hs_stat_completion_t)+ peekRet ptr = (#peek hs_stat_completion_t, rc) ptr+ peekData ptr = do+ stat_ptr <- (#peek hs_stat_completion_t, stat) ptr+ stat <- peekStat stat_ptr+ return $ StatCompletion stat++newtype VoidCompletion = VoidCompletion ()++instance Completion VoidCompletion where+ csize _ = (#size hs_void_completion_t)+ peekRet ptr = (#peek hs_stat_completion_t, rc) ptr+ peekData _ = return $ VoidCompletion ()++newtype StringsCompletion = StringsCompletion+ { strsCompletionValues :: StringVector }+ deriving Show++instance Completion StringsCompletion where+ csize _ = (#size hs_strings_completion_t)+ peekRet ptr = (#peek hs_strings_completion_t, rc) ptr+ peekData ptr = do+ strs_ptr <- (#peek hs_strings_completion_t, strings) ptr+ vals <- peekStringVector strs_ptr+ return $ StringsCompletion vals++data StringsStatCompletion = StringsStatCompletion+ { strsStatCompletionStrs :: StringVector+ , strsStatCompletionStat :: Stat+ } deriving Show++instance Completion StringsStatCompletion where+ csize _ = (#size hs_strings_stat_completion_t)+ peekRet ptr = (#peek hs_strings_stat_completion_t, rc) ptr+ peekData ptr = do+ strs_ptr <- (#peek hs_strings_stat_completion_t, strings) ptr+ vals <- peekStringVector strs_ptr+ stat_ptr <- (#peek hs_strings_stat_completion_t, stat) ptr+ stat <- peekStat stat_ptr+ return $ StringsStatCompletion vals stat++-------------------------------------------------------------------------------++data CZooOp+data CZooOpResult++zooOpSize :: Int+zooOpSize = (#size zoo_op_t)++zooOpResultSize :: Int+zooOpResultSize = (#size zoo_op_result_t)++-- 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 (Show, Eq)++peekZooCreateOpResult :: ResultBytes -> Ptr CZooOpResult -> IO ZooOpResult+peekZooCreateOpResult (Z.MutableByteArray ba##) ptr = do+ ret <- (#peek zoo_op_result_t, err) ptr+ value <- CBytes.fromMutablePrimArray $ Z.MutablePrimArray ba##+ return $ ZooCreateOpResult ret value++peekZooDeleteOpResult :: Ptr CZooOpResult -> IO ZooOpResult+peekZooDeleteOpResult ptr = ZooDeleteOpResult <$> (#peek zoo_op_result_t, err) ptr++peekZooSetOpResult :: ResultBytes -> Ptr CZooOpResult -> IO ZooOpResult+peekZooSetOpResult mba ptr = do+ ret <- (#peek zoo_op_result_t, err) ptr+ ba <- Z.unsafeFreezeByteArray mba+ stat <- peekStat' $ castPtr $ Z.byteArrayContents ba+ return $ ZooSetOpResult ret stat++peekZooCheckOpResult :: Ptr CZooOpResult -> IO ZooOpResult+peekZooCheckOpResult ptr = ZooCheckOpResult <$> (#peek zoo_op_result_t, err) ptr
+ src/ZooKeeper/Types.hs view
@@ -0,0 +1,51 @@+module ZooKeeper.Types+ ( I.ZHandle+ , I.ClientID++ , I.ZooOp+ , I.ZooOpResult (..)++ , I.AclVector+ , I.zooOpenAclUnsafe+ , I.zooReadAclUnsafe+ , I.zooCreatorAllAcl++ , I.HsWatcherCtx (..)++ , I.VoidCompletion+ , I.DataCompletion (..)+ , I.StatCompletion (..)+ , I.StringCompletion (..)+ , I.StringsCompletion (..)+ , I.StringsStatCompletion (..)++ , I.ZooEvent+ , pattern I.ZooCreateEvent+ , pattern I.ZooDeleteEvent+ , pattern I.ZooChangedEvent+ , pattern I.ZooChildEvent+ , pattern I.ZooSessionEvent+ , pattern I.ZooNoWatchingEvent++ , I.ZooState+ , pattern I.ZooExpiredSession+ , pattern I.ZooAuthFailed+ , pattern I.ZooConnectingState+ , pattern I.ZooAssociatingState+ , pattern I.ZooConnectedState++ , I.CreateMode+ , pattern I.ZooPersistent+ , pattern I.ZooEphemeral+ , pattern I.ZooSequence++ , I.ZooLogLevel+ , pattern I.ZooLogError+ , pattern I.ZooLogWarn+ , pattern I.ZooLogInfo+ , pattern I.ZooLogDebug++ , I.StringVector (..)+ ) where++import qualified ZooKeeper.Internal.Types as I
+ test/Spec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent+import Control.Monad (void)+import Data.Version (makeVersion)+import Test.Hspec+import ZooKeeper+import ZooKeeper.Exception+import ZooKeeper.Types++client :: Resource ZHandle+client = zookeeperResInit "127.0.0.1:2182" 5000 Nothing 0++main :: IO ()+main = withResource client $ \zh -> do+ hspec $ smoke zh+ hspec $ multiSpec zh++smoke :: ZHandle -> Spec+smoke zh = do+ describe "ZooKeeper.zooVersion" $ do+ it "version should be 3.4.*" $ do+ zooVersion `shouldSatisfy` (>= makeVersion [3, 4, 0])+ zooVersion `shouldSatisfy` (< makeVersion [3, 5, 0])++ describe "zookeeper get set" $ do+ it "set some value to a node and get it" $ do+ let nodeName = "/test-node"+ void $ zooCreate zh nodeName Nothing zooOpenAclUnsafe ZooEphemeral+ void $ zooSet zh nodeName (Just "hello") Nothing+ (dataCompletionValue <$> zooGet zh nodeName) `shouldReturn` Just "hello"++ describe "ZooKeeper.zooGet" $ do+ it "get an empty node: the value should be Nothing" $ do+ _ <- zooCreate zh "/a" Nothing zooOpenAclUnsafe ZooEphemeral+ dataCompletionValue <$> zooGet zh "/a" `shouldReturn` Nothing++ describe "ZooKeeper.zooWatchExists" $ do+ it "wathch for node to appear" $ do+ ctx <- newEmptyMVar+ ret <- newEmptyMVar+ _ <- forkIO $ zooWatchExists zh "/b" (ctx `putMVar`) (ret `putMVar`)+ takeMVar ret `shouldReturn` Nothing+ _ <- forkIO $ void $ zooCreate zh "/b" Nothing zooOpenAclUnsafe ZooEphemeral+ ctx' <- takeMVar ctx+ watcherCtxType ctx' `shouldBe` ZooCreateEvent+ watcherCtxState ctx' `shouldBe` ZooConnectedState+ watcherCtxPath ctx' `shouldBe` Just "/b"++ describe "ZooKeeper.zooGetChildren" $ do+ it "test get children" $ do+ void $ zooCreate zh "/x" Nothing zooOpenAclUnsafe ZooPersistent+ void $ zooCreate zh "/x/1" Nothing zooOpenAclUnsafe ZooPersistent+ void $ zooCreate zh "/x/2" Nothing zooOpenAclUnsafe ZooPersistent+ unStrVec . strsCompletionValues <$> zooGetChildren zh "/x" `shouldReturn` ["1", "2"]+ zooDelete zh "/x/1" Nothing `shouldReturn` ()+ zooDelete zh "/x/2" Nothing `shouldReturn` ()+ zooDelete zh "/x" Nothing `shouldReturn` ()++ -- FIXME: Allow ephemeral znodes to have children created only by the owner session+ -- https://issues.apache.org/jira/browse/ZOOKEEPER-834+ it "create children of ephemeral nodes should throw exception" $ do+ void $ zooCreate zh "/x" Nothing zooOpenAclUnsafe ZooEphemeral+ zooCreate zh "/x/1" Nothing zooOpenAclUnsafe ZooEphemeral `shouldThrow` noChildrenForEphemerals++ it "get children of a leaf node should return []" $ do+ void $ zooCreate zh "/y" Nothing zooOpenAclUnsafe ZooPersistent+ unStrVec . strsCompletionValues <$> zooGetChildren zh "/y" `shouldReturn` []+ zooDelete zh "/y" Nothing `shouldReturn` ()++multiSpec :: ZHandle -> Spec+multiSpec zh = describe "ZooKeeper.zooMulti" $ do+ it "Test basic multi-op functionality" $ do+ let op0 = zooCreateOpInit "/multi" (Just "") 64 zooOpenAclUnsafe ZooPersistent+ let op1 = zooCreateOpInit "/multi/a" (Just "") 64 zooOpenAclUnsafe ZooPersistent+ let op2 = zooSetOpInit "/multi/a" (Just "hello") Nothing+ let op3 = zooDeleteOpInit "/multi/a" Nothing+ let op4 = zooDeleteOpInit "/multi" Nothing++ results <- zooMulti zh [op0, op1, op2]+ head results `shouldBe` ZooCreateOpResult CZOK "/multi"+ results !! 1 `shouldBe` ZooCreateOpResult CZOK "/multi/a"+ case results !! 2 of+ ZooSetOpResult ret _ -> ret `shouldBe` CZOK+ _ -> error "Invalid Op Result"+ (dataCompletionValue <$> zooGet zh "/multi/a") `shouldReturn` Just "hello"+ results' <- zooMulti zh [op3, op4]+ head results' `shouldBe` ZooDeleteOpResult CZOK+ results' !! 1 `shouldBe` ZooDeleteOpResult CZOK+ zooExists zh "/multi" `shouldReturn` Nothing++-------------------------------------------------------------------------------++noChildrenForEphemerals :: Selector ZNOCHILDRENFOREPHEMERALS+noChildrenForEphemerals = const True
+ zoovisitor.cabal view
@@ -0,0 +1,89 @@+cabal-version: 2.2+name: zoovisitor+version: 0.1.0.0+synopsis:+ A haskell binding to Apache Zookeeper C library(mt) using Haskell Z project.++description:+ Please see the README on Github at <https://github.com/ZHaskell/zoovisitor#readme>++license: BSD-3-Clause+license-file: LICENSE+copyright: Copyright (c)+author: mu+maintainer: mu@laxcat.xyz+tested-with: GHC ==8.8.4 || ==8.10.3 || ==9.0.1+category: Database+homepage: https://github.com/ZHaskell/zoovisitor+bug-reports: https://github.com/ZHaskell/zoovisitor/issues+build-type: Simple+extra-source-files:+ ChangeLog.md+ include/hs_zk.h+ LICENSE_ZOOKEEPER+ README.md++source-repository head+ type: git+ location: https://github.com/ZHaskell/zoovisitor++library+ hs-source-dirs: src+ exposed-modules:+ ZooKeeper+ ZooKeeper.Exception+ ZooKeeper.Types++ other-modules:+ ZooKeeper.Internal.FFI+ ZooKeeper.Internal.Types++ build-depends:+ , base >=4.12 && <5+ , Z-Data >=0.7.2 && <1.0+ , Z-IO ^>=0.7++ includes: hs_zk.h+ c-sources: cbits/hs_zk.c+ include-dirs: include /usr/local/include+ build-tool-depends: hsc2hs:hsc2hs -any+ extra-libraries: zookeeper_mt+ default-language: Haskell2010+ default-extensions:+ BangPatterns+ ConstraintKinds+ DeriveGeneric+ DerivingStrategies+ EmptyDataDeriving+ ExistentialQuantification+ GADTSyntax+ GeneralisedNewtypeDeriving+ MagicHash+ OverloadedStrings+ PatternSynonyms+ PolyKinds+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TypeApplications+ TypeOperators++ ghc-options:+ -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints++test-suite zoovisitor-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ build-depends:+ , base >=4.12 && <5+ , hspec+ , zoovisitor++ default-language: Haskell2010+ ghc-options:+ -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+ -threaded -rtsopts -with-rtsopts=-N