Add support for ContentLanguage and StorageClass (#80)

This commit is contained in:
Harshavardhana 2018-03-19 18:50:38 -07:00 committed by GitHub
parent 09d71251da
commit 38b67b4dab
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 77 additions and 6 deletions

View File

@ -1,5 +1,5 @@
-- --
-- Minio Haskell SDK, (C) 2017 Minio, Inc. -- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc.
-- --
-- Licensed under the Apache License, Version 2.0 (the "License"); -- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License. -- you may not use this file except in compliance with the License.
@ -102,7 +102,9 @@ module Network.Minio
, pooContentType , pooContentType
, pooContentEncoding , pooContentEncoding
, pooContentDisposition , pooContentDisposition
, pooContentLanguage
, pooCacheControl , pooCacheControl
, pooStorageClass
, pooUserMetadata , pooUserMetadata
, pooNumThreads , pooNumThreads

View File

@ -27,7 +27,6 @@ import qualified Data.ByteString as B
import Data.CaseInsensitive (mk) import Data.CaseInsensitive (mk)
import Data.Default (Default (..)) import Data.Default (Default (..))
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromJust)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time (defaultTimeLocale, formatTime) import Data.Time (defaultTimeLocale, formatTime)
import Network.HTTP.Client (defaultManagerSettings) import Network.HTTP.Client (defaultManagerSettings)
@ -192,13 +191,15 @@ data PutObjectOptions = PutObjectOptions {
, pooContentEncoding :: Maybe Text , pooContentEncoding :: Maybe Text
, pooContentDisposition :: Maybe Text , pooContentDisposition :: Maybe Text
, pooCacheControl :: Maybe Text , pooCacheControl :: Maybe Text
, pooContentLanguage :: Maybe Text
, pooStorageClass :: Maybe Text
, pooUserMetadata :: [(Text, Text)] , pooUserMetadata :: [(Text, Text)]
, pooNumThreads :: Maybe Word , pooNumThreads :: Maybe Word
} deriving (Show, Eq) } deriving (Show, Eq)
-- Provide a default instance -- Provide a default instance
instance Default PutObjectOptions where instance Default PutObjectOptions where
def = PutObjectOptions def def def def [] def def = PutObjectOptions def def def def def def [] def
addXAmzMetaPrefix :: Text -> Text addXAmzMetaPrefix :: Text -> Text
addXAmzMetaPrefix s = do addXAmzMetaPrefix s = do
@ -221,10 +222,13 @@ pooToHeaders poo = userMetadata
names = ["content-type", names = ["content-type",
"content-encoding", "content-encoding",
"content-disposition", "content-disposition",
"cache-control"] "content-language",
"cache-control",
"x-amz-storage-class"]
values = map (fmap encodeUtf8 . (poo &)) values = map (fmap encodeUtf8 . (poo &))
[pooContentType, pooContentEncoding, [pooContentType, pooContentEncoding,
pooContentDisposition, pooCacheControl] pooContentDisposition, pooContentLanguage,
pooCacheControl, pooStorageClass]
-- | -- |

View File

@ -1,5 +1,5 @@
-- --
-- Minio Haskell SDK, (C) 2017 Minio, Inc. -- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc.
-- --
-- Licensed under the Apache License, Version 2.0 (the "License"); -- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License. -- you may not use this file except in compliance with the License.
@ -352,8 +352,73 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
(Map.lookup "Content-Encoding" m) (Map.lookup "Content-Encoding" m)
step "Cleanup actions" step "Cleanup actions"
removeObject bucket object removeObject bucket object
, funTestWithBucket "putObject contentLanguage tests" $ \step bucket -> do
step "fPutObject content language test"
let object = "xxx-content-language"
size1 = 100 :: Int64
step "create server object with content-language"
inputFile <- mkRandFile size1
fPutObject bucket object inputFile def{
pooContentLanguage = Just "en-US"
}
-- retrieve obj info to check
oi <- headObject bucket object
let m = oiMetadata oi
step "Validate content-language"
liftIO $ assertEqual "content-language did not match" (Just "en-US")
(Map.lookup "Content-Language" m)
step "Cleanup actions"
removeObject bucket object
, funTestWithBucket "putObject storageClass tests" $ \step bucket -> do
step "fPutObject storage class test"
let object = "xxx-storage-class-standard"
object' = "xxx-storage-class-reduced"
object'' = "xxx-storage-class-invalid"
size1 = 100 :: Int64
size0 = 0 :: Int64
step "create server objects with storageClass"
inputFile <- mkRandFile size1
inputFile' <- mkRandFile size1
inputFile'' <- mkRandFile size0
fPutObject bucket object inputFile def{
pooStorageClass = Just "STANDARD"
}
fPutObject bucket object' inputFile' def{
pooStorageClass = Just "REDUCED_REDUNDANCY"
}
removeObject bucket object
-- retrieve obj info to check
oi' <- headObject bucket object'
let m' = oiMetadata oi'
step "Validate x-amz-storage-class rrs"
liftIO $ assertEqual "storageClass did not match" (Just "REDUCED_REDUNDANCY")
(Map.lookup "X-Amz-Storage-Class" m')
fpE <- MC.try $ fPutObject bucket object'' inputFile'' def{
pooStorageClass = Just "INVALID_STORAGE_CLASS"
}
case fpE of
Left exn -> liftIO $ exn @?= ServiceErr "InvalidStorageClass" "Invalid storage class."
_ -> return ()
step "Cleanup actions"
removeObject bucket object'
, funTestWithBucket "copyObject related tests" $ \step bucket -> do , funTestWithBucket "copyObject related tests" $ \step bucket -> do
step "copyObjectSingle basic tests" step "copyObjectSingle basic tests"
let object = "xxx" let object = "xxx"