@@ -1,5 +1,5 @@
11--
2−-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
2+-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
33--
44-- Licensed under the Apache License, Version 2.0 (the "License");
55-- you may not use this file except in compliance with the License.
@@ -13,64 +13,45 @@
1313-- See the License for the specific language governing permissions and
1414-- limitations under the License.
1515--
16−{-# LANGUAGE CPP #-}
17−{-# LANGUAGE GADTs #-}
18−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19−{-# LANGUAGE StrictData #-}
20−{-# LANGUAGE TypeFamilies #-}
2116
17+{-# LANGUAGE CPP #-}
18+{-# LANGUAGE GADTs #-}
19+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
20+{-# LANGUAGE TypeFamilies #-}
2221module Network.Minio.Data where
2322
24−import qualified Conduit as C
25−import qualified Control.Concurrent.MVar as M
26−import Control.Monad.Trans.Except (throwE)
27−import Control.Monad.Trans.Resource
28− ( MonadResource,
29− MonadThrow (..),
30− MonadUnliftIO,
31− ResourceT,
32− runResourceT,
33− )
34−import qualified Data.Aeson as A
35−import qualified Data.ByteArray as BA
36−import qualified Data.ByteString as B
37−import qualified Data.ByteString.Lazy as LB
38−import Data.Default.Class (def)
39−import qualified Data.HashMap.Strict as H
40−import qualified Data.Ini as Ini
41−import qualified Data.List as List
42−import qualified Data.Text as T
43−import qualified Data.Text.Encoding as TE
44−import Data.Time (defaultTimeLocale, formatTime)
45−import Lib.Prelude (UTCTime, throwIO)
46−import qualified Network.Connection as Conn
47−import Network.HTTP.Client (defaultManagerSettings)
48−import qualified Network.HTTP.Client.TLS as TLS
49−import qualified Network.HTTP.Conduit as NC
50−import Network.HTTP.Types
51− ( ByteRange,
52− Header,
53− Method,
54− Query,
55− hRange,
56− )
57−import qualified Network.HTTP.Types as HT
58−import Network.Minio.Credentials
59−import Network.Minio.Data.Crypto
60− ( encodeToBase64,
61− hashMD5ToBase64,
62− )
63−import Network.Minio.Data.Time (UrlExpiry)
64−import Network.Minio.Errors
65− ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
66− MinioErr (..),
67− )
68−import Network.Minio.Utils
69−import System.Directory (doesFileExist, getHomeDirectory)
70−import qualified System.Environment as Env
71−import System.FilePath.Posix (combine)
72−import qualified UnliftIO as U
73−import qualified UnliftIO.MVar as UM
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
7455
7556-- | max obj size is 5TiB
7657maxObjectSize :: Int64
@@ -90,157 +71,125 @@ maxMultipartParts = 10000
9071-- TODO: Add a type which provides typed constants for region. this
9172-- type should have a IsString instance to infer the appropriate
9273-- constant.
93−
9474-- | awsRegionMap - library constant
9575awsRegionMap :: H.HashMap Text Text
96−awsRegionMap =
97− H.fromList
98− [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
99− ("us-east-2", "s3.us-east-2.amazonaws.com"),
100− ("us-west-1", "s3.us-west-1.amazonaws.com"),
101− ("us-west-2", "s3.us-west-2.amazonaws.com"),
102− ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
103− ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104− ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
105− ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
106− ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107− ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
108− ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
109− ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110− ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
111− ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
112− ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113− ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
114− ("eu-central-1", "s3.eu-central-1.amazonaws.com"),
115− ("eu-central-2", "s3.eu-central-2.amazonaws.com"),
116− ("eu-south-1", "s3.eu-south-1.amazonaws.com"),
117− ("eu-south-2", "s3.eu-south-2.amazonaws.com"),
118− ("af-south-1", "s3.af-south-1.amazonaws.com"),
119− ("ap-east-1", "s3.ap-east-1.amazonaws.com"),
120− ("cn-north-1", "s3.cn-north-1.amazonaws.com.cn"),
121− ("cn-northwest-1", "s3.cn-northwest-1.amazonaws.com.cn"),
122− ("eu-north-1", "s3.eu-north-1.amazonaws.com"),
123− ("me-south-1", "s3.me-south-1.amazonaws.com"),
124− ("me-central-1", "s3.me-central-1.amazonaws.com"),
125− ("us-gov-east-1", "s3.us-gov-east-1.amazonaws.com"),
126− ("us-gov-west-1", "s3.us-gov-west-1.amazonaws.com"),
127− ("sa-east-1", "s3.sa-east-1.amazonaws.com")
128− ]
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+ ]
12992
13093-- | Connection Info data type. To create a 'ConnectInfo' value,
13194-- enable the @OverloadedStrings@ language extension and use the
13295-- `IsString` instance to provide a URL, for example:
13396--
13497-- > let c :: ConnectInfo = "https://play.min.io"
135−data ConnectInfo = ConnectInfo
136− { connectHost :: Text,
137− connectPort :: Int,
138− connectCreds :: Creds,
139− connectIsSecure :: Bool,
140− connectRegion :: Region,
141− connectAutoDiscoverRegion :: Bool,
142− connectDisableTLSCertValidation :: Bool
143− }
144−
145−getEndpoint :: ConnectInfo -> Endpoint
146−getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
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)
147108
148109instance IsString ConnectInfo where
149− fromString str =
150− let req = NC.parseRequest_ str
151− in ConnectInfo
152− { connectHost = TE.decodeUtf8 $ NC.host req,
153− connectPort = NC.port req,
154− connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
155− connectIsSecure = NC.secure req,
156− connectRegion = "",
157− connectAutoDiscoverRegion = True,
158− connectDisableTLSCertValidation = False
159− }
160−
161−-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
162−-- Loaders may be chained together using 'findFirst'.
163−--
164−-- @since 1.7.0
165−type CredentialLoader = IO (Maybe CredentialValue)
166−
167−-- | Combines the given list of loaders, by calling each one in
168−-- order until a 'CredentialValue' is returned.
169−findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
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+ }
122+
123+-- | Contains access key and secret key to access object storage.
124+data Credentials = Credentials { cAccessKey :: Text
125+ , cSecretKey :: Text
126+ } deriving (Eq, Show)
127+
128+-- | A Provider is an action that may return Credentials. Providers
129+-- may be chained together using 'findFirst'.
130+type Provider = IO (Maybe Credentials)
131+
132+-- | Combines the given list of providers, by calling each one in
133+-- order until Credentials are found.
134+findFirst :: [Provider] -> Provider
170135findFirst [] = return Nothing
171−findFirst (f : fs) = do
172− c <- f
173− maybe (findFirst fs) (return . Just) c
136+findFirst (f:fs) = do c <- f
137+ maybe (findFirst fs) (return . Just) c
174138
175−-- | This action returns a 'CredentialValue' populated from
176−-- @~\/.aws\/credentials@
177−fromAWSConfigFile :: CredentialLoader
139+-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
140+fromAWSConfigFile :: Provider
178141fromAWSConfigFile = do
179− credsE <- runExceptT $ do
180− homeDir <- lift getHomeDirectory
181− let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
182− fileExists <- lift $ doesFileExist awsCredsFile
183− bool (throwE "FileNotFound") (return ()) fileExists
184− ini <- ExceptT $ Ini.readIniFile awsCredsFile
185− akey <-
186− ExceptT $
187− return $
188− Ini.lookupValue "default" "aws_access_key_id" ini
189− skey <-
190− ExceptT $
191− return $
192− Ini.lookupValue "default" "aws_secret_access_key" ini
193− return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
194− return $ either (const Nothing) Just credsE
195−
196−-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
197−-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
198−fromAWSEnv :: CredentialLoader
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
154+
155+-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
156+-- @AWS_SECRET_ACCESS_KEY@ environment variables.
157+fromAWSEnv :: Provider
199158fromAWSEnv = runMaybeT $ do
200− akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
201− skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
202− return $ CredentialValue (fromString akey) (fromString skey) Nothing
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)
203162
204−-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205−-- and @MINIO_SECRET_KEY@ environment variables.
206−fromMinioEnv :: CredentialLoader
163+-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
164+-- @MINIO_SECRET_KEY@ environment variables.
165+fromMinioEnv :: Provider
207166fromMinioEnv = runMaybeT $ do
208− akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
209− skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
210− return $ CredentialValue (fromString akey) (fromString skey) Nothing
211−
212−-- | setCredsFrom retrieves access credentials from the first action in the
213−-- given list that succeeds and sets it in the 'ConnectInfo'.
214−setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
215−setCredsFrom ps ci = do
216− pMay <- findFirst ps
217− maybe
218− (throwIO MErrVMissingCredentials)
219− (return . (`setCreds` ci))
220− pMay
221−
222−-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223−setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224−setCreds cv connInfo =
225− connInfo
226− { connectCreds = CredsStatic cv
227− }
228−
229−-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230−-- credentials via the STS API on demand. It is automatically refreshed on
231−-- expiry.
232−setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233−setSTSCredential p ci = do
234− store <- initSTSCredential p
235− return ci {connectCreds = CredsSTS store}
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)
170+
171+-- | setCredsFrom retrieves access credentials from the first
172+-- `Provider` form the given list that succeeds and sets it in the
173+-- `ConnectInfo`.
174+setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
175+setCredsFrom ps ci = do pMay <- findFirst ps
176+ maybe
177+ (throwIO MErrVMissingCredentials)
178+ (return . (flip setCreds ci))
179+ pMay
180+
181+-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
182+setCreds :: Credentials -> ConnectInfo -> ConnectInfo
183+setCreds (Credentials accessKey secretKey) connInfo =
184+ connInfo { connectAccessKey = accessKey
185+ , connectSecretKey = secretKey
186+ }
236187
237188-- | Set the S3 region parameter in the `ConnectInfo`
238189setRegion :: Region -> ConnectInfo -> ConnectInfo
239−setRegion r connInfo =
240− connInfo
241− { connectRegion = r,
242− connectAutoDiscoverRegion = False
243− }
190+setRegion r connInfo = connInfo { connectRegion = r
191+ , connectAutoDiscoverRegion = False
192+ }
244193
245194-- | Check if the connection to object storage server is secure
246195-- (i.e. uses TLS)
@@ -252,10 +201,16 @@ isConnectInfoSecure = connectIsSecure
252201-- certificates. Note that this option has no effect, if you provide
253202-- your own Manager in `mkMinioConn`.
254203disableTLSCertValidation :: ConnectInfo -> ConnectInfo
255−disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
204+disableTLSCertValidation c = c { connectDisableTLSCertValidation = True }
256205
257206getHostAddr :: ConnectInfo -> ByteString
258−getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
207+getHostAddr ci = if | port == 80 || port == 443 -> toS host
208+ | otherwise -> toS $
209+ T.concat [ host, ":" , Lib.Prelude.show port]
210+ where
211+ port = connectPort ci
212+ host = connectHost ci
213+
259214
260215-- | Default Google Compute Storage ConnectInfo. Works only for
261216-- "Simple Migration" use-case with interoperability mode enabled on
@@ -264,25 +219,23 @@ getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
264219--
265220-- Credentials should be supplied before use.
266221gcsCI :: ConnectInfo
267−gcsCI =
268− setRegion
269− "us"
270− "https://storage.googleapis.com"
222+gcsCI = setRegion "us"
223+ "https://storage.googleapis.com"
224+
271225
272226-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
273227-- should be supplied before use.
274228awsCI :: ConnectInfo
275229awsCI = "https://s3.amazonaws.com"
276230
231+
277232-- | <https://play.min.io MinIO Play Server>
278233-- ConnectInfo. Credentials are already filled in.
279234minioPlayCI :: ConnectInfo
280−minioPlayCI =
281− let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
282− in setCreds playCreds $
283− setRegion
284− "us-east-1"
285− "https://play.min.io"
235+minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
236+ in setCreds playCreds
237+ $ setRegion "us-east-1"
238+ "https://play.min.io"
286239
287240-- |
288241-- Represents a bucket in the object store
@@ -301,147 +254,135 @@ type ETag = Text
301254-- | Data type to represent an object encryption key. Create one using
302255-- the `mkSSECKey` function.
303256newtype SSECKey = SSECKey BA.ScrubbedBytes
304− deriving stock (Eq, Show)
257+ deriving (Eq, Show)
305258
306259-- | Validates that the given ByteString is 32 bytes long and creates
307260-- an encryption key.
308−mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
309−mkSSECKey keyBytes
310− | B.length keyBytes /= 32 =
311− throwM MErrVInvalidEncryptionKeyLength
312− | otherwise =
313− return $ SSECKey $ BA.convert keyBytes
261+mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
262+mkSSECKey keyBytes | B.length keyBytes /= 32 =
263+ throwM MErrVInvalidEncryptionKeyLength
264+ | otherwise =
265+ return $ SSECKey $ BA.convert keyBytes
314266
315267-- | Data type to represent Server-Side-Encryption settings
316268data SSE where
317− -- | Specifies SSE S3 encryption - server manages encryption keys
318− SSE :: SSE
319− -- | Specifies that KMS service should be used. The first argument
320− -- to the constructor is the Key Id to be used by the server (if
321− -- not specified, the default KMS key id is used). The second
322− -- argument is the optional KMS context that must have a
323− -- `A.ToJSON` instance - please refer to the AWS S3 documentation
324− -- for detailed information.
325− SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
326− -- | Specifies server-side encryption with customer provided
327− -- key. The argument is the encryption key to be used.
328− SSEC :: SSECKey -> SSE
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
329281
330282toPutObjectHeaders :: SSE -> [HT.Header]
331283toPutObjectHeaders sseArg =
332− let sseHeader = "x-amz-server-side-encryption"
333− sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
334− sseKmsContextHeader = sseHeader <> "-context"
335− ssecAlgo = sseHeader <> "-customer-algorithm"
336− ssecKey = sseHeader <> "-customer-key"
337− ssecKeyMD5 = ssecKey <> "-MD5"
338− in case sseArg of
339− SSE -> [(sseHeader, "AES256")]
340− SSEKMS keyIdMay ctxMay ->
341− [(sseHeader, "aws:kms")]
342− ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
343− ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
344− SSEC (SSECKey sb) ->
345− [ (ssecAlgo, "AES256"),
346− (ssecKey, encodeToBase64 sb),
347− (ssecKeyMD5, hashMD5ToBase64 sb)
348− ]
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)]
349303
350304-- | Data type for options in PutObject call. Start with the empty
351305-- `defaultPutObjectOptions` and use various the various poo*
352306-- accessors.
353−data PutObjectOptions = PutObjectOptions
354− { -- | Set a standard MIME type describing the format of the object.
355− pooContentType :: Maybe Text,
356− -- | Set what content encodings have been applied to the object and thus
357− -- what decoding mechanisms must be applied to obtain the media-type
358− -- referenced by the Content-Type header field.
359− pooContentEncoding :: Maybe Text,
360− -- | Set presentational information for the object.
361− pooContentDisposition :: Maybe Text,
362− -- | Set to specify caching behavior for the object along the
363− -- request/reply chain.
364− pooCacheControl :: Maybe Text,
365− -- | Set to describe the language(s) intended for the audience.
366− pooContentLanguage :: Maybe Text,
367− -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
368− -- performance needs, storage class is @STANDARD@ by default (i.e
369− -- when Nothing is passed).
370− pooStorageClass :: Maybe Text,
371− -- | Set user defined metadata to store with the object.
372− pooUserMetadata :: [(Text, Text)],
373− -- | Set number of worker threads used to upload an object.
374− pooNumThreads :: Maybe Word,
375− -- | Set object encryption parameters for the request.
376− pooSSE :: Maybe SSE
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
377331 }
378332
379333-- | Provide default `PutObjectOptions`.
380334defaultPutObjectOptions :: PutObjectOptions
381335defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
382336
337+-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
338+-- stripped and a Just is returned.
339+userMetadataHeaderNameMaybe :: Text -> Maybe Text
340+userMetadataHeaderNameMaybe 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
346+
347+addXAmzMetaPrefix :: Text -> Text
348+addXAmzMetaPrefix s | isJust (userMetadataHeaderNameMaybe s) = s
349+ | otherwise = "X-Amz-Meta-" <> s
350+
351+mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
352+mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y))
353+
383354pooToHeaders :: PutObjectOptions -> [HT.Header]
384−pooToHeaders poo =
385− userMetadata
386− ++ mapMaybe tupToMaybe (zip names values)
387− ++ maybe [] toPutObjectHeaders (pooSSE poo)
355+pooToHeaders poo = userMetadata
356+ ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
357+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
388358 where
389− tupToMaybe (k, Just v) = Just (k, v)
359+ tupToMaybe (k, Just v) = Just (k, v)
390360 tupToMaybe (_, Nothing) = Nothing
361+
391362 userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
392− names =
393− [ "content-type",
394− "content-encoding",
395− "content-disposition",
396− "content-language",
397− "cache-control",
398− "x-amz-storage-class"
399− ]
400− values =
401− map
402− (fmap encodeUtf8 . (poo &))
403− [ pooContentType,
404− pooContentEncoding,
405− pooContentDisposition,
406− pooContentLanguage,
407− pooCacheControl,
408− pooStorageClass
409− ]
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+
410375
411376-- |
412377-- BucketInfo returned for list buckets call
413−data BucketInfo = BucketInfo
414− { biName :: Bucket,
415− biCreationDate :: UTCTime
416− }
417− deriving stock (Show, Eq)
378+data BucketInfo = BucketInfo {
379+ biName :: Bucket
380+ , biCreationDate :: UTCTime
381+ } deriving (Show, Eq)
418382
419383-- | A type alias to represent a part-number for multipart upload
420384type PartNumber = Int16
421385
422−-- | Select part sizes - the logic is that the minimum part-size will
423−-- be 64MiB.
424−selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
425−selectPartSizes size =
426− uncurry (List.zip3 [1 ..]) $
427− List.unzip $
428− loop 0 size
429− where
430− ceil :: Double -> Int64
431− ceil = ceiling
432− partSize =
433− max
434− minPartSize
435− ( ceil $
436− fromIntegral size
437− / fromIntegral maxMultipartParts
438− )
439− m = partSize
440− loop st sz
441− | st > sz = []
442− | st + m >= sz = [(st, sz - st)]
443− | otherwise = (st, m) : loop (st + m) sz
444−
445386-- | A type alias to represent an upload-id for multipart upload
446387type UploadId = Text
447388
@@ -450,116 +391,95 @@ type PartTuple = (PartNumber, ETag)
450391
451392-- | Represents result from a listing of object parts of an ongoing
452393-- multipart upload.
453−data ListPartsResult = ListPartsResult
454− { lprHasMore :: Bool,
455− lprNextPart :: Maybe Int,
456− lprParts :: [ObjectPartInfo]
457− }
458− deriving stock (Show, Eq)
394+data ListPartsResult = ListPartsResult {
395+ lprHasMore :: Bool
396+ , lprNextPart :: Maybe Int
397+ , lprParts :: [ObjectPartInfo]
398+ } deriving (Show, Eq)
459399
460400-- | Represents information about an object part in an ongoing
461401-- multipart upload.
462−data ObjectPartInfo = ObjectPartInfo
463− { opiNumber :: PartNumber,
464− opiETag :: ETag,
465− opiSize :: Int64,
466− opiModTime :: UTCTime
467− }
468− deriving stock (Show, Eq)
402+data ObjectPartInfo = ObjectPartInfo {
403+ opiNumber :: PartNumber
404+ , opiETag :: ETag
405+ , opiSize :: Int64
406+ , opiModTime :: UTCTime
407+ } deriving (Show, Eq)
469408
470409-- | Represents result from a listing of incomplete uploads to a
471410-- bucket.
472−data ListUploadsResult = ListUploadsResult
473− { lurHasMore :: Bool,
474− lurNextKey :: Maybe Text,
475− lurNextUpload :: Maybe Text,
476− lurUploads :: [(Object, UploadId, UTCTime)],
477− lurCPrefixes :: [Text]
478− }
479− deriving stock (Show, Eq)
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)
480418
481419-- | Represents information about a multipart upload.
482−data UploadInfo = UploadInfo
483− { uiKey :: Object,
484− uiUploadId :: UploadId,
485− uiInitTime :: UTCTime,
486− uiSize :: Int64
487− }
488− deriving stock (Show, Eq)
420+data UploadInfo = UploadInfo {
421+ uiKey :: Object
422+ , uiUploadId :: UploadId
423+ , uiInitTime :: UTCTime
424+ , uiSize :: Int64
425+ } deriving (Show, Eq)
489426
490427-- | Represents result from a listing of objects in a bucket.
491−data ListObjectsResult = ListObjectsResult
492− { lorHasMore :: Bool,
493− lorNextToken :: Maybe Text,
494− lorObjects :: [ObjectInfo],
495− lorCPrefixes :: [Text]
496− }
497− deriving stock (Show, Eq)
428+data ListObjectsResult = ListObjectsResult {
429+ lorHasMore :: Bool
430+ , lorNextToken :: Maybe Text
431+ , lorObjects :: [ObjectInfo]
432+ , lorCPrefixes :: [Text]
433+ } deriving (Show, Eq)
498434
499435-- | Represents result from a listing of objects version 1 in a bucket.
500−data ListObjectsV1Result = ListObjectsV1Result
501− { lorHasMore' :: Bool,
502− lorNextMarker :: Maybe Text,
503− lorObjects' :: [ObjectInfo],
504− lorCPrefixes' :: [Text]
505− }
506− deriving stock (Show, Eq)
436+data ListObjectsV1Result = ListObjectsV1Result {
437+ lorHasMore' :: Bool
438+ , lorNextMarker :: Maybe Text
439+ , lorObjects' :: [ObjectInfo]
440+ , lorCPrefixes' :: [Text]
441+ } deriving (Show, Eq)
507442
508443-- | Represents information about an object.
509444data ObjectInfo = ObjectInfo
510− { -- | Object key
511− oiObject :: Object,
512− -- | Modification time of the object
513− oiModTime :: UTCTime,
514− -- | ETag of the object
515− oiETag :: ETag,
516− -- | Size of the object in bytes
517− oiSize :: Int64,
518− -- | A map of user-metadata
519− -- pairs stored with an
520− -- object (keys will not
521− -- have the @X-Amz-Meta-@
522− -- prefix).
523− oiUserMetadata :: H.HashMap Text Text,
524− -- | A map of metadata
525− -- key-value pairs (not
526− -- including the
527− -- user-metadata pairs)
528− oiMetadata :: H.HashMap Text Text
529− }
530− deriving stock (Show, Eq)
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)
531459
532460-- | Represents source object in server-side copy object
533461data SourceInfo = SourceInfo
534− { -- | Bucket containing the source object
535− srcBucket :: Text,
536− -- | Source object key
537− srcObject :: Text,
538− -- | Source object
539− -- byte-range
540− -- (inclusive)
541− srcRange :: Maybe (Int64, Int64),
542− -- | ETag condition on source -
543− -- object is copied only if the
544− -- source object's ETag matches
545− -- this value.
546− srcIfMatch :: Maybe Text,
547− -- | ETag not match condition
548− -- on source - object is copied
549− -- if ETag does not match this
550− -- value.
551− srcIfNoneMatch :: Maybe Text,
552− -- | Copy source object only
553− -- if the source has been
554− -- modified since this time.
555− srcIfModifiedSince :: Maybe UTCTime,
556− -- | Copy source object only
557− -- if the source has been
558− -- un-modified since this
559− -- given time.
560− srcIfUnmodifiedSince :: Maybe UTCTime
561− }
562− deriving stock (Show, Eq)
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)
563483
564484-- | Provide a default for `SourceInfo`
565485defaultSourceInfo :: SourceInfo
@@ -567,12 +487,9 @@ defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
567487
568488-- | Represents destination object in server-side copy object
569489data DestinationInfo = DestinationInfo
570− { -- | Destination bucket
571− dstBucket :: Text,
572− -- | Destination object key
573− dstObject :: Text
574− }
575− deriving stock (Show, Eq)
490+ { dstBucket :: Text -- ^ Destination bucket
491+ , dstObject :: Text -- ^ Destination object key
492+ } deriving (Show, Eq)
576493
577494-- | Provide a default for `DestinationInfo`
578495defaultDestinationInfo :: DestinationInfo
@@ -581,106 +498,96 @@ defaultDestinationInfo = DestinationInfo "" ""
581498-- | Data type for options when getting an object from the
582499-- service. Start with the empty `defaultGetObjectOptions` and modify
583500-- it using the goo* functions.
584−data GetObjectOptions = GetObjectOptions
585− { -- | Set object's data of given offset begin and end,
501+data GetObjectOptions = GetObjectOptions {
502+ -- | Set object's data of given offset begin and end,
586503 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
587− gooRange :: Maybe ByteRange,
504+ gooRange :: Maybe ByteRange
588505 -- | Set matching ETag condition, GetObject which matches the following
589506 -- ETag.
590− gooIfMatch :: Maybe ETag,
507+ , gooIfMatch :: Maybe ETag
591508 -- | Set matching ETag none condition, GetObject which does not match
592509 -- the following ETag.
593− gooIfNoneMatch :: Maybe ETag,
510+ , gooIfNoneMatch :: Maybe ETag
594511 -- | Set object unmodified condition, GetObject unmodified since given time.
595− gooIfUnmodifiedSince :: Maybe UTCTime,
512+ , gooIfUnmodifiedSince :: Maybe UTCTime
596513 -- | Set object modified condition, GetObject modified since given time.
597− gooIfModifiedSince :: Maybe UTCTime,
514+ , gooIfModifiedSince :: Maybe UTCTime
598515 -- | Specify SSE-C key
599− gooSSECKey :: Maybe SSECKey
516+ , gooSSECKey :: Maybe SSECKey
600517 }
601518
602519-- | Provide default `GetObjectOptions`.
603520defaultGetObjectOptions :: GetObjectOptions
604521defaultGetObjectOptions =
605− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
522+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
606523
607524gooToHeaders :: GetObjectOptions -> [HT.Header]
608−gooToHeaders goo =
609− rangeHdr
610− ++ zip names values
611− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
525+gooToHeaders goo = rangeHdr ++ zip names values
526+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
612527 where
613− names =
614− [ "If-Match",
615− "If-None-Match",
616− "If-Unmodified-Since",
617− "If-Modified-Since"
618− ]
619− values =
620− mapMaybe
621− (fmap encodeUtf8 . (goo &))
622− [ gooIfMatch,
623− gooIfNoneMatch,
624− fmap formatRFC1123 . gooIfUnmodifiedSince,
625− fmap formatRFC1123 . gooIfModifiedSince
626− ]
627− rangeHdr =
628− maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
629− gooRange goo
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
630538
631539-- | Data type returned by 'getObject' representing the object being
632540-- retrieved. Use the @gor*@ functions to access its contents.
633−data GetObjectResponse = GetObjectResponse
634− { -- | ObjectInfo of the object being retrieved.
635− gorObjectInfo :: ObjectInfo,
636− -- | A conduit of the bytes of the object.
637− gorObjectStream :: C.ConduitM () ByteString Minio ()
638− }
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+ }
639547
640548-- | A data-type for events that can occur in the object storage
641549-- server. Reference:
642550-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
643−data Event
644− = ObjectCreated
645− | ObjectCreatedPut
646− | ObjectCreatedPost
647− | ObjectCreatedCopy
648− | ObjectCreatedMultipartUpload
649− | ObjectRemoved
650− | ObjectRemovedDelete
651− | ObjectRemovedDeleteMarkerCreated
652− | ReducedRedundancyLostObject
653− deriving stock (Eq, Show)
654−
655−instance ToText Event where
656− toText ObjectCreated = "s3:ObjectCreated:*"
657− toText ObjectCreatedPut = "s3:ObjectCreated:Put"
658− toText ObjectCreatedPost = "s3:ObjectCreated:Post"
659− toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
660− toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
661− toText ObjectRemoved = "s3:ObjectRemoved:*"
662− toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
663− toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
664− toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
551+data Event = ObjectCreated
552+ | ObjectCreatedPut
553+ | ObjectCreatedPost
554+ | ObjectCreatedCopy
555+ | ObjectCreatedMultipartUpload
556+ | ObjectRemoved
557+ | ObjectRemovedDelete
558+ | ObjectRemovedDeleteMarkerCreated
559+ | ReducedRedundancyLostObject
560+ deriving (Eq)
561+
562+instance 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"
570+ show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
571+ show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
665572
666573textToEvent :: Text -> Maybe Event
667574textToEvent t = case t of
668− "s3:ObjectCreated:*" -> Just ObjectCreated
669− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
670− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
671− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
672− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
673− "s3:ObjectRemoved:*" -> Just ObjectRemoved
674− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
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
675582 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
676− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
677− _ -> Nothing
583+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
584+ _ -> Nothing
585+
678586
679587-- | Filter data type - part of notification configuration
680−newtype Filter = Filter
588+data Filter = Filter
681589 { fFilter :: FilterKey
682− }
683− deriving stock (Show, Eq)
590+ } deriving (Show, Eq)
684591
685592-- | defaultFilter is empty, used to create a notification
686593-- configuration.
@@ -688,10 +595,9 @@ defaultFilter :: Filter
688595defaultFilter = Filter defaultFilterKey
689596
690597-- | FilterKey contains FilterRules, and is part of a Filter.
691−newtype FilterKey = FilterKey
598+data FilterKey = FilterKey
692599 { fkKey :: FilterRules
693− }
694− deriving stock (Show, Eq)
600+ } deriving (Show, Eq)
695601
696602-- | defaultFilterKey is empty, used to create notification
697603-- configuration.
@@ -699,16 +605,16 @@ defaultFilterKey :: FilterKey
699605defaultFilterKey = FilterKey defaultFilterRules
700606
701607-- | FilterRules represents a collection of `FilterRule`s.
702−newtype FilterRules = FilterRules
608+data FilterRules = FilterRules
703609 { frFilterRules :: [FilterRule]
704− }
705− deriving stock (Show, Eq)
610+ } deriving (Show, Eq)
706611
707612-- | defaultFilterRules is empty, used to create notification
708613-- configuration.
709614defaultFilterRules :: FilterRules
710615defaultFilterRules = FilterRules []
711616
617+
712618-- | A filter rule that can act based on the suffix or prefix of an
713619-- object. As an example, let's create two filter rules:
714620--
@@ -719,10 +625,9 @@ defaultFilterRules = FilterRules []
719625-- for objects having a suffix of ".jpg", and the @prefixRule@
720626-- restricts it to objects having a prefix of "images/".
721627data FilterRule = FilterRule
722− { frName :: Text,
723− frValue :: Text
724− }
725− deriving stock (Show, Eq)
628+ { frName :: Text
629+ , frValue :: Text
630+ } deriving (Show, Eq)
726631
727632-- | Arn is an alias of Text
728633type Arn = Text
@@ -731,12 +636,11 @@ type Arn = Text
731636-- notification system. It could represent a Queue, Topic or Lambda
732637-- Function configuration.
733638data NotificationConfig = NotificationConfig
734− { ncId :: Text,
735− ncArn :: Arn,
736− ncEvents :: [Event],
737− ncFilter :: Filter
738− }
739− deriving stock (Show, Eq)
639+ { ncId :: Text
640+ , ncArn :: Arn
641+ , ncEvents :: [Event]
642+ , ncFilter :: Filter
643+ } deriving (Show, Eq)
740644
741645-- | A data-type to represent bucket notification configuration. It is
742646-- a collection of queue, topic or lambda function configurations. The
@@ -744,16 +648,16 @@ data NotificationConfig = NotificationConfig
744648-- described at
745649-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
746650data Notification = Notification
747− { nQueueConfigurations :: [NotificationConfig],
748− nTopicConfigurations :: [NotificationConfig],
749− nCloudFunctionConfigurations :: [NotificationConfig]
750− }
751− deriving stock (Show, Eq)
651+ { nQueueConfigurations :: [NotificationConfig]
652+ , nTopicConfigurations :: [NotificationConfig]
653+ , nCloudFunctionConfigurations :: [NotificationConfig]
654+ } deriving (Eq, Show)
752655
753656-- | The default notification configuration is empty.
754657defaultNotification :: Notification
755658defaultNotification = Notification [] [] []
756659
660+
757661--------------------------------------------------------------------------
758662-- Select API Related Types
759663--------------------------------------------------------------------------
@@ -761,42 +665,38 @@ defaultNotification = Notification [] [] []
761665-- | SelectRequest represents the Select API call. Use the
762666-- `selectRequest` function to create a value of this type.
763667data SelectRequest = SelectRequest
764− { srExpression :: Text,
765− srExpressionType :: ExpressionType,
766− srInputSerialization :: InputSerialization,
767− srOutputSerialization :: OutputSerialization,
768− srRequestProgressEnabled :: Maybe Bool
769− }
770− deriving stock (Show, Eq)
668+ { srExpression :: Text
669+ , srExpressionType :: ExpressionType
670+ , srInputSerialization :: InputSerialization
671+ , srOutputSerialization :: OutputSerialization
672+ , srRequestProgressEnabled :: Maybe Bool
673+ } deriving (Eq, Show)
771674
772675data ExpressionType = SQL
773− deriving stock (Show, Eq)
676+ deriving (Eq, Show)
774677
775678-- | InputSerialization represents format information of the input
776679-- object being queried. Use one of the smart constructors such as
777680-- `defaultCsvInput` as a starting value, and add compression info
778681-- using `setInputCompressionType`
779682data InputSerialization = InputSerialization
780− { isCompressionType :: Maybe CompressionType,
781− isFormatInfo :: InputFormatInfo
782− }
783− deriving stock (Show, Eq)
683+ { isCompressionType :: Maybe CompressionType
684+ , isFormatInfo :: InputFormatInfo
685+ } deriving (Eq, Show)
784686
785687-- | Data type representing the compression setting in a Select
786688-- request.
787−data CompressionType
788− = CompressionTypeNone
789− | CompressionTypeGzip
790− | CompressionTypeBzip2
791− deriving stock (Show, Eq)
689+data CompressionType = CompressionTypeNone
690+ | CompressionTypeGzip
691+ | CompressionTypeBzip2
692+ deriving (Eq, Show)
792693
793694-- | Data type representing input object format information in a
794695-- Select request.
795−data InputFormatInfo
796− = InputFormatCSV CSVInputProp
797− | InputFormatJSON JSONInputProp
798− | InputFormatParquet
799− deriving stock (Show, Eq)
696+data InputFormatInfo = InputFormatCSV CSVInputProp
697+ | InputFormatJSON JSONInputProp
698+ | InputFormatParquet
699+ deriving (Eq, Show)
800700
801701-- | defaultCsvInput returns InputSerialization with default CSV
802702-- format, and without any compression setting.
@@ -806,18 +706,14 @@ defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
806706-- | linesJsonInput returns InputSerialization with JSON line based
807707-- format with no compression setting.
808708linesJsonInput :: InputSerialization
809−linesJsonInput =
810− InputSerialization
811− Nothing
812− (InputFormatJSON $ JSONInputProp JSONTypeLines)
709+linesJsonInput = InputSerialization Nothing
710+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
813711
814712-- | documentJsonInput returns InputSerialization with JSON document
815713-- based format with no compression setting.
816714documentJsonInput :: InputSerialization
817−documentJsonInput =
818− InputSerialization
819− Nothing
820− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
715+documentJsonInput = InputSerialization Nothing
716+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
821717
822718-- | defaultParquetInput returns InputSerialization with Parquet
823719-- format, and no compression setting.
@@ -826,14 +722,12 @@ defaultParquetInput = InputSerialization Nothing InputFormatParquet
826722
827723-- | setInputCompressionType sets the compression type for the input
828724-- of the SelectRequest
829−setInputCompressionType ::
830− CompressionType ->
831− SelectRequest ->
832− SelectRequest
725+setInputCompressionType :: CompressionType -> SelectRequest
726+ -> SelectRequest
833727setInputCompressionType c i =
834− let is = srInputSerialization i
835− is' = is {isCompressionType = Just c}
836− in i {srInputSerialization = is'}
728+ let is = srInputSerialization i
729+ is' = is { isCompressionType = Just c }
730+ in i { srInputSerialization = is' }
837731
838732-- | defaultCsvOutput returns OutputSerialization with default CSV
839733-- format.
@@ -850,42 +744,40 @@ defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
850744-- SelectRequest with the SQL query text given by @query@, the input
851745-- serialization settings (compression format and format information)
852746-- @inputSer@ and the output serialization settings @outputSer@.
853−selectRequest ::
854− Text ->
855− InputSerialization ->
856− OutputSerialization ->
857− SelectRequest
747+selectRequest :: Text -> InputSerialization -> OutputSerialization
748+ -> SelectRequest
858749selectRequest sqlQuery inputSer outputSer =
859− SelectRequest
860− { srExpression = sqlQuery,
861− srExpressionType = SQL,
862− srInputSerialization = inputSer,
863− srOutputSerialization = outputSer,
864− srRequestProgressEnabled = Nothing
865− }
750+ SelectRequest { srExpression = sqlQuery
751+ , srExpressionType = SQL
752+ , srInputSerialization = inputSer
753+ , srOutputSerialization = outputSer
754+ , srRequestProgressEnabled = Nothing
755+ }
866756
867757-- | setRequestProgressEnabled sets the flag for turning on progress
868758-- messages when the Select response is being streamed back to the
869759-- client.
870760setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
871761setRequestProgressEnabled enabled sr =
872− sr {srRequestProgressEnabled = Just enabled}
762+ sr { srRequestProgressEnabled = Just enabled }
873763
874764type CSVInputProp = CSVProp
875765
876766-- | CSVProp represents CSV format properties. It is built up using
877767-- the Monoid instance.
878−newtype CSVProp = CSVProp (H.HashMap Text Text)
879− deriving stock (Show, Eq)
768+data CSVProp = CSVProp (H.HashMap Text Text)
769+ deriving (Eq, Show)
880770
771+#if (__GLASGOW_HASKELL__ >= 804)
881772instance Semigroup CSVProp where
882− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
773+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
774+#endif
883775
884776instance Monoid CSVProp where
885− mempty = CSVProp mempty
886−
887−csvPropsList :: CSVProp -> [(Text, Text)]
888−csvPropsList (CSVProp h) = sort $ H.toList h
777+ mempty = CSVProp mempty
778+#if (__GLASGOW_HASKELL__ < 804)
779+ mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
780+#endif
889781
890782defaultCSVProp :: CSVProp
891783defaultCSVProp = mempty
@@ -909,21 +801,18 @@ quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
909801-- | FileHeaderInfo specifies information about column headers for CSV
910802-- format.
911803data FileHeaderInfo
912− = -- | No column headers are present
913− FileHeaderNone
914− | -- | Headers are present and they should be used
915− FileHeaderUse
916− | -- | Header are present, but should be ignored
917− FileHeaderIgnore
918− deriving stock (Show, Eq)
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)
919808
920809-- | Specify the CSV file header info property.
921810fileHeaderInfo :: FileHeaderInfo -> CSVProp
922−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
811+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
923812 where
924− toStr FileHeaderNone = "NONE"
925− toStr FileHeaderUse = "USE"
926− toStr FileHeaderIgnore = "IGNORE"
813+ toString FileHeaderNone = "NONE"
814+ toString FileHeaderUse = "USE"
815+ toString FileHeaderIgnore = "IGNORE"
927816
928817-- | Specify the CSV comment character property. Lines starting with
929818-- this character are ignored by the server.
@@ -936,69 +825,64 @@ allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter"
936825
937826-- | Set the CSV format properties in the InputSerialization.
938827setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
939−setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
828+setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }
940829
941830-- | Set the CSV format properties in the OutputSerialization.
942831outputCSVFromProps :: CSVProp -> OutputSerialization
943−outputCSVFromProps = OutputSerializationCSV
832+outputCSVFromProps p = OutputSerializationCSV p
944833
945−newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946− deriving stock (Show, Eq)
834+data JSONInputProp = JSONInputProp { jsonipType :: JSONType }
835+ deriving (Eq, Show)
947836
948837data JSONType = JSONTypeDocument | JSONTypeLines
949− deriving stock (Show, Eq)
838+ deriving (Eq, Show)
839+
950840
951841-- | OutputSerialization represents output serialization settings for
952842-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
953843-- a starting point.
954−data OutputSerialization
955− = OutputSerializationJSON JSONOutputProp
956− | OutputSerializationCSV CSVOutputProp
957− deriving stock (Show, Eq)
844+data OutputSerialization = OutputSerializationJSON JSONOutputProp
845+ | OutputSerializationCSV CSVOutputProp
846+ deriving (Eq, Show)
958847
959848type CSVOutputProp = CSVProp
960849
961850-- | quoteFields is an output serialization parameter
962851quoteFields :: QuoteFields -> CSVProp
963−quoteFields q = CSVProp $
964− H.singleton "QuoteFields" $
965− case q of
966− QuoteFieldsAsNeeded -> "ASNEEDED"
967− QuoteFieldsAlways -> "ALWAYS"
852+quoteFields q = CSVProp $ H.singleton "QuoteFields" $
853+ case q of
854+ QuoteFieldsAsNeeded -> "ASNEEDED"
855+ QuoteFieldsAlways -> "ALWAYS"
968856
969857-- | Represent the QuoteField setting.
970858data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
971− deriving stock (Show, Eq)
859+ deriving (Eq, Show)
972860
973−newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974− deriving stock (Show, Eq)
861+data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }
862+ deriving (Eq, Show)
975863
976864-- | Set the output record delimiter for JSON format
977865outputJSONFromRecordDelimiter :: Text -> OutputSerialization
978866outputJSONFromRecordDelimiter t =
979− OutputSerializationJSON (JSONOutputProp $ Just t)
867+ OutputSerializationJSON (JSONOutputProp $ Just t)
980868
981869-- Response related types
982870
983871-- | An EventMessage represents each kind of message received from the server.
984−data EventMessage
985− = ProgressEventMessage Progress
986− | StatsEventMessage Stats
987− | RequestLevelErrorMessage
988− Text
989− -- ^ Error code
990− Text
991− -- ^ Error message
992− | RecordPayloadEventMessage ByteString
993− deriving stock (Show, Eq)
994−
995−data MsgHeaderName
996− = MessageType
997− | EventType
998− | ContentType
999− | ErrorCode
1000− | ErrorMessage
1001− deriving stock (Show, Eq)
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)
1002886
1003887msgHeaderValueType :: Word8
1004888msgHeaderValueType = 7
@@ -1006,12 +890,11 @@ msgHeaderValueType = 7
1006890type MessageHeader = (MsgHeaderName, Text)
1007891
1008892-- | Represent the progress event returned in the Select response.
1009−data Progress = Progress
1010− { pBytesScanned :: Int64,
1011− pBytesProcessed :: Int64,
1012− pBytesReturned :: Int64
1013− }
1014− deriving stock (Show, Eq)
893+data Progress = Progress { pBytesScanned :: Int64
894+ , pBytesProcessed :: Int64
895+ , pBytesReturned :: Int64
896+ }
897+ deriving (Eq, Show)
1015898
1016899-- | Represent the stats event returned at the end of the Select
1017900-- response.
@@ -1024,89 +907,86 @@ type Stats = Progress
1024907-- | Represents different kinds of payload that are used with S3 API
1025908-- requests.
1026909data Payload
1027− = PayloadBS ByteString
1028− | PayloadH Handle Int64 Int64 -- file handle, offset and length
1029− | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
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
1030913
1031914defaultPayload :: Payload
1032915defaultPayload = PayloadBS ""
1033916
1034−data AdminReqInfo = AdminReqInfo
1035− { ariMethod :: Method,
1036− ariPayloadHash :: Maybe ByteString,
1037− ariPayload :: Payload,
1038− ariPath :: ByteString,
1039− ariHeaders :: [Header],
1040− ariQueryParams :: Query
917+data AdminReqInfo = AdminReqInfo {
918+ ariMethod :: Method
919+ , ariPayloadHash :: Maybe ByteString
920+ , ariPayload :: Payload
921+ , ariPath :: ByteString
922+ , ariHeaders :: [Header]
923+ , ariQueryParams :: Query
1041924 }
1042925
1043926data S3ReqInfo = S3ReqInfo
1044− { riMethod :: Method,
1045− riBucket :: Maybe Bucket,
1046− riObject :: Maybe Object,
1047− riQueryParams :: Query,
1048− riHeaders :: [Header],
1049− riPayload :: Payload,
1050− riPayloadHash :: Maybe ByteString,
1051− riRegion :: Maybe Region,
1052− riNeedsLocation :: Bool,
1053− riPresignExpirySecs :: Maybe UrlExpiry
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
1054936 }
1055937
1056938defaultS3ReqInfo :: S3ReqInfo
1057−defaultS3ReqInfo =
1058− S3ReqInfo
1059− HT.methodGet
1060− Nothing
1061− Nothing
1062− []
1063− []
1064− defaultPayload
1065− Nothing
1066− Nothing
1067− True
1068− Nothing
939+defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
940+ [] [] defaultPayload Nothing Nothing True
1069941
1070942getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
1071943getS3Path b o =
1072− let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073− in B.concat ["/", B.intercalate "/" segments]
944+ let segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
945+ in
946+ B.concat ["/", B.intercalate "/" segments]
947+
948+-- | Time to expire for a presigned URL. It interpreted as a number of
949+-- seconds. The maximum duration that can be specified is 7 days.
950+type UrlExpiry = Int
1074951
1075952type RegionMap = H.HashMap Bucket Region
1076953
1077954-- | The Minio Monad - all computations accessing object storage
1078955-- happens in it.
1079−newtype Minio a = Minio
1080− { unMinio :: ReaderT MinioConn (ResourceT IO) a
956+newtype Minio a = Minio {
957+ unMinio :: ReaderT MinioConn (ResourceT IO) a
1081958 }
1082− deriving newtype
1083− ( Functor,
1084− Applicative,
1085− Monad,
1086− MonadIO,
1087− MonadReader MinioConn,
1088− MonadResource,
1089− MonadUnliftIO
959+ deriving (
960+ Functor
961+ , Applicative
962+ , Monad
963+ , MonadIO
964+ , MonadReader MinioConn
965+ , MonadResource
1090966 )
1091967
968+instance MonadUnliftIO Minio where
969+ askUnliftIO = Minio $ ReaderT $ \r ->
970+ withUnliftIO $ \u ->
971+ return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))
972+
1092973-- | MinioConn holds connection info and a connection pool to allow
1093974-- for efficient resource re-use.
1094975data MinioConn = MinioConn
1095− { mcConnInfo :: ConnectInfo,
1096− mcConnManager :: NC.Manager,
1097− mcRegionMap :: MVar RegionMap
976+ { mcConnInfo :: ConnectInfo
977+ , mcConnManager :: NC.Manager
978+ , mcRegionMap :: MVar RegionMap
1098979 }
1099980
1100981class HasSvcNamespace env where
1101982 getSvcNamespace :: env -> Text
1102983
1103984instance HasSvcNamespace MinioConn where
1104− getSvcNamespace env =
1105− let host = connectHost $ mcConnInfo env
1106− in ( if host == "storage.googleapis.com"
1107− then "http://doc.s3.amazonaws.com/2006-03-01"
1108− else "http://s3.amazonaws.com/doc/2006-03-01/"
1109− )
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/"
1110990
1111991-- | Takes connection information and returns a connection object to
1112992-- be passed to 'runMinio'. The returned value can be kept in the
@@ -1114,16 +994,11 @@ instance HasSvcNamespace MinioConn where
1114994-- object storage is accessed.
1115995connect :: ConnectInfo -> IO MinioConn
1116996connect ci = do
1117− let settings
1118− | connectIsSecure ci && connectDisableTLSCertValidation ci =
1119− let badTlsSettings =
1120− case def of
1121− tlsSettings@Conn.TLSSettingsSimple {} ->
1122− tlsSettings {Conn.settingDisableCertificateValidation = True}
1123− _ -> def
1124− in TLS.mkManagerSettings badTlsSettings Nothing
1125− | connectIsSecure ci = NC.tlsManagerSettings
1126− | otherwise = defaultManagerSettings
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
11271002 mgr <- NC.newManager settings
11281003 mkMinioConn ci mgr
11291004
@@ -1137,8 +1012,8 @@ runMinioWith conn m = runResourceT $ runMinioResWith conn m
11371012-- `MinioConn`.
11381013mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
11391014mkMinioConn ci mgr = do
1140− rMapMVar <- M.newMVar H.empty
1141− return $ MinioConn ci mgr rMapMVar
1015+ rMapMVar <- M.newMVar H.empty
1016+ return $ MinioConn ci mgr rMapMVar
11421017
11431018-- | Run the Minio action and return the result or an error.
11441019runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
@@ -1151,12 +1026,12 @@ runMinio ci m = do
11511026runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
11521027runMinioResWith conn m =
11531028 flip runReaderT conn . unMinio $
1154− fmap Right m
1155− `U.catches` [ U.Handler handlerServiceErr,
1156− U.Handler handlerHE,
1157− U.Handler handlerFE,
1158− U.Handler handlerValidation
1159− ]
1029+ fmap Right m `U.catches`
1030+ [ U.Handler handlerServiceErr
1031+ , U.Handler handlerHE
1032+ , U.Handler handlerFE
1033+ , U.Handler handlerValidation
1034+ ]
11601035 where
11611036 handlerServiceErr = return . Left . MErrService
11621037 handlerHE = return . Left . MErrHTTP
@@ -1170,22 +1045,9 @@ runMinioRes ci m = do
11701045 conn <- liftIO $ connect ci
11711046 runMinioResWith conn m
11721047
1048+s3Name :: Text -> Text -> Name
1049+s3Name ns s = Name s (Just ns) Nothing
1050+
11731051-- | Format as per RFC 1123.
11741052formatRFC1123 :: UTCTime -> T.Text
11751053formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1176−
1177−lookupRegionCache :: Bucket -> Minio (Maybe Region)
1178−lookupRegionCache b = do
1179− rMVar <- asks mcRegionMap
1180− rMap <- UM.readMVar rMVar
1181− return $ H.lookup b rMap
1182−
1183−addToRegionCache :: Bucket -> Region -> Minio ()
1184−addToRegionCache b region = do
1185− rMVar <- asks mcRegionMap
1186− UM.modifyMVar_ rMVar $ return . H.insert b region
1187−
1188−deleteFromRegionCache :: Bucket -> Minio ()
1189−deleteFromRegionCache b = do
1190− rMVar <- asks mcRegionMap
1191− UM.modifyMVar_ rMVar $ return . H.delete b