From 38b67b4dabc2790ac8ab902c4507da5c1a686438 Mon Sep 17 00:00:00 2001
From: Harshavardhana <harsha@minio.io>
Date: Mon, 19 Mar 2018 18:50:38 -0700
Subject: [PATCH] Add support for ContentLanguage and StorageClass (#80)

---
 src/Network/Minio.hs      |  4 ++-
 src/Network/Minio/Data.hs | 12 ++++---
 test/LiveServer.hs        | 67 ++++++++++++++++++++++++++++++++++++++-
 3 files changed, 77 insertions(+), 6 deletions(-)

diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs
index 21b9451..73fa61b 100644
--- a/src/Network/Minio.hs
+++ b/src/Network/Minio.hs
@@ -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");
 -- you may not use this file except in compliance with the License.
@@ -102,7 +102,9 @@ module Network.Minio
   , pooContentType
   , pooContentEncoding
   , pooContentDisposition
+  , pooContentLanguage
   , pooCacheControl
+  , pooStorageClass
   , pooUserMetadata
   , pooNumThreads
 
diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs
index f39c0ce..eaffd84 100644
--- a/src/Network/Minio/Data.hs
+++ b/src/Network/Minio/Data.hs
@@ -27,7 +27,6 @@ import qualified Data.ByteString              as B
 import           Data.CaseInsensitive         (mk)
 import           Data.Default                 (Default (..))
 import qualified Data.Map                     as Map
-import           Data.Maybe                   (fromJust)
 import qualified Data.Text                    as T
 import           Data.Time                    (defaultTimeLocale, formatTime)
 import           Network.HTTP.Client          (defaultManagerSettings)
@@ -192,13 +191,15 @@ data PutObjectOptions = PutObjectOptions {
   , pooContentEncoding    :: Maybe Text
   , pooContentDisposition :: Maybe Text
   , pooCacheControl       :: Maybe Text
+  , pooContentLanguage    :: Maybe Text
+  , pooStorageClass       :: Maybe Text
   , pooUserMetadata       :: [(Text, Text)]
   , pooNumThreads         :: Maybe Word
     } deriving (Show, Eq)
 
 -- Provide a default instance
 instance Default PutObjectOptions where
-    def = PutObjectOptions def def def def [] def
+    def = PutObjectOptions def def def def def def [] def
 
 addXAmzMetaPrefix :: Text -> Text
 addXAmzMetaPrefix s = do
@@ -221,10 +222,13 @@ pooToHeaders poo = userMetadata
     names = ["content-type",
              "content-encoding",
              "content-disposition",
-             "cache-control"]
+             "content-language",
+             "cache-control",
+             "x-amz-storage-class"]
     values = map (fmap encodeUtf8 . (poo &))
              [pooContentType, pooContentEncoding,
-              pooContentDisposition, pooCacheControl]
+              pooContentDisposition, pooContentLanguage,
+              pooCacheControl, pooStorageClass]
 
 
 -- |
diff --git a/test/LiveServer.hs b/test/LiveServer.hs
index 9e3cb2b..4ace2c1 100644
--- a/test/LiveServer.hs
+++ b/test/LiveServer.hs
@@ -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");
 -- 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)
 
       step "Cleanup actions"
+
       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
       step "copyObjectSingle basic tests"
       let object = "xxx"