diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for zoovisitor + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/LICENSE_ZOOKEEPER b/LICENSE_ZOOKEEPER new file mode 100644 --- /dev/null +++ b/LICENSE_ZOOKEEPER @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/hs_zk.c b/cbits/hs_zk.c new file mode 100644 --- /dev/null +++ b/cbits/hs_zk.c @@ -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); +} + +// ---------------------------------------------------------------------------- diff --git a/include/hs_zk.h b/include/hs_zk.h new file mode 100644 --- /dev/null +++ b/include/hs_zk.h @@ -0,0 +1,152 @@ +#ifndef HS_ZK +#define HS_ZK + +#include +#include +#include +#include +#include + +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 diff --git a/src/ZooKeeper.hs b/src/ZooKeeper.hs new file mode 100644 --- /dev/null +++ b/src/ZooKeeper.hs @@ -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 diff --git a/src/ZooKeeper/Exception.hs b/src/ZooKeeper/Exception.hs new file mode 100644 --- /dev/null +++ b/src/ZooKeeper/Exception.hs @@ -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 diff --git a/src/ZooKeeper/Internal/FFI.hsc b/src/ZooKeeper/Internal/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/ZooKeeper/Internal/FFI.hsc @@ -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 #-} diff --git a/src/ZooKeeper/Internal/Types.hsc b/src/ZooKeeper/Internal/Types.hsc new file mode 100644 --- /dev/null +++ b/src/ZooKeeper/Internal/Types.hsc @@ -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 diff --git a/src/ZooKeeper/Types.hs b/src/ZooKeeper/Types.hs new file mode 100644 --- /dev/null +++ b/src/ZooKeeper/Types.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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 diff --git a/zoovisitor.cabal b/zoovisitor.cabal new file mode 100644 --- /dev/null +++ b/zoovisitor.cabal @@ -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 + +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