Fix pooToHeaders to associate right header names to values (#81)

This commit is contained in:
Krishnan Parthasarathi 2018-03-20 00:18:24 +05:30 committed by Aditya Manthramurthy
parent 37940ad170
commit 09d71251da
2 changed files with 37 additions and 18 deletions

View File

@ -24,14 +24,16 @@ import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import qualified Data.ByteString as B import qualified Data.ByteString as B
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.CaseInsensitive (mk)
import Data.Time (defaultTimeLocale, formatTime) import Data.Time (defaultTimeLocale, formatTime)
import Network.HTTP.Client (defaultManagerSettings) import Network.HTTP.Client (defaultManagerSettings)
import qualified Network.HTTP.Conduit as NC 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 qualified Network.HTTP.Types as HT
import Network.Minio.Errors import Network.Minio.Errors
import Text.XML import Text.XML
@ -186,12 +188,12 @@ type ETag = Text
-- Data type represents various options specified for PutObject call. -- Data type represents various options specified for PutObject call.
-- To specify PutObject options use the poo* accessors. -- To specify PutObject options use the poo* accessors.
data PutObjectOptions = PutObjectOptions { data PutObjectOptions = PutObjectOptions {
pooContentType :: Maybe Text pooContentType :: Maybe Text
, pooContentEncoding :: Maybe Text , pooContentEncoding :: Maybe Text
, pooContentDisposition :: Maybe Text , pooContentDisposition :: Maybe Text
, pooCacheControl :: Maybe Text , pooCacheControl :: 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
@ -208,15 +210,19 @@ mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y)) mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y))
pooToHeaders :: PutObjectOptions -> [HT.Header] pooToHeaders :: PutObjectOptions -> [HT.Header]
pooToHeaders poo = userMetadata ++ zip names values pooToHeaders poo = userMetadata
++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
where where
tupToMaybe (k, Just v) = Just (k, v)
tupToMaybe (_, Nothing) = Nothing
userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
names = ["content-type", names = ["content-type",
"content-encoding", "content-encoding",
"content-disposition", "content-disposition",
"cache-control"] "cache-control"]
values = mapMaybe (fmap encodeUtf8 . (poo &)) values = map (fmap encodeUtf8 . (poo &))
[pooContentType, pooContentEncoding, [pooContentType, pooContentEncoding,
pooContentDisposition, pooCacheControl] pooContentDisposition, pooCacheControl]
@ -290,10 +296,10 @@ data ListObjectsV1Result = ListObjectsV1Result {
-- | Represents information about an object. -- | Represents information about an object.
data ObjectInfo = ObjectInfo { data ObjectInfo = ObjectInfo {
oiObject :: Object oiObject :: Object
, oiModTime :: UTCTime , oiModTime :: UTCTime
, oiETag :: ETag , oiETag :: ETag
, oiSize :: Int64 , oiSize :: Int64
, oiMetadata :: Map.Map Text Text , oiMetadata :: Map.Map Text Text
} deriving (Show, Eq) } deriving (Show, Eq)
@ -322,11 +328,11 @@ instance Default DestinationInfo where
data GetObjectOptions = GetObjectOptions { data GetObjectOptions = GetObjectOptions {
-- | [ByteRangeFromTo 0 9] means first ten bytes of the source object. -- | [ByteRangeFromTo 0 9] means first ten bytes of the source object.
gooRange :: Maybe ByteRange gooRange :: Maybe ByteRange
, gooIfMatch :: Maybe ETag , gooIfMatch :: Maybe ETag
, gooIfNoneMatch :: Maybe ETag , gooIfNoneMatch :: Maybe ETag
, gooIfUnmodifiedSince :: Maybe UTCTime , gooIfUnmodifiedSince :: Maybe UTCTime
, gooIfModifiedSince :: Maybe UTCTime , gooIfModifiedSince :: Maybe UTCTime
} deriving (Show, Eq) } deriving (Show, Eq)
instance Default GetObjectOptions where instance Default GetObjectOptions where

View File

@ -34,8 +34,8 @@ import Data.Conduit.Combinators (sinkList)
import Data.Default (Default (..)) import Data.Default (Default (..))
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Time as Time
import Data.Time (fromGregorian) import Data.Time (fromGregorian)
import qualified Data.Time as Time
import qualified Network.HTTP.Client.MultipartFormData as Form import qualified Network.HTTP.Client.MultipartFormData as Form
import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types as HT
@ -338,6 +338,19 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
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") (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" step "Cleanup actions"
removeObject bucket object removeObject bucket object