1{-# LANGUAGE CPP #-}
2
3module Aws.S3.Commands.GetObject
4where
5
6import           Aws.Core
7import           Aws.S3.Core
8import           Control.Applicative
9import           Control.Monad.Trans.Resource (ResourceT)
10import           Data.ByteString.Char8 ({- IsString -})
11import qualified Data.ByteString.Char8 as B8
12import qualified Data.ByteString.Lazy  as L
13import qualified Data.Conduit          as C
14import           Data.Conduit ((.|))
15import qualified Data.Conduit.List     as CL
16import           Data.Maybe
17import qualified Data.Text             as T
18import qualified Data.Text.Encoding    as T
19import           Prelude
20import qualified Network.HTTP.Conduit  as HTTP
21import qualified Network.HTTP.Types    as HTTP
22
23data GetObject
24    = GetObject {
25        goBucket :: Bucket
26      , goObjectName :: Object
27      , goVersionId :: Maybe T.Text
28      , goResponseContentType :: Maybe T.Text
29      , goResponseContentLanguage :: Maybe T.Text
30      , goResponseExpires :: Maybe T.Text
31      , goResponseCacheControl :: Maybe T.Text
32      , goResponseContentDisposition :: Maybe T.Text
33      , goResponseContentEncoding :: Maybe T.Text
34      , goResponseContentRange :: Maybe (Int,Int)
35      , goIfMatch :: Maybe T.Text
36      -- ^ Return the object only if its entity tag (ETag, which is an md5sum of the content) is the same as the one specified; otherwise, catch a 'StatusCodeException' with a status of 412 precondition failed.
37      , goIfNoneMatch :: Maybe T.Text
38      -- ^ Return the object only if its entity tag (ETag, which is an md5sum of the content) is different from the one specified; otherwise, catch a 'StatusCodeException' with a status of 304 not modified.
39      }
40  deriving (Show)
41
42getObject :: Bucket -> T.Text -> GetObject
43getObject b o = GetObject b o Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
44
45data GetObjectResponse
46    = GetObjectResponse {
47        gorMetadata :: ObjectMetadata,
48        gorResponse :: HTTP.Response (C.ConduitM () B8.ByteString (ResourceT IO) ())
49      }
50
51data GetObjectMemoryResponse
52    = GetObjectMemoryResponse ObjectMetadata (HTTP.Response L.ByteString)
53    deriving (Show)
54
55-- | ServiceConfiguration: 'S3Configuration'
56instance SignQuery GetObject where
57    type ServiceConfiguration GetObject = S3Configuration
58    signQuery GetObject {..} = s3SignQuery S3Query {
59                                   s3QMethod = Get
60                                 , s3QBucket = Just $ T.encodeUtf8 goBucket
61                                 , s3QObject = Just $ T.encodeUtf8 goObjectName
62                                 , s3QSubresources = HTTP.toQuery [
63                                                       ("versionId" :: B8.ByteString,) <$> goVersionId
64                                                     , ("response-content-type" :: B8.ByteString,) <$> goResponseContentType
65                                                     , ("response-content-language",) <$> goResponseContentLanguage
66                                                     , ("response-expires",) <$> goResponseExpires
67                                                     , ("response-cache-control",) <$> goResponseCacheControl
68                                                     , ("response-content-disposition",) <$> goResponseContentDisposition
69                                                     , ("response-content-encoding",) <$> goResponseContentEncoding
70                                                     ]
71                                 , s3QQuery = []
72                                 , s3QContentType = Nothing
73                                 , s3QContentMd5 = Nothing
74                                 , s3QAmzHeaders = []
75                                 , s3QOtherHeaders = catMaybes [
76                                                       decodeRange <$> goResponseContentRange
77                                                     , ("if-match",) . T.encodeUtf8 <$> goIfMatch
78                                                     , ("if-none-match",) . T.encodeUtf8 <$> goIfNoneMatch
79                                                     ]
80                                 , s3QRequestBody = Nothing
81                                 }
82      where decodeRange (pos,len) = ("range",B8.concat $ ["bytes=", B8.pack (show pos), "-", B8.pack (show len)])
83
84instance ResponseConsumer GetObject GetObjectResponse where
85    type ResponseMetadata GetObjectResponse = S3Metadata
86    responseConsumer httpReq GetObject{..} metadata resp
87        | status == HTTP.status200 = do
88            rsp <- s3BinaryResponseConsumer return metadata resp
89            om <- parseObjectMetadata (HTTP.responseHeaders resp)
90            return $ GetObjectResponse om rsp
91        | otherwise = throwStatusCodeException httpReq resp
92      where
93        status  = HTTP.responseStatus    resp
94
95instance Transaction GetObject GetObjectResponse
96
97instance AsMemoryResponse GetObjectResponse where
98    type MemoryResponse GetObjectResponse = GetObjectMemoryResponse
99    loadToMemory (GetObjectResponse om x) = do
100        bss <- C.runConduit $ HTTP.responseBody x .| CL.consume
101        return $ GetObjectMemoryResponse om x
102            { HTTP.responseBody = L.fromChunks bss
103            }
104