Switch to more performant map data type (#131)
This commit is contained in:
parent
3291f8673c
commit
04d1193201
@ -1,6 +1,12 @@
|
|||||||
Changelog
|
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
|
## Version 1.4.0
|
||||||
|
|
||||||
* Expose runMinioRes and runMinioResWith (#129)
|
* Expose runMinioRes and runMinioResWith (#129)
|
||||||
|
|||||||
19
docs/API.md
19
docs/API.md
@ -247,12 +247,13 @@ __Return Value__
|
|||||||
|
|
||||||
__ObjectInfo record type__
|
__ObjectInfo record type__
|
||||||
|
|
||||||
| Field | Type | Description |
|
| Field | Type | Description |
|
||||||
|:------------|:----------------------------|:---------------------------------|
|
|:-------------|:----------------------------|:-------------------------------------|
|
||||||
| `oiObject` | _Object_ (alias for `Text`) | Name of object |
|
| `oiObject` | _Object_ (alias for `Text`) | Name of object |
|
||||||
| `oiModTime` | _UTCTime_ | Last modified time of the object |
|
| `oiModTime` | _UTCTime_ | Last modified time of the object |
|
||||||
| `oiETag` | _ETag_ (alias for `Text`) | ETag of the object |
|
| `oiETag` | _ETag_ (alias for `Text`) | ETag of the object |
|
||||||
| `oiSize` | _Int64_ | Size of the object in bytes |
|
| `oiSize` | _Int64_ | Size of the object in bytes |
|
||||||
|
| `oiMetadata` | _HashMap Text Text_ | Map of key-value user-metadata pairs |
|
||||||
|
|
||||||
__Example__
|
__Example__
|
||||||
|
|
||||||
@ -928,7 +929,7 @@ main = do
|
|||||||
```
|
```
|
||||||
|
|
||||||
<a name="presignedPostPolicy"></a>
|
<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
|
Generate a presigned URL and POST policy to upload files via a POST
|
||||||
request. This is intended for browser uploads and generates form data
|
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 as B
|
||||||
import qualified Data.ByteString.Char8 as Char8
|
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.Text.Encoding as Enc
|
||||||
import qualified Data.Time as Time
|
import qualified Data.Time as Time
|
||||||
|
|
||||||
@ -1005,7 +1006,7 @@ main = do
|
|||||||
let
|
let
|
||||||
formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",
|
formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",
|
||||||
"'", v, "'"]
|
"'", v, "'"]
|
||||||
formOptions = B.intercalate " " $ map formFn $ Map.toList formData
|
formOptions = B.intercalate " " $ map formFn $ H.toList formData
|
||||||
|
|
||||||
|
|
||||||
return $ B.intercalate " " $
|
return $ B.intercalate " " $
|
||||||
|
|||||||
@ -22,7 +22,7 @@ import Network.Minio
|
|||||||
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Char8 as Char8
|
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.Text.Encoding as Enc
|
||||||
import qualified Data.Time as Time
|
import qualified Data.Time as Time
|
||||||
|
|
||||||
@ -69,7 +69,7 @@ main = do
|
|||||||
let
|
let
|
||||||
formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",
|
formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",
|
||||||
"'", v, "'"]
|
"'", v, "'"]
|
||||||
formOptions = B.intercalate " " $ map formFn $ Map.toList formData
|
formOptions = B.intercalate " " $ map formFn $ H.toList formData
|
||||||
|
|
||||||
|
|
||||||
return $ B.intercalate " " $
|
return $ B.intercalate " " $
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: minio-hs
|
name: minio-hs
|
||||||
version: 1.4.0
|
version: 1.5.0
|
||||||
synopsis: A MinIO Haskell Library for Amazon S3 compatible cloud
|
synopsis: A MinIO Haskell Library for Amazon S3 compatible cloud
|
||||||
storage.
|
storage.
|
||||||
description: The MinIO Haskell client library provides simple APIs to
|
description: The MinIO Haskell client library provides simple APIs to
|
||||||
@ -57,7 +57,6 @@ library
|
|||||||
, conduit >= 1.3
|
, conduit >= 1.3
|
||||||
, conduit-extra >= 1.3
|
, conduit-extra >= 1.3
|
||||||
, connection
|
, connection
|
||||||
, containers >= 0.5
|
|
||||||
, cryptonite >= 0.25
|
, cryptonite >= 0.25
|
||||||
, cryptonite-conduit >= 0.2
|
, cryptonite-conduit >= 0.2
|
||||||
, digest >= 0.0.1
|
, digest >= 0.0.1
|
||||||
@ -153,7 +152,6 @@ test-suite minio-hs-live-server-test
|
|||||||
, conduit
|
, conduit
|
||||||
, conduit-extra
|
, conduit-extra
|
||||||
, connection
|
, connection
|
||||||
, containers
|
|
||||||
, cryptonite
|
, cryptonite
|
||||||
, cryptonite-conduit
|
, cryptonite-conduit
|
||||||
, digest
|
, digest
|
||||||
@ -200,7 +198,6 @@ test-suite minio-hs-test
|
|||||||
, conduit
|
, conduit
|
||||||
, conduit-extra
|
, conduit-extra
|
||||||
, connection
|
, connection
|
||||||
, containers
|
|
||||||
, cryptonite
|
, cryptonite
|
||||||
, cryptonite-conduit
|
, cryptonite-conduit
|
||||||
, digest
|
, digest
|
||||||
|
|||||||
@ -34,7 +34,7 @@ import Control.Retry (fullJitterBackoff,
|
|||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Char as C
|
import qualified Data.Char as C
|
||||||
import qualified Data.Conduit 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.Text as T
|
||||||
import qualified Data.Time.Clock as Time
|
import qualified Data.Time.Clock as Time
|
||||||
import Network.HTTP.Conduit (Response)
|
import Network.HTTP.Conduit (Response)
|
||||||
@ -95,7 +95,7 @@ getRegionHost r = do
|
|||||||
|
|
||||||
if "amazonaws.com" `T.isSuffixOf` connectHost ci
|
if "amazonaws.com" `T.isSuffixOf` connectHost ci
|
||||||
then maybe (throwIO $ MErrVRegionNotSupported r)
|
then maybe (throwIO $ MErrVRegionNotSupported r)
|
||||||
return (Map.lookup r awsRegionMap)
|
return (H.lookup r awsRegionMap)
|
||||||
else return $ connectHost ci
|
else return $ connectHost ci
|
||||||
|
|
||||||
buildRequest :: S3ReqInfo -> Minio NC.Request
|
buildRequest :: S3ReqInfo -> Minio NC.Request
|
||||||
|
|||||||
@ -32,7 +32,6 @@ import qualified Data.ByteString as B
|
|||||||
import Data.CaseInsensitive (mk)
|
import Data.CaseInsensitive (mk)
|
||||||
import qualified Data.HashMap.Strict as H
|
import qualified Data.HashMap.Strict as H
|
||||||
import qualified Data.Ini as Ini
|
import qualified Data.Ini as Ini
|
||||||
import qualified Data.Map as Map
|
|
||||||
import Data.String (IsString (..))
|
import Data.String (IsString (..))
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
@ -74,8 +73,8 @@ maxMultipartParts = 10000
|
|||||||
-- type should have a IsString instance to infer the appropriate
|
-- type should have a IsString instance to infer the appropriate
|
||||||
-- constant.
|
-- constant.
|
||||||
-- | awsRegionMap - library constant
|
-- | awsRegionMap - library constant
|
||||||
awsRegionMap :: Map.Map Text Text
|
awsRegionMap :: H.HashMap Text Text
|
||||||
awsRegionMap = Map.fromList [
|
awsRegionMap = H.fromList [
|
||||||
("us-east-1", "s3.amazonaws.com")
|
("us-east-1", "s3.amazonaws.com")
|
||||||
, ("us-east-2", "s3-us-east-2.amazonaws.com")
|
, ("us-east-2", "s3-us-east-2.amazonaws.com")
|
||||||
, ("us-west-1", "s3-us-west-1.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
|
, oiModTime :: UTCTime -- ^ Mdification time of the object
|
||||||
, oiETag :: ETag -- ^ ETag of the object
|
, oiETag :: ETag -- ^ ETag of the object
|
||||||
, oiSize :: Int64 -- ^ Size of the object in bytes
|
, oiSize :: Int64 -- ^ Size of the object in bytes
|
||||||
, oiMetadata :: Map.Map Text Text -- ^ A map of the metadata
|
, oiMetadata :: H.HashMap Text Text -- ^ A map of the metadata
|
||||||
-- key-value pairs
|
-- key-value pairs
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
-- | Represents source object in server-side copy object
|
-- | 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.
|
-- seconds. The maximum duration that can be specified is 7 days.
|
||||||
type UrlExpiry = Int
|
type UrlExpiry = Int
|
||||||
|
|
||||||
type RegionMap = Map.Map Bucket Region
|
type RegionMap = H.HashMap Bucket Region
|
||||||
|
|
||||||
-- | The Minio Monad - all computations accessing object storage
|
-- | The Minio Monad - all computations accessing object storage
|
||||||
-- happens in it.
|
-- happens in it.
|
||||||
@ -991,7 +990,7 @@ runMinioWith conn m = runResourceT $ runMinioResWith conn m
|
|||||||
-- `MinioConn`.
|
-- `MinioConn`.
|
||||||
mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
|
mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
|
||||||
mkMinioConn ci mgr = do
|
mkMinioConn ci mgr = do
|
||||||
rMapMVar <- M.newMVar Map.empty
|
rMapMVar <- M.newMVar H.empty
|
||||||
return $ MinioConn ci mgr rMapMVar
|
return $ MinioConn ci mgr rMapMVar
|
||||||
|
|
||||||
-- | Run the Minio action and return the result or an error.
|
-- | Run the Minio action and return the result or an error.
|
||||||
|
|||||||
@ -39,7 +39,7 @@ module Network.Minio.PresignedOperations
|
|||||||
import Data.Aeson ((.=))
|
import Data.Aeson ((.=))
|
||||||
import qualified Data.Aeson as Json
|
import qualified Data.Aeson as Json
|
||||||
import Data.ByteString.Builder (byteString, toLazyByteString)
|
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.Text as T
|
||||||
import qualified Data.Time as Time
|
import qualified Data.Time as Time
|
||||||
import qualified Network.HTTP.Conduit as NC
|
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
|
-- browser. On success, this function returns a URL and POST
|
||||||
-- form-data.
|
-- form-data.
|
||||||
presignedPostPolicy :: PostPolicy
|
presignedPostPolicy :: PostPolicy
|
||||||
-> Minio (ByteString, Map.Map Text ByteString)
|
-> Minio (ByteString, H.HashMap Text ByteString)
|
||||||
presignedPostPolicy p = do
|
presignedPostPolicy p = do
|
||||||
ci <- asks mcConnInfo
|
ci <- asks mcConnInfo
|
||||||
signTime <- liftIO $ Time.getCurrentTime
|
signTime <- liftIO $ Time.getCurrentTime
|
||||||
@ -277,12 +277,12 @@ presignedPostPolicy p = do
|
|||||||
mkPair (PPCStartsWith k v) = Just (k, v)
|
mkPair (PPCStartsWith k v) = Just (k, v)
|
||||||
mkPair (PPCEquals k v) = Just (k, v)
|
mkPair (PPCEquals k v) = Just (k, v)
|
||||||
mkPair _ = Nothing
|
mkPair _ = Nothing
|
||||||
formFromPolicy = Map.map toS $ Map.fromList $ catMaybes $
|
formFromPolicy = H.map toS $ H.fromList $ catMaybes $
|
||||||
mkPair <$> conditions ppWithCreds
|
mkPair <$> conditions ppWithCreds
|
||||||
formData = formFromPolicy `Map.union` signData
|
formData = formFromPolicy `H.union` signData
|
||||||
|
|
||||||
-- compute POST upload URL
|
-- compute POST upload URL
|
||||||
bucket = Map.findWithDefault "" "bucket" formData
|
bucket = H.lookupDefault "" "bucket" formData
|
||||||
scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci
|
scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci
|
||||||
region = connectRegion ci
|
region = connectRegion ci
|
||||||
|
|
||||||
|
|||||||
@ -22,8 +22,8 @@ import qualified Data.ByteString.Base64 as Base64
|
|||||||
import qualified Data.ByteString.Char8 as B8
|
import qualified Data.ByteString.Char8 as B8
|
||||||
import Data.CaseInsensitive (mk)
|
import Data.CaseInsensitive (mk)
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.HashSet as Set
|
||||||
import qualified Data.Time as Time
|
import qualified Data.Time as Time
|
||||||
import qualified Network.HTTP.Conduit as NC
|
import qualified Network.HTTP.Conduit as NC
|
||||||
import Network.HTTP.Types (Header, parseQuery)
|
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
|
-- these headers are not included in the string to sign when signing a
|
||||||
-- request
|
-- request
|
||||||
ignoredHeaders :: Set ByteString
|
ignoredHeaders :: Set.HashSet ByteString
|
||||||
ignoredHeaders = Set.fromList $ map CI.foldedCase
|
ignoredHeaders = Set.fromList $ map CI.foldedCase
|
||||||
[ H.hAuthorization
|
[ H.hAuthorization
|
||||||
, H.hContentType
|
, H.hContentType
|
||||||
@ -178,7 +178,7 @@ mkScope ts region = B.intercalate "/"
|
|||||||
|
|
||||||
getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
|
getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
|
||||||
getHeadersToSign !h =
|
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
|
map (\(x, y) -> (CI.foldedCase x, stripBS y)) h
|
||||||
|
|
||||||
mkCanonicalRequest :: Bool -> SignParams -> NC.Request -> [(ByteString, ByteString)]
|
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
|
-- and ConnInfo and returns form-data for the POST upload containing
|
||||||
-- just the signature and the encoded post-policy.
|
-- just the signature and the encoded post-policy.
|
||||||
signV4PostPolicy :: ByteString -> SignParams
|
signV4PostPolicy :: ByteString -> SignParams
|
||||||
-> Map.Map Text ByteString
|
-> Map.HashMap Text ByteString
|
||||||
signV4PostPolicy !postPolicyJSON !sp =
|
signV4PostPolicy !postPolicyJSON !sp =
|
||||||
let
|
let
|
||||||
stringToSign = Base64.encode postPolicyJSON
|
stringToSign = Base64.encode postPolicyJSON
|
||||||
|
|||||||
@ -23,8 +23,8 @@ import qualified Data.ByteString as B
|
|||||||
import qualified Data.ByteString.Lazy as LB
|
import qualified Data.ByteString.Lazy as LB
|
||||||
import Data.CaseInsensitive (mk, original)
|
import Data.CaseInsensitive (mk, original)
|
||||||
import qualified Data.Conduit.Binary as CB
|
import qualified Data.Conduit.Binary as CB
|
||||||
|
import qualified Data.HashMap.Strict as H
|
||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
import qualified Data.Map as Map
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
import Data.Text.Read (decimal)
|
import Data.Text.Read (decimal)
|
||||||
@ -105,8 +105,8 @@ getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs
|
|||||||
getMetadata :: [HT.Header] -> [(Text, Text)]
|
getMetadata :: [HT.Header] -> [(Text, Text)]
|
||||||
getMetadata = map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)))
|
getMetadata = map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)))
|
||||||
|
|
||||||
getMetadataMap :: [HT.Header] -> Map Text Text
|
getMetadataMap :: [HT.Header] -> H.HashMap Text Text
|
||||||
getMetadataMap hs = Map.fromList (getMetadata hs)
|
getMetadataMap hs = H.fromList (getMetadata hs)
|
||||||
|
|
||||||
getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
|
getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
|
||||||
getLastModifiedHeader hs = do
|
getLastModifiedHeader hs = do
|
||||||
@ -245,14 +245,14 @@ lookupRegionCache :: Bucket -> Minio (Maybe Region)
|
|||||||
lookupRegionCache b = do
|
lookupRegionCache b = do
|
||||||
rMVar <- asks mcRegionMap
|
rMVar <- asks mcRegionMap
|
||||||
rMap <- UM.readMVar rMVar
|
rMap <- UM.readMVar rMVar
|
||||||
return $ Map.lookup b rMap
|
return $ H.lookup b rMap
|
||||||
|
|
||||||
addToRegionCache :: Bucket -> Region -> Minio ()
|
addToRegionCache :: Bucket -> Region -> Minio ()
|
||||||
addToRegionCache b region = do
|
addToRegionCache b region = do
|
||||||
rMVar <- asks mcRegionMap
|
rMVar <- asks mcRegionMap
|
||||||
UM.modifyMVar_ rMVar $ return . Map.insert b region
|
UM.modifyMVar_ rMVar $ return . H.insert b region
|
||||||
|
|
||||||
deleteFromRegionCache :: Bucket -> Minio ()
|
deleteFromRegionCache :: Bucket -> Minio ()
|
||||||
deleteFromRegionCache b = do
|
deleteFromRegionCache b = do
|
||||||
rMVar <- asks mcRegionMap
|
rMVar <- asks mcRegionMap
|
||||||
UM.modifyMVar_ rMVar $ return . Map.delete b
|
UM.modifyMVar_ rMVar $ return . H.delete b
|
||||||
|
|||||||
@ -30,8 +30,8 @@ module Network.Minio.XmlParser
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as LB
|
import qualified Data.ByteString.Lazy as LB
|
||||||
|
import qualified Data.HashMap.Strict as H
|
||||||
import Data.List (zip3, zip4, zip5)
|
import Data.List (zip3, zip4, zip5)
|
||||||
import qualified Data.Map as Map
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text.Read (decimal)
|
import Data.Text.Read (decimal)
|
||||||
import Data.Time
|
import Data.Time
|
||||||
@ -149,7 +149,7 @@ parseListObjectsV1Response xmldata = do
|
|||||||
sizes <- parseDecimals sizeStr
|
sizes <- parseDecimals sizeStr
|
||||||
|
|
||||||
let
|
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
|
return $ ListObjectsV1Result hasMore nextMarker objects prefixes
|
||||||
|
|
||||||
@ -178,7 +178,7 @@ parseListObjectsResponse xmldata = do
|
|||||||
sizes <- parseDecimals sizeStr
|
sizes <- parseDecimals sizeStr
|
||||||
|
|
||||||
let
|
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
|
return $ ListObjectsResult hasMore nextToken objects prefixes
|
||||||
|
|
||||||
|
|||||||
@ -27,7 +27,7 @@ import Data.Conduit (yield)
|
|||||||
import qualified Data.Conduit as C
|
import qualified Data.Conduit as C
|
||||||
import qualified Data.Conduit.Binary as CB
|
import qualified Data.Conduit.Binary as CB
|
||||||
import Data.Conduit.Combinators (sinkList)
|
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 qualified Data.Text as T
|
||||||
import Data.Time (fromGregorian)
|
import Data.Time (fromGregorian)
|
||||||
import qualified Data.Time as Time
|
import qualified Data.Time as Time
|
||||||
@ -513,8 +513,8 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $
|
|||||||
"presigned HEAD failed (presignedHeadObjectUrl)"
|
"presigned HEAD failed (presignedHeadObjectUrl)"
|
||||||
|
|
||||||
-- check that header info is accurate
|
-- check that header info is accurate
|
||||||
let h = Map.fromList $ NC.responseHeaders headResp
|
let h = H.fromList $ NC.responseHeaders headResp
|
||||||
cLen = Map.findWithDefault "0" HT.hContentLength h
|
cLen = H.lookupDefault "0" HT.hContentLength h
|
||||||
liftIO $ (cLen == show size2) @? "Head req returned bad content length"
|
liftIO $ (cLen == show size2) @? "Head req returned bad content length"
|
||||||
|
|
||||||
step "GET object presigned URL - presignedGetObjectUrl"
|
step "GET object presigned URL - presignedGetObjectUrl"
|
||||||
@ -580,7 +580,7 @@ presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $
|
|||||||
postForm url formData inputFile = do
|
postForm url formData inputFile = do
|
||||||
req <- NC.parseRequest $ toS url
|
req <- NC.parseRequest $ toS url
|
||||||
let parts = map (\(x, y) -> Form.partBS x y) $
|
let parts = map (\(x, y) -> Form.partBS x y) $
|
||||||
Map.toList formData
|
H.toList formData
|
||||||
parts' = parts ++ [Form.partFile "file" inputFile]
|
parts' = parts ++ [Form.partFile "file" inputFile]
|
||||||
req' <- Form.formDataBody parts' req
|
req' <- Form.formDataBody parts' req
|
||||||
mgr <- NC.newManager NC.tlsManagerSettings
|
mgr <- NC.newManager NC.tlsManagerSettings
|
||||||
@ -698,7 +698,7 @@ putObjectContentTypeTest = funTestWithBucket "putObject contentType tests" $
|
|||||||
let m = oiMetadata oi
|
let m = oiMetadata oi
|
||||||
|
|
||||||
step "Validate content-type"
|
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"
|
step "upload object with content-encoding set to identity"
|
||||||
fPutObject bucket object inputFile defaultPutObjectOptions {
|
fPutObject bucket object inputFile defaultPutObjectOptions {
|
||||||
@ -710,7 +710,7 @@ putObjectContentTypeTest = funTestWithBucket "putObject contentType tests" $
|
|||||||
|
|
||||||
step "Validate content-encoding"
|
step "Validate content-encoding"
|
||||||
liftIO $ assertEqual "Content-Encoding did not match" (Just "identity")
|
liftIO $ assertEqual "Content-Encoding did not match" (Just "identity")
|
||||||
(Map.lookup "Content-Encoding" m')
|
(H.lookup "Content-Encoding" m')
|
||||||
|
|
||||||
step "Cleanup actions"
|
step "Cleanup actions"
|
||||||
|
|
||||||
@ -735,7 +735,7 @@ putObjectContentLanguageTest = funTestWithBucket "putObject contentLanguage test
|
|||||||
|
|
||||||
step "Validate content-language"
|
step "Validate content-language"
|
||||||
liftIO $ assertEqual "content-language did not match" (Just "en-US")
|
liftIO $ assertEqual "content-language did not match" (Just "en-US")
|
||||||
(Map.lookup "Content-Language" m)
|
(H.lookup "Content-Language" m)
|
||||||
step "Cleanup actions"
|
step "Cleanup actions"
|
||||||
|
|
||||||
removeObject bucket object
|
removeObject bucket object
|
||||||
@ -771,7 +771,7 @@ putObjectStorageClassTest = funTestWithBucket "putObject storageClass tests" $
|
|||||||
|
|
||||||
step "Validate x-amz-storage-class rrs"
|
step "Validate x-amz-storage-class rrs"
|
||||||
liftIO $ assertEqual "storageClass did not match" (Just "REDUCED_REDUNDANCY")
|
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 {
|
fpE <- try $ fPutObject bucket object'' inputFile'' defaultPutObjectOptions {
|
||||||
pooStorageClass = Just "INVALID_STORAGE_CLASS"
|
pooStorageClass = Just "INVALID_STORAGE_CLASS"
|
||||||
|
|||||||
@ -19,7 +19,7 @@ module Network.Minio.XmlParser.Test
|
|||||||
( xmlParserTests
|
( xmlParserTests
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.HashMap.Strict as H
|
||||||
import Data.Time (fromGregorian)
|
import Data.Time (fromGregorian)
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
@ -128,7 +128,7 @@ testParseListObjectsResult = do
|
|||||||
\</ListBucketResult>"
|
\</ListBucketResult>"
|
||||||
|
|
||||||
expectedListResult = ListObjectsResult True (Just "opaque") [object1] []
|
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
|
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
|
||||||
|
|
||||||
parsedListObjectsResult <- tryValidationErr $ runTestNS $ parseListObjectsResponse xmldata
|
parsedListObjectsResult <- tryValidationErr $ runTestNS $ parseListObjectsResponse xmldata
|
||||||
@ -155,7 +155,7 @@ testParseListObjectsV1Result = do
|
|||||||
\</ListBucketResult>"
|
\</ListBucketResult>"
|
||||||
|
|
||||||
expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] []
|
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
|
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
|
||||||
|
|
||||||
parsedListObjectsV1Result <- tryValidationErr $ runTestNS $ parseListObjectsV1Response xmldata
|
parsedListObjectsV1Result <- tryValidationErr $ runTestNS $ parseListObjectsV1Response xmldata
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user