From 09d71251dac9a4e7303fc33f4cdfd152ef7c2f2e Mon Sep 17 00:00:00 2001
From: Krishnan Parthasarathi <krisis@users.noreply.github.com>
Date: Tue, 20 Mar 2018 00:18:24 +0530
Subject: [PATCH] Fix pooToHeaders to associate right header names to values
 (#81)

---
 src/Network/Minio/Data.hs | 40 ++++++++++++++++++++++-----------------
 test/LiveServer.hs        | 15 ++++++++++++++-
 2 files changed, 37 insertions(+), 18 deletions(-)

diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs
index df2e6a0..f39c0ce 100644
--- a/src/Network/Minio/Data.hs
+++ b/src/Network/Minio/Data.hs
@@ -24,14 +24,16 @@ import           Control.Monad.Trans.Control
 import           Control.Monad.Trans.Resource
 
 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.CaseInsensitive         (mk)
 import           Data.Time                    (defaultTimeLocale, formatTime)
 import           Network.HTTP.Client          (defaultManagerSettings)
 import qualified Network.HTTP.Conduit         as NC
-import           Network.HTTP.Types           (Header, Method, Query, ByteRange, hRange)
+import           Network.HTTP.Types           (ByteRange, Header, Method, Query,
+                                               hRange)
 import qualified Network.HTTP.Types           as HT
 import           Network.Minio.Errors
 import           Text.XML
@@ -186,12 +188,12 @@ type ETag = Text
 -- Data type represents various options specified for PutObject call.
 -- To specify PutObject options use the poo* accessors.
 data PutObjectOptions = PutObjectOptions {
-    pooContentType :: Maybe Text
-  , pooContentEncoding :: Maybe Text
+    pooContentType        :: Maybe Text
+  , pooContentEncoding    :: Maybe Text
   , pooContentDisposition :: Maybe Text
-  , pooCacheControl :: Maybe Text
-  , pooUserMetadata :: [(Text, Text)]
-  , pooNumThreads :: Maybe Word
+  , pooCacheControl       :: Maybe Text
+  , pooUserMetadata       :: [(Text, Text)]
+  , pooNumThreads         :: Maybe Word
     } deriving (Show, Eq)
 
 -- Provide a default instance
@@ -208,15 +210,19 @@ mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
 mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y))
 
 pooToHeaders :: PutObjectOptions -> [HT.Header]
-pooToHeaders poo = userMetadata ++ zip names values
+pooToHeaders poo = userMetadata
+                   ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
   where
+    tupToMaybe (k, Just v)  = Just (k, v)
+    tupToMaybe (_, Nothing) = Nothing
+
     userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
 
     names = ["content-type",
              "content-encoding",
              "content-disposition",
              "cache-control"]
-    values = mapMaybe (fmap encodeUtf8 . (poo &))
+    values = map (fmap encodeUtf8 . (poo &))
              [pooContentType, pooContentEncoding,
               pooContentDisposition, pooCacheControl]
 
@@ -290,10 +296,10 @@ data ListObjectsV1Result = ListObjectsV1Result {
 
 -- | Represents information about an object.
 data ObjectInfo = ObjectInfo {
-    oiObject  :: Object
-  , oiModTime :: UTCTime
-  , oiETag    :: ETag
-  , oiSize    :: Int64
+    oiObject   :: Object
+  , oiModTime  :: UTCTime
+  , oiETag     :: ETag
+  , oiSize     :: Int64
   , oiMetadata :: Map.Map Text Text
   } deriving (Show, Eq)
 
@@ -322,11 +328,11 @@ instance Default DestinationInfo where
 
 data GetObjectOptions = GetObjectOptions {
     -- | [ByteRangeFromTo 0 9] means first ten bytes of the source object.
-    gooRange :: Maybe ByteRange
-  , gooIfMatch :: Maybe ETag
-  , gooIfNoneMatch :: Maybe ETag
+    gooRange             :: Maybe ByteRange
+  , gooIfMatch           :: Maybe ETag
+  , gooIfNoneMatch       :: Maybe ETag
   , gooIfUnmodifiedSince :: Maybe UTCTime
-  , gooIfModifiedSince :: Maybe UTCTime
+  , gooIfModifiedSince   :: Maybe UTCTime
   } deriving (Show, Eq)
 
 instance Default GetObjectOptions where
diff --git a/test/LiveServer.hs b/test/LiveServer.hs
index 0180496..9e3cb2b 100644
--- a/test/LiveServer.hs
+++ b/test/LiveServer.hs
@@ -34,8 +34,8 @@ import           Data.Conduit.Combinators              (sinkList)
 import           Data.Default                          (Default (..))
 import qualified Data.Map.Strict                       as Map
 import qualified Data.Text                             as T
-import qualified Data.Time                             as Time
 import           Data.Time                             (fromGregorian)
+import qualified Data.Time                             as Time
 import qualified Network.HTTP.Client.MultipartFormData as Form
 import qualified Network.HTTP.Conduit                  as NC
 import qualified Network.HTTP.Types                    as HT
@@ -338,6 +338,19 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
 
       step "Validate content-type"
       liftIO $ assertEqual "Content-Type did not match" (Just "application/javascript") (Map.lookup "Content-Type" m)
+
+      step "upload object with content-encoding set to identity"
+      fPutObject bucket object inputFile def {
+        pooContentEncoding = Just "identity"
+        }
+
+      oiCE <- headObject bucket object
+      let m = oiMetadata oiCE
+
+      step "Validate content-encoding"
+      liftIO $ assertEqual "Content-Encoding did not match" (Just "identity")
+        (Map.lookup "Content-Encoding" m)
+
       step "Cleanup actions"
       removeObject bucket object