@@ -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,47 +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 Control.Concurrent.MVar (MVar)
25−import qualified Control.Concurrent.MVar as M
26−import Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO (..),
27− askUnliftIO, withUnliftIO)
28−import Control.Monad.Trans.Resource
29−import qualified Data.Aeson as A
30−import qualified Data.ByteArray as BA
31−import qualified Data.ByteString as B
32−import Data.CaseInsensitive (mk)
33−import qualified Data.HashMap.Strict as H
34−import qualified Data.Ini as Ini
35−import qualified Data.Map as Map
36−import Data.String (IsString (..))
37−import qualified Data.Text as T
38−import qualified Data.Text.Encoding as TE
39−import Data.Time (defaultTimeLocale, formatTime)
40−import GHC.Show (Show (show))
41−import qualified Network.Connection as Conn
42−import Network.HTTP.Client (defaultManagerSettings)
43−import qualified Network.HTTP.Client.TLS as TLS
44−import qualified Network.HTTP.Conduit as NC
45−import Network.HTTP.Types (ByteRange, Header, Method, Query,
46− hRange)
47−import qualified Network.HTTP.Types as HT
48−import Network.Minio.Errors
49−import System.Directory (doesFileExist, getHomeDirectory)
50−import qualified System.Environment as Env
51−import System.FilePath.Posix (combine)
52−import Text.XML
53−import qualified UnliftIO as U
54−
55−import Lib.Prelude
56−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
5774
5875-- | max obj size is 5TiB
5976maxObjectSize :: Int64
@@ -73,124 +90,157 @@ maxMultipartParts = 10000
7390-- TODO: Add a type which provides typed constants for region. this
7491-- type should have a IsString instance to infer the appropriate
7592-- constant.
93+
7694-- | awsRegionMap - library constant
77−awsRegionMap :: Map.Map Text Text
78−awsRegionMap = Map.fromList [
79− ("us-east-1", "s3.amazonaws.com")
80− , ("us-east-2", "s3-us-east-2.amazonaws.com")
81− , ("us-west-1", "s3-us-west-1.amazonaws.com")
82− , ("us-east-2", "s3-us-west-2.amazonaws.com")
83− , ("ca-central-1", "s3-ca-central-1.amazonaws.com")
84− , ("ap-south-1", "s3-ap-south-1.amazonaws.com")
85− , ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com")
86− , ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com")
87− , ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com")
88− , ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com")
89− , ("eu-west-1", "s3-eu-west-1.amazonaws.com")
90− , ("eu-west-2", "s3-eu-west-2.amazonaws.com")
91− , ("eu-central-1", "s3-eu-central-1.amazonaws.com")
92− , ("sa-east-1", "s3-sa-east-1.amazonaws.com")
93− ]
95+awsRegionMap :: H.HashMap Text Text
96+awsRegionMap =
97+ H.fromList
98+ [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
99+ ("us-east-2", "s3.us-east-2.amazonaws.com"),
100+ ("us-west-1", "s3.us-west-1.amazonaws.com"),
101+ ("us-west-2", "s3.us-west-2.amazonaws.com"),
102+ ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
103+ ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104+ ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
105+ ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
106+ ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107+ ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
108+ ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
109+ ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110+ ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
111+ ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
112+ ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113+ ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
114+ ("eu-central-1", "s3.eu-central-1.amazonaws.com"),
115+ ("eu-central-2", "s3.eu-central-2.amazonaws.com"),
116+ ("eu-south-1", "s3.eu-south-1.amazonaws.com"),
117+ ("eu-south-2", "s3.eu-south-2.amazonaws.com"),
118+ ("af-south-1", "s3.af-south-1.amazonaws.com"),
119+ ("ap-east-1", "s3.ap-east-1.amazonaws.com"),
120+ ("cn-north-1", "s3.cn-north-1.amazonaws.com.cn"),
121+ ("cn-northwest-1", "s3.cn-northwest-1.amazonaws.com.cn"),
122+ ("eu-north-1", "s3.eu-north-1.amazonaws.com"),
123+ ("me-south-1", "s3.me-south-1.amazonaws.com"),
124+ ("me-central-1", "s3.me-central-1.amazonaws.com"),
125+ ("us-gov-east-1", "s3.us-gov-east-1.amazonaws.com"),
126+ ("us-gov-west-1", "s3.us-gov-west-1.amazonaws.com"),
127+ ("sa-east-1", "s3.sa-east-1.amazonaws.com")
128+ ]
94129
95130-- | Connection Info data type. To create a 'ConnectInfo' value,
96131-- enable the @OverloadedStrings@ language extension and use the
97132-- `IsString` instance to provide a URL, for example:
98133--
99−-- > let c :: ConnectInfo = "https://play.min.io:9000"
100−data ConnectInfo =
101− ConnectInfo { connectHost :: Text
102− , connectPort :: Int
103− , connectAccessKey :: Text
104− , connectSecretKey :: Text
105− , connectIsSecure :: Bool
106− , connectRegion :: Region
107− , connectAutoDiscoverRegion :: Bool
108− , connectDisableTLSCertValidation :: Bool
109− } deriving (Eq, Show)
134+-- > let c :: ConnectInfo = "https://play.min.io"
135+data ConnectInfo = ConnectInfo
136+ { connectHost :: Text,
137+ connectPort :: Int,
138+ connectCreds :: Creds,
139+ connectIsSecure :: Bool,
140+ connectRegion :: Region,
141+ connectAutoDiscoverRegion :: Bool,
142+ connectDisableTLSCertValidation :: Bool
143+ }
144+
145+getEndpoint :: ConnectInfo -> Endpoint
146+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
110147
111148instance IsString ConnectInfo where
112− fromString str =
113− let req = NC.parseRequest_ str
114− in ConnectInfo
115− { connectHost = TE.decodeUtf8 $ NC.host req
116− , connectPort = NC.port req
117− , connectAccessKey = ""
118− , connectSecretKey = ""
119− , connectIsSecure = NC.secure req
120− , connectRegion = ""
121− , connectAutoDiscoverRegion = True
122− , connectDisableTLSCertValidation = False
123− }
124−
125−-- | Contains access key and secret key to access object storage.
126−data Credentials = Credentials { cAccessKey :: Text
127− , cSecretKey :: Text
128− } deriving (Eq, Show)
129−
130−-- | A Provider is an action that may return Credentials
131−type Provider = IO (Maybe Credentials)
132−
133−-- | Combines the given list of providers, by calling each one in
134−-- order until Credentials are found.
135−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)
136170findFirst [] = return Nothing
137−findFirst (f:fs) = do c <- f
138− maybe (findFirst fs) (return . Just) c
171+findFirst (f : fs) = do
172+ c <- f
173+ maybe (findFirst fs) (return . Just) c
139174
140−-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
141−fromAWSConfigFile :: Provider
175+-- | This action returns a 'CredentialValue' populated from
176+-- @~\/.aws\/credentials@
177+fromAWSConfigFile :: CredentialLoader
142178fromAWSConfigFile = do
143− credsE <- runExceptT $ do
144− homeDir <- lift $ getHomeDirectory
145− let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
146− fileExists <- lift $ doesFileExist awsCredsFile
147− bool (throwE "FileNotFound") (return ()) fileExists
148− ini <- ExceptT $ Ini.readIniFile awsCredsFile
149− akey <- ExceptT $ return
150− $ Ini.lookupValue "default" "aws_access_key_id" ini
151− skey <- ExceptT $ return
152− $ Ini.lookupValue "default" "aws_secret_access_key" ini
153− return $ Credentials akey skey
154− return $ hush credsE
155−
156−-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
157−-- @AWS_SECRET_ACCESS_KEY@ environment variables.
158−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
159199fromAWSEnv = runMaybeT $ do
160− akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
161− skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
162− 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
163203
164−-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
165−-- @MINIO_SECRET_KEY@ environment variables.
166−fromMinioEnv :: Provider
204+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205+-- and @MINIO_SECRET_KEY@ environment variables.
206+fromMinioEnv :: CredentialLoader
167207fromMinioEnv = runMaybeT $ do
168− akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
169− skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
170− return $ Credentials (T.pack akey) (T.pack skey)
171−
172−-- | setCredsFrom retrieves access credentials from the first
173−-- `Provider` form the given list that succeeds and sets it in the
174−-- `ConnectInfo`.
175−setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
176−setCredsFrom ps ci = do pMay <- findFirst ps
177− maybe
178− (throwIO MErrVMissingCredentials)
179− (return . (flip setCreds ci))
180− pMay
181−
182−-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
183−setCreds :: Credentials -> ConnectInfo -> ConnectInfo
184−setCreds (Credentials accessKey secretKey) connInfo =
185− connInfo { connectAccessKey = accessKey
186− , connectSecretKey = secretKey
187− }
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}
188236
189237-- | Set the S3 region parameter in the `ConnectInfo`
190238setRegion :: Region -> ConnectInfo -> ConnectInfo
191−setRegion r connInfo = connInfo { connectRegion = r
192− , connectAutoDiscoverRegion = False
193− }
239+setRegion r connInfo =
240+ connInfo
241+ { connectRegion = r,
242+ connectAutoDiscoverRegion = False
243+ }
194244
195245-- | Check if the connection to object storage server is secure
196246-- (i.e. uses TLS)
@@ -202,39 +252,37 @@ isConnectInfoSecure = connectIsSecure
202252-- certificates. Note that this option has no effect, if you provide
203253-- your own Manager in `mkMinioConn`.
204254disableTLSCertValidation :: ConnectInfo -> ConnectInfo
205−disableTLSCertValidation c = c { connectDisableTLSCertValidation = True }
255+disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
206256
207257getHostAddr :: ConnectInfo -> ByteString
208−getHostAddr ci = if | port == 80 || port == 443 -> toS host
209− | otherwise -> toS $
210− T.concat [ host, ":" , Lib.Prelude.show port]
211− where
212− port = connectPort ci
213− host = connectHost ci
214−
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
215259
216−-- | Default GCS ConnectInfo. Works only for "Simple Migration"
217−-- use-case with interoperability mode enabled on GCP console. For
218−-- more information - https://cloud.google.com/storage/docs/migrating
260+-- | Default Google Compute Storage ConnectInfo. Works only for
261+-- "Simple Migration" use-case with interoperability mode enabled on
262+-- GCP console. For more information -
263+-- https://cloud.google.com/storage/docs/migrating
264+--
219265-- Credentials should be supplied before use.
220266gcsCI :: ConnectInfo
221−gcsCI = setRegion "us"
222− "https://storage.googleapis.com"
223−
267+gcsCI =
268+ setRegion
269+ "us"
270+ "https://storage.googleapis.com"
224271
225−-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
272+-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
226273-- should be supplied before use.
227274awsCI :: ConnectInfo
228275awsCI = "https://s3.amazonaws.com"
229276
230−
231−-- | <https://play.min.io:9000 MinIO Play Server>
277+-- | <https://play.min.io MinIO Play Server>
232278-- ConnectInfo. Credentials are already filled in.
233279minioPlayCI :: ConnectInfo
234−minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
235− in setCreds playCreds
236− $ setRegion "us-east-1"
237− "https://play.min.io:9000"
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"
238286
239287-- |
240288-- Represents a bucket in the object store
@@ -244,9 +292,7 @@ type Bucket = Text
244292-- Represents an object name
245293type Object = Text
246294
247−-- |
248−-- Represents a region
249−-- TODO: This could be a Sum Type with all defined regions for AWS.
295+-- | Represents a region
250296type Region = Text
251297
252298-- | A type alias to represent an Entity-Tag returned by S3-compatible APIs.
@@ -255,127 +301,147 @@ type ETag = Text
255301-- | Data type to represent an object encryption key. Create one using
256302-- the `mkSSECKey` function.
257303newtype SSECKey = SSECKey BA.ScrubbedBytes
258− deriving (Eq, Show)
304+ deriving stock (Eq, Show)
259305
260306-- | Validates that the given ByteString is 32 bytes long and creates
261307-- an encryption key.
262−mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
263−mkSSECKey keyBytes | B.length keyBytes /= 32 =
264− throwM MErrVInvalidEncryptionKeyLength
265− | otherwise =
266− 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
267314
268315-- | Data type to represent Server-Side-Encryption settings
269316data SSE where
270− -- | Specifies SSE S3 encryption - server manages encryption keys
271− SSE :: SSE
272− -- | Specifies that KMS service should be used. The first argument
273− -- to the constructor is the Key Id to be used by the server (if
274− -- not specified, the default KMS key id is used). The second
275− -- argument is the optional KMS context that must have a
276− -- `A.ToJSON` instance - please refer to the AWS S3 documentation
277− -- for detailed information.
278− SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
279− -- | Specifies server-side encryption with customer provided
280− -- key. The argument is the encryption key to be used.
281− 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
282329
283330toPutObjectHeaders :: SSE -> [HT.Header]
284331toPutObjectHeaders sseArg =
285− let sseHeader = "x-amz-server-side-encryption"
286− sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
287− sseKmsContextHeader = sseHeader <> "-context"
288− ssecAlgo = sseHeader <> "-customer-algorithm"
289− ssecKey = sseHeader <> "-customer-key"
290− ssecKeyMD5 = ssecKey <> "-MD5"
291−
292− in case sseArg of
293− SSE -> [(sseHeader, "AES256")]
294−
295− SSEKMS keyIdMay ctxMay ->
296− [(sseHeader, "aws:kms")] ++
297− maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay ++
298− maybe [] (\k -> [(sseKmsContextHeader, toS $ A.encode k)]) ctxMay
299−
300− SSEC (SSECKey sb) ->
301− [(ssecAlgo, "AES256"),
302− (ssecKey, encodeToBase64 sb),
303− (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+ ]
304349
305350-- | Data type for options in PutObject call. Start with the empty
306351-- `defaultPutObjectOptions` and use various the various poo*
307352-- accessors.
308−data PutObjectOptions = PutObjectOptions {
309− -- | Set a standard MIME type describing the format of the object.
310− pooContentType :: Maybe Text
311− -- | Set what content encodings have been applied to the object and thus
312− -- what decoding mechanisms must be applied to obtain the media-type
313− -- referenced by the Content-Type header field.
314− , pooContentEncoding :: Maybe Text
315− -- | Set presentational information for the object.
316− , pooContentDisposition :: Maybe Text
317− -- | Set to specify caching behavior for the object along the
318− -- request/reply chain.
319− , pooCacheControl :: Maybe Text
320− -- | Set to describe the language(s) intended for the audience.
321− , pooContentLanguage :: Maybe Text
322− -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
323− -- performance needs, storage class is @STANDARD@ by default (i.e
324− -- when Nothing is passed).
325− , pooStorageClass :: Maybe Text
326− -- | Set user defined metadata to store with the object.
327− , pooUserMetadata :: [(Text, Text)]
328− -- | Set number of worker threads used to upload an object.
329− , pooNumThreads :: Maybe Word
330− -- | Set object encryption parameters for the request.
331− , 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
332377 }
333378
334379-- | Provide default `PutObjectOptions`.
335380defaultPutObjectOptions :: PutObjectOptions
336381defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
337382
338−addXAmzMetaPrefix :: Text -> Text
339−addXAmzMetaPrefix s = do
340− if (T.isPrefixOf "x-amz-meta-" s)
341− then s
342− else T.concat ["x-amz-meta-", s]
343−
344−mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
345−mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y))
346−
347383pooToHeaders :: PutObjectOptions -> [HT.Header]
348−pooToHeaders poo = userMetadata
349− ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
350− ++ maybe [] toPutObjectHeaders (pooSSE poo)
384+pooToHeaders poo =
385+ userMetadata
386+ ++ mapMaybe tupToMaybe (zip names values)
387+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
351388 where
352− tupToMaybe (k, Just v) = Just (k, v)
389+ tupToMaybe (k, Just v) = Just (k, v)
353390 tupToMaybe (_, Nothing) = Nothing
354−
355391 userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
356−
357− names = ["content-type",
358− "content-encoding",
359− "content-disposition",
360− "content-language",
361− "cache-control",
362− "x-amz-storage-class"]
363− values = map (fmap encodeUtf8 . (poo &))
364− [pooContentType, pooContentEncoding,
365− pooContentDisposition, pooContentLanguage,
366− pooCacheControl, pooStorageClass]
367−
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+ ]
368410
369411-- |
370412-- BucketInfo returned for list buckets call
371−data BucketInfo = BucketInfo {
372− biName :: Bucket
373− , biCreationDate :: UTCTime
374− } deriving (Show, Eq)
413+data BucketInfo = BucketInfo
414+ { biName :: Bucket,
415+ biCreationDate :: UTCTime
416+ }
417+ deriving stock (Show, Eq)
375418
376419-- | A type alias to represent a part-number for multipart upload
377420type PartNumber = Int16
378421
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+
379445-- | A type alias to represent an upload-id for multipart upload
380446type UploadId = Text
381447
@@ -384,88 +450,116 @@ type PartTuple = (PartNumber, ETag)
384450
385451-- | Represents result from a listing of object parts of an ongoing
386452-- multipart upload.
387−data ListPartsResult = ListPartsResult {
388− lprHasMore :: Bool
389− , lprNextPart :: Maybe Int
390− , lprParts :: [ObjectPartInfo]
391− } deriving (Show, Eq)
453+data ListPartsResult = ListPartsResult
454+ { lprHasMore :: Bool,
455+ lprNextPart :: Maybe Int,
456+ lprParts :: [ObjectPartInfo]
457+ }
458+ deriving stock (Show, Eq)
392459
393460-- | Represents information about an object part in an ongoing
394461-- multipart upload.
395−data ObjectPartInfo = ObjectPartInfo {
396− opiNumber :: PartNumber
397− , opiETag :: ETag
398− , opiSize :: Int64
399− , opiModTime :: UTCTime
400− } 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)
401469
402470-- | Represents result from a listing of incomplete uploads to a
403471-- bucket.
404−data ListUploadsResult = ListUploadsResult {
405− lurHasMore :: Bool
406− , lurNextKey :: Maybe Text
407− , lurNextUpload :: Maybe Text
408− , lurUploads :: [(Object, UploadId, UTCTime)]
409− , lurCPrefixes :: [Text]
410− } 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)
411480
412481-- | Represents information about a multipart upload.
413−data UploadInfo = UploadInfo {
414− uiKey :: Object
415− , uiUploadId :: UploadId
416− , uiInitTime :: UTCTime
417− , uiSize :: Int64
418− } 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)
419489
420490-- | Represents result from a listing of objects in a bucket.
421−data ListObjectsResult = ListObjectsResult {
422− lorHasMore :: Bool
423− , lorNextToken :: Maybe Text
424− , lorObjects :: [ObjectInfo]
425− , lorCPrefixes :: [Text]
426− } 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)
427498
428499-- | Represents result from a listing of objects version 1 in a bucket.
429−data ListObjectsV1Result = ListObjectsV1Result {
430− lorHasMore' :: Bool
431− , lorNextMarker :: Maybe Text
432− , lorObjects' :: [ObjectInfo]
433− , lorCPrefixes' :: [Text]
434− } 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)
435507
436508-- | Represents information about an object.
437509data ObjectInfo = ObjectInfo
438− { oiObject :: Object -- ^ Object key
439− , oiModTime :: UTCTime -- ^ Mdification time of the object
440− , oiETag :: ETag -- ^ ETag of the object
441− , oiSize :: Int64 -- ^ Size of the object in bytes
442− , oiMetadata :: Map.Map Text Text -- ^ A map of the metadata
443− -- key-value pairs
444− } 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)
445531
446532-- | Represents source object in server-side copy object
447533data SourceInfo = SourceInfo
448− { srcBucket :: Text -- ^ Bucket containing the source object
449− , srcObject :: Text -- ^ Source object key
450− , srcRange :: Maybe (Int64, Int64) -- ^ Source object
451− -- byte-range
452− -- (inclusive)
453− , srcIfMatch :: Maybe Text -- ^ ETag condition on source -
454− -- object is copied only if the
455− -- source object's ETag matches
456− -- this value.
457− , srcIfNoneMatch :: Maybe Text -- ^ ETag not match condition
458− -- on source - object is copied
459− -- if ETag does not match this
460− -- value.
461− , srcIfModifiedSince :: Maybe UTCTime -- ^ Copy source object only
462− -- if the source has been
463− -- modified since this time.
464− , srcIfUnmodifiedSince :: Maybe UTCTime -- ^ Copy source object only
465− -- if the source has been
466− -- un-modified since this
467− -- given time.
468− } 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)
469563
470564-- | Provide a default for `SourceInfo`
471565defaultSourceInfo :: SourceInfo
@@ -473,9 +567,12 @@ defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
473567
474568-- | Represents destination object in server-side copy object
475569data DestinationInfo = DestinationInfo
476− { dstBucket :: Text -- ^ Destination bucket
477− , dstObject :: Text -- ^ Destination object key
478− } deriving (Show, Eq)
570+ { -- | Destination bucket
571+ dstBucket :: Text,
572+ -- | Destination object key
573+ dstObject :: Text
574+ }
575+ deriving stock (Show, Eq)
479576
480577-- | Provide a default for `DestinationInfo`
481578defaultDestinationInfo :: DestinationInfo
@@ -484,88 +581,106 @@ defaultDestinationInfo = DestinationInfo "" ""
484581-- | Data type for options when getting an object from the
485582-- service. Start with the empty `defaultGetObjectOptions` and modify
486583-- it using the goo* functions.
487−data GetObjectOptions = GetObjectOptions {
488− -- | 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,
489586 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
490− gooRange :: Maybe ByteRange
587+ gooRange :: Maybe ByteRange,
491588 -- | Set matching ETag condition, GetObject which matches the following
492589 -- ETag.
493− , gooIfMatch :: Maybe ETag
590+ gooIfMatch :: Maybe ETag,
494591 -- | Set matching ETag none condition, GetObject which does not match
495592 -- the following ETag.
496− , gooIfNoneMatch :: Maybe ETag
593+ gooIfNoneMatch :: Maybe ETag,
497594 -- | Set object unmodified condition, GetObject unmodified since given time.
498− , gooIfUnmodifiedSince :: Maybe UTCTime
595+ gooIfUnmodifiedSince :: Maybe UTCTime,
499596 -- | Set object modified condition, GetObject modified since given time.
500− , gooIfModifiedSince :: Maybe UTCTime
597+ gooIfModifiedSince :: Maybe UTCTime,
501598 -- | Specify SSE-C key
502− , gooSSECKey :: Maybe SSECKey
599+ gooSSECKey :: Maybe SSECKey
503600 }
504601
505602-- | Provide default `GetObjectOptions`.
506603defaultGetObjectOptions :: GetObjectOptions
507604defaultGetObjectOptions =
508− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
605+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
509606
510607gooToHeaders :: GetObjectOptions -> [HT.Header]
511−gooToHeaders goo = rangeHdr ++ zip names values
512− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
608+gooToHeaders goo =
609+ rangeHdr
610+ ++ zip names values
611+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
513612 where
514− names = ["If-Match",
515− "If-None-Match",
516− "If-Unmodified-Since",
517− "If-Modified-Since"]
518− values = mapMaybe (fmap encodeUtf8 . (goo &))
519− [gooIfMatch, gooIfNoneMatch,
520− fmap formatRFC1123 . gooIfUnmodifiedSince,
521− fmap formatRFC1123 . gooIfModifiedSince]
522− rangeHdr = maybe [] (\a -> [(hRange, HT.renderByteRanges [a])])
523− $ gooRange goo
524−
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
630+
631+-- | Data type returned by 'getObject' representing the object being
632+-- retrieved. Use the @gor*@ functions to access its contents.
633+data GetObjectResponse = GetObjectResponse
634+ { -- | ObjectInfo of the object being retrieved.
635+ gorObjectInfo :: ObjectInfo,
636+ -- | A conduit of the bytes of the object.
637+ gorObjectStream :: C.ConduitM () ByteString Minio ()
638+ }
525639
526640-- | A data-type for events that can occur in the object storage
527641-- server. Reference:
528642-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
529−data Event = ObjectCreated
530− | ObjectCreatedPut
531− | ObjectCreatedPost
532− | ObjectCreatedCopy
533− | ObjectCreatedMultipartUpload
534− | ObjectRemoved
535− | ObjectRemovedDelete
536− | ObjectRemovedDeleteMarkerCreated
537− | ReducedRedundancyLostObject
538− deriving (Eq)
539−
540−instance Show Event where
541− show ObjectCreated = "s3:ObjectCreated:*"
542− show ObjectCreatedPut = "s3:ObjectCreated:Put"
543− show ObjectCreatedPost = "s3:ObjectCreated:Post"
544− show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
545− show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
546− show ObjectRemoved = "s3:ObjectRemoved:*"
547− show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
548− show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
549− 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"
550665
551666textToEvent :: Text -> Maybe Event
552667textToEvent t = case t of
553− "s3:ObjectCreated:*" -> Just ObjectCreated
554− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
555− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
556− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
557− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
558− "s3:ObjectRemoved:*" -> Just ObjectRemoved
559− "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
560675 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
561− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
562− _ -> Nothing
563−
676+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
677+ _ -> Nothing
564678
565679-- | Filter data type - part of notification configuration
566−data Filter = Filter
680+newtype Filter = Filter
567681 { fFilter :: FilterKey
568− } deriving (Show, Eq)
682+ }
683+ deriving stock (Show, Eq)
569684
570685-- | defaultFilter is empty, used to create a notification
571686-- configuration.
@@ -573,9 +688,10 @@ defaultFilter :: Filter
573688defaultFilter = Filter defaultFilterKey
574689
575690-- | FilterKey contains FilterRules, and is part of a Filter.
576−data FilterKey = FilterKey
691+newtype FilterKey = FilterKey
577692 { fkKey :: FilterRules
578− } deriving (Show, Eq)
693+ }
694+ deriving stock (Show, Eq)
579695
580696-- | defaultFilterKey is empty, used to create notification
581697-- configuration.
@@ -583,16 +699,16 @@ defaultFilterKey :: FilterKey
583699defaultFilterKey = FilterKey defaultFilterRules
584700
585701-- | FilterRules represents a collection of `FilterRule`s.
586−data FilterRules = FilterRules
702+newtype FilterRules = FilterRules
587703 { frFilterRules :: [FilterRule]
588− } deriving (Show, Eq)
704+ }
705+ deriving stock (Show, Eq)
589706
590707-- | defaultFilterRules is empty, used to create notification
591708-- configuration.
592709defaultFilterRules :: FilterRules
593710defaultFilterRules = FilterRules []
594711
595−
596712-- | A filter rule that can act based on the suffix or prefix of an
597713-- object. As an example, let's create two filter rules:
598714--
@@ -603,9 +719,10 @@ defaultFilterRules = FilterRules []
603719-- for objects having a suffix of ".jpg", and the @prefixRule@
604720-- restricts it to objects having a prefix of "images/".
605721data FilterRule = FilterRule
606− { frName :: Text
607− , frValue :: Text
608− } deriving (Show, Eq)
722+ { frName :: Text,
723+ frValue :: Text
724+ }
725+ deriving stock (Show, Eq)
609726
610727-- | Arn is an alias of Text
611728type Arn = Text
@@ -614,11 +731,12 @@ type Arn = Text
614731-- notification system. It could represent a Queue, Topic or Lambda
615732-- Function configuration.
616733data NotificationConfig = NotificationConfig
617− { ncId :: Text
618− , ncArn :: Arn
619− , ncEvents :: [Event]
620− , ncFilter :: Filter
621− } deriving (Show, Eq)
734+ { ncId :: Text,
735+ ncArn :: Arn,
736+ ncEvents :: [Event],
737+ ncFilter :: Filter
738+ }
739+ deriving stock (Show, Eq)
622740
623741-- | A data-type to represent bucket notification configuration. It is
624742-- a collection of queue, topic or lambda function configurations. The
@@ -626,16 +744,16 @@ data NotificationConfig = NotificationConfig
626744-- described at
627745-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
628746data Notification = Notification
629− { nQueueConfigurations :: [NotificationConfig]
630− , nTopicConfigurations :: [NotificationConfig]
631− , nCloudFunctionConfigurations :: [NotificationConfig]
632− } deriving (Eq, Show)
747+ { nQueueConfigurations :: [NotificationConfig],
748+ nTopicConfigurations :: [NotificationConfig],
749+ nCloudFunctionConfigurations :: [NotificationConfig]
750+ }
751+ deriving stock (Show, Eq)
633752
634753-- | The default notification configuration is empty.
635754defaultNotification :: Notification
636755defaultNotification = Notification [] [] []
637756
638−
639757--------------------------------------------------------------------------
640758-- Select API Related Types
641759--------------------------------------------------------------------------
@@ -643,38 +761,42 @@ defaultNotification = Notification [] [] []
643761-- | SelectRequest represents the Select API call. Use the
644762-- `selectRequest` function to create a value of this type.
645763data SelectRequest = SelectRequest
646− { srExpression :: Text
647− , srExpressionType :: ExpressionType
648− , srInputSerialization :: InputSerialization
649− , srOutputSerialization :: OutputSerialization
650− , srRequestProgressEnabled :: Maybe Bool
651− } 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)
652771
653772data ExpressionType = SQL
654− deriving (Eq, Show)
773+ deriving stock (Show, Eq)
655774
656775-- | InputSerialization represents format information of the input
657776-- object being queried. Use one of the smart constructors such as
658777-- `defaultCsvInput` as a starting value, and add compression info
659778-- using `setInputCompressionType`
660779data InputSerialization = InputSerialization
661− { isCompressionType :: Maybe CompressionType
662− , isFormatInfo :: InputFormatInfo
663− } deriving (Eq, Show)
780+ { isCompressionType :: Maybe CompressionType,
781+ isFormatInfo :: InputFormatInfo
782+ }
783+ deriving stock (Show, Eq)
664784
665785-- | Data type representing the compression setting in a Select
666786-- request.
667−data CompressionType = CompressionTypeNone
668− | CompressionTypeGzip
669− | CompressionTypeBzip2
670− deriving (Eq, Show)
787+data CompressionType
788+ = CompressionTypeNone
789+ | CompressionTypeGzip
790+ | CompressionTypeBzip2
791+ deriving stock (Show, Eq)
671792
672793-- | Data type representing input object format information in a
673794-- Select request.
674−data InputFormatInfo = InputFormatCSV CSVInputProp
675− | InputFormatJSON JSONInputProp
676− | InputFormatParquet
677− deriving (Eq, Show)
795+data InputFormatInfo
796+ = InputFormatCSV CSVInputProp
797+ | InputFormatJSON JSONInputProp
798+ | InputFormatParquet
799+ deriving stock (Show, Eq)
678800
679801-- | defaultCsvInput returns InputSerialization with default CSV
680802-- format, and without any compression setting.
@@ -684,14 +806,18 @@ defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
684806-- | linesJsonInput returns InputSerialization with JSON line based
685807-- format with no compression setting.
686808linesJsonInput :: InputSerialization
687−linesJsonInput = InputSerialization Nothing
688− (InputFormatJSON $ JSONInputProp JSONTypeLines)
809+linesJsonInput =
810+ InputSerialization
811+ Nothing
812+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
689813
690814-- | documentJsonInput returns InputSerialization with JSON document
691815-- based format with no compression setting.
692816documentJsonInput :: InputSerialization
693−documentJsonInput = InputSerialization Nothing
694− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
817+documentJsonInput =
818+ InputSerialization
819+ Nothing
820+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
695821
696822-- | defaultParquetInput returns InputSerialization with Parquet
697823-- format, and no compression setting.
@@ -700,12 +826,14 @@ defaultParquetInput = InputSerialization Nothing InputFormatParquet
700826
701827-- | setInputCompressionType sets the compression type for the input
702828-- of the SelectRequest
703−setInputCompressionType :: CompressionType -> SelectRequest
704− -> SelectRequest
829+setInputCompressionType ::
830+ CompressionType ->
831+ SelectRequest ->
832+ SelectRequest
705833setInputCompressionType c i =
706− let is = srInputSerialization i
707− is' = is { isCompressionType = Just c }
708− in i { srInputSerialization = is' }
834+ let is = srInputSerialization i
835+ is' = is {isCompressionType = Just c}
836+ in i {srInputSerialization = is'}
709837
710838-- | defaultCsvOutput returns OutputSerialization with default CSV
711839-- format.
@@ -722,40 +850,42 @@ defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
722850-- SelectRequest with the SQL query text given by @query@, the input
723851-- serialization settings (compression format and format information)
724852-- @inputSer@ and the output serialization settings @outputSer@.
725−selectRequest :: Text -> InputSerialization -> OutputSerialization
726− -> SelectRequest
853+selectRequest ::
854+ Text ->
855+ InputSerialization ->
856+ OutputSerialization ->
857+ SelectRequest
727858selectRequest sqlQuery inputSer outputSer =
728− SelectRequest { srExpression = sqlQuery
729− , srExpressionType = SQL
730− , srInputSerialization = inputSer
731− , srOutputSerialization = outputSer
732− , srRequestProgressEnabled = Nothing
733− }
859+ SelectRequest
860+ { srExpression = sqlQuery,
861+ srExpressionType = SQL,
862+ srInputSerialization = inputSer,
863+ srOutputSerialization = outputSer,
864+ srRequestProgressEnabled = Nothing
865+ }
734866
735867-- | setRequestProgressEnabled sets the flag for turning on progress
736868-- messages when the Select response is being streamed back to the
737869-- client.
738870setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
739871setRequestProgressEnabled enabled sr =
740− sr { srRequestProgressEnabled = Just enabled }
872+ sr {srRequestProgressEnabled = Just enabled}
741873
742874type CSVInputProp = CSVProp
743875
744876-- | CSVProp represents CSV format properties. It is built up using
745877-- the Monoid instance.
746−data CSVProp = CSVProp (H.HashMap Text Text)
747− deriving (Eq, Show)
878+newtype CSVProp = CSVProp (H.HashMap Text Text)
879+ deriving stock (Show, Eq)
748880
749−#if (__GLASGOW_HASKELL__ >= 804)
750881instance Semigroup CSVProp where
751− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
752−#endif
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
753883
754884instance Monoid CSVProp where
755− mempty = CSVProp mempty
756−#if (__GLASGOW_HASKELL__ < 804)
757− mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
758−#endif
885+ mempty = CSVProp mempty
886+
887+csvPropsList :: CSVProp -> [(Text, Text)]
888+csvPropsList (CSVProp h) = sort $ H.toList h
759889
760890defaultCSVProp :: CSVProp
761891defaultCSVProp = mempty
@@ -779,18 +909,21 @@ quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
779909-- | FileHeaderInfo specifies information about column headers for CSV
780910-- format.
781911data FileHeaderInfo
782− = FileHeaderNone -- ^ No column headers are present
783− | FileHeaderUse -- ^ Headers are present and they should be used
784− | FileHeaderIgnore -- ^ Header are present, but should be ignored
785− 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)
786919
787920-- | Specify the CSV file header info property.
788921fileHeaderInfo :: FileHeaderInfo -> CSVProp
789−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
922+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
790923 where
791− toString FileHeaderNone = "NONE"
792− toString FileHeaderUse = "USE"
793− toString FileHeaderIgnore = "IGNORE"
924+ toStr FileHeaderNone = "NONE"
925+ toStr FileHeaderUse = "USE"
926+ toStr FileHeaderIgnore = "IGNORE"
794927
795928-- | Specify the CSV comment character property. Lines starting with
796929-- this character are ignored by the server.
@@ -803,64 +936,69 @@ allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter"
803936
804937-- | Set the CSV format properties in the InputSerialization.
805938setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
806−setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }
939+setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
807940
808941-- | Set the CSV format properties in the OutputSerialization.
809942outputCSVFromProps :: CSVProp -> OutputSerialization
810−outputCSVFromProps p = OutputSerializationCSV p
943+outputCSVFromProps = OutputSerializationCSV
811944
812−data JSONInputProp = JSONInputProp { jsonipType :: JSONType }
813− deriving (Eq, Show)
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946+ deriving stock (Show, Eq)
814947
815948data JSONType = JSONTypeDocument | JSONTypeLines
816− deriving (Eq, Show)
817−
949+ deriving stock (Show, Eq)
818950
819951-- | OutputSerialization represents output serialization settings for
820952-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
821953-- a starting point.
822−data OutputSerialization = OutputSerializationJSON JSONOutputProp
823− | OutputSerializationCSV CSVOutputProp
824− deriving (Eq, Show)
954+data OutputSerialization
955+ = OutputSerializationJSON JSONOutputProp
956+ | OutputSerializationCSV CSVOutputProp
957+ deriving stock (Show, Eq)
825958
826959type CSVOutputProp = CSVProp
827960
828961-- | quoteFields is an output serialization parameter
829962quoteFields :: QuoteFields -> CSVProp
830−quoteFields q = CSVProp $ H.singleton "QuoteFields" $
831− case q of
832− QuoteFieldsAsNeeded -> "ASNEEDED"
833− QuoteFieldsAlways -> "ALWAYS"
963+quoteFields q = CSVProp $
964+ H.singleton "QuoteFields" $
965+ case q of
966+ QuoteFieldsAsNeeded -> "ASNEEDED"
967+ QuoteFieldsAlways -> "ALWAYS"
834968
835969-- | Represent the QuoteField setting.
836970data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
837− deriving (Eq, Show)
971+ deriving stock (Show, Eq)
838972
839−data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }
840− deriving (Eq, Show)
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974+ deriving stock (Show, Eq)
841975
842976-- | Set the output record delimiter for JSON format
843977outputJSONFromRecordDelimiter :: Text -> OutputSerialization
844978outputJSONFromRecordDelimiter t =
845− OutputSerializationJSON (JSONOutputProp $ Just t)
979+ OutputSerializationJSON (JSONOutputProp $ Just t)
846980
847981-- Response related types
848982
849983-- | An EventMessage represents each kind of message received from the server.
850−data EventMessage = ProgressEventMessage { emProgress :: Progress }
851− | StatsEventMessage { emStats :: Stats }
852− | RequestLevelErrorMessage { emErrorCode :: Text
853− , emErrorMessage :: Text
854− }
855− | RecordPayloadEventMessage { emPayloadBytes :: ByteString }
856− deriving (Eq, Show)
857−
858−data MsgHeaderName = MessageType
859− | EventType
860− | ContentType
861− | ErrorCode
862− | ErrorMessage
863− 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)
8641002
8651003msgHeaderValueType :: Word8
8661004msgHeaderValueType = 7
@@ -868,11 +1006,12 @@ msgHeaderValueType = 7
8681006type MessageHeader = (MsgHeaderName, Text)
8691007
8701008-- | Represent the progress event returned in the Select response.
871−data Progress = Progress { pBytesScanned :: Int64
872− , pBytesProcessed :: Int64
873− , pBytesReturned :: Int64
874− }
875− deriving (Eq, Show)
1009+data Progress = Progress
1010+ { pBytesScanned :: Int64,
1011+ pBytesProcessed :: Int64,
1012+ pBytesReturned :: Int64
1013+ }
1014+ deriving stock (Show, Eq)
8761015
8771016-- | Represent the stats event returned at the end of the Select
8781017-- response.
@@ -885,86 +1024,89 @@ type Stats = Progress
8851024-- | Represents different kinds of payload that are used with S3 API
8861025-- requests.
8871026data Payload
888− = PayloadBS ByteString
889− | PayloadH Handle Int64 Int64 -- file handle, offset and length
890− | 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
8911030
8921031defaultPayload :: Payload
8931032defaultPayload = PayloadBS ""
8941033
895−data AdminReqInfo = AdminReqInfo {
896− ariMethod :: Method
897− , ariPayloadHash :: Maybe ByteString
898− , ariPayload :: Payload
899− , ariPath :: ByteString
900− , ariHeaders :: [Header]
901− , 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
9021041 }
9031042
9041043data S3ReqInfo = S3ReqInfo
905− { riMethod :: Method
906− , riBucket :: Maybe Bucket
907− , riObject :: Maybe Object
908− , riQueryParams :: Query
909− , riHeaders :: [Header]
910− , riPayload :: Payload
911− , riPayloadHash :: Maybe ByteString
912− , riRegion :: Maybe Region
913− , 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
9141054 }
9151055
9161056defaultS3ReqInfo :: S3ReqInfo
917−defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
918− [] [] 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
9191069
9201070getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
9211071getS3Path b o =
922− let segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
923− in
924− B.concat ["/", B.intercalate "/" segments]
925−
926−-- | Time to expire for a presigned URL. It interpreted as a number of
927−-- seconds. The maximum duration that can be specified is 7 days.
928−type UrlExpiry = Int
1072+ let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073+ in B.concat ["/", B.intercalate "/" segments]
9291074
930−type RegionMap = Map.Map Bucket Region
1075+type RegionMap = H.HashMap Bucket Region
9311076
9321077-- | The Minio Monad - all computations accessing object storage
9331078-- happens in it.
934−newtype Minio a = Minio {
935− unMinio :: ReaderT MinioConn (ResourceT IO) a
1079+newtype Minio a = Minio
1080+ { unMinio :: ReaderT MinioConn (ResourceT IO) a
9361081 }
937− deriving (
938− Functor
939− , Applicative
940− , Monad
941− , MonadIO
942− , MonadReader MinioConn
943− , MonadResource
1082+ deriving newtype
1083+ ( Functor,
1084+ Applicative,
1085+ Monad,
1086+ MonadIO,
1087+ MonadReader MinioConn,
1088+ MonadResource,
1089+ MonadUnliftIO
9441090 )
9451091
946−instance MonadUnliftIO Minio where
947− askUnliftIO = Minio $ ReaderT $ \r ->
948− withUnliftIO $ \u ->
949− return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))
950−
9511092-- | MinioConn holds connection info and a connection pool to allow
9521093-- for efficient resource re-use.
9531094data MinioConn = MinioConn
954− { mcConnInfo :: ConnectInfo
955− , mcConnManager :: NC.Manager
956− , mcRegionMap :: MVar RegionMap
1095+ { mcConnInfo :: ConnectInfo,
1096+ mcConnManager :: NC.Manager,
1097+ mcRegionMap :: MVar RegionMap
9571098 }
9581099
9591100class HasSvcNamespace env where
9601101 getSvcNamespace :: env -> Text
9611102
9621103instance HasSvcNamespace MinioConn where
963− getSvcNamespace env = let host = connectHost $ mcConnInfo env
964− in if | host == "storage.googleapis.com" ->
965− "http://doc.s3.amazonaws.com/2006-03-01"
966− | otherwise ->
967− "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+ )
9681110
9691111-- | Takes connection information and returns a connection object to
9701112-- be passed to 'runMinio'. The returned value can be kept in the
@@ -972,11 +1114,16 @@ instance HasSvcNamespace MinioConn where
9721114-- object storage is accessed.
9731115connect :: ConnectInfo -> IO MinioConn
9741116connect ci = do
975− let settings | connectIsSecure ci && connectDisableTLSCertValidation ci =
976− let badTlsSettings = Conn.TLSSettingsSimple True False False
977− in TLS.mkManagerSettings badTlsSettings Nothing
978− | connectIsSecure ci = NC.tlsManagerSettings
979− | 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
9801127 mgr <- NC.newManager settings
9811128 mkMinioConn ci mgr
9821129
@@ -984,35 +1131,61 @@ connect ci = do
9841131-- `MinioConn`. This reuses connections, but otherwise it is similar
9851132-- to `runMinio`.
9861133runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
987−runMinioWith conn m = runResourceT . flip runReaderT conn . unMinio $
988− fmap Right m `U.catches`
989− [ U.Handler handlerServiceErr
990− , U.Handler handlerHE
991− , U.Handler handlerFE
992− , U.Handler handlerValidation
993− ]
994− where
995− handlerServiceErr = return . Left . MErrService
996− handlerHE = return . Left . MErrHTTP
997− handlerFE = return . Left . MErrIO
998− handlerValidation = return . Left . MErrValidation
1134+runMinioWith conn m = runResourceT $ runMinioResWith conn m
9991135
10001136-- | Given `ConnectInfo` and a HTTP connection manager, create a
10011137-- `MinioConn`.
10021138mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
10031139mkMinioConn ci mgr = do
1004− rMapMVar <- M.newMVar Map.empty
1005− return $ MinioConn ci mgr rMapMVar
1140+ rMapMVar <- M.newMVar H.empty
1141+ return $ MinioConn ci mgr rMapMVar
10061142
10071143-- | Run the Minio action and return the result or an error.
10081144runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
10091145runMinio ci m = do
10101146 conn <- connect ci
1011− runMinioWith conn m
1147+ runResourceT $ runMinioResWith conn m
1148+
1149+-- | Similar to 'runMinioWith'. Allows applications to allocate/release
1150+-- its resources along side MinIO's internal resources.
1151+runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
1152+runMinioResWith conn m =
1153+ flip runReaderT conn . unMinio $
1154+ fmap Right m
1155+ `U.catches` [ U.Handler handlerServiceErr,
1156+ U.Handler handlerHE,
1157+ U.Handler handlerFE,
1158+ U.Handler handlerValidation
1159+ ]
1160+ where
1161+ handlerServiceErr = return . Left . MErrService
1162+ handlerHE = return . Left . MErrHTTP
1163+ handlerFE = return . Left . MErrIO
1164+ handlerValidation = return . Left . MErrValidation
10121165
1013−s3Name :: Text -> Text -> Name
1014−s3Name ns s = Name s (Just ns) Nothing
1166+-- | Similar to 'runMinio'. Allows applications to allocate/release
1167+-- its resources along side MinIO's internal resources.
1168+runMinioRes :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
1169+runMinioRes ci m = do
1170+ conn <- liftIO $ connect ci
1171+ runMinioResWith conn m
10151172
10161173-- | Format as per RFC 1123.
10171174formatRFC1123 :: UTCTime -> T.Text
10181175formatRFC1123 = 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