haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Switch to more performant map data type (#131)

Browse Source
This commit is contained in:
Aditya Manthramurthy 2019-07-24 12:52:18 -07:00 committed by GitHub
parent 3291f8673c
commit 04d1193201
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 57 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CHANGELOG.md
View File

@ -1,6 +1,12 @@
Changelog
==========
## Version 1.5.0
* Switch to faster map data type - all previous usage of
Data.Map.Strict and Data.Set is replaced with Data.HashMap.Strict
and Data.HashSet.
## Version 1.4.0
* Expose runMinioRes and runMinioResWith (#129)

19
docs/API.md
View File

@ -247,12 +247,13 @@ __Return Value__
__ObjectInfo record type__
| Field | Type | Description |
|:------------|:----------------------------|:---------------------------------|
| `oiObject` | _Object_ (alias for `Text`) | Name of object |
| `oiModTime` | _UTCTime_ | Last modified time of the object |
| `oiETag` | _ETag_ (alias for `Text`) | ETag of the object |
| `oiSize` | _Int64_ | Size of the object in bytes |
| Field | Type | Description |
|:-------------|:----------------------------|:-------------------------------------|
| `oiObject` | _Object_ (alias for `Text`) | Name of object |
| `oiModTime` | _UTCTime_ | Last modified time of the object |
| `oiETag` | _ETag_ (alias for `Text`) | ETag of the object |
| `oiSize` | _Int64_ | Size of the object in bytes |
| `oiMetadata` | _HashMap Text Text_ | Map of key-value user-metadata pairs |
__Example__
@ -928,7 +929,7 @@ main = do
```
<a name="presignedPostPolicy"></a>
### presignedPostPolicy :: PostPolicy -> Minio (ByteString, Map.Map Text ByteString)
### presignedPostPolicy :: PostPolicy -> Minio (ByteString, HashMap Text ByteString)
Generate a presigned URL and POST policy to upload files via a POST
request. This is intended for browser uploads and generates form data
@ -965,7 +966,7 @@ import Network.Minio
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as H
import qualified Data.Text.Encoding as Enc
import qualified Data.Time as Time
@ -1005,7 +1006,7 @@ main = do
let
formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",
"'", v, "'"]
formOptions = B.intercalate " " $ map formFn $ Map.toList formData
formOptions = B.intercalate " " $ map formFn $ H.toList formData
return $ B.intercalate " " $

4
examples/PresignedPostPolicy.hs
View File

@ -22,7 +22,7 @@ import Network.Minio
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as H
import qualified Data.Text.Encoding as Enc
import qualified Data.Time as Time
@ -69,7 +69,7 @@ main = do
let
formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",
"'", v, "'"]
formOptions = B.intercalate " " $ map formFn $ Map.toList formData
formOptions = B.intercalate " " $ map formFn $ H.toList formData
return $ B.intercalate " " $

5
minio-hs.cabal
View File

@ -1,5 +1,5 @@
name: minio-hs
version: 1.4.0
version: 1.5.0
synopsis: A MinIO Haskell Library for Amazon S3 compatible cloud
storage.
description: The MinIO Haskell client library provides simple APIs to
@ -57,7 +57,6 @@ library
, conduit >= 1.3
, conduit-extra >= 1.3
, connection
, containers >= 0.5
, cryptonite >= 0.25
, cryptonite-conduit >= 0.2
, digest >= 0.0.1
@ -153,7 +152,6 @@ test-suite minio-hs-live-server-test
, conduit
, conduit-extra
, connection
, containers
, cryptonite
, cryptonite-conduit
, digest
@ -200,7 +198,6 @@ test-suite minio-hs-test
, conduit
, conduit-extra
, connection
, containers
, cryptonite
, cryptonite-conduit
, digest

4
src/Network/Minio/API.hs
View File

@ -34,7 +34,7 @@ import Control.Retry (fullJitterBackoff,
import qualified Data.ByteString as B
import qualified Data.Char as C
import qualified Data.Conduit as C
import qualified Data.Map as Map
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified Data.Time.Clock as Time
import Network.HTTP.Conduit (Response)
@ -95,7 +95,7 @@ getRegionHost r = do
if "amazonaws.com" `T.isSuffixOf` connectHost ci
then maybe (throwIO $ MErrVRegionNotSupported r)
return (Map.lookup r awsRegionMap)
return (H.lookup r awsRegionMap)
else return $ connectHost ci
buildRequest :: S3ReqInfo -> Minio NC.Request

13
src/Network/Minio/Data.hs
View File

@ -32,7 +32,6 @@ import qualified Data.ByteString as B
import Data.CaseInsensitive (mk)
import qualified Data.HashMap.Strict as H
import qualified Data.Ini as Ini
import qualified Data.Map as Map
import Data.String (IsString (..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@ -74,8 +73,8 @@ maxMultipartParts = 10000
-- type should have a IsString instance to infer the appropriate
-- constant.
-- | awsRegionMap - library constant
awsRegionMap :: Map.Map Text Text
awsRegionMap = Map.fromList [
awsRegionMap :: H.HashMap Text Text
awsRegionMap = H.fromList [
("us-east-1", "s3.amazonaws.com")
, ("us-east-2", "s3-us-east-2.amazonaws.com")
, ("us-west-1", "s3-us-west-1.amazonaws.com")
@ -440,8 +439,8 @@ data ObjectInfo = ObjectInfo
, oiModTime :: UTCTime -- ^ Mdification time of the object
, oiETag :: ETag -- ^ ETag of the object
, oiSize :: Int64 -- ^ Size of the object in bytes
, oiMetadata :: Map.Map Text Text -- ^ A map of the metadata
-- key-value pairs
, oiMetadata :: H.HashMap Text Text -- ^ A map of the metadata
-- key-value pairs
} deriving (Show, Eq)
-- | Represents source object in server-side copy object
@ -928,7 +927,7 @@ getS3Path b o =
-- seconds. The maximum duration that can be specified is 7 days.
type UrlExpiry = Int
type RegionMap = Map.Map Bucket Region
type RegionMap = H.HashMap Bucket Region
-- | The Minio Monad - all computations accessing object storage
-- happens in it.
@ -991,7 +990,7 @@ runMinioWith conn m = runResourceT $ runMinioResWith conn m
-- `MinioConn`.
mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
mkMinioConn ci mgr = do
rMapMVar <- M.newMVar Map.empty
rMapMVar <- M.newMVar H.empty
return $ MinioConn ci mgr rMapMVar
-- | Run the Minio action and return the result or an error.

10
src/Network/Minio/PresignedOperations.hs
View File

@ -39,7 +39,7 @@ module Network.Minio.PresignedOperations
import Data.Aeson ((.=))
import qualified Data.Aeson as Json
import Data.ByteString.Builder (byteString, toLazyByteString)
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified Data.Time as Time
import qualified Network.HTTP.Conduit as NC
@ -252,7 +252,7 @@ showPostPolicy = toS . Json.encode
-- browser. On success, this function returns a URL and POST
-- form-data.
presignedPostPolicy :: PostPolicy
-> Minio (ByteString, Map.Map Text ByteString)
-> Minio (ByteString, H.HashMap Text ByteString)
presignedPostPolicy p = do
ci <- asks mcConnInfo
signTime <- liftIO $ Time.getCurrentTime
@ -277,12 +277,12 @@ presignedPostPolicy p = do
mkPair (PPCStartsWith k v) = Just (k, v)
mkPair (PPCEquals k v) = Just (k, v)
mkPair _ = Nothing
formFromPolicy = Map.map toS $ Map.fromList $ catMaybes $
formFromPolicy = H.map toS $ H.fromList $ catMaybes $
mkPair <$> conditions ppWithCreds
formData = formFromPolicy `Map.union` signData
formData = formFromPolicy `H.union` signData
-- compute POST upload URL
bucket = Map.findWithDefault "" "bucket" formData
bucket = H.lookupDefault "" "bucket" formData
scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci
region = connectRegion ci

10
src/Network/Minio/Sign/V4.hs
View File

@ -22,8 +22,8 @@ import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B8
import Data.CaseInsensitive (mk)
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import qualified Data.Time as Time
import qualified Network.HTTP.Conduit as NC
import Network.HTTP.Types (Header, parseQuery)
@ -39,7 +39,7 @@ import Network.Minio.Errors
-- these headers are not included in the string to sign when signing a
-- request
ignoredHeaders :: Set ByteString
ignoredHeaders :: Set.HashSet ByteString
ignoredHeaders = Set.fromList $ map CI.foldedCase
[ H.hAuthorization
, H.hContentType
@ -178,7 +178,7 @@ mkScope ts region = B.intercalate "/"
getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
getHeadersToSign !h =
filter (flip Set.notMember ignoredHeaders . fst) $
filter ((\hdr -> not $ Set.member hdr ignoredHeaders) . fst) $
map (\(x, y) -> (CI.foldedCase x, stripBS y)) h
mkCanonicalRequest :: Bool -> SignParams -> NC.Request -> [(ByteString, ByteString)]
@ -234,7 +234,7 @@ computeSignature !toSign !key = digestToBase16 $ hmacSHA256 toSign key
-- and ConnInfo and returns form-data for the POST upload containing
-- just the signature and the encoded post-policy.
signV4PostPolicy :: ByteString -> SignParams
-> Map.Map Text ByteString
-> Map.HashMap Text ByteString
signV4PostPolicy !postPolicyJSON !sp =
let
stringToSign = Base64.encode postPolicyJSON

12
src/Network/Minio/Utils.hs
View File

@ -23,8 +23,8 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.CaseInsensitive (mk, original)
import qualified Data.Conduit.Binary as CB
import qualified Data.HashMap.Strict as H
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Text.Encoding.Error (lenientDecode)
import Data.Text.Read (decimal)
@ -105,8 +105,8 @@ getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs
getMetadata :: [HT.Header] -> [(Text, Text)]
getMetadata = map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)))
getMetadataMap :: [HT.Header] -> Map Text Text
getMetadataMap hs = Map.fromList (getMetadata hs)
getMetadataMap :: [HT.Header] -> H.HashMap Text Text
getMetadataMap hs = H.fromList (getMetadata hs)
getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
getLastModifiedHeader hs = do
@ -245,14 +245,14 @@ lookupRegionCache :: Bucket -> Minio (Maybe Region)
lookupRegionCache b = do
rMVar <- asks mcRegionMap
rMap <- UM.readMVar rMVar
return $ Map.lookup b rMap
return $ H.lookup b rMap
addToRegionCache :: Bucket -> Region -> Minio ()
addToRegionCache b region = do
rMVar <- asks mcRegionMap
UM.modifyMVar_ rMVar $ return . Map.insert b region
UM.modifyMVar_ rMVar $ return . H.insert b region
deleteFromRegionCache :: Bucket -> Minio ()
deleteFromRegionCache b = do
rMVar <- asks mcRegionMap
UM.modifyMVar_ rMVar $ return . Map.delete b
UM.modifyMVar_ rMVar $ return . H.delete b

6
src/Network/Minio/XmlParser.hs
View File

@ -30,8 +30,8 @@ module Network.Minio.XmlParser
) where
import qualified Data.ByteString.Lazy as LB
import qualified Data.HashMap.Strict as H
import Data.List (zip3, zip4, zip5)
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Data.Time
@ -149,7 +149,7 @@ parseListObjectsV1Response xmldata = do
sizes <- parseDecimals sizeStr
let
objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat Map.empty)
objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat H.empty)
return $ ListObjectsV1Result hasMore nextMarker objects prefixes
@ -178,7 +178,7 @@ parseListObjectsResponse xmldata = do
sizes <- parseDecimals sizeStr
let
objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat Map.empty)
objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat H.empty)
return $ ListObjectsResult hasMore nextToken objects prefixes

16
test/LiveServer.hs
View File

@ -27,7 +27,7 @@ import Data.Conduit (yield)
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import Data.Conduit.Combinators (sinkList)
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import Data.Time (fromGregorian)
import qualified Data.Time as Time
@ -513,8 +513,8 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $
"presigned HEAD failed (presignedHeadObjectUrl)"
-- check that header info is accurate
let h = Map.fromList $ NC.responseHeaders headResp
cLen = Map.findWithDefault "0" HT.hContentLength h
let h = H.fromList $ NC.responseHeaders headResp
cLen = H.lookupDefault "0" HT.hContentLength h
liftIO $ (cLen == show size2) @? "Head req returned bad content length"
step "GET object presigned URL - presignedGetObjectUrl"
@ -580,7 +580,7 @@ presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $
postForm url formData inputFile = do
req <- NC.parseRequest $ toS url
let parts = map (\(x, y) -> Form.partBS x y) $
Map.toList formData
H.toList formData
parts' = parts ++ [Form.partFile "file" inputFile]
req' <- Form.formDataBody parts' req
mgr <- NC.newManager NC.tlsManagerSettings
@ -698,7 +698,7 @@ putObjectContentTypeTest = funTestWithBucket "putObject contentType tests" $
let m = oiMetadata oi
step "Validate content-type"
liftIO $ assertEqual "Content-Type did not match" (Just "application/javascript") (Map.lookup "Content-Type" m)
liftIO $ assertEqual "Content-Type did not match" (Just "application/javascript") (H.lookup "Content-Type" m)
step "upload object with content-encoding set to identity"
fPutObject bucket object inputFile defaultPutObjectOptions {
@ -710,7 +710,7 @@ putObjectContentTypeTest = funTestWithBucket "putObject contentType tests" $
step "Validate content-encoding"
liftIO $ assertEqual "Content-Encoding did not match" (Just "identity")
(Map.lookup "Content-Encoding" m')
(H.lookup "Content-Encoding" m')
step "Cleanup actions"
@ -735,7 +735,7 @@ putObjectContentLanguageTest = funTestWithBucket "putObject contentLanguage test
step "Validate content-language"
liftIO $ assertEqual "content-language did not match" (Just "en-US")
(Map.lookup "Content-Language" m)
(H.lookup "Content-Language" m)
step "Cleanup actions"
removeObject bucket object
@ -771,7 +771,7 @@ putObjectStorageClassTest = funTestWithBucket "putObject storageClass tests" $
step "Validate x-amz-storage-class rrs"
liftIO $ assertEqual "storageClass did not match" (Just "REDUCED_REDUNDANCY")
(Map.lookup "X-Amz-Storage-Class" m')
(H.lookup "X-Amz-Storage-Class" m')
fpE <- try $ fPutObject bucket object'' inputFile'' defaultPutObjectOptions {
pooStorageClass = Just "INVALID_STORAGE_CLASS"

6
test/Network/Minio/XmlParser/Test.hs
View File

@ -19,7 +19,7 @@ module Network.Minio.XmlParser.Test
( xmlParserTests
) where
import qualified Data.Map as Map
import qualified Data.HashMap.Strict as H
import Data.Time (fromGregorian)
import Test.Tasty
import Test.Tasty.HUnit
@ -128,7 +128,7 @@ testParseListObjectsResult = do
\</ListBucketResult>"
expectedListResult = ListObjectsResult True (Just "opaque") [object1] []
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
parsedListObjectsResult <- tryValidationErr $ runTestNS $ parseListObjectsResponse xmldata
@ -155,7 +155,7 @@ testParseListObjectsV1Result = do
\</ListBucketResult>"
expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] []
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
parsedListObjectsV1Result <- tryValidationErr $ runTestNS $ parseListObjectsV1Response xmldata