@@ -1,5 +1,5 @@
2−-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
2+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
4-- Licensed under the Apache License, Version 2.0 (the "License");
4-- Licensed under the Apache License, Version 2.0 (the "License");
5-- you may not use this file except in compliance with the License.
5-- you may not use this file except in compliance with the License.
@@ -13,45 +13,64 @@
13-- See the License for the specific language governing permissions and
13-- See the License for the specific language governing permissions and
14-- limitations under the License.
14-- limitations under the License.
17−{-# LANGUAGE CPP #-}
16+{-# LANGUAGE CPP #-}
18−{-# LANGUAGE GADTs #-}
17+{-# LANGUAGE GADTs #-}
19{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19+{-# LANGUAGE StrictData #-}
20−{-# LANGUAGE TypeFamilies #-}
20+{-# LANGUAGE TypeFamilies #-}
21module Network.Minio.Data where
22module Network.Minio.Data where
23−import qualified Conduit as C
24+import qualified Conduit as C
24−import qualified Control.Concurrent.MVar as M
25+import qualified Control.Concurrent.MVar as M
25−import Control.Monad.IO.Unlift (UnliftIO (..), askUnliftIO,
26+import Control.Monad.Trans.Except (throwE)
27−import Control.Monad.Trans.Resource
27+import Control.Monad.Trans.Resource
28−import qualified Data.Aeson as A
34+import qualified Data.Aeson as A
29−import qualified Data.ByteArray as BA
35+import qualified Data.ByteArray as BA
30−import qualified Data.ByteString as B
36+import qualified Data.ByteString as B
31−import Data.CaseInsensitive (mk)
37+import qualified Data.ByteString.Lazy as LB
38+import Data.Default.Class (def)
32−import qualified Data.HashMap.Strict as H
39+import qualified Data.HashMap.Strict as H
33−import qualified Data.Ini as Ini
40+import qualified Data.Ini as Ini
34−import Data.String (IsString (..))
41+import qualified Data.List as List
35−import qualified Data.Text as T
42+import qualified Data.Text as T
36−import qualified Data.Text.Encoding as TE
43+import qualified Data.Text.Encoding as TE
37−import Data.Time (defaultTimeLocale, formatTime)
44+import Data.Time (defaultTimeLocale, formatTime)
38−import GHC.Show (Show (show))
45+import Lib.Prelude (UTCTime, throwIO)
39−import qualified Network.Connection as Conn
46+import qualified Network.Connection as Conn
40−import Network.HTTP.Client (defaultManagerSettings)
47+import Network.HTTP.Client (defaultManagerSettings)
41−import qualified Network.HTTP.Client.TLS as TLS
48+import qualified Network.HTTP.Client.TLS as TLS
42−import qualified Network.HTTP.Conduit as NC
49+import qualified Network.HTTP.Conduit as NC
43−import Network.HTTP.Types (ByteRange, Header, Method, Query,
50+import Network.HTTP.Types
45−import qualified Network.HTTP.Types as HT
57+import qualified Network.HTTP.Types as HT
58+import Network.Minio.Credentials
59+import Network.Minio.Data.Crypto
63+import Network.Minio.Data.Time (UrlExpiry)
46−import Network.Minio.Errors
64+import Network.Minio.Errors
65+ ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
68+import Network.Minio.Utils
47−import System.Directory (doesFileExist, getHomeDirectory)
69+import System.Directory (doesFileExist, getHomeDirectory)
48−import qualified System.Environment as Env
70+import qualified System.Environment as Env
49−import System.FilePath.Posix (combine)
71+import System.FilePath.Posix (combine)
51−import qualified UnliftIO as U
72+import qualified UnliftIO as U
52−
73+import qualified UnliftIO.MVar as UM
54−import Network.Minio.Data.Crypto
56-- | max obj size is 5TiB
75-- | max obj size is 5TiB
57maxObjectSize :: Int64
76maxObjectSize :: Int64
@@ -71,125 +90,157 @@ maxMultipartParts = 10000
71-- TODO: Add a type which provides typed constants for region. this
90-- TODO: Add a type which provides typed constants for region. this
72-- type should have a IsString instance to infer the appropriate
91-- type should have a IsString instance to infer the appropriate
73-- constant.
92-- constant.
74-- | awsRegionMap - library constant
94-- | awsRegionMap - library constant
75awsRegionMap :: H.HashMap Text Text
95awsRegionMap :: H.HashMap Text Text
76−awsRegionMap = H.fromList [
96+awsRegionMap =
77− ("us-east-1", "s3.amazonaws.com")
98+ [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
78− , ("us-east-2", "s3-us-east-2.amazonaws.com")
99+ ("us-east-2", "s3.us-east-2.amazonaws.com"),
79− , ("us-west-1", "s3-us-west-1.amazonaws.com")
100+ ("us-west-1", "s3.us-west-1.amazonaws.com"),
80− , ("us-west-2", "s3-us-west-2.amazonaws.com")
101+ ("us-west-2", "s3.us-west-2.amazonaws.com"),
81− , ("ca-central-1", "s3-ca-central-1.amazonaws.com")
102+ ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
82− , ("ap-south-1", "s3-ap-south-1.amazonaws.com")
103+ ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104+ ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
83− , ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com")
105+ ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
84− , ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com")
106+ ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107+ ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
85− , ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com")
108+ ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
86− , ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com")
109+ ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110+ ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
87− , ("eu-west-1", "s3-eu-west-1.amazonaws.com")
111+ ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
88− , ("eu-west-2", "s3-eu-west-2.amazonaws.com")
112+ ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113+ ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
89− , ("eu-central-1", "s3-eu-central-1.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"),
90− , ("sa-east-1", "s3-sa-east-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")
93-- | Connection Info data type. To create a 'ConnectInfo' value,
130-- | Connection Info data type. To create a 'ConnectInfo' value,
94-- enable the @OverloadedStrings@ language extension and use the
131-- enable the @OverloadedStrings@ language extension and use the
95-- `IsString` instance to provide a URL, for example:
132-- `IsString` instance to provide a URL, for example:
97-- > let c :: ConnectInfo = "https://play.min.io"
134-- > let c :: ConnectInfo = "https://play.min.io"
98−data ConnectInfo =
135+data ConnectInfo = ConnectInfo
99− ConnectInfo { connectHost :: Text
136+ { connectHost :: Text,
100− , connectPort :: Int
137+ connectPort :: Int,
101− , connectAccessKey :: Text
138+ connectCreds :: Creds,
102− , connectSecretKey :: Text
139+ connectIsSecure :: Bool,
103− , connectIsSecure :: Bool
104− , connectRegion :: Region
140+ connectRegion :: Region,
105− , connectAutoDiscoverRegion :: Bool
141+ connectAutoDiscoverRegion :: Bool,
106− , connectDisableTLSCertValidation :: Bool
142+ connectDisableTLSCertValidation :: Bool
107− } deriving (Eq, Show)
143+ }
145+getEndpoint :: ConnectInfo -> Endpoint
146+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
109instance IsString ConnectInfo where
148instance IsString ConnectInfo where
110− fromString str =
149+ fromString str =
111− let req = NC.parseRequest_ str
150+ let req = NC.parseRequest_ str
112− in ConnectInfo
151+ in ConnectInfo
113− { connectHost = TE.decodeUtf8 $ NC.host req
152+ { connectHost = TE.decodeUtf8 $ NC.host req,
114− , connectPort = NC.port req
153+ connectPort = NC.port req,
115− , connectAccessKey = ""
154+ connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
116− , connectSecretKey = ""
117− , connectIsSecure = NC.secure req
155+ connectIsSecure = NC.secure req,
118− , connectRegion = ""
156+ connectRegion = "",
119− , connectAutoDiscoverRegion = True
157+ connectAutoDiscoverRegion = True,
120− , connectDisableTLSCertValidation = False
158+ connectDisableTLSCertValidation = False
123−-- | Contains access key and secret key to access object storage.
124−data Credentials = Credentials { cAccessKey :: Text
125− , cSecretKey :: Text
126− } deriving (Eq, Show)
128−-- | A Provider is an action that may return Credentials. Providers
161+-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
129−-- may be chained together using 'findFirst'.
162+-- Loaders may be chained together using 'findFirst'.
130−type Provider = IO (Maybe Credentials)
163+--
165+type CredentialLoader = IO (Maybe CredentialValue)
132−-- | Combines the given list of providers, by calling each one in
167+-- | Combines the given list of loaders, by calling each one in
133−-- order until Credentials are found.
168+-- order until a 'CredentialValue' is returned.
134−findFirst :: [Provider] -> Provider
169+findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
135findFirst [] = return Nothing
170findFirst [] = return Nothing
136−findFirst (f:fs) = do c <- f
171+findFirst (f : fs) = do
137− maybe (findFirst fs) (return . Just) c
173+ maybe (findFirst fs) (return . Just) c
175+-- | This action returns a 'CredentialValue' populated from
139−-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
176+-- @~\/.aws\/credentials@
140−fromAWSConfigFile :: Provider
177+fromAWSConfigFile :: CredentialLoader
141fromAWSConfigFile = do
178fromAWSConfigFile = do
142− credsE <- runExceptT $ do
179+ credsE <- runExceptT $ do
143− homeDir <- lift $ getHomeDirectory
180+ homeDir <- lift getHomeDirectory
144− let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
181+ let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
145− fileExists <- lift $ doesFileExist awsCredsFile
182+ fileExists <- lift $ doesFileExist awsCredsFile
146− bool (throwE "FileNotFound") (return ()) fileExists
183+ bool (throwE "FileNotFound") (return ()) fileExists
147− ini <- ExceptT $ Ini.readIniFile awsCredsFile
184+ ini <- ExceptT $ Ini.readIniFile awsCredsFile
148− akey <- ExceptT $ return
186+ ExceptT $
149− $ Ini.lookupValue "default" "aws_access_key_id" ini
188+ Ini.lookupValue "default" "aws_access_key_id" ini
150− skey <- ExceptT $ return
190+ ExceptT $
151− $ Ini.lookupValue "default" "aws_secret_access_key" ini
192+ Ini.lookupValue "default" "aws_secret_access_key" ini
152− return $ Credentials akey skey
193+ return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
153− return $ hush credsE
194+ return $ either (const Nothing) Just credsE
155−-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
196+-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
156−-- @AWS_SECRET_ACCESS_KEY@ environment variables.
197+-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
157−fromAWSEnv :: Provider
198+fromAWSEnv :: CredentialLoader
158fromAWSEnv = runMaybeT $ do
199fromAWSEnv = runMaybeT $ do
159− akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
200+ akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
160− skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
201+ skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
161− return $ Credentials (T.pack akey) (T.pack skey)
202+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
163−-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
204+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
164−-- @MINIO_SECRET_KEY@ environment variables.
205+-- and @MINIO_SECRET_KEY@ environment variables.
165−fromMinioEnv :: Provider
206+fromMinioEnv :: CredentialLoader
166fromMinioEnv = runMaybeT $ do
207fromMinioEnv = runMaybeT $ do
167− akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
208+ akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
168− skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
209+ skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
169− return $ Credentials (T.pack akey) (T.pack skey)
210+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
171−-- | setCredsFrom retrieves access credentials from the first
212+-- | setCredsFrom retrieves access credentials from the first action in the
172−-- `Provider` form the given list that succeeds and sets it in the
213+-- given list that succeeds and sets it in the 'ConnectInfo'.
174−setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
214+setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
175−setCredsFrom ps ci = do pMay <- findFirst ps
215+setCredsFrom ps ci = do
216+ pMay <- findFirst ps
177− (throwIO MErrVMissingCredentials)
218+ (throwIO MErrVMissingCredentials)
178− (return . (flip setCreds ci))
219+ (return . (`setCreds` ci))
181−-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
222+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
182−setCreds :: Credentials -> ConnectInfo -> ConnectInfo
223+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
183−setCreds (Credentials accessKey secretKey) connInfo =
224+setCreds cv connInfo =
184− connInfo { connectAccessKey = accessKey
225+ connInfo
185− , connectSecretKey = secretKey
226+ { connectCreds = CredsStatic cv
229+-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230+-- credentials via the STS API on demand. It is automatically refreshed on
232+setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233+setSTSCredential p ci = do
234+ store <- initSTSCredential p
235+ return ci {connectCreds = CredsSTS store}
188-- | Set the S3 region parameter in the `ConnectInfo`
237-- | Set the S3 region parameter in the `ConnectInfo`
189setRegion :: Region -> ConnectInfo -> ConnectInfo
238setRegion :: Region -> ConnectInfo -> ConnectInfo
190−setRegion r connInfo = connInfo { connectRegion = r
239+setRegion r connInfo =
241+ { connectRegion = r,
191− , connectAutoDiscoverRegion = False
242+ connectAutoDiscoverRegion = False
194-- | Check if the connection to object storage server is secure
245-- | Check if the connection to object storage server is secure
195-- (i.e. uses TLS)
246-- (i.e. uses TLS)
@@ -201,16 +252,10 @@ isConnectInfoSecure = connectIsSecure
201-- certificates. Note that this option has no effect, if you provide
252-- certificates. Note that this option has no effect, if you provide
202-- your own Manager in `mkMinioConn`.
253-- your own Manager in `mkMinioConn`.
203disableTLSCertValidation :: ConnectInfo -> ConnectInfo
254disableTLSCertValidation :: ConnectInfo -> ConnectInfo
204−disableTLSCertValidation c = c { connectDisableTLSCertValidation = True }
255+disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
206getHostAddr :: ConnectInfo -> ByteString
257getHostAddr :: ConnectInfo -> ByteString
207−getHostAddr ci = if | port == 80 || port == 443 -> toS host
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
208− | otherwise -> toS $
209− T.concat [ host, ":" , Lib.Prelude.show port]
211− port = connectPort ci
212− host = connectHost ci
215-- | Default Google Compute Storage ConnectInfo. Works only for
260-- | Default Google Compute Storage ConnectInfo. Works only for
216-- "Simple Migration" use-case with interoperability mode enabled on
261-- "Simple Migration" use-case with interoperability mode enabled on
@@ -219,23 +264,25 @@ getHostAddr ci = if | port == 80 || port == 443 -> toS host
220-- Credentials should be supplied before use.
265-- Credentials should be supplied before use.
221gcsCI :: ConnectInfo
266gcsCI :: ConnectInfo
222−gcsCI = setRegion "us"
268+ setRegion
223− "https://storage.googleapis.com"
270+ "https://storage.googleapis.com"
226-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
272-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
227-- should be supplied before use.
273-- should be supplied before use.
228awsCI :: ConnectInfo
274awsCI :: ConnectInfo
229awsCI = "https://s3.amazonaws.com"
275awsCI = "https://s3.amazonaws.com"
232-- | <https://play.min.io MinIO Play Server>
277-- | <https://play.min.io MinIO Play Server>
233-- ConnectInfo. Credentials are already filled in.
278-- ConnectInfo. Credentials are already filled in.
234minioPlayCI :: ConnectInfo
279minioPlayCI :: ConnectInfo
235−minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
281+ let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
236− in setCreds playCreds
282+ in setCreds playCreds $
237− $ setRegion "us-east-1"
283+ setRegion
238− "https://play.min.io"
285+ "https://play.min.io"
241-- Represents a bucket in the object store
288-- Represents a bucket in the object store
@@ -254,135 +301,147 @@ type ETag = Text
254-- | Data type to represent an object encryption key. Create one using
301-- | Data type to represent an object encryption key. Create one using
255-- the `mkSSECKey` function.
302-- the `mkSSECKey` function.
256newtype SSECKey = SSECKey BA.ScrubbedBytes
303newtype SSECKey = SSECKey BA.ScrubbedBytes
257− deriving (Eq, Show)
304+ deriving stock (Eq, Show)
259-- | Validates that the given ByteString is 32 bytes long and creates
306-- | Validates that the given ByteString is 32 bytes long and creates
260-- an encryption key.
307-- an encryption key.
261−mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
308+mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
262−mkSSECKey keyBytes | B.length keyBytes /= 32 =
309+mkSSECKey keyBytes
310+ | B.length keyBytes /= 32 =
263− throwM MErrVInvalidEncryptionKeyLength
311+ throwM MErrVInvalidEncryptionKeyLength
264− | otherwise =
312+ | otherwise =
265− return $ SSECKey $ BA.convert keyBytes
313+ return $ SSECKey $ BA.convert keyBytes
267-- | Data type to represent Server-Side-Encryption settings
315-- | Data type to represent Server-Side-Encryption settings
268data SSE where
316data SSE where
269− -- | Specifies SSE S3 encryption - server manages encryption keys
317+ -- | Specifies SSE S3 encryption - server manages encryption keys
270− SSE :: SSE
318+ SSE :: SSE
271− -- | Specifies that KMS service should be used. The first argument
319+ -- | 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
320+ -- 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
321+ -- not specified, the default KMS key id is used). The second
274− -- argument is the optional KMS context that must have a
322+ -- argument is the optional KMS context that must have a
275− -- `A.ToJSON` instance - please refer to the AWS S3 documentation
323+ -- `A.ToJSON` instance - please refer to the AWS S3 documentation
276− -- for detailed information.
324+ -- for detailed information.
277− SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
325+ SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
278− -- | Specifies server-side encryption with customer provided
326+ -- | Specifies server-side encryption with customer provided
279− -- key. The argument is the encryption key to be used.
327+ -- key. The argument is the encryption key to be used.
280− SSEC :: SSECKey -> SSE
328+ SSEC :: SSECKey -> SSE
282toPutObjectHeaders :: SSE -> [HT.Header]
330toPutObjectHeaders :: SSE -> [HT.Header]
283toPutObjectHeaders sseArg =
331toPutObjectHeaders sseArg =
284− let sseHeader = "x-amz-server-side-encryption"
332+ let sseHeader = "x-amz-server-side-encryption"
285− sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
333+ sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
286− sseKmsContextHeader = sseHeader <> "-context"
334+ sseKmsContextHeader = sseHeader <> "-context"
287− ssecAlgo = sseHeader <> "-customer-algorithm"
335+ ssecAlgo = sseHeader <> "-customer-algorithm"
288− ssecKey = sseHeader <> "-customer-key"
336+ ssecKey = sseHeader <> "-customer-key"
289− ssecKeyMD5 = ssecKey <> "-MD5"
337+ ssecKeyMD5 = ssecKey <> "-MD5"
291− in case sseArg of
338+ in case sseArg of
292− SSE -> [(sseHeader, "AES256")]
339+ SSE -> [(sseHeader, "AES256")]
294− SSEKMS keyIdMay ctxMay ->
340+ SSEKMS keyIdMay ctxMay ->
295− [(sseHeader, "aws:kms")] ++
341+ [(sseHeader, "aws:kms")]
296− maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay ++
342+ ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
297− maybe [] (\k -> [(sseKmsContextHeader, toS $ A.encode k)]) ctxMay
343+ ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
299− SSEC (SSECKey sb) ->
344+ SSEC (SSECKey sb) ->
300− [(ssecAlgo, "AES256"),
345+ [ (ssecAlgo, "AES256"),
301− (ssecKey, encodeToBase64 sb),
346+ (ssecKey, encodeToBase64 sb),
302− (ssecKeyMD5, hashMD5ToBase64 sb)]
347+ (ssecKeyMD5, hashMD5ToBase64 sb)
304-- | Data type for options in PutObject call. Start with the empty
350-- | Data type for options in PutObject call. Start with the empty
305-- `defaultPutObjectOptions` and use various the various poo*
351-- `defaultPutObjectOptions` and use various the various poo*
306-- accessors.
352-- accessors.
307−data PutObjectOptions = PutObjectOptions {
353+data PutObjectOptions = PutObjectOptions
308− -- | Set a standard MIME type describing the format of the object.
354+ { -- | Set a standard MIME type describing the format of the object.
309− pooContentType :: Maybe Text
355+ pooContentType :: Maybe Text,
310− -- | Set what content encodings have been applied to the object and thus
356+ -- | Set what content encodings have been applied to the object and thus
311− -- what decoding mechanisms must be applied to obtain the media-type
357+ -- what decoding mechanisms must be applied to obtain the media-type
312− -- referenced by the Content-Type header field.
358+ -- referenced by the Content-Type header field.
313− , pooContentEncoding :: Maybe Text
359+ pooContentEncoding :: Maybe Text,
314− -- | Set presentational information for the object.
360+ -- | Set presentational information for the object.
315− , pooContentDisposition :: Maybe Text
361+ pooContentDisposition :: Maybe Text,
316− -- | Set to specify caching behavior for the object along the
362+ -- | Set to specify caching behavior for the object along the
317− -- request/reply chain.
363+ -- request/reply chain.
318− , pooCacheControl :: Maybe Text
364+ pooCacheControl :: Maybe Text,
319− -- | Set to describe the language(s) intended for the audience.
365+ -- | Set to describe the language(s) intended for the audience.
320− , pooContentLanguage :: Maybe Text
366+ pooContentLanguage :: Maybe Text,
321− -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
367+ -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
322− -- performance needs, storage class is @STANDARD@ by default (i.e
368+ -- performance needs, storage class is @STANDARD@ by default (i.e
323− -- when Nothing is passed).
369+ -- when Nothing is passed).
324− , pooStorageClass :: Maybe Text
370+ pooStorageClass :: Maybe Text,
325− -- | Set user defined metadata to store with the object.
371+ -- | Set user defined metadata to store with the object.
326− , pooUserMetadata :: [(Text, Text)]
372+ pooUserMetadata :: [(Text, Text)],
327− -- | Set number of worker threads used to upload an object.
373+ -- | Set number of worker threads used to upload an object.
328− , pooNumThreads :: Maybe Word
374+ pooNumThreads :: Maybe Word,
329− -- | Set object encryption parameters for the request.
375+ -- | Set object encryption parameters for the request.
330− , pooSSE :: Maybe SSE
376+ pooSSE :: Maybe SSE
333-- | Provide default `PutObjectOptions`.
379-- | Provide default `PutObjectOptions`.
334defaultPutObjectOptions :: PutObjectOptions
380defaultPutObjectOptions :: PutObjectOptions
335defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
381defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
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-"
343− in if T.toCaseFold (T.take n k) == prefix
344− then Just (T.drop n k)
347−addXAmzMetaPrefix :: Text -> Text
348−addXAmzMetaPrefix s | isJust (userMetadataHeaderNameMaybe s) = s
349− | otherwise = "X-Amz-Meta-" <> s
351−mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
352−mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y))
354pooToHeaders :: PutObjectOptions -> [HT.Header]
383pooToHeaders :: PutObjectOptions -> [HT.Header]
355−pooToHeaders poo = userMetadata
384+pooToHeaders poo =
356− ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
386+ ++ mapMaybe tupToMaybe (zip names values)
357− ++ maybe [] toPutObjectHeaders (pooSSE poo)
387+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
359− tupToMaybe (k, Just v) = Just (k, v)
389+ tupToMaybe (k, Just v) = Just (k, v)
360 tupToMaybe (_, Nothing) = Nothing
390 tupToMaybe (_, Nothing) = Nothing
362 userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
391 userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
364− names = ["content-type",
393+ [ "content-type",
365− "content-encoding",
394+ "content-encoding",
366− "content-disposition",
395+ "content-disposition",
367− "content-language",
396+ "content-language",
368− "cache-control",
397+ "cache-control",
369− "x-amz-storage-class"]
398+ "x-amz-storage-class"
370− values = map (fmap encodeUtf8 . (poo &))
402+ (fmap encodeUtf8 . (poo &))
371− [pooContentType, pooContentEncoding,
404+ pooContentEncoding,
372− pooContentDisposition, pooContentLanguage,
405+ pooContentDisposition,
373− pooCacheControl, pooStorageClass]
407+ pooCacheControl,
377-- BucketInfo returned for list buckets call
412-- BucketInfo returned for list buckets call
378−data BucketInfo = BucketInfo {
413+data BucketInfo = BucketInfo
379− biName :: Bucket
414+ { biName :: Bucket,
380− , biCreationDate :: UTCTime
415+ biCreationDate :: UTCTime
381− } deriving (Show, Eq)
417+ deriving stock (Show, Eq)
383-- | A type alias to represent a part-number for multipart upload
419-- | A type alias to represent a part-number for multipart upload
384type PartNumber = Int16
420type PartNumber = Int16
422+-- | Select part sizes - the logic is that the minimum part-size will
424+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
425+selectPartSizes size =
426+ uncurry (List.zip3 [1 ..]) $
430+ ceil :: Double -> Int64
437+ / fromIntegral maxMultipartParts
442+ | st + m >= sz = [(st, sz - st)]
443+ | otherwise = (st, m) : loop (st + m) sz
386-- | A type alias to represent an upload-id for multipart upload
445-- | A type alias to represent an upload-id for multipart upload
387type UploadId = Text
446type UploadId = Text
@@ -391,95 +450,116 @@ type PartTuple = (PartNumber, ETag)
392-- | Represents result from a listing of object parts of an ongoing
451-- | Represents result from a listing of object parts of an ongoing
393-- multipart upload.
452-- multipart upload.
394−data ListPartsResult = ListPartsResult {
453+data ListPartsResult = ListPartsResult
395− lprHasMore :: Bool
454+ { lprHasMore :: Bool,
396− , lprNextPart :: Maybe Int
455+ lprNextPart :: Maybe Int,
397− , lprParts :: [ObjectPartInfo]
456+ lprParts :: [ObjectPartInfo]
398− } deriving (Show, Eq)
458+ deriving stock (Show, Eq)
400-- | Represents information about an object part in an ongoing
460-- | Represents information about an object part in an ongoing
401-- multipart upload.
461-- multipart upload.
402−data ObjectPartInfo = ObjectPartInfo {
462+data ObjectPartInfo = ObjectPartInfo
403− opiNumber :: PartNumber
463+ { opiNumber :: PartNumber,
404− , opiETag :: ETag
464+ opiETag :: ETag,
405− , opiSize :: Int64
465+ opiSize :: Int64,
406− , opiModTime :: UTCTime
466+ opiModTime :: UTCTime
407− } deriving (Show, Eq)
468+ deriving stock (Show, Eq)
409-- | Represents result from a listing of incomplete uploads to a
470-- | Represents result from a listing of incomplete uploads to a
410-- bucket.
471-- bucket.
411−data ListUploadsResult = ListUploadsResult {
472+data ListUploadsResult = ListUploadsResult
412− lurHasMore :: Bool
473+ { lurHasMore :: Bool,
413− , lurNextKey :: Maybe Text
474+ lurNextKey :: Maybe Text,
414− , lurNextUpload :: Maybe Text
475+ lurNextUpload :: Maybe Text,
415− , lurUploads :: [(Object, UploadId, UTCTime)]
476+ lurUploads :: [(Object, UploadId, UTCTime)],
416− , lurCPrefixes :: [Text]
477+ lurCPrefixes :: [Text]
417− } deriving (Show, Eq)
479+ deriving stock (Show, Eq)
419-- | Represents information about a multipart upload.
481-- | Represents information about a multipart upload.
420−data UploadInfo = UploadInfo {
482+data UploadInfo = UploadInfo
421− uiKey :: Object
483+ { uiKey :: Object,
422− , uiUploadId :: UploadId
484+ uiUploadId :: UploadId,
423− , uiInitTime :: UTCTime
485+ uiInitTime :: UTCTime,
424− , uiSize :: Int64
486+ uiSize :: Int64
425− } deriving (Show, Eq)
488+ deriving stock (Show, Eq)
427-- | Represents result from a listing of objects in a bucket.
490-- | Represents result from a listing of objects in a bucket.
428−data ListObjectsResult = ListObjectsResult {
491+data ListObjectsResult = ListObjectsResult
429− lorHasMore :: Bool
492+ { lorHasMore :: Bool,
430− , lorNextToken :: Maybe Text
493+ lorNextToken :: Maybe Text,
431− , lorObjects :: [ObjectInfo]
494+ lorObjects :: [ObjectInfo],
432− , lorCPrefixes :: [Text]
495+ lorCPrefixes :: [Text]
433− } deriving (Show, Eq)
497+ deriving stock (Show, Eq)
435-- | Represents result from a listing of objects version 1 in a bucket.
499-- | Represents result from a listing of objects version 1 in a bucket.
436−data ListObjectsV1Result = ListObjectsV1Result {
500+data ListObjectsV1Result = ListObjectsV1Result
437− lorHasMore' :: Bool
501+ { lorHasMore' :: Bool,
438− , lorNextMarker :: Maybe Text
502+ lorNextMarker :: Maybe Text,
439− , lorObjects' :: [ObjectInfo]
503+ lorObjects' :: [ObjectInfo],
440− , lorCPrefixes' :: [Text]
504+ lorCPrefixes' :: [Text]
441− } deriving (Show, Eq)
506+ deriving stock (Show, Eq)
443-- | Represents information about an object.
508-- | Represents information about an object.
444data ObjectInfo = ObjectInfo
509data ObjectInfo = ObjectInfo
445− { oiObject :: Object -- ^ Object key
511+ oiObject :: Object,
512+ -- | Modification time of the object
446− , oiModTime :: UTCTime -- ^ Modification time of the object
513+ oiModTime :: UTCTime,
514+ -- | ETag of the object
447− , oiETag :: ETag -- ^ ETag of the object
515+ oiETag :: ETag,
448− , oiSize :: Int64 -- ^ Size of the object in bytes
516+ -- | Size of the object in bytes
449− , oiUserMetadata :: H.HashMap Text Text -- ^ A map of user-metadata
518+ -- | A map of user-metadata
450− -- pairs stored with an
519+ -- pairs stored with an
451− -- object (keys will not
520+ -- object (keys will not
452− -- have the @X-Amz-Meta-@
521+ -- have the @X-Amz-Meta-@
453− -- prefix).
522+ -- prefix).
523+ oiUserMetadata :: H.HashMap Text Text,
454− , oiMetadata :: H.HashMap Text Text -- ^ A map of metadata
524+ -- | A map of metadata
455− -- key-value pairs (not
525+ -- key-value pairs (not
456− -- including the
526+ -- including the
457− -- user-metadata pairs)
527+ -- user-metadata pairs)
528+ oiMetadata :: H.HashMap Text Text
458− } deriving (Show, Eq)
530+ deriving stock (Show, Eq)
460-- | Represents source object in server-side copy object
532-- | Represents source object in server-side copy object
461data SourceInfo = SourceInfo
533data SourceInfo = SourceInfo
462− { srcBucket :: Text -- ^ Bucket containing the source object
534+ { -- | Bucket containing the source object
463− , srcObject :: Text -- ^ Source object key
536+ -- | Source object key
464− , srcRange :: Maybe (Int64, Int64) -- ^ Source object
538+ -- | Source object
465− -- byte-range
539+ -- byte-range
466− -- (inclusive)
540+ -- (inclusive)
541+ srcRange :: Maybe (Int64, Int64),
467− , srcIfMatch :: Maybe Text -- ^ ETag condition on source -
542+ -- | ETag condition on source -
468− -- object is copied only if the
543+ -- object is copied only if the
469− -- source object's ETag matches
544+ -- source object's ETag matches
470− -- this value.
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
471− , srcIfNoneMatch :: Maybe Text -- ^ ETag not match condition
551+ srcIfNoneMatch :: Maybe Text,
472− -- on source - object is copied
552+ -- | Copy source object only
473− -- if ETag does not match this
553+ -- if the source has been
474− -- value.
554+ -- modified since this time.
475− , srcIfModifiedSince :: Maybe UTCTime -- ^ Copy source object only
555+ srcIfModifiedSince :: Maybe UTCTime,
476− -- if the source has been
477− -- modified since this time.
478− , srcIfUnmodifiedSince :: Maybe UTCTime -- ^ Copy source object only
556+ -- | Copy source object only
479− -- if the source has been
557+ -- if the source has been
480− -- un-modified since this
558+ -- un-modified since this
481− -- given time.
559+ -- given time.
560+ srcIfUnmodifiedSince :: Maybe UTCTime
482− } deriving (Show, Eq)
562+ deriving stock (Show, Eq)
484-- | Provide a default for `SourceInfo`
564-- | Provide a default for `SourceInfo`
485defaultSourceInfo :: SourceInfo
565defaultSourceInfo :: SourceInfo
@@ -487,9 +567,12 @@ defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
488-- | Represents destination object in server-side copy object
568-- | Represents destination object in server-side copy object
489data DestinationInfo = DestinationInfo
569data DestinationInfo = DestinationInfo
490− { dstBucket :: Text -- ^ Destination bucket
570+ { -- | Destination bucket
491− , dstObject :: Text -- ^ Destination object key
572+ -- | Destination object key
492− } deriving (Show, Eq)
575+ deriving stock (Show, Eq)
494-- | Provide a default for `DestinationInfo`
577-- | Provide a default for `DestinationInfo`
495defaultDestinationInfo :: DestinationInfo
578defaultDestinationInfo :: DestinationInfo
@@ -498,96 +581,106 @@ defaultDestinationInfo = DestinationInfo "" ""
498-- | Data type for options when getting an object from the
581-- | Data type for options when getting an object from the
499-- service. Start with the empty `defaultGetObjectOptions` and modify
582-- service. Start with the empty `defaultGetObjectOptions` and modify
500-- it using the goo* functions.
583-- it using the goo* functions.
501−data GetObjectOptions = GetObjectOptions {
584+data GetObjectOptions = GetObjectOptions
502− -- | Set object's data of given offset begin and end,
585+ { -- | Set object's data of given offset begin and end,
503 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
586 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
504− gooRange :: Maybe ByteRange
587+ gooRange :: Maybe ByteRange,
505 -- | Set matching ETag condition, GetObject which matches the following
588 -- | Set matching ETag condition, GetObject which matches the following
507− , gooIfMatch :: Maybe ETag
590+ gooIfMatch :: Maybe ETag,
508 -- | Set matching ETag none condition, GetObject which does not match
591 -- | Set matching ETag none condition, GetObject which does not match
509 -- the following ETag.
592 -- the following ETag.
510− , gooIfNoneMatch :: Maybe ETag
593+ gooIfNoneMatch :: Maybe ETag,
511 -- | Set object unmodified condition, GetObject unmodified since given time.
594 -- | Set object unmodified condition, GetObject unmodified since given time.
512− , gooIfUnmodifiedSince :: Maybe UTCTime
595+ gooIfUnmodifiedSince :: Maybe UTCTime,
513 -- | Set object modified condition, GetObject modified since given time.
596 -- | Set object modified condition, GetObject modified since given time.
514− , gooIfModifiedSince :: Maybe UTCTime
597+ gooIfModifiedSince :: Maybe UTCTime,
515 -- | Specify SSE-C key
598 -- | Specify SSE-C key
516− , gooSSECKey :: Maybe SSECKey
599+ gooSSECKey :: Maybe SSECKey
519-- | Provide default `GetObjectOptions`.
602-- | Provide default `GetObjectOptions`.
520defaultGetObjectOptions :: GetObjectOptions
603defaultGetObjectOptions :: GetObjectOptions
521defaultGetObjectOptions =
604defaultGetObjectOptions =
522− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
605+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
524gooToHeaders :: GetObjectOptions -> [HT.Header]
607gooToHeaders :: GetObjectOptions -> [HT.Header]
525−gooToHeaders goo = rangeHdr ++ zip names values
608+gooToHeaders goo =
526− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
611+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
528− names = ["If-Match",
614+ [ "If-Match",
529− "If-None-Match",
615+ "If-None-Match",
530− "If-Unmodified-Since",
616+ "If-Unmodified-Since",
531− "If-Modified-Since"]
617+ "If-Modified-Since"
532− values = mapMaybe (fmap encodeUtf8 . (goo &))
621+ (fmap encodeUtf8 . (goo &))
533− [gooIfMatch, gooIfNoneMatch,
623+ gooIfNoneMatch,
534− fmap formatRFC1123 . gooIfUnmodifiedSince,
624+ fmap formatRFC1123 . gooIfUnmodifiedSince,
535− fmap formatRFC1123 . gooIfModifiedSince]
625+ fmap formatRFC1123 . gooIfModifiedSince
536− rangeHdr = maybe [] (\a -> [(hRange, HT.renderByteRanges [a])])
628+ maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
537− $ gooRange goo
629+ gooRange goo
539-- | Data type returned by 'getObject' representing the object being
631-- | Data type returned by 'getObject' representing the object being
540-- retrieved. Use the @gor*@ functions to access its contents.
632-- retrieved. Use the @gor*@ functions to access its contents.
541−data GetObjectResponse = GetObjectResponse {
633+data GetObjectResponse = GetObjectResponse
542− -- | ObjectInfo of the object being retrieved.
634+ { -- | ObjectInfo of the object being retrieved.
543− gorObjectInfo :: ObjectInfo
635+ gorObjectInfo :: ObjectInfo,
544− -- | A conduit of the bytes of the object.
636+ -- | A conduit of the bytes of the object.
545− , gorObjectStream :: C.ConduitM () ByteString Minio ()
637+ gorObjectStream :: C.ConduitM () ByteString Minio ()
548-- | A data-type for events that can occur in the object storage
640-- | A data-type for events that can occur in the object storage
549-- server. Reference:
641-- server. Reference:
550-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
642-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
551−data Event = ObjectCreated
644+ = ObjectCreated
552− | ObjectCreatedPut
645+ | ObjectCreatedPut
553− | ObjectCreatedPost
646+ | ObjectCreatedPost
554− | ObjectCreatedCopy
647+ | ObjectCreatedCopy
555− | ObjectCreatedMultipartUpload
648+ | ObjectCreatedMultipartUpload
556− | ObjectRemoved
649+ | ObjectRemoved
557− | ObjectRemovedDelete
650+ | ObjectRemovedDelete
558− | ObjectRemovedDeleteMarkerCreated
651+ | ObjectRemovedDeleteMarkerCreated
559− | ReducedRedundancyLostObject
652+ | ReducedRedundancyLostObject
560− deriving (Eq)
653+ deriving stock (Eq, Show)
562−instance Show Event where
655+instance ToText Event where
563− show ObjectCreated = "s3:ObjectCreated:*"
656+ toText ObjectCreated = "s3:ObjectCreated:*"
564− show ObjectCreatedPut = "s3:ObjectCreated:Put"
657+ toText ObjectCreatedPut = "s3:ObjectCreated:Put"
565− show ObjectCreatedPost = "s3:ObjectCreated:Post"
658+ toText ObjectCreatedPost = "s3:ObjectCreated:Post"
566− show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
659+ toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
567− show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
660+ toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
568− show ObjectRemoved = "s3:ObjectRemoved:*"
661+ toText ObjectRemoved = "s3:ObjectRemoved:*"
569− show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
662+ toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
570− show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
663+ toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
571− show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
664+ toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
573textToEvent :: Text -> Maybe Event
666textToEvent :: Text -> Maybe Event
574textToEvent t = case t of
667textToEvent t = case t of
575− "s3:ObjectCreated:*" -> Just ObjectCreated
668+ "s3:ObjectCreated:*" -> Just ObjectCreated
576− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
669+ "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
577− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
670+ "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
578− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
671+ "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
579− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
672+ "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
580− "s3:ObjectRemoved:*" -> Just ObjectRemoved
673+ "s3:ObjectRemoved:*" -> Just ObjectRemoved
581− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
674+ "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
582 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
675 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
583− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
676+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
584− _ -> Nothing
677+ _ -> Nothing
587-- | Filter data type - part of notification configuration
679-- | Filter data type - part of notification configuration
588−data Filter = Filter
680+newtype Filter = Filter
589 { fFilter :: FilterKey
681 { fFilter :: FilterKey
590− } deriving (Show, Eq)
683+ deriving stock (Show, Eq)
592-- | defaultFilter is empty, used to create a notification
685-- | defaultFilter is empty, used to create a notification
593-- configuration.
686-- configuration.
@@ -595,9 +688,10 @@ defaultFilter :: Filter
595defaultFilter = Filter defaultFilterKey
688defaultFilter = Filter defaultFilterKey
597-- | FilterKey contains FilterRules, and is part of a Filter.
690-- | FilterKey contains FilterRules, and is part of a Filter.
598−data FilterKey = FilterKey
691+newtype FilterKey = FilterKey
599 { fkKey :: FilterRules
692 { fkKey :: FilterRules
600− } deriving (Show, Eq)
694+ deriving stock (Show, Eq)
602-- | defaultFilterKey is empty, used to create notification
696-- | defaultFilterKey is empty, used to create notification
603-- configuration.
697-- configuration.
@@ -605,16 +699,16 @@ defaultFilterKey :: FilterKey
605defaultFilterKey = FilterKey defaultFilterRules
699defaultFilterKey = FilterKey defaultFilterRules
607-- | FilterRules represents a collection of `FilterRule`s.
701-- | FilterRules represents a collection of `FilterRule`s.
608−data FilterRules = FilterRules
702+newtype FilterRules = FilterRules
609 { frFilterRules :: [FilterRule]
703 { frFilterRules :: [FilterRule]
610− } deriving (Show, Eq)
705+ deriving stock (Show, Eq)
612-- | defaultFilterRules is empty, used to create notification
707-- | defaultFilterRules is empty, used to create notification
613-- configuration.
708-- configuration.
614defaultFilterRules :: FilterRules
709defaultFilterRules :: FilterRules
615defaultFilterRules = FilterRules []
710defaultFilterRules = FilterRules []
618-- | A filter rule that can act based on the suffix or prefix of an
712-- | A filter rule that can act based on the suffix or prefix of an
619-- object. As an example, let's create two filter rules:
713-- object. As an example, let's create two filter rules:
@@ -625,9 +719,10 @@ defaultFilterRules = FilterRules []
625-- for objects having a suffix of ".jpg", and the @prefixRule@
719-- for objects having a suffix of ".jpg", and the @prefixRule@
626-- restricts it to objects having a prefix of "images/".
720-- restricts it to objects having a prefix of "images/".
627data FilterRule = FilterRule
721data FilterRule = FilterRule
628− { frName :: Text
722+ { frName :: Text,
629− , frValue :: Text
723+ frValue :: Text
630− } deriving (Show, Eq)
725+ deriving stock (Show, Eq)
632-- | Arn is an alias of Text
727-- | Arn is an alias of Text
633type Arn = Text
728type Arn = Text
@@ -636,11 +731,12 @@ type Arn = Text
636-- notification system. It could represent a Queue, Topic or Lambda
731-- notification system. It could represent a Queue, Topic or Lambda
637-- Function configuration.
732-- Function configuration.
638data NotificationConfig = NotificationConfig
733data NotificationConfig = NotificationConfig
639− { ncId :: Text
734+ { ncId :: Text,
640− , ncArn :: Arn
735+ ncArn :: Arn,
641− , ncEvents :: [Event]
736+ ncEvents :: [Event],
642− , ncFilter :: Filter
737+ ncFilter :: Filter
643− } deriving (Show, Eq)
739+ deriving stock (Show, Eq)
645-- | A data-type to represent bucket notification configuration. It is
741-- | A data-type to represent bucket notification configuration. It is
646-- a collection of queue, topic or lambda function configurations. The
742-- a collection of queue, topic or lambda function configurations. The
@@ -648,16 +744,16 @@ data NotificationConfig = NotificationConfig
648-- described at
744-- described at
649-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
745-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
650data Notification = Notification
746data Notification = Notification
651− { nQueueConfigurations :: [NotificationConfig]
747+ { nQueueConfigurations :: [NotificationConfig],
652− , nTopicConfigurations :: [NotificationConfig]
748+ nTopicConfigurations :: [NotificationConfig],
653− , nCloudFunctionConfigurations :: [NotificationConfig]
749+ nCloudFunctionConfigurations :: [NotificationConfig]
654− } deriving (Eq, Show)
751+ deriving stock (Show, Eq)
656-- | The default notification configuration is empty.
753-- | The default notification configuration is empty.
657defaultNotification :: Notification
754defaultNotification :: Notification
658defaultNotification = Notification [] [] []
755defaultNotification = Notification [] [] []
661--------------------------------------------------------------------------
757--------------------------------------------------------------------------
662-- Select API Related Types
758-- Select API Related Types
663--------------------------------------------------------------------------
759--------------------------------------------------------------------------
@@ -665,38 +761,42 @@ defaultNotification = Notification [] [] []
665-- | SelectRequest represents the Select API call. Use the
761-- | SelectRequest represents the Select API call. Use the
666-- `selectRequest` function to create a value of this type.
762-- `selectRequest` function to create a value of this type.
667data SelectRequest = SelectRequest
763data SelectRequest = SelectRequest
668− { srExpression :: Text
764+ { srExpression :: Text,
669− , srExpressionType :: ExpressionType
765+ srExpressionType :: ExpressionType,
670− , srInputSerialization :: InputSerialization
766+ srInputSerialization :: InputSerialization,
671− , srOutputSerialization :: OutputSerialization
767+ srOutputSerialization :: OutputSerialization,
672− , srRequestProgressEnabled :: Maybe Bool
768+ srRequestProgressEnabled :: Maybe Bool
673− } deriving (Eq, Show)
770+ deriving stock (Show, Eq)
675data ExpressionType = SQL
772data ExpressionType = SQL
676− deriving (Eq, Show)
773+ deriving stock (Show, Eq)
678-- | InputSerialization represents format information of the input
775-- | InputSerialization represents format information of the input
679-- object being queried. Use one of the smart constructors such as
776-- object being queried. Use one of the smart constructors such as
680-- `defaultCsvInput` as a starting value, and add compression info
777-- `defaultCsvInput` as a starting value, and add compression info
681-- using `setInputCompressionType`
778-- using `setInputCompressionType`
682data InputSerialization = InputSerialization
779data InputSerialization = InputSerialization
683− { isCompressionType :: Maybe CompressionType
780+ { isCompressionType :: Maybe CompressionType,
684− , isFormatInfo :: InputFormatInfo
781+ isFormatInfo :: InputFormatInfo
685− } deriving (Eq, Show)
783+ deriving stock (Show, Eq)
687-- | Data type representing the compression setting in a Select
785-- | Data type representing the compression setting in a Select
688-- request.
786-- request.
689−data CompressionType = CompressionTypeNone
787+data CompressionType
788+ = CompressionTypeNone
690− | CompressionTypeGzip
789+ | CompressionTypeGzip
691− | CompressionTypeBzip2
790+ | CompressionTypeBzip2
692− deriving (Eq, Show)
791+ deriving stock (Show, Eq)
694-- | Data type representing input object format information in a
793-- | Data type representing input object format information in a
695-- Select request.
794-- Select request.
696−data InputFormatInfo = InputFormatCSV CSVInputProp
796+ = InputFormatCSV CSVInputProp
697− | InputFormatJSON JSONInputProp
797+ | InputFormatJSON JSONInputProp
698− | InputFormatParquet
798+ | InputFormatParquet
699− deriving (Eq, Show)
799+ deriving stock (Show, Eq)
701-- | defaultCsvInput returns InputSerialization with default CSV
801-- | defaultCsvInput returns InputSerialization with default CSV
702-- format, and without any compression setting.
802-- format, and without any compression setting.
@@ -706,14 +806,18 @@ defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
706-- | linesJsonInput returns InputSerialization with JSON line based
806-- | linesJsonInput returns InputSerialization with JSON line based
707-- format with no compression setting.
807-- format with no compression setting.
708linesJsonInput :: InputSerialization
808linesJsonInput :: InputSerialization
709−linesJsonInput = InputSerialization Nothing
810+ InputSerialization
710− (InputFormatJSON $ JSONInputProp JSONTypeLines)
812+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
712-- | documentJsonInput returns InputSerialization with JSON document
814-- | documentJsonInput returns InputSerialization with JSON document
713-- based format with no compression setting.
815-- based format with no compression setting.
714documentJsonInput :: InputSerialization
816documentJsonInput :: InputSerialization
715−documentJsonInput = InputSerialization Nothing
818+ InputSerialization
716− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
820+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
718-- | defaultParquetInput returns InputSerialization with Parquet
822-- | defaultParquetInput returns InputSerialization with Parquet
719-- format, and no compression setting.
823-- format, and no compression setting.
@@ -722,12 +826,14 @@ defaultParquetInput = InputSerialization Nothing InputFormatParquet
723-- | setInputCompressionType sets the compression type for the input
827-- | setInputCompressionType sets the compression type for the input
724-- of the SelectRequest
828-- of the SelectRequest
725−setInputCompressionType :: CompressionType -> SelectRequest
829+setInputCompressionType ::
726− -> SelectRequest
832+ SelectRequest
727setInputCompressionType c i =
833setInputCompressionType c i =
728− let is = srInputSerialization i
834+ let is = srInputSerialization i
729− is' = is { isCompressionType = Just c }
835+ is' = is {isCompressionType = Just c}
730− in i { srInputSerialization = is' }
836+ in i {srInputSerialization = is'}
732-- | defaultCsvOutput returns OutputSerialization with default CSV
838-- | defaultCsvOutput returns OutputSerialization with default CSV
733-- format.
839-- format.
@@ -744,40 +850,42 @@ defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
744-- SelectRequest with the SQL query text given by @query@, the input
850-- SelectRequest with the SQL query text given by @query@, the input
745-- serialization settings (compression format and format information)
851-- serialization settings (compression format and format information)
746-- @inputSer@ and the output serialization settings @outputSer@.
852-- @inputSer@ and the output serialization settings @outputSer@.
855+ InputSerialization ->
747−selectRequest :: Text -> InputSerialization -> OutputSerialization
856+ OutputSerialization ->
748− -> SelectRequest
857+ SelectRequest
749selectRequest sqlQuery inputSer outputSer =
858selectRequest sqlQuery inputSer outputSer =
750− SelectRequest { srExpression = sqlQuery
860+ { srExpression = sqlQuery,
751− , srExpressionType = SQL
861+ srExpressionType = SQL,
752− , srInputSerialization = inputSer
862+ srInputSerialization = inputSer,
753− , srOutputSerialization = outputSer
863+ srOutputSerialization = outputSer,
754− , srRequestProgressEnabled = Nothing
864+ srRequestProgressEnabled = Nothing
757-- | setRequestProgressEnabled sets the flag for turning on progress
867-- | setRequestProgressEnabled sets the flag for turning on progress
758-- messages when the Select response is being streamed back to the
868-- messages when the Select response is being streamed back to the
759-- client.
869-- client.
760setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
870setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
761setRequestProgressEnabled enabled sr =
871setRequestProgressEnabled enabled sr =
762− sr { srRequestProgressEnabled = Just enabled }
872+ sr {srRequestProgressEnabled = Just enabled}
764type CSVInputProp = CSVProp
874type CSVInputProp = CSVProp
766-- | CSVProp represents CSV format properties. It is built up using
876-- | CSVProp represents CSV format properties. It is built up using
767-- the Monoid instance.
877-- the Monoid instance.
768−data CSVProp = CSVProp (H.HashMap Text Text)
878+newtype CSVProp = CSVProp (H.HashMap Text Text)
769− deriving (Eq, Show)
879+ deriving stock (Show, Eq)
771−#if (__GLASGOW_HASKELL__ >= 804)
772instance Semigroup CSVProp where
881instance Semigroup CSVProp where
773− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
776instance Monoid CSVProp where
884instance Monoid CSVProp where
777− mempty = CSVProp mempty
885+ mempty = CSVProp mempty
778−#if (__GLASGOW_HASKELL__ < 804)
886+
779− mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
887+csvPropsList :: CSVProp -> [(Text, Text)]
780−#endif
888+csvPropsList (CSVProp h) = sort $ H.toList h
782defaultCSVProp :: CSVProp
890defaultCSVProp :: CSVProp
783defaultCSVProp = mempty
891defaultCSVProp = mempty
@@ -801,18 +909,21 @@ quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
801-- | FileHeaderInfo specifies information about column headers for CSV
909-- | FileHeaderInfo specifies information about column headers for CSV
802-- format.
910-- format.
803data FileHeaderInfo
911data FileHeaderInfo
804− = FileHeaderNone -- ^ No column headers are present
912+ = -- | No column headers are present
805− | FileHeaderUse -- ^ Headers are present and they should be used
914+ | -- | Headers are present and they should be used
806− | FileHeaderIgnore -- ^ Header are present, but should be ignored
916+ | -- | Header are present, but should be ignored
807− deriving (Eq, Show)
918+ deriving stock (Show, Eq)
809-- | Specify the CSV file header info property.
920-- | Specify the CSV file header info property.
810fileHeaderInfo :: FileHeaderInfo -> CSVProp
921fileHeaderInfo :: FileHeaderInfo -> CSVProp
811−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
922+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
813− toString FileHeaderNone = "NONE"
924+ toStr FileHeaderNone = "NONE"
814− toString FileHeaderUse = "USE"
925+ toStr FileHeaderUse = "USE"
815− toString FileHeaderIgnore = "IGNORE"
926+ toStr FileHeaderIgnore = "IGNORE"
817-- | Specify the CSV comment character property. Lines starting with
928-- | Specify the CSV comment character property. Lines starting with
818-- this character are ignored by the server.
929-- this character are ignored by the server.
@@ -825,64 +936,69 @@ allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter"
826-- | Set the CSV format properties in the InputSerialization.
937-- | Set the CSV format properties in the InputSerialization.
827setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
938setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
828−setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }
939+setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
830-- | Set the CSV format properties in the OutputSerialization.
941-- | Set the CSV format properties in the OutputSerialization.
831outputCSVFromProps :: CSVProp -> OutputSerialization
942outputCSVFromProps :: CSVProp -> OutputSerialization
832−outputCSVFromProps p = OutputSerializationCSV p
943+outputCSVFromProps = OutputSerializationCSV
834−data JSONInputProp = JSONInputProp { jsonipType :: JSONType }
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
835− deriving (Eq, Show)
946+ deriving stock (Show, Eq)
837data JSONType = JSONTypeDocument | JSONTypeLines
948data JSONType = JSONTypeDocument | JSONTypeLines
838− deriving (Eq, Show)
949+ deriving stock (Show, Eq)
841-- | OutputSerialization represents output serialization settings for
951-- | OutputSerialization represents output serialization settings for
842-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
952-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
843-- a starting point.
953-- a starting point.
954+data OutputSerialization
844−data OutputSerialization = OutputSerializationJSON JSONOutputProp
955+ = OutputSerializationJSON JSONOutputProp
845− | OutputSerializationCSV CSVOutputProp
956+ | OutputSerializationCSV CSVOutputProp
846− deriving (Eq, Show)
957+ deriving stock (Show, Eq)
848type CSVOutputProp = CSVProp
959type CSVOutputProp = CSVProp
850-- | quoteFields is an output serialization parameter
961-- | quoteFields is an output serialization parameter
851quoteFields :: QuoteFields -> CSVProp
962quoteFields :: QuoteFields -> CSVProp
963+quoteFields q = CSVProp $
852−quoteFields q = CSVProp $ H.singleton "QuoteFields" $
964+ H.singleton "QuoteFields" $
853− case q of
965+ case q of
854− QuoteFieldsAsNeeded -> "ASNEEDED"
966+ QuoteFieldsAsNeeded -> "ASNEEDED"
855− QuoteFieldsAlways -> "ALWAYS"
967+ QuoteFieldsAlways -> "ALWAYS"
857-- | Represent the QuoteField setting.
969-- | Represent the QuoteField setting.
858data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
970data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
859− deriving (Eq, Show)
971+ deriving stock (Show, Eq)
861−data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
862− deriving (Eq, Show)
974+ deriving stock (Show, Eq)
864-- | Set the output record delimiter for JSON format
976-- | Set the output record delimiter for JSON format
865outputJSONFromRecordDelimiter :: Text -> OutputSerialization
977outputJSONFromRecordDelimiter :: Text -> OutputSerialization
866outputJSONFromRecordDelimiter t =
978outputJSONFromRecordDelimiter t =
867− OutputSerializationJSON (JSONOutputProp $ Just t)
979+ OutputSerializationJSON (JSONOutputProp $ Just t)
869-- Response related types
981-- Response related types
871-- | An EventMessage represents each kind of message received from the server.
983-- | An EventMessage represents each kind of message received from the server.
872−data EventMessage = ProgressEventMessage { emProgress :: Progress }
985+ = ProgressEventMessage Progress
873− | StatsEventMessage { emStats :: Stats }
986+ | StatsEventMessage Stats
874− | RequestLevelErrorMessage { emErrorCode :: Text
987+ | RequestLevelErrorMessage
875− , emErrorMessage :: Text
988+ Text
876− }
989+ -- ^ Error code
877− | RecordPayloadEventMessage { emPayloadBytes :: ByteString }
992+ | RecordPayloadEventMessage ByteString
878− deriving (Eq, Show)
993+ deriving stock (Show, Eq)
880−data MsgHeaderName = MessageType
995+data MsgHeaderName
881− | EventType
997+ | EventType
882− | ContentType
998+ | ContentType
883− | ErrorCode
999+ | ErrorCode
884− | ErrorMessage
1000+ | ErrorMessage
885− deriving (Eq, Show)
1001+ deriving stock (Show, Eq)
887msgHeaderValueType :: Word8
1003msgHeaderValueType :: Word8
888msgHeaderValueType = 7
1004msgHeaderValueType = 7
@@ -890,11 +1006,12 @@ msgHeaderValueType = 7
890type MessageHeader = (MsgHeaderName, Text)
1006type MessageHeader = (MsgHeaderName, Text)
892-- | Represent the progress event returned in the Select response.
1008-- | Represent the progress event returned in the Select response.
893−data Progress = Progress { pBytesScanned :: Int64
1009+data Progress = Progress
1010+ { pBytesScanned :: Int64,
894− , pBytesProcessed :: Int64
1011+ pBytesProcessed :: Int64,
895− , pBytesReturned :: Int64
1012+ pBytesReturned :: Int64
897− deriving (Eq, Show)
1014+ deriving stock (Show, Eq)
899-- | Represent the stats event returned at the end of the Select
1016-- | Represent the stats event returned at the end of the Select
900-- response.
1017-- response.
@@ -907,86 +1024,89 @@ type Stats = Progress
907-- | Represents different kinds of payload that are used with S3 API
1024-- | Represents different kinds of payload that are used with S3 API
908-- requests.
1025-- requests.
909data Payload
1026data Payload
910− = PayloadBS ByteString
1027+ = PayloadBS ByteString
911− | PayloadH Handle Int64 Int64 -- file handle, offset and length
1028+ | PayloadH Handle Int64 Int64 -- file handle, offset and length
912− | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
1029+ | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
914defaultPayload :: Payload
1031defaultPayload :: Payload
915defaultPayload = PayloadBS ""
1032defaultPayload = PayloadBS ""
917−data AdminReqInfo = AdminReqInfo {
1034+data AdminReqInfo = AdminReqInfo
918− ariMethod :: Method
1035+ { ariMethod :: Method,
919− , ariPayloadHash :: Maybe ByteString
1036+ ariPayloadHash :: Maybe ByteString,
920− , ariPayload :: Payload
1037+ ariPayload :: Payload,
921− , ariPath :: ByteString
1038+ ariPath :: ByteString,
922− , ariHeaders :: [Header]
1039+ ariHeaders :: [Header],
923− , ariQueryParams :: Query
1040+ ariQueryParams :: Query
926data S3ReqInfo = S3ReqInfo
1043data S3ReqInfo = S3ReqInfo
927− { riMethod :: Method
1044+ { riMethod :: Method,
928− , riBucket :: Maybe Bucket
1045+ riBucket :: Maybe Bucket,
929− , riObject :: Maybe Object
1046+ riObject :: Maybe Object,
930− , riQueryParams :: Query
1047+ riQueryParams :: Query,
931− , riHeaders :: [Header]
1048+ riHeaders :: [Header],
932− , riPayload :: Payload
1049+ riPayload :: Payload,
933− , riPayloadHash :: Maybe ByteString
1050+ riPayloadHash :: Maybe ByteString,
934− , riRegion :: Maybe Region
1051+ riRegion :: Maybe Region,
935− , riNeedsLocation :: Bool
1052+ riNeedsLocation :: Bool,
1053+ riPresignExpirySecs :: Maybe UrlExpiry
938defaultS3ReqInfo :: S3ReqInfo
1056defaultS3ReqInfo :: S3ReqInfo
939−defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
1057+defaultS3ReqInfo =
940− [] [] defaultPayload Nothing Nothing True
1064+ defaultPayload
942getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
1070getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
943getS3Path b o =
1071getS3Path b o =
944− let segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
1072+ let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
946− B.concat ["/", B.intercalate "/" segments]
1073+ in B.concat ["/", B.intercalate "/" segments]
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.
952type RegionMap = H.HashMap Bucket Region
1075type RegionMap = H.HashMap Bucket Region
954-- | The Minio Monad - all computations accessing object storage
1077-- | The Minio Monad - all computations accessing object storage
955-- happens in it.
1078-- happens in it.
956−newtype Minio a = Minio {
1079+newtype Minio a = Minio
957− unMinio :: ReaderT MinioConn (ResourceT IO) a
1080+ { unMinio :: ReaderT MinioConn (ResourceT IO) a
959− deriving (
1082+ deriving newtype
960− Functor
1083+ ( Functor,
961− , Applicative
1084+ Applicative,
963− , MonadIO
1086+ MonadIO,
964− , MonadReader MinioConn
1087+ MonadReader MinioConn,
965− , MonadResource
1088+ MonadResource,
968−instance MonadUnliftIO Minio where
969− askUnliftIO = Minio $ ReaderT $ \r ->
970− withUnliftIO $ \u ->
971− return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))
973-- | MinioConn holds connection info and a connection pool to allow
1092-- | MinioConn holds connection info and a connection pool to allow
974-- for efficient resource re-use.
1093-- for efficient resource re-use.
975data MinioConn = MinioConn
1094data MinioConn = MinioConn
976− { mcConnInfo :: ConnectInfo
1095+ { mcConnInfo :: ConnectInfo,
977− , mcConnManager :: NC.Manager
1096+ mcConnManager :: NC.Manager,
978− , mcRegionMap :: MVar RegionMap
1097+ mcRegionMap :: MVar RegionMap
981class HasSvcNamespace env where
1100class HasSvcNamespace env where
982 getSvcNamespace :: env -> Text
1101 getSvcNamespace :: env -> Text
984instance HasSvcNamespace MinioConn where
1103instance HasSvcNamespace MinioConn where
1104+ getSvcNamespace env =
985− getSvcNamespace env = let host = connectHost $ mcConnInfo env
1105+ let host = connectHost $ mcConnInfo env
986− in if | host == "storage.googleapis.com" ->
1106+ in ( if host == "storage.googleapis.com"
987− "http://doc.s3.amazonaws.com/2006-03-01"
1107+ then "http://doc.s3.amazonaws.com/2006-03-01"
989− "http://s3.amazonaws.com/doc/2006-03-01/"
1108+ else "http://s3.amazonaws.com/doc/2006-03-01/"
991-- | Takes connection information and returns a connection object to
1111-- | Takes connection information and returns a connection object to
992-- be passed to 'runMinio'. The returned value can be kept in the
1112-- be passed to 'runMinio'. The returned value can be kept in the
@@ -994,11 +1114,16 @@ instance HasSvcNamespace MinioConn where
994-- object storage is accessed.
1114-- object storage is accessed.
995connect :: ConnectInfo -> IO MinioConn
1115connect :: ConnectInfo -> IO MinioConn
996connect ci = do
1116connect ci = do
997− let settings | connectIsSecure ci && connectDisableTLSCertValidation ci =
1118+ | connectIsSecure ci && connectDisableTLSCertValidation ci =
1119+ let badTlsSettings =
998− let badTlsSettings = Conn.TLSSettingsSimple True False False
1121+ tlsSettings@Conn.TLSSettingsSimple {} ->
1122+ tlsSettings {Conn.settingDisableCertificateValidation = True}
999− in TLS.mkManagerSettings badTlsSettings Nothing
1124+ in TLS.mkManagerSettings badTlsSettings Nothing
1000− | connectIsSecure ci = NC.tlsManagerSettings
1125+ | connectIsSecure ci = NC.tlsManagerSettings
1001− | otherwise = defaultManagerSettings
1126+ | otherwise = defaultManagerSettings
1002 mgr <- NC.newManager settings
1127 mgr <- NC.newManager settings
1003 mkMinioConn ci mgr
1128 mkMinioConn ci mgr
@@ -1012,8 +1137,8 @@ runMinioWith conn m = runResourceT $ runMinioResWith conn m
1012-- `MinioConn`.
1137-- `MinioConn`.
1013mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
1138mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
1014mkMinioConn ci mgr = do
1139mkMinioConn ci mgr = do
1015− rMapMVar <- M.newMVar H.empty
1140+ rMapMVar <- M.newMVar H.empty
1016− return $ MinioConn ci mgr rMapMVar
1141+ return $ MinioConn ci mgr rMapMVar
1018-- | Run the Minio action and return the result or an error.
1143-- | Run the Minio action and return the result or an error.
1019runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
1144runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
@@ -1026,12 +1151,12 @@ runMinio ci m = do
1026runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
1151runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
1027runMinioResWith conn m =
1152runMinioResWith conn m =
1028 flip runReaderT conn . unMinio $
1153 flip runReaderT conn . unMinio $
1029− fmap Right m `U.catches`
1154+ fmap Right m
1030− [ U.Handler handlerServiceErr
1155+ `U.catches` [ U.Handler handlerServiceErr,
1031− , U.Handler handlerHE
1156+ U.Handler handlerHE,
1032− , U.Handler handlerFE
1157+ U.Handler handlerFE,
1033− , U.Handler handlerValidation
1158+ U.Handler handlerValidation
1036 handlerServiceErr = return . Left . MErrService
1161 handlerServiceErr = return . Left . MErrService
1037 handlerHE = return . Left . MErrHTTP
1162 handlerHE = return . Left . MErrHTTP
@@ -1045,9 +1170,22 @@ runMinioRes ci m = do
1045 conn <- liftIO $ connect ci
1170 conn <- liftIO $ connect ci
1046 runMinioResWith conn m
1171 runMinioResWith conn m
1048−s3Name :: Text -> Text -> Name
1049−s3Name ns s = Name s (Just ns) Nothing
1051-- | Format as per RFC 1123.
1173-- | Format as per RFC 1123.
1052formatRFC1123 :: UTCTime -> T.Text
1174formatRFC1123 :: UTCTime -> T.Text
1053formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1175formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
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
1183+addToRegionCache :: Bucket -> Region -> Minio ()
1184+addToRegionCache b region = do
1185+ rMVar <- asks mcRegionMap
1186+ UM.modifyMVar_ rMVar $ return . H.insert b region
1188+deleteFromRegionCache :: Bucket -> Minio ()
1189+deleteFromRegionCache b = do
1190+ rMVar <- asks mcRegionMap
1191+ UM.modifyMVar_ rMVar $ return . H.delete b