minio-hs 0.3.0 → 0.3.1
raw patch · 5 files changed
+83/−27 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- minio-hs.cabal +8/−5
- src/Network/Minio/Utils.hs +9/−17
- test/LiveServer.hs +16/−4
- test/Network/Minio/Utils/Test.hs +47/−0
- test/Spec.hs +3/−1
minio-hs.cabal view
@@ -1,9 +1,10 @@ name: minio-hs-version: 0.3.0-synopsis: A Minio client library, compatible with S3 like services.-description: minio-hs provides simple APIs to access Minio and Amazon- S3 compatible object storage server. For more details,- please see README.md.+version: 0.3.1+synopsis: A Minio Haskell Library for Amazon S3 compatible cloud+ storage.+description: The Minio Haskell client library provides simple APIs to+ access Minio, Amazon S3 and other API compatible cloud+ storage servers. homepage: https://github.com/minio/minio-hs#readme license: Apache-2.0 license-file: LICENSE@@ -106,6 +107,7 @@ , Network.Minio.S3API , Network.Minio.Sign.V4 , Network.Minio.Utils+ , Network.Minio.Utils.Test , Network.Minio.API.Test , Network.Minio.XmlGenerator , Network.Minio.XmlGenerator.Test@@ -215,6 +217,7 @@ , Network.Minio.S3API , Network.Minio.Sign.V4 , Network.Minio.Utils+ , Network.Minio.Utils.Test , Network.Minio.API.Test , Network.Minio.XmlGenerator , Network.Minio.XmlGenerator.Test
src/Network/Minio/Utils.hs view
@@ -17,10 +17,9 @@ module Network.Minio.Utils where import qualified Control.Concurrent.Async.Lifted as A-import qualified Control.Concurrent.QSem as Q+import qualified Control.Concurrent.QSem.Lifted as Q import qualified Control.Exception.Lifted as ExL import qualified Control.Monad.Catch as MC-import Control.Monad.Trans.Control (liftBaseOp_, StM) import qualified Control.Monad.Trans.Resource as R import qualified Data.ByteString as B@@ -162,25 +161,18 @@ tryHttpEx = ExL.try contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp --- like mapConcurrently but with a limited number of concurrent--- threads.-limitedMapConcurrently :: forall t a (m :: * -> *) b.- (MonadIO m, R.MonadBaseControl IO m,- StM m a ~ StM m b)- => Int -> (t -> m a) -> [t] -> m [b]+-- Similar to mapConcurrently but limits the number of threads that+-- can run using a quantity semaphore.+limitedMapConcurrently :: (MonadIO m, R.MonadBaseControl IO m)+ => Int -> (t -> m a) -> [t] -> m [a] limitedMapConcurrently count act args = do qSem <- liftIO $ Q.newQSem count- threads <- workOn qSem args+ threads <- mapM (A.async . wThread qSem) args mapM A.wait threads where- workOn _ [] = return []- workOn qs (a:as) = liftBaseOp_- (bracket_ (Q.waitQSem qs) (Q.signalQSem qs)) $- do- thread <- A.async $ act a- others <- workOn qs as- return (thread : others)-+ -- grab 1 unit from semaphore, run action and release it+ wThread qs arg =+ ExL.bracket_ (Q.waitQSem qs) (Q.signalQSem qs) $ act arg -- helper function to 'drop' empty optional parameter. mkQuery :: Text -> Maybe Text -> Maybe (Text, Text)
test/LiveServer.hs view
@@ -263,7 +263,10 @@ step "list incomplete multipart uploads" incompleteUploads <- listIncompleteUploads' bucket Nothing Nothing Nothing Nothing Nothing- liftIO $ (length $ lurUploads incompleteUploads) @?= 10+ -- Minio server behaviour changed to list no incomplete uploads,+ -- so the check below reflects this; this test is expected to+ -- fail on AWS S3.+ liftIO $ (length $ lurUploads incompleteUploads) @?= 0 step "cleanup" forM_ (lurUploads incompleteUploads) $@@ -286,7 +289,10 @@ step "fetch list parts" listPartsResult <- listIncompleteParts' bucket object uid Nothing Nothing- liftIO $ (length $ lprParts listPartsResult) @?= 10+ -- Minio server behaviour changed to list no incomplete uploads,+ -- so the check below reflects this; this test is expected to+ -- fail on AWS S3.+ liftIO $ (length $ lprParts listPartsResult) @?= 0 abortMultipartUpload bucket object uid step "High-level listObjects Test"@@ -314,7 +320,10 @@ step "High-level listing of incomplete multipart uploads" uploads <- (listIncompleteUploads bucket Nothing True) $$ sinkList- liftIO $ (length uploads) @?= 10+ -- Minio server behaviour changed to list no incomplete uploads,+ -- so the check below reflects this; this test is expected to+ -- fail on AWS S3.+ liftIO $ (length uploads) @?= 0 step "cleanup" forM_ uploads $ \(UploadInfo _ uid _ _) ->@@ -337,7 +346,10 @@ step "fetch list parts" incompleteParts <- (listIncompleteParts bucket object uid) $$ sinkList- liftIO $ (length incompleteParts) @?= 10+ -- Minio server behaviour changed to list no incomplete uploads,+ -- so the check below reflects this; this test is expected to+ -- fail on AWS S3.+ liftIO $ (length incompleteParts) @?= 0 step "cleanup" abortMultipartUpload bucket object uid
+ test/Network/Minio/Utils/Test.hs view
@@ -0,0 +1,47 @@+--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- 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.+--++module Network.Minio.Utils.Test+ (+ limitedMapConcurrentlyTests+ ) where++import Test.Tasty+import Test.Tasty.HUnit++import Lib.Prelude++import Network.Minio.Utils++limitedMapConcurrentlyTests :: TestTree+limitedMapConcurrentlyTests = testGroup "limitedMapConcurrently Tests"+ [ testCase "Test with various thread counts" testLMC+ ]++testLMC :: Assertion+testLMC = do+ let maxNum = 50+ -- test with thread count of 1 to 2*maxNum+ forM_ [1..(2*maxNum)] $ \threads -> do+ res <- limitedMapConcurrently threads compute [1..maxNum]+ sum res @?= overallResultCheck maxNum+ where+ -- simple function to run in each thread+ compute :: Int -> IO Int+ compute n = return $ sum [1..n]++ -- function to check overall result+ overallResultCheck n = sum $ map (\t -> (t * (t+1)) `div` 2) [1..n]
test/Spec.hs view
@@ -23,6 +23,7 @@ import Network.Minio.API.Test import Network.Minio.PutObject+import Network.Minio.Utils.Test import Network.Minio.XmlGenerator.Test import Network.Minio.XmlParser.Test @@ -113,4 +114,5 @@ unitTests :: TestTree unitTests = testGroup "Unit tests" [xmlGeneratorTests, xmlParserTests, bucketNameValidityTests,- objectNameValidityTests]+ objectNameValidityTests,+ limitedMapConcurrentlyTests]