@@ -13,45 +13,48 @@
1313-- See the License for the specific language governing permissions and
1414-- limitations under the License.
1515--
16−
17−{-# LANGUAGE CPP #-}
18−{-# LANGUAGE GADTs #-}
16+{-# LANGUAGE CPP #-}
17+{-# LANGUAGE GADTs #-}
1918{-# LANGUAGE GeneralizedNewtypeDeriving #-}
20−{-# LANGUAGE TypeFamilies #-}
19+{-# LANGUAGE TypeFamilies #-}
20+
2121module Network.Minio.Data where
2222
23−import qualified Conduit as C
24−import qualified Control.Concurrent.MVar as M
25−import Control.Monad.IO.Unlift (UnliftIO (..), askUnliftIO,
26− withUnliftIO)
27−import Control.Monad.Trans.Resource
28−import qualified Data.Aeson as A
29−import qualified Data.ByteArray as BA
30−import qualified Data.ByteString as B
31−import Data.CaseInsensitive (mk)
32−import qualified Data.HashMap.Strict as H
33−import qualified Data.Ini as Ini
34−import Data.String (IsString (..))
35−import qualified Data.Text as T
36−import qualified Data.Text.Encoding as TE
37−import Data.Time (defaultTimeLocale, formatTime)
38−import GHC.Show (Show (show))
39−import qualified Network.Connection as Conn
40−import Network.HTTP.Client (defaultManagerSettings)
41−import qualified Network.HTTP.Client.TLS as TLS
42−import qualified Network.HTTP.Conduit as NC
43−import Network.HTTP.Types (ByteRange, Header, Method, Query,
44− hRange)
45−import qualified Network.HTTP.Types as HT
46−import Network.Minio.Errors
47−import System.Directory (doesFileExist, getHomeDirectory)
48−import qualified System.Environment as Env
49−import System.FilePath.Posix (combine)
50−import Text.XML
51−import qualified UnliftIO as U
52−
53−import Lib.Prelude
54−import Network.Minio.Data.Crypto
23+import qualified Conduit as C
24+import qualified Control.Concurrent.MVar as M
25+import Control.Monad.Trans.Resource
26+import qualified Data.Aeson as A
27+import qualified Data.ByteArray as BA
28+import qualified Data.ByteString as B
29+import qualified Data.ByteString.Lazy as LB
30+import Data.CaseInsensitive (mk)
31+import qualified Data.HashMap.Strict as H
32+import qualified Data.Ini as Ini
33+import Data.String (IsString (..))
34+import qualified Data.Text as T
35+import qualified Data.Text.Encoding as TE
36+import Data.Time (defaultTimeLocale, formatTime)
37+import GHC.Show (Show (show))
38+import Lib.Prelude
39+import qualified Network.Connection as Conn
40+import Network.HTTP.Client (defaultManagerSettings)
41+import qualified Network.HTTP.Client.TLS as TLS
42+import qualified Network.HTTP.Conduit as NC
43+import Network.HTTP.Types
44+ ( ByteRange,
45+ Header,
46+ Method,
47+ Query,
48+ hRange,
49+ )
50+import qualified Network.HTTP.Types as HT
51+import Network.Minio.Data.Crypto
52+import Network.Minio.Errors
53+import System.Directory (doesFileExist, getHomeDirectory)
54+import qualified System.Environment as Env
55+import System.FilePath.Posix (combine)
56+import Text.XML
57+import qualified UnliftIO as U
5558
5659-- | max obj size is 5TiB
5760maxObjectSize :: Int64
@@ -71,59 +74,64 @@ maxMultipartParts = 10000
7174-- TODO: Add a type which provides typed constants for region. this
7275-- type should have a IsString instance to infer the appropriate
7376-- constant.
77+
7478-- | awsRegionMap - library constant
7579awsRegionMap :: H.HashMap Text Text
76−awsRegionMap = H.fromList [
77− ("us-east-1", "s3.amazonaws.com")
78− , ("us-east-2", "s3-us-east-2.amazonaws.com")
79− , ("us-west-1", "s3-us-west-1.amazonaws.com")
80− , ("us-west-2", "s3-us-west-2.amazonaws.com")
81− , ("ca-central-1", "s3-ca-central-1.amazonaws.com")
82− , ("ap-south-1", "s3-ap-south-1.amazonaws.com")
83− , ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com")
84− , ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com")
85− , ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com")
86− , ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com")
87− , ("eu-west-1", "s3-eu-west-1.amazonaws.com")
88− , ("eu-west-2", "s3-eu-west-2.amazonaws.com")
89− , ("eu-central-1", "s3-eu-central-1.amazonaws.com")
90− , ("sa-east-1", "s3-sa-east-1.amazonaws.com")
91− ]
80+awsRegionMap =
81+ H.fromList
82+ [ ("us-east-1", "s3.amazonaws.com"),
83+ ("us-east-2", "s3-us-east-2.amazonaws.com"),
84+ ("us-west-1", "s3-us-west-1.amazonaws.com"),
85+ ("us-west-2", "s3-us-west-2.amazonaws.com"),
86+ ("ca-central-1", "s3-ca-central-1.amazonaws.com"),
87+ ("ap-south-1", "s3-ap-south-1.amazonaws.com"),
88+ ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com"),
89+ ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com"),
90+ ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com"),
91+ ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com"),
92+ ("eu-west-1", "s3-eu-west-1.amazonaws.com"),
93+ ("eu-west-2", "s3-eu-west-2.amazonaws.com"),
94+ ("eu-central-1", "s3-eu-central-1.amazonaws.com"),
95+ ("sa-east-1", "s3-sa-east-1.amazonaws.com")
96+ ]
9297
9398-- | Connection Info data type. To create a 'ConnectInfo' value,
9499-- enable the @OverloadedStrings@ language extension and use the
95100-- `IsString` instance to provide a URL, for example:
96101--
97102-- > let c :: ConnectInfo = "https://play.min.io"
98−data ConnectInfo =
99− ConnectInfo { connectHost :: Text
100− , connectPort :: Int
101− , connectAccessKey :: Text
102− , connectSecretKey :: Text
103− , connectIsSecure :: Bool
104− , connectRegion :: Region
105− , connectAutoDiscoverRegion :: Bool
106− , connectDisableTLSCertValidation :: Bool
107− } deriving (Eq, Show)
103+data ConnectInfo = ConnectInfo
104+ { connectHost :: Text,
105+ connectPort :: Int,
106+ connectAccessKey :: Text,
107+ connectSecretKey :: Text,
108+ connectIsSecure :: Bool,
109+ connectRegion :: Region,
110+ connectAutoDiscoverRegion :: Bool,
111+ connectDisableTLSCertValidation :: Bool
112+ }
113+ deriving (Eq, Show)
108114
109115instance IsString ConnectInfo where
110− fromString str =
111− let req = NC.parseRequest_ str
112− in ConnectInfo
113− { connectHost = TE.decodeUtf8 $ NC.host req
114− , connectPort = NC.port req
115− , connectAccessKey = ""
116− , connectSecretKey = ""
117− , connectIsSecure = NC.secure req
118− , connectRegion = ""
119− , connectAutoDiscoverRegion = True
120− , connectDisableTLSCertValidation = False
121− }
116+ fromString str =
117+ let req = NC.parseRequest_ str
118+ in ConnectInfo
119+ { connectHost = TE.decodeUtf8 $ NC.host req,
120+ connectPort = NC.port req,
121+ connectAccessKey = "",
122+ connectSecretKey = "",
123+ connectIsSecure = NC.secure req,
124+ connectRegion = "",
125+ connectAutoDiscoverRegion = True,
126+ connectDisableTLSCertValidation = False
127+ }
122128
123129-- | Contains access key and secret key to access object storage.
124−data Credentials = Credentials { cAccessKey :: Text
125− , cSecretKey :: Text
126− } deriving (Eq, Show)
130+data Credentials = Credentials
131+ { cAccessKey :: Text,
132+ cSecretKey :: Text
133+ }
134+ deriving (Eq, Show)
127135
128136-- | A Provider is an action that may return Credentials. Providers
129137-- may be chained together using 'findFirst'.
@@ -133,63 +141,70 @@ type Provider = IO (Maybe Credentials)
133141-- order until Credentials are found.
134142findFirst :: [Provider] -> Provider
135143findFirst [] = return Nothing
136−findFirst (f:fs) = do c <- f
137− maybe (findFirst fs) (return . Just) c
144+findFirst (f : fs) = do
145+ c <- f
146+ maybe (findFirst fs) (return . Just) c
138147
139148-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
140149fromAWSConfigFile :: Provider
141150fromAWSConfigFile = do
142− credsE <- runExceptT $ do
143− homeDir <- lift $ getHomeDirectory
144− let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
145− fileExists <- lift $ doesFileExist awsCredsFile
146− bool (throwE "FileNotFound") (return ()) fileExists
147− ini <- ExceptT $ Ini.readIniFile awsCredsFile
148− akey <- ExceptT $ return
149− $ Ini.lookupValue "default" "aws_access_key_id" ini
150− skey <- ExceptT $ return
151− $ Ini.lookupValue "default" "aws_secret_access_key" ini
152− return $ Credentials akey skey
153− return $ hush credsE
151+ credsE <- runExceptT $ do
152+ homeDir <- lift $ getHomeDirectory
153+ let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
154+ fileExists <- lift $ doesFileExist awsCredsFile
155+ bool (throwE "FileNotFound") (return ()) fileExists
156+ ini <- ExceptT $ Ini.readIniFile awsCredsFile
157+ akey <-
158+ ExceptT $ return $
159+ Ini.lookupValue "default" "aws_access_key_id" ini
160+ skey <-
161+ ExceptT $ return $
162+ Ini.lookupValue "default" "aws_secret_access_key" ini
163+ return $ Credentials akey skey
164+ return $ hush credsE
154165
155166-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
156167-- @AWS_SECRET_ACCESS_KEY@ environment variables.
157168fromAWSEnv :: Provider
158169fromAWSEnv = runMaybeT $ do
159− akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
160− skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
161− return $ Credentials (T.pack akey) (T.pack skey)
170+ akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
171+ skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
172+ return $ Credentials (T.pack akey) (T.pack skey)
162173
163174-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
164175-- @MINIO_SECRET_KEY@ environment variables.
165176fromMinioEnv :: Provider
166177fromMinioEnv = runMaybeT $ do
167− akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
168− skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
169− return $ Credentials (T.pack akey) (T.pack skey)
178+ akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
179+ skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
180+ return $ Credentials (T.pack akey) (T.pack skey)
170181
171182-- | setCredsFrom retrieves access credentials from the first
172183-- `Provider` form the given list that succeeds and sets it in the
173184-- `ConnectInfo`.
174185setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
175−setCredsFrom ps ci = do pMay <- findFirst ps
176− maybe
177− (throwIO MErrVMissingCredentials)
178− (return . (flip setCreds ci))
179− pMay
186+setCredsFrom ps ci = do
187+ pMay <- findFirst ps
188+ maybe
189+ (throwIO MErrVMissingCredentials)
190+ (return . (flip setCreds ci))
191+ pMay
180192
181193-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
182194setCreds :: Credentials -> ConnectInfo -> ConnectInfo
183195setCreds (Credentials accessKey secretKey) connInfo =
184− connInfo { connectAccessKey = accessKey
185− , connectSecretKey = secretKey
186− }
196+ connInfo
197+ { connectAccessKey = accessKey,
198+ connectSecretKey = secretKey
199+ }
187200
188201-- | Set the S3 region parameter in the `ConnectInfo`
189202setRegion :: Region -> ConnectInfo -> ConnectInfo
190−setRegion r connInfo = connInfo { connectRegion = r
191− , connectAutoDiscoverRegion = False
192− }
203+setRegion r connInfo =
204+ connInfo
205+ { connectRegion = r,
206+ connectAutoDiscoverRegion = False
207+ }
193208
194209-- | Check if the connection to object storage server is secure
195210-- (i.e. uses TLS)
@@ -201,17 +216,19 @@ isConnectInfoSecure = connectIsSecure
201216-- certificates. Note that this option has no effect, if you provide
202217-- your own Manager in `mkMinioConn`.
203218disableTLSCertValidation :: ConnectInfo -> ConnectInfo
204−disableTLSCertValidation c = c { connectDisableTLSCertValidation = True }
219+disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
205220
206221getHostAddr :: ConnectInfo -> ByteString
207−getHostAddr ci = if | port == 80 || port == 443 -> toS host
208− | otherwise -> toS $
209− T.concat [ host, ":" , Lib.Prelude.show port]
222+getHostAddr ci =
223+ if
224+ | port == 80 || port == 443 -> toUtf8 host
225+ | otherwise ->
226+ toUtf8 $
227+ T.concat [host, ":", Lib.Prelude.show port]
210228 where
211229 port = connectPort ci
212230 host = connectHost ci
213231
214−
215232-- | Default Google Compute Storage ConnectInfo. Works only for
216233-- "Simple Migration" use-case with interoperability mode enabled on
217234-- GCP console. For more information -
@@ -219,23 +236,25 @@ getHostAddr ci = if | port == 80 || port == 443 -> toS host
219236--
220237-- Credentials should be supplied before use.
221238gcsCI :: ConnectInfo
222−gcsCI = setRegion "us"
223− "https://storage.googleapis.com"
224−
239+gcsCI =
240+ setRegion
241+ "us"
242+ "https://storage.googleapis.com"
225243
226244-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
227245-- should be supplied before use.
228246awsCI :: ConnectInfo
229247awsCI = "https://s3.amazonaws.com"
230248
231−
232249-- | <https://play.min.io MinIO Play Server>
233250-- ConnectInfo. Credentials are already filled in.
234251minioPlayCI :: ConnectInfo
235−minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
236− in setCreds playCreds
237− $ setRegion "us-east-1"
238− "https://play.min.io"
252+minioPlayCI =
253+ let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
254+ in setCreds playCreds $
255+ setRegion
256+ "us-east-1"
257+ "https://play.min.io"
239258
240259-- |
241260-- Represents a bucket in the object store
@@ -254,80 +273,79 @@ type ETag = Text
254273-- | Data type to represent an object encryption key. Create one using
255274-- the `mkSSECKey` function.
256275newtype SSECKey = SSECKey BA.ScrubbedBytes
257− deriving (Eq, Show)
276+ deriving (Eq, Show)
258277
259278-- | Validates that the given ByteString is 32 bytes long and creates
260279-- an encryption key.
261280mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
262−mkSSECKey keyBytes | B.length keyBytes /= 32 =
263− throwM MErrVInvalidEncryptionKeyLength
264− | otherwise =
265− return $ SSECKey $ BA.convert keyBytes
281+mkSSECKey keyBytes
282+ | B.length keyBytes /= 32 =
283+ throwM MErrVInvalidEncryptionKeyLength
284+ | otherwise =
285+ return $ SSECKey $ BA.convert keyBytes
266286
267287-- | Data type to represent Server-Side-Encryption settings
268288data SSE where
269− -- | Specifies SSE S3 encryption - server manages encryption keys
270− SSE :: SSE
271− -- | Specifies that KMS service should be used. The first argument
272− -- to the constructor is the Key Id to be used by the server (if
273− -- not specified, the default KMS key id is used). The second
274− -- argument is the optional KMS context that must have a
275− -- `A.ToJSON` instance - please refer to the AWS S3 documentation
276− -- for detailed information.
277− SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
278− -- | Specifies server-side encryption with customer provided
279− -- key. The argument is the encryption key to be used.
280− SSEC :: SSECKey -> SSE
289+ -- | Specifies SSE S3 encryption - server manages encryption keys
290+ SSE :: SSE
291+ -- | Specifies that KMS service should be used. The first argument
292+ -- to the constructor is the Key Id to be used by the server (if
293+ -- not specified, the default KMS key id is used). The second
294+ -- argument is the optional KMS context that must have a
295+ -- `A.ToJSON` instance - please refer to the AWS S3 documentation
296+ -- for detailed information.
297+ SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
298+ -- | Specifies server-side encryption with customer provided
299+ -- key. The argument is the encryption key to be used.
300+ SSEC :: SSECKey -> SSE
281301
282302toPutObjectHeaders :: SSE -> [HT.Header]
283303toPutObjectHeaders sseArg =
284− let sseHeader = "x-amz-server-side-encryption"
285− sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
286− sseKmsContextHeader = sseHeader <> "-context"
287− ssecAlgo = sseHeader <> "-customer-algorithm"
288− ssecKey = sseHeader <> "-customer-key"
289− ssecKeyMD5 = ssecKey <> "-MD5"
290−
291− in case sseArg of
292− SSE -> [(sseHeader, "AES256")]
293−
294− SSEKMS keyIdMay ctxMay ->
295− [(sseHeader, "aws:kms")] ++
296− maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay ++
297− maybe [] (\k -> [(sseKmsContextHeader, toS $ A.encode k)]) ctxMay
298−
299− SSEC (SSECKey sb) ->
300− [(ssecAlgo, "AES256"),
301− (ssecKey, encodeToBase64 sb),
302− (ssecKeyMD5, hashMD5ToBase64 sb)]
304+ let sseHeader = "x-amz-server-side-encryption"
305+ sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
306+ sseKmsContextHeader = sseHeader <> "-context"
307+ ssecAlgo = sseHeader <> "-customer-algorithm"
308+ ssecKey = sseHeader <> "-customer-key"
309+ ssecKeyMD5 = ssecKey <> "-MD5"
310+ in case sseArg of
311+ SSE -> [(sseHeader, "AES256")]
312+ SSEKMS keyIdMay ctxMay ->
313+ [(sseHeader, "aws:kms")]
314+ ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
315+ ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
316+ SSEC (SSECKey sb) ->
317+ [ (ssecAlgo, "AES256"),
318+ (ssecKey, encodeToBase64 sb),
319+ (ssecKeyMD5, hashMD5ToBase64 sb)
320+ ]
303321
304322-- | Data type for options in PutObject call. Start with the empty
305323-- `defaultPutObjectOptions` and use various the various poo*
306324-- accessors.
307−data PutObjectOptions = PutObjectOptions {
308− -- | Set a standard MIME type describing the format of the object.
309− pooContentType :: Maybe Text
310− -- | Set what content encodings have been applied to the object and thus
311− -- what decoding mechanisms must be applied to obtain the media-type
312− -- referenced by the Content-Type header field.
313− , pooContentEncoding :: Maybe Text
314− -- | Set presentational information for the object.
315− , pooContentDisposition :: Maybe Text
316− -- | Set to specify caching behavior for the object along the
317− -- request/reply chain.
318− , pooCacheControl :: Maybe Text
319− -- | Set to describe the language(s) intended for the audience.
320− , pooContentLanguage :: Maybe Text
321− -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
322− -- performance needs, storage class is @STANDARD@ by default (i.e
323− -- when Nothing is passed).
324− , pooStorageClass :: Maybe Text
325− -- | Set user defined metadata to store with the object.
326− , pooUserMetadata :: [(Text, Text)]
327− -- | Set number of worker threads used to upload an object.
328− , pooNumThreads :: Maybe Word
329− -- | Set object encryption parameters for the request.
330− , pooSSE :: Maybe SSE
325+data PutObjectOptions = PutObjectOptions
326+ { -- | Set a standard MIME type describing the format of the object.
327+ pooContentType :: Maybe Text,
328+ -- | Set what content encodings have been applied to the object and thus
329+ -- what decoding mechanisms must be applied to obtain the media-type
330+ -- referenced by the Content-Type header field.
331+ pooContentEncoding :: Maybe Text,
332+ -- | Set presentational information for the object.
333+ pooContentDisposition :: Maybe Text,
334+ -- | Set to specify caching behavior for the object along the
335+ -- request/reply chain.
336+ pooCacheControl :: Maybe Text,
337+ -- | Set to describe the language(s) intended for the audience.
338+ pooContentLanguage :: Maybe Text,
339+ -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
340+ -- performance needs, storage class is @STANDARD@ by default (i.e
341+ -- when Nothing is passed).
342+ pooStorageClass :: Maybe Text,
343+ -- | Set user defined metadata to store with the object.
344+ pooUserMetadata :: [(Text, Text)],
345+ -- | Set number of worker threads used to upload an object.
346+ pooNumThreads :: Maybe Word,
347+ -- | Set object encryption parameters for the request.
348+ pooSSE :: Maybe SSE
331349 }
332350
333351-- | Provide default `PutObjectOptions`.
@@ -338,47 +356,55 @@ defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothi
338356-- stripped and a Just is returned.
339357userMetadataHeaderNameMaybe :: Text -> Maybe Text
340358userMetadataHeaderNameMaybe k =
341− let prefix = T.toCaseFold "X-Amz-Meta-"
342− n = T.length prefix
343− in if T.toCaseFold (T.take n k) == prefix
344− then Just (T.drop n k)
345− else Nothing
359+ let prefix = T.toCaseFold "X-Amz-Meta-"
360+ n = T.length prefix
361+ in if T.toCaseFold (T.take n k) == prefix
362+ then Just (T.drop n k)
363+ else Nothing
346364
347365addXAmzMetaPrefix :: Text -> Text
348−addXAmzMetaPrefix s | isJust (userMetadataHeaderNameMaybe s) = s
349− | otherwise = "X-Amz-Meta-" <> s
366+addXAmzMetaPrefix s
367+ | isJust (userMetadataHeaderNameMaybe s) = s
368+ | otherwise = "X-Amz-Meta-" <> s
350369
351370mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
352371mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y))
353372
354373pooToHeaders :: PutObjectOptions -> [HT.Header]
355−pooToHeaders poo = userMetadata
356− ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
357− ++ maybe [] toPutObjectHeaders (pooSSE poo)
374+pooToHeaders poo =
375+ userMetadata
376+ ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
377+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
358378 where
359− tupToMaybe (k, Just v) = Just (k, v)
379+ tupToMaybe (k, Just v) = Just (k, v)
360380 tupToMaybe (_, Nothing) = Nothing
361−
362381 userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
363−
364− names = ["content-type",
365− "content-encoding",
366− "content-disposition",
367− "content-language",
368− "cache-control",
369− "x-amz-storage-class"]
370− values = map (fmap encodeUtf8 . (poo &))
371− [pooContentType, pooContentEncoding,
372− pooContentDisposition, pooContentLanguage,
373− pooCacheControl, pooStorageClass]
374−
382+ names =
383+ [ "content-type",
384+ "content-encoding",
385+ "content-disposition",
386+ "content-language",
387+ "cache-control",
388+ "x-amz-storage-class"
389+ ]
390+ values =
391+ map
392+ (fmap encodeUtf8 . (poo &))
393+ [ pooContentType,
394+ pooContentEncoding,
395+ pooContentDisposition,
396+ pooContentLanguage,
397+ pooCacheControl,
398+ pooStorageClass
399+ ]
375400
376401-- |
377402-- BucketInfo returned for list buckets call
378−data BucketInfo = BucketInfo {
379− biName :: Bucket
380− , biCreationDate :: UTCTime
381− } deriving (Show, Eq)
403+data BucketInfo = BucketInfo
404+ { biName :: Bucket,
405+ biCreationDate :: UTCTime
406+ }
407+ deriving (Show, Eq)
382408
383409-- | A type alias to represent a part-number for multipart upload
384410type PartNumber = Int16
@@ -391,95 +417,116 @@ type PartTuple = (PartNumber, ETag)
391417
392418-- | Represents result from a listing of object parts of an ongoing
393419-- multipart upload.
394−data ListPartsResult = ListPartsResult {
395− lprHasMore :: Bool
396− , lprNextPart :: Maybe Int
397− , lprParts :: [ObjectPartInfo]
398− } deriving (Show, Eq)
420+data ListPartsResult = ListPartsResult
421+ { lprHasMore :: Bool,
422+ lprNextPart :: Maybe Int,
423+ lprParts :: [ObjectPartInfo]
424+ }
425+ deriving (Show, Eq)
399426
400427-- | Represents information about an object part in an ongoing
401428-- multipart upload.
402−data ObjectPartInfo = ObjectPartInfo {
403− opiNumber :: PartNumber
404− , opiETag :: ETag
405− , opiSize :: Int64
406− , opiModTime :: UTCTime
407− } deriving (Show, Eq)
429+data ObjectPartInfo = ObjectPartInfo
430+ { opiNumber :: PartNumber,
431+ opiETag :: ETag,
432+ opiSize :: Int64,
433+ opiModTime :: UTCTime
434+ }
435+ deriving (Show, Eq)
408436
409437-- | Represents result from a listing of incomplete uploads to a
410438-- bucket.
411−data ListUploadsResult = ListUploadsResult {
412− lurHasMore :: Bool
413− , lurNextKey :: Maybe Text
414− , lurNextUpload :: Maybe Text
415− , lurUploads :: [(Object, UploadId, UTCTime)]
416− , lurCPrefixes :: [Text]
417− } deriving (Show, Eq)
439+data ListUploadsResult = ListUploadsResult
440+ { lurHasMore :: Bool,
441+ lurNextKey :: Maybe Text,
442+ lurNextUpload :: Maybe Text,
443+ lurUploads :: [(Object, UploadId, UTCTime)],
444+ lurCPrefixes :: [Text]
445+ }
446+ deriving (Show, Eq)
418447
419448-- | Represents information about a multipart upload.
420−data UploadInfo = UploadInfo {
421− uiKey :: Object
422− , uiUploadId :: UploadId
423− , uiInitTime :: UTCTime
424− , uiSize :: Int64
425− } deriving (Show, Eq)
449+data UploadInfo = UploadInfo
450+ { uiKey :: Object,
451+ uiUploadId :: UploadId,
452+ uiInitTime :: UTCTime,
453+ uiSize :: Int64
454+ }
455+ deriving (Show, Eq)
426456
427457-- | Represents result from a listing of objects in a bucket.
428−data ListObjectsResult = ListObjectsResult {
429− lorHasMore :: Bool
430− , lorNextToken :: Maybe Text
431− , lorObjects :: [ObjectInfo]
432− , lorCPrefixes :: [Text]
433− } deriving (Show, Eq)
458+data ListObjectsResult = ListObjectsResult
459+ { lorHasMore :: Bool,
460+ lorNextToken :: Maybe Text,
461+ lorObjects :: [ObjectInfo],
462+ lorCPrefixes :: [Text]
463+ }
464+ deriving (Show, Eq)
434465
435466-- | Represents result from a listing of objects version 1 in a bucket.
436−data ListObjectsV1Result = ListObjectsV1Result {
437− lorHasMore' :: Bool
438− , lorNextMarker :: Maybe Text
439− , lorObjects' :: [ObjectInfo]
440− , lorCPrefixes' :: [Text]
441− } deriving (Show, Eq)
467+data ListObjectsV1Result = ListObjectsV1Result
468+ { lorHasMore' :: Bool,
469+ lorNextMarker :: Maybe Text,
470+ lorObjects' :: [ObjectInfo],
471+ lorCPrefixes' :: [Text]
472+ }
473+ deriving (Show, Eq)
442474
443475-- | Represents information about an object.
444476data ObjectInfo = ObjectInfo
445− { oiObject :: Object -- ^ Object key
446− , oiModTime :: UTCTime -- ^ Modification time of the object
447− , oiETag :: ETag -- ^ ETag of the object
448− , oiSize :: Int64 -- ^ Size of the object in bytes
449− , oiUserMetadata :: H.HashMap Text Text -- ^ A map of user-metadata
450− -- pairs stored with an
451− -- object (keys will not
452− -- have the @X-Amz-Meta-@
453− -- prefix).
454− , oiMetadata :: H.HashMap Text Text -- ^ A map of metadata
455− -- key-value pairs (not
456− -- including the
457− -- user-metadata pairs)
458− } deriving (Show, Eq)
477+ { -- | Object key
478+ oiObject :: Object,
479+ -- | Modification time of the object
480+ oiModTime :: UTCTime,
481+ -- | ETag of the object
482+ oiETag :: ETag,
483+ -- | Size of the object in bytes
484+ oiSize :: Int64,
485+ -- | A map of user-metadata
486+ -- pairs stored with an
487+ -- object (keys will not
488+ -- have the @X-Amz-Meta-@
489+ -- prefix).
490+ oiUserMetadata :: H.HashMap Text Text,
491+ -- | A map of metadata
492+ -- key-value pairs (not
493+ -- including the
494+ -- user-metadata pairs)
495+ oiMetadata :: H.HashMap Text Text
496+ }
497+ deriving (Show, Eq)
459498
460499-- | Represents source object in server-side copy object
461500data SourceInfo = SourceInfo
462− { srcBucket :: Text -- ^ Bucket containing the source object
463− , srcObject :: Text -- ^ Source object key
464− , srcRange :: Maybe (Int64, Int64) -- ^ Source object
465− -- byte-range
466− -- (inclusive)
467− , srcIfMatch :: Maybe Text -- ^ ETag condition on source -
468− -- object is copied only if the
469− -- source object's ETag matches
470− -- this value.
471− , srcIfNoneMatch :: Maybe Text -- ^ ETag not match condition
472− -- on source - object is copied
473− -- if ETag does not match this
474− -- value.
475− , srcIfModifiedSince :: Maybe UTCTime -- ^ Copy source object only
476− -- if the source has been
477− -- modified since this time.
478− , srcIfUnmodifiedSince :: Maybe UTCTime -- ^ Copy source object only
479− -- if the source has been
480− -- un-modified since this
481− -- given time.
482− } deriving (Show, Eq)
501+ { -- | Bucket containing the source object
502+ srcBucket :: Text,
503+ -- | Source object key
504+ srcObject :: Text,
505+ -- | Source object
506+ -- byte-range
507+ -- (inclusive)
508+ srcRange :: Maybe (Int64, Int64),
509+ -- | ETag condition on source -
510+ -- object is copied only if the
511+ -- source object's ETag matches
512+ -- this value.
513+ srcIfMatch :: Maybe Text,
514+ -- | ETag not match condition
515+ -- on source - object is copied
516+ -- if ETag does not match this
517+ -- value.
518+ srcIfNoneMatch :: Maybe Text,
519+ -- | Copy source object only
520+ -- if the source has been
521+ -- modified since this time.
522+ srcIfModifiedSince :: Maybe UTCTime,
523+ -- | Copy source object only
524+ -- if the source has been
525+ -- un-modified since this
526+ -- given time.
527+ srcIfUnmodifiedSince :: Maybe UTCTime
528+ }
529+ deriving (Show, Eq)
483530
484531-- | Provide a default for `SourceInfo`
485532defaultSourceInfo :: SourceInfo
@@ -487,9 +534,12 @@ defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
487534
488535-- | Represents destination object in server-side copy object
489536data DestinationInfo = DestinationInfo
490− { dstBucket :: Text -- ^ Destination bucket
491− , dstObject :: Text -- ^ Destination object key
492− } deriving (Show, Eq)
537+ { -- | Destination bucket
538+ dstBucket :: Text,
539+ -- | Destination object key
540+ dstObject :: Text
541+ }
542+ deriving (Show, Eq)
493543
494544-- | Provide a default for `DestinationInfo`
495545defaultDestinationInfo :: DestinationInfo
@@ -498,96 +548,105 @@ defaultDestinationInfo = DestinationInfo "" ""
498548-- | Data type for options when getting an object from the
499549-- service. Start with the empty `defaultGetObjectOptions` and modify
500550-- it using the goo* functions.
501−data GetObjectOptions = GetObjectOptions {
502− -- | Set object's data of given offset begin and end,
551+data GetObjectOptions = GetObjectOptions
552+ { -- | Set object's data of given offset begin and end,
503553 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
504− gooRange :: Maybe ByteRange
554+ gooRange :: Maybe ByteRange,
505555 -- | Set matching ETag condition, GetObject which matches the following
506556 -- ETag.
507− , gooIfMatch :: Maybe ETag
557+ gooIfMatch :: Maybe ETag,
508558 -- | Set matching ETag none condition, GetObject which does not match
509559 -- the following ETag.
510− , gooIfNoneMatch :: Maybe ETag
560+ gooIfNoneMatch :: Maybe ETag,
511561 -- | Set object unmodified condition, GetObject unmodified since given time.
512− , gooIfUnmodifiedSince :: Maybe UTCTime
562+ gooIfUnmodifiedSince :: Maybe UTCTime,
513563 -- | Set object modified condition, GetObject modified since given time.
514− , gooIfModifiedSince :: Maybe UTCTime
564+ gooIfModifiedSince :: Maybe UTCTime,
515565 -- | Specify SSE-C key
516− , gooSSECKey :: Maybe SSECKey
566+ gooSSECKey :: Maybe SSECKey
517567 }
518568
519569-- | Provide default `GetObjectOptions`.
520570defaultGetObjectOptions :: GetObjectOptions
521571defaultGetObjectOptions =
522− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
572+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
523573
524574gooToHeaders :: GetObjectOptions -> [HT.Header]
525−gooToHeaders goo = rangeHdr ++ zip names values
526− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
575+gooToHeaders goo =
576+ rangeHdr ++ zip names values
577+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
527578 where
528− names = ["If-Match",
529− "If-None-Match",
530− "If-Unmodified-Since",
531− "If-Modified-Since"]
532− values = mapMaybe (fmap encodeUtf8 . (goo &))
533− [gooIfMatch, gooIfNoneMatch,
534− fmap formatRFC1123 . gooIfUnmodifiedSince,
535− fmap formatRFC1123 . gooIfModifiedSince]
536− rangeHdr = maybe [] (\a -> [(hRange, HT.renderByteRanges [a])])
537− $ gooRange goo
579+ names =
580+ [ "If-Match",
581+ "If-None-Match",
582+ "If-Unmodified-Since",
583+ "If-Modified-Since"
584+ ]
585+ values =
586+ mapMaybe
587+ (fmap encodeUtf8 . (goo &))
588+ [ gooIfMatch,
589+ gooIfNoneMatch,
590+ fmap formatRFC1123 . gooIfUnmodifiedSince,
591+ fmap formatRFC1123 . gooIfModifiedSince
592+ ]
593+ rangeHdr =
594+ maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
595+ gooRange goo
538596
539597-- | Data type returned by 'getObject' representing the object being
540598-- retrieved. Use the @gor*@ functions to access its contents.
541−data GetObjectResponse = GetObjectResponse {
542− -- | ObjectInfo of the object being retrieved.
543− gorObjectInfo :: ObjectInfo
544− -- | A conduit of the bytes of the object.
545− , gorObjectStream :: C.ConduitM () ByteString Minio ()
546− }
599+data GetObjectResponse = GetObjectResponse
600+ { -- | ObjectInfo of the object being retrieved.
601+ gorObjectInfo :: ObjectInfo,
602+ -- | A conduit of the bytes of the object.
603+ gorObjectStream :: C.ConduitM () ByteString Minio ()
604+ }
547605
548606-- | A data-type for events that can occur in the object storage
549607-- server. Reference:
550608-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
551−data Event = ObjectCreated
552− | ObjectCreatedPut
553− | ObjectCreatedPost
554− | ObjectCreatedCopy
555− | ObjectCreatedMultipartUpload
556− | ObjectRemoved
557− | ObjectRemovedDelete
558− | ObjectRemovedDeleteMarkerCreated
559− | ReducedRedundancyLostObject
560− deriving (Eq)
609+data Event
610+ = ObjectCreated
611+ | ObjectCreatedPut
612+ | ObjectCreatedPost
613+ | ObjectCreatedCopy
614+ | ObjectCreatedMultipartUpload
615+ | ObjectRemoved
616+ | ObjectRemovedDelete
617+ | ObjectRemovedDeleteMarkerCreated
618+ | ReducedRedundancyLostObject
619+ deriving (Eq)
561620
562621instance Show Event where
563− show ObjectCreated = "s3:ObjectCreated:*"
564− show ObjectCreatedPut = "s3:ObjectCreated:Put"
565− show ObjectCreatedPost = "s3:ObjectCreated:Post"
566− show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
567− show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
568− show ObjectRemoved = "s3:ObjectRemoved:*"
569− show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
622+ show ObjectCreated = "s3:ObjectCreated:*"
623+ show ObjectCreatedPut = "s3:ObjectCreated:Put"
624+ show ObjectCreatedPost = "s3:ObjectCreated:Post"
625+ show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
626+ show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
627+ show ObjectRemoved = "s3:ObjectRemoved:*"
628+ show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
570629 show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
571− show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
630+ show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
572631
573632textToEvent :: Text -> Maybe Event
574633textToEvent t = case t of
575− "s3:ObjectCreated:*" -> Just ObjectCreated
576− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
577− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
578− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
579− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
580− "s3:ObjectRemoved:*" -> Just ObjectRemoved
581− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
634+ "s3:ObjectCreated:*" -> Just ObjectCreated
635+ "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
636+ "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
637+ "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
638+ "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
639+ "s3:ObjectRemoved:*" -> Just ObjectRemoved
640+ "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
582641 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
583− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
584− _ -> Nothing
585−
642+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
643+ _ -> Nothing
586644
587645-- | Filter data type - part of notification configuration
588646data Filter = Filter
589647 { fFilter :: FilterKey
590− } deriving (Show, Eq)
648+ }
649+ deriving (Show, Eq)
591650
592651-- | defaultFilter is empty, used to create a notification
593652-- configuration.
@@ -597,7 +656,8 @@ defaultFilter = Filter defaultFilterKey
597656-- | FilterKey contains FilterRules, and is part of a Filter.
598657data FilterKey = FilterKey
599658 { fkKey :: FilterRules
600− } deriving (Show, Eq)
659+ }
660+ deriving (Show, Eq)
601661
602662-- | defaultFilterKey is empty, used to create notification
603663-- configuration.
@@ -607,14 +667,14 @@ defaultFilterKey = FilterKey defaultFilterRules
607667-- | FilterRules represents a collection of `FilterRule`s.
608668data FilterRules = FilterRules
609669 { frFilterRules :: [FilterRule]
610− } deriving (Show, Eq)
670+ }
671+ deriving (Show, Eq)
611672
612673-- | defaultFilterRules is empty, used to create notification
613674-- configuration.
614675defaultFilterRules :: FilterRules
615676defaultFilterRules = FilterRules []
616677
617−
618678-- | A filter rule that can act based on the suffix or prefix of an
619679-- object. As an example, let's create two filter rules:
620680--
@@ -625,9 +685,10 @@ defaultFilterRules = FilterRules []
625685-- for objects having a suffix of ".jpg", and the @prefixRule@
626686-- restricts it to objects having a prefix of "images/".
627687data FilterRule = FilterRule
628− { frName :: Text
629− , frValue :: Text
630− } deriving (Show, Eq)
688+ { frName :: Text,
689+ frValue :: Text
690+ }
691+ deriving (Show, Eq)
631692
632693-- | Arn is an alias of Text
633694type Arn = Text
@@ -636,11 +697,12 @@ type Arn = Text
636697-- notification system. It could represent a Queue, Topic or Lambda
637698-- Function configuration.
638699data NotificationConfig = NotificationConfig
639− { ncId :: Text
640− , ncArn :: Arn
641− , ncEvents :: [Event]
642− , ncFilter :: Filter
643− } deriving (Show, Eq)
700+ { ncId :: Text,
701+ ncArn :: Arn,
702+ ncEvents :: [Event],
703+ ncFilter :: Filter
704+ }
705+ deriving (Show, Eq)
644706
645707-- | A data-type to represent bucket notification configuration. It is
646708-- a collection of queue, topic or lambda function configurations. The
@@ -648,16 +710,16 @@ data NotificationConfig = NotificationConfig
648710-- described at
649711-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
650712data Notification = Notification
651− { nQueueConfigurations :: [NotificationConfig]
652− , nTopicConfigurations :: [NotificationConfig]
653− , nCloudFunctionConfigurations :: [NotificationConfig]
654− } deriving (Eq, Show)
713+ { nQueueConfigurations :: [NotificationConfig],
714+ nTopicConfigurations :: [NotificationConfig],
715+ nCloudFunctionConfigurations :: [NotificationConfig]
716+ }
717+ deriving (Eq, Show)
655718
656719-- | The default notification configuration is empty.
657720defaultNotification :: Notification
658721defaultNotification = Notification [] [] []
659722
660−
661723--------------------------------------------------------------------------
662724-- Select API Related Types
663725--------------------------------------------------------------------------
@@ -665,38 +727,42 @@ defaultNotification = Notification [] [] []
665727-- | SelectRequest represents the Select API call. Use the
666728-- `selectRequest` function to create a value of this type.
667729data SelectRequest = SelectRequest
668− { srExpression :: Text
669− , srExpressionType :: ExpressionType
670− , srInputSerialization :: InputSerialization
671− , srOutputSerialization :: OutputSerialization
672− , srRequestProgressEnabled :: Maybe Bool
673− } deriving (Eq, Show)
730+ { srExpression :: Text,
731+ srExpressionType :: ExpressionType,
732+ srInputSerialization :: InputSerialization,
733+ srOutputSerialization :: OutputSerialization,
734+ srRequestProgressEnabled :: Maybe Bool
735+ }
736+ deriving (Eq, Show)
674737
675738data ExpressionType = SQL
676− deriving (Eq, Show)
739+ deriving (Eq, Show)
677740
678741-- | InputSerialization represents format information of the input
679742-- object being queried. Use one of the smart constructors such as
680743-- `defaultCsvInput` as a starting value, and add compression info
681744-- using `setInputCompressionType`
682745data InputSerialization = InputSerialization
683− { isCompressionType :: Maybe CompressionType
684− , isFormatInfo :: InputFormatInfo
685− } deriving (Eq, Show)
746+ { isCompressionType :: Maybe CompressionType,
747+ isFormatInfo :: InputFormatInfo
748+ }
749+ deriving (Eq, Show)
686750
687751-- | Data type representing the compression setting in a Select
688752-- request.
689−data CompressionType = CompressionTypeNone
690− | CompressionTypeGzip
691− | CompressionTypeBzip2
692− deriving (Eq, Show)
753+data CompressionType
754+ = CompressionTypeNone
755+ | CompressionTypeGzip
756+ | CompressionTypeBzip2
757+ deriving (Eq, Show)
693758
694759-- | Data type representing input object format information in a
695760-- Select request.
696−data InputFormatInfo = InputFormatCSV CSVInputProp
697− | InputFormatJSON JSONInputProp
698− | InputFormatParquet
699− deriving (Eq, Show)
761+data InputFormatInfo
762+ = InputFormatCSV CSVInputProp
763+ | InputFormatJSON JSONInputProp
764+ | InputFormatParquet
765+ deriving (Eq, Show)
700766
701767-- | defaultCsvInput returns InputSerialization with default CSV
702768-- format, and without any compression setting.
@@ -706,14 +772,18 @@ defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
706772-- | linesJsonInput returns InputSerialization with JSON line based
707773-- format with no compression setting.
708774linesJsonInput :: InputSerialization
709−linesJsonInput = InputSerialization Nothing
710− (InputFormatJSON $ JSONInputProp JSONTypeLines)
775+linesJsonInput =
776+ InputSerialization
777+ Nothing
778+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
711779
712780-- | documentJsonInput returns InputSerialization with JSON document
713781-- based format with no compression setting.
714782documentJsonInput :: InputSerialization
715−documentJsonInput = InputSerialization Nothing
716− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
783+documentJsonInput =
784+ InputSerialization
785+ Nothing
786+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
717787
718788-- | defaultParquetInput returns InputSerialization with Parquet
719789-- format, and no compression setting.
@@ -722,12 +792,14 @@ defaultParquetInput = InputSerialization Nothing InputFormatParquet
722792
723793-- | setInputCompressionType sets the compression type for the input
724794-- of the SelectRequest
725−setInputCompressionType :: CompressionType -> SelectRequest
726− -> SelectRequest
795+setInputCompressionType ::
796+ CompressionType ->
797+ SelectRequest ->
798+ SelectRequest
727799setInputCompressionType c i =
728− let is = srInputSerialization i
729− is' = is { isCompressionType = Just c }
730− in i { srInputSerialization = is' }
800+ let is = srInputSerialization i
801+ is' = is {isCompressionType = Just c}
802+ in i {srInputSerialization = is'}
731803
732804-- | defaultCsvOutput returns OutputSerialization with default CSV
733805-- format.
@@ -744,29 +816,33 @@ defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
744816-- SelectRequest with the SQL query text given by @query@, the input
745817-- serialization settings (compression format and format information)
746818-- @inputSer@ and the output serialization settings @outputSer@.
747−selectRequest :: Text -> InputSerialization -> OutputSerialization
748− -> SelectRequest
819+selectRequest ::
820+ Text ->
821+ InputSerialization ->
822+ OutputSerialization ->
823+ SelectRequest
749824selectRequest sqlQuery inputSer outputSer =
750− SelectRequest { srExpression = sqlQuery
751− , srExpressionType = SQL
752− , srInputSerialization = inputSer
753− , srOutputSerialization = outputSer
754− , srRequestProgressEnabled = Nothing
755− }
825+ SelectRequest
826+ { srExpression = sqlQuery,
827+ srExpressionType = SQL,
828+ srInputSerialization = inputSer,
829+ srOutputSerialization = outputSer,
830+ srRequestProgressEnabled = Nothing
831+ }
756832
757833-- | setRequestProgressEnabled sets the flag for turning on progress
758834-- messages when the Select response is being streamed back to the
759835-- client.
760836setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
761837setRequestProgressEnabled enabled sr =
762− sr { srRequestProgressEnabled = Just enabled }
838+ sr {srRequestProgressEnabled = Just enabled}
763839
764840type CSVInputProp = CSVProp
765841
766842-- | CSVProp represents CSV format properties. It is built up using
767843-- the Monoid instance.
768844data CSVProp = CSVProp (H.HashMap Text Text)
769− deriving (Eq, Show)
845+ deriving (Eq, Show)
770846
771847#if (__GLASGOW_HASKELL__ >= 804)
772848instance Semigroup CSVProp where
@@ -774,7 +850,8 @@ instance Semigroup CSVProp where
774850#endif
775851
776852instance Monoid CSVProp where
777− mempty = CSVProp mempty
853+ mempty = CSVProp mempty
854+
778855#if (__GLASGOW_HASKELL__ < 804)
779856 mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
780857#endif
@@ -801,17 +878,20 @@ quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
801878-- | FileHeaderInfo specifies information about column headers for CSV
802879-- format.
803880data FileHeaderInfo
804− = FileHeaderNone -- ^ No column headers are present
805− | FileHeaderUse -- ^ Headers are present and they should be used
806− | FileHeaderIgnore -- ^ Header are present, but should be ignored
807− deriving (Eq, Show)
881+ = -- | No column headers are present
882+ FileHeaderNone
883+ | -- | Headers are present and they should be used
884+ FileHeaderUse
885+ | -- | Header are present, but should be ignored
886+ FileHeaderIgnore
887+ deriving (Eq, Show)
808888
809889-- | Specify the CSV file header info property.
810890fileHeaderInfo :: FileHeaderInfo -> CSVProp
811891fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
812892 where
813− toString FileHeaderNone = "NONE"
814− toString FileHeaderUse = "USE"
893+ toString FileHeaderNone = "NONE"
894+ toString FileHeaderUse = "USE"
815895 toString FileHeaderIgnore = "IGNORE"
816896
817897-- | Specify the CSV comment character property. Lines starting with
@@ -825,25 +905,25 @@ allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter"
825905
826906-- | Set the CSV format properties in the InputSerialization.
827907setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
828−setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }
908+setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
829909
830910-- | Set the CSV format properties in the OutputSerialization.
831911outputCSVFromProps :: CSVProp -> OutputSerialization
832912outputCSVFromProps p = OutputSerializationCSV p
833913
834−data JSONInputProp = JSONInputProp { jsonipType :: JSONType }
835− deriving (Eq, Show)
914+data JSONInputProp = JSONInputProp {jsonipType :: JSONType}
915+ deriving (Eq, Show)
836916
837917data JSONType = JSONTypeDocument | JSONTypeLines
838− deriving (Eq, Show)
839−
918+ deriving (Eq, Show)
840919
841920-- | OutputSerialization represents output serialization settings for
842921-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
843922-- a starting point.
844−data OutputSerialization = OutputSerializationJSON JSONOutputProp
845− | OutputSerializationCSV CSVOutputProp
846− deriving (Eq, Show)
923+data OutputSerialization
924+ = OutputSerializationJSON JSONOutputProp
925+ | OutputSerializationCSV CSVOutputProp
926+ deriving (Eq, Show)
847927
848928type CSVOutputProp = CSVProp
849929
@@ -852,37 +932,40 @@ quoteFields :: QuoteFields -> CSVProp
852932quoteFields q = CSVProp $ H.singleton "QuoteFields" $
853933 case q of
854934 QuoteFieldsAsNeeded -> "ASNEEDED"
855− QuoteFieldsAlways -> "ALWAYS"
935+ QuoteFieldsAlways -> "ALWAYS"
856936
857937-- | Represent the QuoteField setting.
858938data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
859− deriving (Eq, Show)
939+ deriving (Eq, Show)
860940
861−data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }
862− deriving (Eq, Show)
941+data JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
942+ deriving (Eq, Show)
863943
864944-- | Set the output record delimiter for JSON format
865945outputJSONFromRecordDelimiter :: Text -> OutputSerialization
866946outputJSONFromRecordDelimiter t =
867− OutputSerializationJSON (JSONOutputProp $ Just t)
947+ OutputSerializationJSON (JSONOutputProp $ Just t)
868948
869949-- Response related types
870950
871951-- | An EventMessage represents each kind of message received from the server.
872−data EventMessage = ProgressEventMessage { emProgress :: Progress }
873− | StatsEventMessage { emStats :: Stats }
874− | RequestLevelErrorMessage { emErrorCode :: Text
875− , emErrorMessage :: Text
876− }
877− | RecordPayloadEventMessage { emPayloadBytes :: ByteString }
878− deriving (Eq, Show)
879−
880−data MsgHeaderName = MessageType
881− | EventType
882− | ContentType
883− | ErrorCode
884− | ErrorMessage
885− deriving (Eq, Show)
952+data EventMessage
953+ = ProgressEventMessage {emProgress :: Progress}
954+ | StatsEventMessage {emStats :: Stats}
955+ | RequestLevelErrorMessage
956+ { emErrorCode :: Text,
957+ emErrorMessage :: Text
958+ }
959+ | RecordPayloadEventMessage {emPayloadBytes :: ByteString}
960+ deriving (Eq, Show)
961+
962+data MsgHeaderName
963+ = MessageType
964+ | EventType
965+ | ContentType
966+ | ErrorCode
967+ | ErrorMessage
968+ deriving (Eq, Show)
886969
887970msgHeaderValueType :: Word8
888971msgHeaderValueType = 7
@@ -890,11 +973,12 @@ msgHeaderValueType = 7
890973type MessageHeader = (MsgHeaderName, Text)
891974
892975-- | Represent the progress event returned in the Select response.
893−data Progress = Progress { pBytesScanned :: Int64
894− , pBytesProcessed :: Int64
895− , pBytesReturned :: Int64
896− }
897− deriving (Eq, Show)
976+data Progress = Progress
977+ { pBytesScanned :: Int64,
978+ pBytesProcessed :: Int64,
979+ pBytesReturned :: Int64
980+ }
981+ deriving (Eq, Show)
898982
899983-- | Represent the stats event returned at the end of the Select
900984-- response.
@@ -907,43 +991,51 @@ type Stats = Progress
907991-- | Represents different kinds of payload that are used with S3 API
908992-- requests.
909993data Payload
910− = PayloadBS ByteString
911− | PayloadH Handle Int64 Int64 -- file handle, offset and length
912− | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
994+ = PayloadBS ByteString
995+ | PayloadH Handle Int64 Int64 -- file handle, offset and length
996+ | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
913997
914998defaultPayload :: Payload
915999defaultPayload = PayloadBS ""
9161000
917−data AdminReqInfo = AdminReqInfo {
918− ariMethod :: Method
919− , ariPayloadHash :: Maybe ByteString
920− , ariPayload :: Payload
921− , ariPath :: ByteString
922− , ariHeaders :: [Header]
923− , ariQueryParams :: Query
1001+data AdminReqInfo = AdminReqInfo
1002+ { ariMethod :: Method,
1003+ ariPayloadHash :: Maybe ByteString,
1004+ ariPayload :: Payload,
1005+ ariPath :: ByteString,
1006+ ariHeaders :: [Header],
1007+ ariQueryParams :: Query
9241008 }
9251009
9261010data S3ReqInfo = S3ReqInfo
927− { riMethod :: Method
928− , riBucket :: Maybe Bucket
929− , riObject :: Maybe Object
930− , riQueryParams :: Query
931− , riHeaders :: [Header]
932− , riPayload :: Payload
933− , riPayloadHash :: Maybe ByteString
934− , riRegion :: Maybe Region
935− , riNeedsLocation :: Bool
1011+ { riMethod :: Method,
1012+ riBucket :: Maybe Bucket,
1013+ riObject :: Maybe Object,
1014+ riQueryParams :: Query,
1015+ riHeaders :: [Header],
1016+ riPayload :: Payload,
1017+ riPayloadHash :: Maybe ByteString,
1018+ riRegion :: Maybe Region,
1019+ riNeedsLocation :: Bool
9361020 }
9371021
9381022defaultS3ReqInfo :: S3ReqInfo
939−defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
940− [] [] defaultPayload Nothing Nothing True
1023+defaultS3ReqInfo =
1024+ S3ReqInfo
1025+ HT.methodGet
1026+ Nothing
1027+ Nothing
1028+ []
1029+ []
1030+ defaultPayload
1031+ Nothing
1032+ Nothing
1033+ True
9411034
9421035getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
9431036getS3Path b o =
944− let segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
945− in
946− B.concat ["/", B.intercalate "/" segments]
1037+ let segments = map toUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1038+ in B.concat ["/", B.intercalate "/" segments]
9471039
9481040-- | Time to expire for a presigned URL. It interpreted as a number of
9491041-- seconds. The maximum duration that can be specified is 7 days.
@@ -953,40 +1045,38 @@ type RegionMap = H.HashMap Bucket Region
9531045
9541046-- | The Minio Monad - all computations accessing object storage
9551047-- happens in it.
956−newtype Minio a = Minio {
957− unMinio :: ReaderT MinioConn (ResourceT IO) a
1048+newtype Minio a = Minio
1049+ { unMinio :: ReaderT MinioConn (ResourceT IO) a
9581050 }
959− deriving (
960− Functor
961− , Applicative
962− , Monad
963− , MonadIO
964− , MonadReader MinioConn
965− , MonadResource
1051+ deriving
1052+ ( Functor,
1053+ Applicative,
1054+ Monad,
1055+ MonadIO,
1056+ MonadReader MinioConn,
1057+ MonadResource,
1058+ MonadUnliftIO
9661059 )
9671060
968−instance MonadUnliftIO Minio where
969− askUnliftIO = Minio $ ReaderT $ \r ->
970− withUnliftIO $ \u ->
971− return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))
972−
9731061-- | MinioConn holds connection info and a connection pool to allow
9741062-- for efficient resource re-use.
9751063data MinioConn = MinioConn
976− { mcConnInfo :: ConnectInfo
977− , mcConnManager :: NC.Manager
978− , mcRegionMap :: MVar RegionMap
1064+ { mcConnInfo :: ConnectInfo,
1065+ mcConnManager :: NC.Manager,
1066+ mcRegionMap :: MVar RegionMap
9791067 }
9801068
9811069class HasSvcNamespace env where
9821070 getSvcNamespace :: env -> Text
9831071
9841072instance HasSvcNamespace MinioConn where
985− getSvcNamespace env = let host = connectHost $ mcConnInfo env
986− in if | host == "storage.googleapis.com" ->
987− "http://doc.s3.amazonaws.com/2006-03-01"
988− | otherwise ->
989− "http://s3.amazonaws.com/doc/2006-03-01/"
1073+ getSvcNamespace env =
1074+ let host = connectHost $ mcConnInfo env
1075+ in if
1076+ | host == "storage.googleapis.com" ->
1077+ "http://doc.s3.amazonaws.com/2006-03-01"
1078+ | otherwise ->
1079+ "http://s3.amazonaws.com/doc/2006-03-01/"
9901080
9911081-- | Takes connection information and returns a connection object to
9921082-- be passed to 'runMinio'. The returned value can be kept in the
@@ -994,11 +1084,12 @@ instance HasSvcNamespace MinioConn where
9941084-- object storage is accessed.
9951085connect :: ConnectInfo -> IO MinioConn
9961086connect ci = do
997− let settings | connectIsSecure ci && connectDisableTLSCertValidation ci =
998− let badTlsSettings = Conn.TLSSettingsSimple True False False
999− in TLS.mkManagerSettings badTlsSettings Nothing
1000− | connectIsSecure ci = NC.tlsManagerSettings
1001− | otherwise = defaultManagerSettings
1087+ let settings
1088+ | connectIsSecure ci && connectDisableTLSCertValidation ci =
1089+ let badTlsSettings = Conn.TLSSettingsSimple True False False
1090+ in TLS.mkManagerSettings badTlsSettings Nothing
1091+ | connectIsSecure ci = NC.tlsManagerSettings
1092+ | otherwise = defaultManagerSettings
10021093 mgr <- NC.newManager settings
10031094 mkMinioConn ci mgr
10041095
@@ -1012,8 +1103,8 @@ runMinioWith conn m = runResourceT $ runMinioResWith conn m
10121103-- `MinioConn`.
10131104mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
10141105mkMinioConn ci mgr = do
1015− rMapMVar <- M.newMVar H.empty
1016− return $ MinioConn ci mgr rMapMVar
1106+ rMapMVar <- M.newMVar H.empty
1107+ return $ MinioConn ci mgr rMapMVar
10171108
10181109-- | Run the Minio action and return the result or an error.
10191110runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
@@ -1026,12 +1117,12 @@ runMinio ci m = do
10261117runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
10271118runMinioResWith conn m =
10281119 flip runReaderT conn . unMinio $
1029− fmap Right m `U.catches`
1030− [ U.Handler handlerServiceErr
1031− , U.Handler handlerHE
1032− , U.Handler handlerFE
1033− , U.Handler handlerValidation
1034− ]
1120+ fmap Right m
1121+ `U.catches` [ U.Handler handlerServiceErr,
1122+ U.Handler handlerHE,
1123+ U.Handler handlerFE,
1124+ U.Handler handlerValidation
1125+ ]
10351126 where
10361127 handlerServiceErr = return . Left . MErrService
10371128 handlerHE = return . Left . MErrHTTP