You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@opendal.apache.org by si...@apache.org on 2023/07/24 08:59:52 UTC
[incubator-opendal] 01/01: feat(bindings/haskell): support ConcurrentLimitLayer && ImmutableIndexLayer
This is an automated email from the ASF dual-hosted git repository.
silver pushed a commit to branch feat/haskell-layers
in repository https://gitbox.apache.org/repos/asf/incubator-opendal.git
commit 228e9ab8cac963e67e347e9521679ca215fa73fa
Author: silver-ymz <yi...@gmail.com>
AuthorDate: Mon Jul 24 16:58:47 2023 +0800
feat(bindings/haskell): support ConcurrentLimitLayer && ImmutableIndexLayer
Signed-off-by: silver-ymz <yi...@gmail.com>
---
bindings/haskell/haskell-src/OpenDAL.hs | 53 +++++++++++++++-
bindings/haskell/haskell-src/OpenDAL/FFI.hs | 37 ++++++++++++
bindings/haskell/src/layers.rs | 74 +++++++++++++++++++++++
bindings/haskell/src/lib.rs | 94 +++++++++++++++++++++++++----
bindings/haskell/test/BasicTest.hs | 15 ++++-
bindings/haskell/test/Spec.hs | 16 ++---
6 files changed, 266 insertions(+), 23 deletions(-)
diff --git a/bindings/haskell/haskell-src/OpenDAL.hs b/bindings/haskell/haskell-src/OpenDAL.hs
index 15e980033..3004520fb 100644
--- a/bindings/haskell/haskell-src/OpenDAL.hs
+++ b/bindings/haskell/haskell-src/OpenDAL.hs
@@ -30,6 +30,7 @@ This module provides Haskell bindings for OpenDAL.
module OpenDAL (
Operator,
Lister,
+ Layer (..),
OpenDALError (..),
ErrorCode (..),
EntryMode (..),
@@ -38,6 +39,7 @@ module OpenDAL (
MonadOperation (..),
runOp,
newOp,
+ newOpWithLayers,
readOpRaw,
writeOpRaw,
isExistOpRaw,
@@ -49,7 +51,8 @@ module OpenDAL (
listOpRaw,
scanOpRaw,
nextLister,
-) where
+)
+where
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.Reader (ReaderT, ask, liftIO, runReaderT)
@@ -73,6 +76,13 @@ Users can construct Lister by `listOp` or `scanOp`.
-}
newtype Lister = Lister (ForeignPtr RawLister)
+data Layer
+ = -- | Add concurrent request limit.
+ ConcurrentLimit {concurrentLimitPermits :: Int}
+ | -- | Add immutable in-memory index for underlying storage services.
+ ImmutableIndex {immutableIndexKeys :: [String]}
+ deriving (Eq, Show)
+
-- | Represents the possible error codes that can be returned by OpenDAL.
data ErrorCode
= -- | An error occurred in the FFI layer.
@@ -269,6 +279,20 @@ parseFFIMetadata (FFIMetadata mode cacheControl contentDisposition contentLength
, mLastModified = lastModified'
}
+toFFILayer :: Layer -> IO FFILayer
+toFFILayer (ConcurrentLimit permits) = return $ FFIConcurrentLimit (fromIntegral permits)
+toFFILayer (ImmutableIndex keys) = do
+ cKeys <- mapM newCString keys
+ cKeysPtr <- newArray cKeys
+ return $ FFIImmutableIndex cKeysPtr (fromIntegral $ length keys)
+
+freeFFILayer :: FFILayer -> IO ()
+freeFFILayer (FFIImmutableIndex cKeysPtr len) = do
+ cKeys <- peekArray (fromIntegral len) cKeysPtr
+ mapM_ free cKeys
+ free cKeysPtr
+freeFFILayer _ = return ()
+
-- Exported functions
-- | Runs an OpenDAL operation in the 'OpMonad'.
@@ -298,6 +322,33 @@ newOp scheme hashMap = do
errMsg <- peekCString (errorMessage ffiResult)
return $ Left $ OpenDALError code errMsg
+-- | Creates a new OpenDAL operator via `HashMap`.
+newOpWithLayers :: String -> HashMap String String -> [Layer] -> IO (Either OpenDALError Operator)
+newOpWithLayers scheme hashMap layers = do
+ let keysAndValues = HashMap.toList hashMap
+ withCString scheme $ \cScheme ->
+ withMany withCString (map fst keysAndValues) $ \cKeys ->
+ withMany withCString (map snd keysAndValues) $ \cValues ->
+ allocaArray (length keysAndValues) $ \cKeysPtr ->
+ allocaArray (length keysAndValues) $ \cValuesPtr ->
+ allocaArray (length layers) $ \cLayersPtr ->
+ alloca $ \ffiResultPtr -> do
+ pokeArray cKeysPtr cKeys
+ pokeArray cValuesPtr cValues
+ cLayers <- mapM toFFILayer layers
+ pokeArray cLayersPtr cLayers
+ c_via_map_ffi_with_layers cScheme cKeysPtr cValuesPtr (fromIntegral $ length keysAndValues) cLayersPtr (fromIntegral $ length layers) ffiResultPtr
+ mapM_ freeFFILayer cLayers
+ ffiResult <- peek ffiResultPtr
+ if ffiCode ffiResult == 0
+ then do
+ op <- Operator <$> newForeignPtr c_free_operator (dataPtr ffiResult)
+ return $ Right op
+ else do
+ let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+ errMsg <- peekCString (errorMessage ffiResult)
+ return $ Left $ OpenDALError code errMsg
+
-- Functions for performing raw OpenDAL operations are defined below.
-- These functions are not meant to be used directly in most cases.
-- Instead, use the high-level interface provided by the 'MonadOperation' type class.
diff --git a/bindings/haskell/haskell-src/OpenDAL/FFI.hs b/bindings/haskell/haskell-src/OpenDAL/FFI.hs
index ccb63e2e4..7843dfa94 100644
--- a/bindings/haskell/haskell-src/OpenDAL/FFI.hs
+++ b/bindings/haskell/haskell-src/OpenDAL/FFI.hs
@@ -129,9 +129,46 @@ instance Storable FFIMetadata where
eTagOffset = contentTypeOffset + sizeOf (undefined :: CString)
lastModifiedOffset = eTagOffset + sizeOf (undefined :: CString)
+data FFILayer
+ = FFIConcurrentLimit {concurrentLimitPermits :: CSize}
+ | FFIImmutableIndex {immutableIndexKeys :: Ptr CString, immutableIndexkeysLen :: CSize}
+
+instance Storable FFILayer where
+ sizeOf _ = sizeOf (undefined :: CSize) * 3
+ alignment _ = alignment (undefined :: CSize)
+ peek ptr = do
+ tag <- peekByteOff ptr tagOffset :: IO CUInt
+ case tag of
+ 0 -> do
+ permits <- peekByteOff ptr dataPtrOffset
+ return $ FFIConcurrentLimit permits
+ 1 -> do
+ keys <- peekByteOff ptr dataPtrOffset
+ keysLen <- peekByteOff ptr (dataPtrOffset + sizeOf (undefined :: Ptr ()))
+ return $ FFIImmutableIndex keys keysLen
+ _ -> error "unknown tag"
+ where
+ tagOffset = 0
+ dataPtrOffset = sizeOf (undefined :: CSize)
+ poke ptr layer = do
+ case layer of
+ FFIConcurrentLimit permits -> do
+ pokeByteOff ptr tagOffset (0 :: CUInt)
+ pokeByteOff ptr dataPtrOffset permits
+ FFIImmutableIndex keys keysLen -> do
+ pokeByteOff ptr tagOffset (1 :: CUInt)
+ pokeByteOff ptr dataPtrOffset keys
+ pokeByteOff ptr (dataPtrOffset + sizeOf (undefined :: Ptr ())) keysLen
+ where
+ tagOffset = 0
+ dataPtrOffset = sizeOf (undefined :: CSize)
+
foreign import ccall "via_map_ffi"
c_via_map_ffi ::
CString -> Ptr CString -> Ptr CString -> CSize -> Ptr (FFIResult RawOperator) -> IO ()
+foreign import ccall "via_map_ffi_with_layers"
+ c_via_map_ffi_with_layers ::
+ CString -> Ptr CString -> Ptr CString -> CSize -> Ptr FFILayer -> CSize -> Ptr (FFIResult RawOperator) -> IO ()
foreign import ccall "&free_operator" c_free_operator :: FunPtr (Ptr RawOperator -> IO ())
foreign import ccall "free_byteslice" c_free_byteslice :: Ptr CChar -> CSize -> IO ()
foreign import ccall "blocking_read" c_blocking_read :: Ptr RawOperator -> CString -> Ptr (FFIResult ByteSlice) -> IO ()
diff --git a/bindings/haskell/src/layers.rs b/bindings/haskell/src/layers.rs
new file mode 100644
index 000000000..eea2c72f0
--- /dev/null
+++ b/bindings/haskell/src/layers.rs
@@ -0,0 +1,74 @@
+// Licensed to the Apache Software Foundation (ASF) under one
+// or more contributor license agreements. See the NOTICE file
+// distributed with this work for additional information
+// regarding copyright ownership. The ASF licenses this file
+// to you 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.
+
+use std::ffi::c_char;
+
+use ::opendal as od;
+
+#[repr(C)]
+pub struct Layer {
+ tag: LayerTag,
+ data: LayerData,
+}
+
+#[allow(dead_code)]
+#[repr(C)]
+pub enum LayerTag {
+ ConcurrentLimit,
+ ImmutableIndex,
+}
+
+#[repr(C)]
+pub union LayerData {
+ concurrent_limit: ConcurrentLimit,
+ immutable_index: ImmutableIndex,
+}
+
+#[repr(C)]
+#[derive(Clone, Copy)]
+pub struct ConcurrentLimit {
+ permits: usize,
+}
+
+#[repr(C)]
+#[derive(Clone, Copy)]
+pub struct ImmutableIndex {
+ keys: *const *const c_char,
+ keys_len: usize,
+}
+
+pub fn apply_layer(operator: od::Operator, layer: &Layer) -> od::Operator {
+ match layer.tag {
+ LayerTag::ConcurrentLimit => {
+ let layer = unsafe { &layer.data.concurrent_limit };
+ operator.layer(od::layers::ConcurrentLimitLayer::new(layer.permits))
+ }
+ LayerTag::ImmutableIndex => {
+ let layer = unsafe { &layer.data.immutable_index };
+ let key_slice = unsafe { std::slice::from_raw_parts(layer.keys, layer.keys_len) };
+ let iter = key_slice.iter().map(|key| unsafe {
+ std::ffi::CStr::from_ptr(*key)
+ .to_string_lossy()
+ .into_owned()
+ });
+
+ let mut layer = od::layers::ImmutableIndexLayer::default();
+ layer.extend_iter(iter);
+ operator.layer(layer)
+ }
+ }
+}
diff --git a/bindings/haskell/src/lib.rs b/bindings/haskell/src/lib.rs
index 0d4350c64..510decbad 100644
--- a/bindings/haskell/src/lib.rs
+++ b/bindings/haskell/src/lib.rs
@@ -15,6 +15,7 @@
// specific language governing permissions and limitations
// under the License.
+mod layers;
mod result;
mod types;
@@ -25,6 +26,7 @@ use std::os::raw::c_char;
use std::str::FromStr;
use ::opendal as od;
+use layers::Layer;
use od::BlockingLister;
use result::FFIResult;
use types::ByteSlice;
@@ -88,6 +90,74 @@ pub unsafe extern "C" fn via_map_ffi(
*result = res;
}
+/// # Safety
+///
+/// * The `keys`, `values`, `len` are valid from `HashMap`.
+/// * The memory pointed to by `scheme` contain a valid nul terminator at the end of
+/// the string.
+/// * The `result` is a valid pointer, and has available memory to write to.
+///
+/// # Panics
+///
+/// * If `keys` or `values` are not valid pointers.
+/// * If `len` is not the same for `keys` and `values`.
+/// * If `result` is not a valid pointer.
+#[no_mangle]
+pub unsafe extern "C" fn via_map_ffi_with_layers(
+ scheme: *const c_char,
+ keys: *const *const c_char,
+ values: *const *const c_char,
+ map_len: usize,
+ layers: *const Layer,
+ layers_len: usize,
+ result: *mut FFIResult<od::BlockingOperator>,
+) {
+ let scheme_str = match CStr::from_ptr(scheme).to_str() {
+ Ok(s) => s,
+ Err(_) => {
+ *result = FFIResult::err("Failed to convert scheme to string");
+ return;
+ }
+ };
+
+ let scheme = match od::Scheme::from_str(scheme_str) {
+ Ok(s) => s,
+ Err(_) => {
+ *result = FFIResult::err("Failed to parse scheme");
+ return;
+ }
+ };
+
+ let keys_vec = std::slice::from_raw_parts(keys, map_len);
+ let values_vec = std::slice::from_raw_parts(values, map_len);
+
+ let map = keys_vec
+ .iter()
+ .zip(values_vec.iter())
+ .map(|(&k, &v)| {
+ (
+ CStr::from_ptr(k).to_string_lossy().into_owned(),
+ CStr::from_ptr(v).to_string_lossy().into_owned(),
+ )
+ })
+ .collect::<HashMap<String, String>>();
+
+ let layers_vec = std::slice::from_raw_parts(layers, layers_len);
+
+ let res = match od::Operator::via_map(scheme, map) {
+ Ok(mut operator) => {
+ for layer in layers_vec {
+ operator = layers::apply_layer(operator, layer);
+ }
+
+ FFIResult::ok(operator.blocking())
+ }
+ Err(e) => FFIResult::err_with_source("Failed to create Operator", e),
+ };
+
+ *result = res;
+}
+
/// # Safety
///
/// * `operator` is a valid pointer to a `BlockingOperator`.
@@ -128,7 +198,7 @@ pub unsafe extern "C" fn blocking_read(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -172,7 +242,7 @@ pub unsafe extern "C" fn blocking_write(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -216,7 +286,7 @@ pub unsafe extern "C" fn blocking_is_exist(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -255,7 +325,7 @@ pub unsafe extern "C" fn blocking_create_dir(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -296,7 +366,7 @@ pub unsafe extern "C" fn blocking_copy(
let path_from_str = match CStr::from_ptr(path_from).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert source path to string");
return;
}
};
@@ -304,7 +374,7 @@ pub unsafe extern "C" fn blocking_copy(
let path_to_str = match CStr::from_ptr(path_to).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert destination path to string");
return;
}
};
@@ -345,7 +415,7 @@ pub unsafe extern "C" fn blocking_rename(
let path_from_str = match CStr::from_ptr(path_from).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert source path to string");
return;
}
};
@@ -353,7 +423,7 @@ pub unsafe extern "C" fn blocking_rename(
let path_to_str = match CStr::from_ptr(path_to).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert destination path to string");
return;
}
};
@@ -392,7 +462,7 @@ pub unsafe extern "C" fn blocking_delete(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -431,7 +501,7 @@ pub unsafe extern "C" fn blocking_stat(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -470,7 +540,7 @@ pub unsafe extern "C" fn blocking_list(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
@@ -509,7 +579,7 @@ pub unsafe extern "C" fn blocking_scan(
let path_str = match CStr::from_ptr(path).to_str() {
Ok(s) => s,
Err(_) => {
- *result = FFIResult::err("Failed to convert scheme to string");
+ *result = FFIResult::err("Failed to convert path to string");
return;
}
};
diff --git a/bindings/haskell/test/BasicTest.hs b/bindings/haskell/test/BasicTest.hs
index 7041fccc9..627b9323d 100644
--- a/bindings/haskell/test/BasicTest.hs
+++ b/bindings/haskell/test/BasicTest.hs
@@ -32,6 +32,7 @@ basicTests =
[ testCase "testBasicOperation" testRawOperation
, testCase "testMonad" testMonad
, testCase "testError" testError
+ , testCase "testLayer" testLayer
]
testRawOperation :: Assertion
@@ -98,10 +99,10 @@ testMonad = do
deleteOp "key1"
isExistOp "key1" ?= False
lister <- listOp "/"
- liftIO $ findLister lister "key3" >>= (@?= True)
+ liftIO $ findLister lister "key3" ?= True
renameOp "key3" "/dir1/key5"
lister2 <- scanOp "/"
- liftIO $ findLister lister2 "dir1/key5" >>= (@?= True)
+ liftIO $ findLister lister2 "dir1/key5" ?= True
except_meta =
Metadata
{ mMode = File
@@ -123,6 +124,16 @@ testError = do
where
operation = readOp "non-exist-path"
+testLayer :: Assertion
+testLayer = do
+ Right op <- newOpWithLayers "memory" HashMap.empty [layer]
+ runOp op operation >>= (@?= Right ())
+ where
+ layer = ImmutableIndex ["key1"]
+ operation = do
+ lister <- listOp "/"
+ liftIO $ findLister lister "key1" ?= True
+
-- helper function
(?=) :: (MonadIO m, Eq a, Show a) => m a -> a -> m ()
diff --git a/bindings/haskell/test/Spec.hs b/bindings/haskell/test/Spec.hs
index 35c5a7d14..b842454f1 100644
--- a/bindings/haskell/test/Spec.hs
+++ b/bindings/haskell/test/Spec.hs
@@ -21,11 +21,11 @@ import Test.Tasty.Ingredients.Basic (consoleTestReporter)
import BasicTest
main :: IO ()
-main = do
- tests <-
- testGroup "All Tests"
- <$> sequence
- [ return basicTests
- -- Add other test groups here as needed
- ]
- defaultMainWithIngredients [consoleTestReporter] tests
\ No newline at end of file
+main =
+ defaultMainWithIngredients
+ [consoleTestReporter]
+ $ testGroup
+ "All Tests"
+ [ basicTests
+ -- Add other test groups here as needed
+ ]
\ No newline at end of file