@@ -1,5 +1,5 @@
11--
2−-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
2+-- MinIO Haskell SDK, (C) 2017-2023 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,45 +13,64 @@
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 StrictData #-}
20+{-# LANGUAGE TypeFamilies #-}
21+
2122module Network.Minio.Data where
2223
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
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
5574
5675-- | max obj size is 5TiB
5776maxObjectSize :: Int64
@@ -71,125 +90,157 @@ maxMultipartParts = 10000
7190-- TODO: Add a type which provides typed constants for region. this
7291-- type should have a IsString instance to infer the appropriate
7392-- constant.
93+
7494-- | awsRegionMap - library constant
7595awsRegionMap :: 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− ]
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+ ]
92129
93130-- | Connection Info data type. To create a 'ConnectInfo' value,
94131-- enable the @OverloadedStrings@ language extension and use the
95132-- `IsString` instance to provide a URL, for example:
96133--
97134-- > 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)
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)
108147
109148instance 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− }
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
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)
135170findFirst [] = return Nothing
136−findFirst (f:fs) = do c <- f
137− maybe (findFirst fs) (return . Just) c
171+findFirst (f : fs) = do
172+ c <- f
173+ maybe (findFirst fs) (return . Just) c
138174
139−-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
140−fromAWSConfigFile :: Provider
175+-- | This action returns a 'CredentialValue' populated from
176+-- @~\/.aws\/credentials@
177+fromAWSConfigFile :: CredentialLoader
141178fromAWSConfigFile = 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
154−
155−-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
156−-- @AWS_SECRET_ACCESS_KEY@ environment variables.
157−fromAWSEnv :: Provider
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
158199fromAWSEnv = 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)
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
162203
163−-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
164−-- @MINIO_SECRET_KEY@ environment variables.
165−fromMinioEnv :: Provider
204+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205+-- and @MINIO_SECRET_KEY@ environment variables.
206+fromMinioEnv :: CredentialLoader
166207fromMinioEnv = 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)
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− }
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}
187236
188237-- | Set the S3 region parameter in the `ConnectInfo`
189238setRegion :: Region -> ConnectInfo -> ConnectInfo
190−setRegion r connInfo = connInfo { connectRegion = r
191− , connectAutoDiscoverRegion = False
192− }
239+setRegion r connInfo =
240+ connInfo
241+ { connectRegion = r,
242+ connectAutoDiscoverRegion = False
243+ }
193244
194245-- | Check if the connection to object storage server is secure
195246-- (i.e. uses TLS)
@@ -201,16 +252,10 @@ isConnectInfoSecure = connectIsSecure
201252-- certificates. Note that this option has no effect, if you provide
202253-- your own Manager in `mkMinioConn`.
203254disableTLSCertValidation :: ConnectInfo -> ConnectInfo
204−disableTLSCertValidation c = c { connectDisableTLSCertValidation = True }
255+disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
205256
206257getHostAddr :: ConnectInfo -> ByteString
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−
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
214259
215260-- | Default Google Compute Storage ConnectInfo. Works only for
216261-- "Simple Migration" use-case with interoperability mode enabled on
@@ -219,23 +264,25 @@ getHostAddr ci = if | port == 80 || port == 443 -> toS host
219264--
220265-- Credentials should be supplied before use.
221266gcsCI :: ConnectInfo
222−gcsCI = setRegion "us"
223− "https://storage.googleapis.com"
224−
267+gcsCI =
268+ setRegion
269+ "us"
270+ "https://storage.googleapis.com"
225271
226272-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
227273-- should be supplied before use.
228274awsCI :: ConnectInfo
229275awsCI = "https://s3.amazonaws.com"
230276
231−
232277-- | <https://play.min.io MinIO Play Server>
233278-- ConnectInfo. Credentials are already filled in.
234279minioPlayCI :: ConnectInfo
235−minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
236− in setCreds playCreds
237− $ setRegion "us-east-1"
238− "https://play.min.io"
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"
239286
240287-- |
241288-- Represents a bucket in the object store
@@ -254,135 +301,147 @@ type ETag = Text
254301-- | Data type to represent an object encryption key. Create one using
255302-- the `mkSSECKey` function.
256303newtype SSECKey = SSECKey BA.ScrubbedBytes
257− deriving (Eq, Show)
304+ deriving stock (Eq, Show)
258305
259306-- | Validates that the given ByteString is 32 bytes long and creates
260307-- an encryption key.
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
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
266314
267315-- | Data type to represent Server-Side-Encryption settings
268316data 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
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
281329
282330toPutObjectHeaders :: SSE -> [HT.Header]
283331toPutObjectHeaders 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)]
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+ ]
303349
304350-- | Data type for options in PutObject call. Start with the empty
305351-- `defaultPutObjectOptions` and use various the various poo*
306352-- 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
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
331377 }
332378
333379-- | Provide default `PutObjectOptions`.
334380defaultPutObjectOptions :: PutObjectOptions
335381defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
336382
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−
354383pooToHeaders :: PutObjectOptions -> [HT.Header]
355−pooToHeaders poo = userMetadata
356− ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
357− ++ maybe [] toPutObjectHeaders (pooSSE poo)
384+pooToHeaders poo =
385+ userMetadata
386+ ++ mapMaybe tupToMaybe (zip names values)
387+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
358388 where
359− tupToMaybe (k, Just v) = Just (k, v)
389+ tupToMaybe (k, Just v) = Just (k, v)
360390 tupToMaybe (_, Nothing) = Nothing
361−
362391 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−
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+ ]
375410
376411-- |
377412-- BucketInfo returned for list buckets call
378−data BucketInfo = BucketInfo {
379− biName :: Bucket
380− , biCreationDate :: UTCTime
381− } deriving (Show, Eq)
413+data BucketInfo = BucketInfo
414+ { biName :: Bucket,
415+ biCreationDate :: UTCTime
416+ }
417+ deriving stock (Show, Eq)
382418
383419-- | A type alias to represent a part-number for multipart upload
384420type PartNumber = Int16
385421
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+
386445-- | A type alias to represent an upload-id for multipart upload
387446type UploadId = Text
388447
@@ -391,95 +450,116 @@ type PartTuple = (PartNumber, ETag)
391450
392451-- | Represents result from a listing of object parts of an ongoing
393452-- multipart upload.
394−data ListPartsResult = ListPartsResult {
395− lprHasMore :: Bool
396− , lprNextPart :: Maybe Int
397− , lprParts :: [ObjectPartInfo]
398− } deriving (Show, Eq)
453+data ListPartsResult = ListPartsResult
454+ { lprHasMore :: Bool,
455+ lprNextPart :: Maybe Int,
456+ lprParts :: [ObjectPartInfo]
457+ }
458+ deriving stock (Show, Eq)
399459
400460-- | Represents information about an object part in an ongoing
401461-- multipart upload.
402−data ObjectPartInfo = ObjectPartInfo {
403− opiNumber :: PartNumber
404− , opiETag :: ETag
405− , opiSize :: Int64
406− , opiModTime :: UTCTime
407− } deriving (Show, Eq)
462+data ObjectPartInfo = ObjectPartInfo
463+ { opiNumber :: PartNumber,
464+ opiETag :: ETag,
465+ opiSize :: Int64,
466+ opiModTime :: UTCTime
467+ }
468+ deriving stock (Show, Eq)
408469
409470-- | Represents result from a listing of incomplete uploads to a
410471-- 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)
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)
418480
419481-- | 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)
482+data UploadInfo = UploadInfo
483+ { uiKey :: Object,
484+ uiUploadId :: UploadId,
485+ uiInitTime :: UTCTime,
486+ uiSize :: Int64
487+ }
488+ deriving stock (Show, Eq)
426489
427490-- | 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)
491+data ListObjectsResult = ListObjectsResult
492+ { lorHasMore :: Bool,
493+ lorNextToken :: Maybe Text,
494+ lorObjects :: [ObjectInfo],
495+ lorCPrefixes :: [Text]
496+ }
497+ deriving stock (Show, Eq)
434498
435499-- | 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)
500+data ListObjectsV1Result = ListObjectsV1Result
501+ { lorHasMore' :: Bool,
502+ lorNextMarker :: Maybe Text,
503+ lorObjects' :: [ObjectInfo],
504+ lorCPrefixes' :: [Text]
505+ }
506+ deriving stock (Show, Eq)
442507
443508-- | Represents information about an object.
444509data 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)
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)
459531
460532-- | Represents source object in server-side copy object
461533data 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)
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)
483563
484564-- | Provide a default for `SourceInfo`
485565defaultSourceInfo :: SourceInfo
@@ -487,9 +567,12 @@ defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
487567
488568-- | Represents destination object in server-side copy object
489569data DestinationInfo = DestinationInfo
490− { dstBucket :: Text -- ^ Destination bucket
491− , dstObject :: Text -- ^ Destination object key
492− } deriving (Show, Eq)
570+ { -- | Destination bucket
571+ dstBucket :: Text,
572+ -- | Destination object key
573+ dstObject :: Text
574+ }
575+ deriving stock (Show, Eq)
493576
494577-- | Provide a default for `DestinationInfo`
495578defaultDestinationInfo :: DestinationInfo
@@ -498,96 +581,106 @@ defaultDestinationInfo = DestinationInfo "" ""
498581-- | Data type for options when getting an object from the
499582-- service. Start with the empty `defaultGetObjectOptions` and modify
500583-- it using the goo* functions.
501−data GetObjectOptions = GetObjectOptions {
502− -- | Set object's data of given offset begin and end,
584+data GetObjectOptions = GetObjectOptions
585+ { -- | Set object's data of given offset begin and end,
503586 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
504− gooRange :: Maybe ByteRange
587+ gooRange :: Maybe ByteRange,
505588 -- | Set matching ETag condition, GetObject which matches the following
506589 -- ETag.
507− , gooIfMatch :: Maybe ETag
590+ gooIfMatch :: Maybe ETag,
508591 -- | Set matching ETag none condition, GetObject which does not match
509592 -- the following ETag.
510− , gooIfNoneMatch :: Maybe ETag
593+ gooIfNoneMatch :: Maybe ETag,
511594 -- | Set object unmodified condition, GetObject unmodified since given time.
512− , gooIfUnmodifiedSince :: Maybe UTCTime
595+ gooIfUnmodifiedSince :: Maybe UTCTime,
513596 -- | Set object modified condition, GetObject modified since given time.
514− , gooIfModifiedSince :: Maybe UTCTime
597+ gooIfModifiedSince :: Maybe UTCTime,
515598 -- | Specify SSE-C key
516− , gooSSECKey :: Maybe SSECKey
599+ gooSSECKey :: Maybe SSECKey
517600 }
518601
519602-- | Provide default `GetObjectOptions`.
520603defaultGetObjectOptions :: GetObjectOptions
521604defaultGetObjectOptions =
522− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
605+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
523606
524607gooToHeaders :: GetObjectOptions -> [HT.Header]
525−gooToHeaders goo = rangeHdr ++ zip names values
526− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
608+gooToHeaders goo =
609+ rangeHdr
610+ ++ zip names values
611+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
527612 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
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
538630
539631-- | Data type returned by 'getObject' representing the object being
540632-- 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− }
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+ }
547639
548640-- | A data-type for events that can occur in the object storage
549641-- server. Reference:
550642-- 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)
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"
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"
572665
573666textToEvent :: Text -> Maybe Event
574667textToEvent 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
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
582675 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
583− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
584− _ -> Nothing
585−
676+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
677+ _ -> Nothing
586678
587679-- | Filter data type - part of notification configuration
588−data Filter = Filter
680+newtype Filter = Filter
589681 { fFilter :: FilterKey
590− } deriving (Show, Eq)
682+ }
683+ deriving stock (Show, Eq)
591684
592685-- | defaultFilter is empty, used to create a notification
593686-- configuration.
@@ -595,9 +688,10 @@ defaultFilter :: Filter
595688defaultFilter = Filter defaultFilterKey
596689
597690-- | FilterKey contains FilterRules, and is part of a Filter.
598−data FilterKey = FilterKey
691+newtype FilterKey = FilterKey
599692 { fkKey :: FilterRules
600− } deriving (Show, Eq)
693+ }
694+ deriving stock (Show, Eq)
601695
602696-- | defaultFilterKey is empty, used to create notification
603697-- configuration.
@@ -605,16 +699,16 @@ defaultFilterKey :: FilterKey
605699defaultFilterKey = FilterKey defaultFilterRules
606700
607701-- | FilterRules represents a collection of `FilterRule`s.
608−data FilterRules = FilterRules
702+newtype FilterRules = FilterRules
609703 { frFilterRules :: [FilterRule]
610− } deriving (Show, Eq)
704+ }
705+ deriving stock (Show, Eq)
611706
612707-- | defaultFilterRules is empty, used to create notification
613708-- configuration.
614709defaultFilterRules :: FilterRules
615710defaultFilterRules = FilterRules []
616711
617−
618712-- | A filter rule that can act based on the suffix or prefix of an
619713-- object. As an example, let's create two filter rules:
620714--
@@ -625,9 +719,10 @@ defaultFilterRules = FilterRules []
625719-- for objects having a suffix of ".jpg", and the @prefixRule@
626720-- restricts it to objects having a prefix of "images/".
627721data FilterRule = FilterRule
628− { frName :: Text
629− , frValue :: Text
630− } deriving (Show, Eq)
722+ { frName :: Text,
723+ frValue :: Text
724+ }
725+ deriving stock (Show, Eq)
631726
632727-- | Arn is an alias of Text
633728type Arn = Text
@@ -636,11 +731,12 @@ type Arn = Text
636731-- notification system. It could represent a Queue, Topic or Lambda
637732-- Function configuration.
638733data NotificationConfig = NotificationConfig
639− { ncId :: Text
640− , ncArn :: Arn
641− , ncEvents :: [Event]
642− , ncFilter :: Filter
643− } deriving (Show, Eq)
734+ { ncId :: Text,
735+ ncArn :: Arn,
736+ ncEvents :: [Event],
737+ ncFilter :: Filter
738+ }
739+ deriving stock (Show, Eq)
644740
645741-- | A data-type to represent bucket notification configuration. It is
646742-- a collection of queue, topic or lambda function configurations. The
@@ -648,16 +744,16 @@ data NotificationConfig = NotificationConfig
648744-- described at
649745-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
650746data Notification = Notification
651− { nQueueConfigurations :: [NotificationConfig]
652− , nTopicConfigurations :: [NotificationConfig]
653− , nCloudFunctionConfigurations :: [NotificationConfig]
654− } deriving (Eq, Show)
747+ { nQueueConfigurations :: [NotificationConfig],
748+ nTopicConfigurations :: [NotificationConfig],
749+ nCloudFunctionConfigurations :: [NotificationConfig]
750+ }
751+ deriving stock (Show, Eq)
655752
656753-- | The default notification configuration is empty.
657754defaultNotification :: Notification
658755defaultNotification = Notification [] [] []
659756
660−
661757--------------------------------------------------------------------------
662758-- Select API Related Types
663759--------------------------------------------------------------------------
@@ -665,38 +761,42 @@ defaultNotification = Notification [] [] []
665761-- | SelectRequest represents the Select API call. Use the
666762-- `selectRequest` function to create a value of this type.
667763data SelectRequest = SelectRequest
668− { srExpression :: Text
669− , srExpressionType :: ExpressionType
670− , srInputSerialization :: InputSerialization
671− , srOutputSerialization :: OutputSerialization
672− , srRequestProgressEnabled :: Maybe Bool
673− } deriving (Eq, Show)
764+ { srExpression :: Text,
765+ srExpressionType :: ExpressionType,
766+ srInputSerialization :: InputSerialization,
767+ srOutputSerialization :: OutputSerialization,
768+ srRequestProgressEnabled :: Maybe Bool
769+ }
770+ deriving stock (Show, Eq)
674771
675772data ExpressionType = SQL
676− deriving (Eq, Show)
773+ deriving stock (Show, Eq)
677774
678775-- | InputSerialization represents format information of the input
679776-- object being queried. Use one of the smart constructors such as
680777-- `defaultCsvInput` as a starting value, and add compression info
681778-- using `setInputCompressionType`
682779data InputSerialization = InputSerialization
683− { isCompressionType :: Maybe CompressionType
684− , isFormatInfo :: InputFormatInfo
685− } deriving (Eq, Show)
780+ { isCompressionType :: Maybe CompressionType,
781+ isFormatInfo :: InputFormatInfo
782+ }
783+ deriving stock (Show, Eq)
686784
687785-- | Data type representing the compression setting in a Select
688786-- request.
689−data CompressionType = CompressionTypeNone
690− | CompressionTypeGzip
691− | CompressionTypeBzip2
692− deriving (Eq, Show)
787+data CompressionType
788+ = CompressionTypeNone
789+ | CompressionTypeGzip
790+ | CompressionTypeBzip2
791+ deriving stock (Show, Eq)
693792
694793-- | Data type representing input object format information in a
695794-- Select request.
696−data InputFormatInfo = InputFormatCSV CSVInputProp
697− | InputFormatJSON JSONInputProp
698− | InputFormatParquet
699− deriving (Eq, Show)
795+data InputFormatInfo
796+ = InputFormatCSV CSVInputProp
797+ | InputFormatJSON JSONInputProp
798+ | InputFormatParquet
799+ deriving stock (Show, Eq)
700800
701801-- | defaultCsvInput returns InputSerialization with default CSV
702802-- format, and without any compression setting.
@@ -706,14 +806,18 @@ defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
706806-- | linesJsonInput returns InputSerialization with JSON line based
707807-- format with no compression setting.
708808linesJsonInput :: InputSerialization
709−linesJsonInput = InputSerialization Nothing
710− (InputFormatJSON $ JSONInputProp JSONTypeLines)
809+linesJsonInput =
810+ InputSerialization
811+ Nothing
812+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
711813
712814-- | documentJsonInput returns InputSerialization with JSON document
713815-- based format with no compression setting.
714816documentJsonInput :: InputSerialization
715−documentJsonInput = InputSerialization Nothing
716− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
817+documentJsonInput =
818+ InputSerialization
819+ Nothing
820+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
717821
718822-- | defaultParquetInput returns InputSerialization with Parquet
719823-- format, and no compression setting.
@@ -722,12 +826,14 @@ defaultParquetInput = InputSerialization Nothing InputFormatParquet
722826
723827-- | setInputCompressionType sets the compression type for the input
724828-- of the SelectRequest
725−setInputCompressionType :: CompressionType -> SelectRequest
726− -> SelectRequest
829+setInputCompressionType ::
830+ CompressionType ->
831+ SelectRequest ->
832+ SelectRequest
727833setInputCompressionType c i =
728− let is = srInputSerialization i
729− is' = is { isCompressionType = Just c }
730− in i { srInputSerialization = is' }
834+ let is = srInputSerialization i
835+ is' = is {isCompressionType = Just c}
836+ in i {srInputSerialization = is'}
731837
732838-- | defaultCsvOutput returns OutputSerialization with default CSV
733839-- format.
@@ -744,40 +850,42 @@ defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
744850-- SelectRequest with the SQL query text given by @query@, the input
745851-- serialization settings (compression format and format information)
746852-- @inputSer@ and the output serialization settings @outputSer@.
747−selectRequest :: Text -> InputSerialization -> OutputSerialization
748− -> SelectRequest
853+selectRequest ::
854+ Text ->
855+ InputSerialization ->
856+ OutputSerialization ->
857+ SelectRequest
749858selectRequest sqlQuery inputSer outputSer =
750− SelectRequest { srExpression = sqlQuery
751− , srExpressionType = SQL
752− , srInputSerialization = inputSer
753− , srOutputSerialization = outputSer
754− , srRequestProgressEnabled = Nothing
755− }
859+ SelectRequest
860+ { srExpression = sqlQuery,
861+ srExpressionType = SQL,
862+ srInputSerialization = inputSer,
863+ srOutputSerialization = outputSer,
864+ srRequestProgressEnabled = Nothing
865+ }
756866
757867-- | setRequestProgressEnabled sets the flag for turning on progress
758868-- messages when the Select response is being streamed back to the
759869-- client.
760870setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
761871setRequestProgressEnabled enabled sr =
762− sr { srRequestProgressEnabled = Just enabled }
872+ sr {srRequestProgressEnabled = Just enabled}
763873
764874type CSVInputProp = CSVProp
765875
766876-- | CSVProp represents CSV format properties. It is built up using
767877-- the Monoid instance.
768−data CSVProp = CSVProp (H.HashMap Text Text)
769− deriving (Eq, Show)
878+newtype CSVProp = CSVProp (H.HashMap Text Text)
879+ deriving stock (Show, Eq)
770880
771−#if (__GLASGOW_HASKELL__ >= 804)
772881instance Semigroup CSVProp where
773− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
774−#endif
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
775883
776884instance Monoid CSVProp where
777− mempty = CSVProp mempty
778−#if (__GLASGOW_HASKELL__ < 804)
779− mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
780−#endif
885+ mempty = CSVProp mempty
886+
887+csvPropsList :: CSVProp -> [(Text, Text)]
888+csvPropsList (CSVProp h) = sort $ H.toList h
781889
782890defaultCSVProp :: CSVProp
783891defaultCSVProp = mempty
@@ -801,18 +909,21 @@ quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
801909-- | FileHeaderInfo specifies information about column headers for CSV
802910-- format.
803911data 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)
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)
808919
809920-- | Specify the CSV file header info property.
810921fileHeaderInfo :: FileHeaderInfo -> CSVProp
811−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
922+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
812923 where
813− toString FileHeaderNone = "NONE"
814− toString FileHeaderUse = "USE"
815− toString FileHeaderIgnore = "IGNORE"
924+ toStr FileHeaderNone = "NONE"
925+ toStr FileHeaderUse = "USE"
926+ toStr FileHeaderIgnore = "IGNORE"
816927
817928-- | Specify the CSV comment character property. Lines starting with
818929-- this character are ignored by the server.
@@ -825,64 +936,69 @@ allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter"
825936
826937-- | Set the CSV format properties in the InputSerialization.
827938setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
828−setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }
939+setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
829940
830941-- | Set the CSV format properties in the OutputSerialization.
831942outputCSVFromProps :: CSVProp -> OutputSerialization
832−outputCSVFromProps p = OutputSerializationCSV p
943+outputCSVFromProps = OutputSerializationCSV
833944
834−data JSONInputProp = JSONInputProp { jsonipType :: JSONType }
835− deriving (Eq, Show)
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946+ deriving stock (Show, Eq)
836947
837948data JSONType = JSONTypeDocument | JSONTypeLines
838− deriving (Eq, Show)
839−
949+ deriving stock (Show, Eq)
840950
841951-- | OutputSerialization represents output serialization settings for
842952-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
843953-- a starting point.
844−data OutputSerialization = OutputSerializationJSON JSONOutputProp
845− | OutputSerializationCSV CSVOutputProp
846− deriving (Eq, Show)
954+data OutputSerialization
955+ = OutputSerializationJSON JSONOutputProp
956+ | OutputSerializationCSV CSVOutputProp
957+ deriving stock (Show, Eq)
847958
848959type CSVOutputProp = CSVProp
849960
850961-- | quoteFields is an output serialization parameter
851962quoteFields :: QuoteFields -> CSVProp
852−quoteFields q = CSVProp $ H.singleton "QuoteFields" $
853− case q of
854− QuoteFieldsAsNeeded -> "ASNEEDED"
855− QuoteFieldsAlways -> "ALWAYS"
963+quoteFields q = CSVProp $
964+ H.singleton "QuoteFields" $
965+ case q of
966+ QuoteFieldsAsNeeded -> "ASNEEDED"
967+ QuoteFieldsAlways -> "ALWAYS"
856968
857969-- | Represent the QuoteField setting.
858970data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
859− deriving (Eq, Show)
971+ deriving stock (Show, Eq)
860972
861−data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }
862− deriving (Eq, Show)
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974+ deriving stock (Show, Eq)
863975
864976-- | Set the output record delimiter for JSON format
865977outputJSONFromRecordDelimiter :: Text -> OutputSerialization
866978outputJSONFromRecordDelimiter t =
867− OutputSerializationJSON (JSONOutputProp $ Just t)
979+ OutputSerializationJSON (JSONOutputProp $ Just t)
868980
869981-- Response related types
870982
871983-- | 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)
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)
8861002
8871003msgHeaderValueType :: Word8
8881004msgHeaderValueType = 7
@@ -890,11 +1006,12 @@ msgHeaderValueType = 7
8901006type MessageHeader = (MsgHeaderName, Text)
8911007
8921008-- | 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)
1009+data Progress = Progress
1010+ { pBytesScanned :: Int64,
1011+ pBytesProcessed :: Int64,
1012+ pBytesReturned :: Int64
1013+ }
1014+ deriving stock (Show, Eq)
8981015
8991016-- | Represent the stats event returned at the end of the Select
9001017-- response.
@@ -907,86 +1024,89 @@ type Stats = Progress
9071024-- | Represents different kinds of payload that are used with S3 API
9081025-- requests.
9091026data 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
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
9131030
9141031defaultPayload :: Payload
9151032defaultPayload = PayloadBS ""
9161033
917−data AdminReqInfo = AdminReqInfo {
918− ariMethod :: Method
919− , ariPayloadHash :: Maybe ByteString
920− , ariPayload :: Payload
921− , ariPath :: ByteString
922− , ariHeaders :: [Header]
923− , ariQueryParams :: Query
1034+data AdminReqInfo = AdminReqInfo
1035+ { ariMethod :: Method,
1036+ ariPayloadHash :: Maybe ByteString,
1037+ ariPayload :: Payload,
1038+ ariPath :: ByteString,
1039+ ariHeaders :: [Header],
1040+ ariQueryParams :: Query
9241041 }
9251042
9261043data 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
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
9361054 }
9371055
9381056defaultS3ReqInfo :: S3ReqInfo
939−defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
940− [] [] defaultPayload Nothing Nothing True
1057+defaultS3ReqInfo =
1058+ S3ReqInfo
1059+ HT.methodGet
1060+ Nothing
1061+ Nothing
1062+ []
1063+ []
1064+ defaultPayload
1065+ Nothing
1066+ Nothing
1067+ True
1068+ Nothing
9411069
9421070getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
9431071getS3Path b o =
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
1072+ let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073+ in B.concat ["/", B.intercalate "/" segments]
9511074
9521075type RegionMap = H.HashMap Bucket Region
9531076
9541077-- | The Minio Monad - all computations accessing object storage
9551078-- happens in it.
956−newtype Minio a = Minio {
957− unMinio :: ReaderT MinioConn (ResourceT IO) a
1079+newtype Minio a = Minio
1080+ { unMinio :: ReaderT MinioConn (ResourceT IO) a
9581081 }
959− deriving (
960− Functor
961− , Applicative
962− , Monad
963− , MonadIO
964− , MonadReader MinioConn
965− , MonadResource
1082+ deriving newtype
1083+ ( Functor,
1084+ Applicative,
1085+ Monad,
1086+ MonadIO,
1087+ MonadReader MinioConn,
1088+ MonadResource,
1089+ MonadUnliftIO
9661090 )
9671091
968−instance MonadUnliftIO Minio where
969− askUnliftIO = Minio $ ReaderT $ \r ->
970− withUnliftIO $ \u ->
971− return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))
972−
9731092-- | MinioConn holds connection info and a connection pool to allow
9741093-- for efficient resource re-use.
9751094data MinioConn = MinioConn
976− { mcConnInfo :: ConnectInfo
977− , mcConnManager :: NC.Manager
978− , mcRegionMap :: MVar RegionMap
1095+ { mcConnInfo :: ConnectInfo,
1096+ mcConnManager :: NC.Manager,
1097+ mcRegionMap :: MVar RegionMap
9791098 }
9801099
9811100class HasSvcNamespace env where
9821101 getSvcNamespace :: env -> Text
9831102
9841103instance 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/"
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+ )
9901110
9911111-- | Takes connection information and returns a connection object to
9921112-- be passed to 'runMinio'. The returned value can be kept in the
@@ -994,11 +1114,16 @@ instance HasSvcNamespace MinioConn where
9941114-- object storage is accessed.
9951115connect :: ConnectInfo -> IO MinioConn
9961116connect 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
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
10021127 mgr <- NC.newManager settings
10031128 mkMinioConn ci mgr
10041129
@@ -1012,8 +1137,8 @@ runMinioWith conn m = runResourceT $ runMinioResWith conn m
10121137-- `MinioConn`.
10131138mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
10141139mkMinioConn ci mgr = do
1015− rMapMVar <- M.newMVar H.empty
1016− return $ MinioConn ci mgr rMapMVar
1140+ rMapMVar <- M.newMVar H.empty
1141+ return $ MinioConn ci mgr rMapMVar
10171142
10181143-- | Run the Minio action and return the result or an error.
10191144runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
@@ -1026,12 +1151,12 @@ runMinio ci m = do
10261151runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
10271152runMinioResWith conn m =
10281153 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− ]
1154+ fmap Right m
1155+ `U.catches` [ U.Handler handlerServiceErr,
1156+ U.Handler handlerHE,
1157+ U.Handler handlerFE,
1158+ U.Handler handlerValidation
1159+ ]
10351160 where
10361161 handlerServiceErr = return . Left . MErrService
10371162 handlerHE = return . Left . MErrHTTP
@@ -1045,9 +1170,22 @@ runMinioRes ci m = do
10451170 conn <- liftIO $ connect ci
10461171 runMinioResWith conn m
10471172
1048−s3Name :: Text -> Text -> Name
1049−s3Name ns s = Name s (Just ns) Nothing
1050−
10511173-- | Format as per RFC 1123.
10521174formatRFC1123 :: UTCTime -> T.Text
10531175formatRFC1123 = 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