Fix pooToHeaders to associate right header names to values (#81)
This commit is contained in:
parent
37940ad170
commit
09d71251da
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user