@@ -1,5 +1,5 @@
11--
2−-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
2+-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
33--
44-- Licensed under the Apache License, Version 2.0 (the "License");
55-- you may not use this file except in compliance with the License.
@@ -13,64 +13,47 @@
1313-- See the License for the specific language governing permissions and
1414-- limitations under the License.
1515--
16−{-# LANGUAGE CPP #-}
17−{-# LANGUAGE GADTs #-}
18−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19−{-# LANGUAGE StrictData #-}
20−{-# LANGUAGE TypeFamilies #-}
2116
17+{-# LANGUAGE CPP #-}
18+{-# LANGUAGE GADTs #-}
19+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
20+{-# LANGUAGE TypeFamilies #-}
2221module Network.Minio.Data where
2322
24−import qualified Conduit as C
25−import qualified Control.Concurrent.MVar as M
26−import Control.Monad.Trans.Except (throwE)
27−import Control.Monad.Trans.Resource
28− ( MonadResource,
29− MonadThrow (..),
30− MonadUnliftIO,
31− ResourceT,
32− runResourceT,
33− )
34−import qualified Data.Aeson as A
35−import qualified Data.ByteArray as BA
36−import qualified Data.ByteString as B
37−import qualified Data.ByteString.Lazy as LB
38−import Data.Default.Class (def)
39−import qualified Data.HashMap.Strict as H
40−import qualified Data.Ini as Ini
41−import qualified Data.List as List
42−import qualified Data.Text as T
43−import qualified Data.Text.Encoding as TE
44−import Data.Time (defaultTimeLocale, formatTime)
45−import Lib.Prelude (UTCTime, throwIO)
46−import qualified Network.Connection as Conn
47−import Network.HTTP.Client (defaultManagerSettings)
48−import qualified Network.HTTP.Client.TLS as TLS
49−import qualified Network.HTTP.Conduit as NC
50−import Network.HTTP.Types
51− ( ByteRange,
52− Header,
53− Method,
54− Query,
55− hRange,
56− )
57−import qualified Network.HTTP.Types as HT
58−import Network.Minio.Credentials
59−import Network.Minio.Data.Crypto
60− ( encodeToBase64,
61− hashMD5ToBase64,
62− )
63−import Network.Minio.Data.Time (UrlExpiry)
64−import Network.Minio.Errors
65− ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
66− MinioErr (..),
67− )
68−import Network.Minio.Utils
69−import System.Directory (doesFileExist, getHomeDirectory)
70−import qualified System.Environment as Env
71−import System.FilePath.Posix (combine)
72−import qualified UnliftIO as U
73−import qualified UnliftIO.MVar as UM
23+import qualified Conduit as C
24+import 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
7457
7558-- | max obj size is 5TiB
7659maxObjectSize :: Int64
@@ -90,157 +73,124 @@ maxMultipartParts = 10000
9073-- TODO: Add a type which provides typed constants for region. this
9174-- type should have a IsString instance to infer the appropriate
9275-- constant.
93−
9476-- | awsRegionMap - library constant
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− ]
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+ ]
12994
13095-- | Connection Info data type. To create a 'ConnectInfo' value,
13196-- enable the @OverloadedStrings@ language extension and use the
13297-- `IsString` instance to provide a URL, for example:
13398--
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)
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)
147110
148111instance IsString ConnectInfo where
149− fromString str =
150− let req = NC.parseRequest_ str
151− in ConnectInfo
152− { connectHost = TE.decodeUtf8 $ NC.host req,
153− connectPort = NC.port req,
154− connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
155− connectIsSecure = NC.secure req,
156− connectRegion = "",
157− connectAutoDiscoverRegion = True,
158− connectDisableTLSCertValidation = False
159− }
160−
161−-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
162−-- Loaders may be chained together using 'findFirst'.
163−--
164−-- @since 1.7.0
165−type CredentialLoader = IO (Maybe CredentialValue)
166−
167−-- | Combines the given list of loaders, by calling each one in
168−-- order until a 'CredentialValue' is returned.
169−findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
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
170136findFirst [] = return Nothing
171−findFirst (f : fs) = do
172− c <- f
173− maybe (findFirst fs) (return . Just) c
137+findFirst (f:fs) = do c <- f
138+ maybe (findFirst fs) (return . Just) c
174139
175−-- | This action returns a 'CredentialValue' populated from
176−-- @~\/.aws\/credentials@
177−fromAWSConfigFile :: CredentialLoader
140+-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
141+fromAWSConfigFile :: Provider
178142fromAWSConfigFile = do
179− credsE <- runExceptT $ do
180− homeDir <- lift getHomeDirectory
181− let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
182− fileExists <- lift $ doesFileExist awsCredsFile
183− bool (throwE "FileNotFound") (return ()) fileExists
184− ini <- ExceptT $ Ini.readIniFile awsCredsFile
185− akey <-
186− ExceptT $
187− return $
188− Ini.lookupValue "default" "aws_access_key_id" ini
189− skey <-
190− ExceptT $
191− return $
192− Ini.lookupValue "default" "aws_secret_access_key" ini
193− return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
194− return $ either (const Nothing) Just credsE
195−
196−-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
197−-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
198−fromAWSEnv :: CredentialLoader
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
199159fromAWSEnv = runMaybeT $ do
200− akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
201− skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
202− return $ CredentialValue (fromString akey) (fromString skey) Nothing
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)
203163
204−-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205−-- and @MINIO_SECRET_KEY@ environment variables.
206−fromMinioEnv :: CredentialLoader
164+-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
165+-- @MINIO_SECRET_KEY@ environment variables.
166+fromMinioEnv :: Provider
207167fromMinioEnv = runMaybeT $ do
208− akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
209− skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
210− return $ CredentialValue (fromString akey) (fromString skey) Nothing
211−
212−-- | setCredsFrom retrieves access credentials from the first action in the
213−-- given list that succeeds and sets it in the 'ConnectInfo'.
214−setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
215−setCredsFrom ps ci = do
216− pMay <- findFirst ps
217− maybe
218− (throwIO MErrVMissingCredentials)
219− (return . (`setCreds` ci))
220− pMay
221−
222−-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223−setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224−setCreds cv connInfo =
225− connInfo
226− { connectCreds = CredsStatic cv
227− }
228−
229−-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230−-- credentials via the STS API on demand. It is automatically refreshed on
231−-- expiry.
232−setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233−setSTSCredential p ci = do
234− store <- initSTSCredential p
235− return ci {connectCreds = CredsSTS store}
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+ }
236188
237189-- | Set the S3 region parameter in the `ConnectInfo`
238190setRegion :: Region -> ConnectInfo -> ConnectInfo
239−setRegion r connInfo =
240− connInfo
241− { connectRegion = r,
242− connectAutoDiscoverRegion = False
243− }
191+setRegion r connInfo = connInfo { connectRegion = r
192+ , connectAutoDiscoverRegion = False
193+ }
244194
245195-- | Check if the connection to object storage server is secure
246196-- (i.e. uses TLS)
@@ -252,37 +202,39 @@ isConnectInfoSecure = connectIsSecure
252202-- certificates. Note that this option has no effect, if you provide
253203-- your own Manager in `mkMinioConn`.
254204disableTLSCertValidation :: ConnectInfo -> ConnectInfo
255−disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
205+disableTLSCertValidation c = c { connectDisableTLSCertValidation = True }
256206
257207getHostAddr :: ConnectInfo -> ByteString
258−getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
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
259214
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−--
215+
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
265219-- Credentials should be supplied before use.
266220gcsCI :: ConnectInfo
267−gcsCI =
268− setRegion
269− "us"
270− "https://storage.googleapis.com"
221+gcsCI = setRegion "us"
222+ "https://storage.googleapis.com"
223+
271224
272−-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
225+-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
273226-- should be supplied before use.
274227awsCI :: ConnectInfo
275228awsCI = "https://s3.amazonaws.com"
276229
277−-- | <https://play.min.io MinIO Play Server>
230+
231+-- | <https://play.min.io:9000 MinIO Play Server>
278232-- ConnectInfo. Credentials are already filled in.
279233minioPlayCI :: ConnectInfo
280−minioPlayCI =
281− let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
282− in setCreds playCreds $
283− setRegion
284− "us-east-1"
285− "https://play.min.io"
234+minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
235+ in setCreds playCreds
236+ $ setRegion "us-east-1"
237+ "https://play.min.io:9000"
286238
287239-- |
288240-- Represents a bucket in the object store
@@ -292,7 +244,9 @@ type Bucket = Text
292244-- Represents an object name
293245type Object = Text
294246
295−-- | Represents a region
247+-- |
248+-- Represents a region
249+-- TODO: This could be a Sum Type with all defined regions for AWS.
296250type Region = Text
297251
298252-- | A type alias to represent an Entity-Tag returned by S3-compatible APIs.
@@ -301,147 +255,127 @@ type ETag = Text
301255-- | Data type to represent an object encryption key. Create one using
302256-- the `mkSSECKey` function.
303257newtype SSECKey = SSECKey BA.ScrubbedBytes
304− deriving stock (Eq, Show)
258+ deriving (Eq, Show)
305259
306260-- | Validates that the given ByteString is 32 bytes long and creates
307261-- an encryption key.
308−mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
309−mkSSECKey keyBytes
310− | B.length keyBytes /= 32 =
311− throwM MErrVInvalidEncryptionKeyLength
312− | otherwise =
313− return $ SSECKey $ BA.convert keyBytes
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
314267
315268-- | Data type to represent Server-Side-Encryption settings
316269data SSE where
317− -- | Specifies SSE S3 encryption - server manages encryption keys
318− SSE :: SSE
319− -- | Specifies that KMS service should be used. The first argument
320− -- to the constructor is the Key Id to be used by the server (if
321− -- not specified, the default KMS key id is used). The second
322− -- argument is the optional KMS context that must have a
323− -- `A.ToJSON` instance - please refer to the AWS S3 documentation
324− -- for detailed information.
325− SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
326− -- | Specifies server-side encryption with customer provided
327− -- key. The argument is the encryption key to be used.
328− SSEC :: SSECKey -> SSE
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
329282
330283toPutObjectHeaders :: SSE -> [HT.Header]
331284toPutObjectHeaders sseArg =
332− let sseHeader = "x-amz-server-side-encryption"
333− sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
334− sseKmsContextHeader = sseHeader <> "-context"
335− ssecAlgo = sseHeader <> "-customer-algorithm"
336− ssecKey = sseHeader <> "-customer-key"
337− ssecKeyMD5 = ssecKey <> "-MD5"
338− in case sseArg of
339− SSE -> [(sseHeader, "AES256")]
340− SSEKMS keyIdMay ctxMay ->
341− [(sseHeader, "aws:kms")]
342− ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
343− ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
344− SSEC (SSECKey sb) ->
345− [ (ssecAlgo, "AES256"),
346− (ssecKey, encodeToBase64 sb),
347− (ssecKeyMD5, hashMD5ToBase64 sb)
348− ]
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)]
349304
350305-- | Data type for options in PutObject call. Start with the empty
351306-- `defaultPutObjectOptions` and use various the various poo*
352307-- accessors.
353−data PutObjectOptions = PutObjectOptions
354− { -- | Set a standard MIME type describing the format of the object.
355− pooContentType :: Maybe Text,
356− -- | Set what content encodings have been applied to the object and thus
357− -- what decoding mechanisms must be applied to obtain the media-type
358− -- referenced by the Content-Type header field.
359− pooContentEncoding :: Maybe Text,
360− -- | Set presentational information for the object.
361− pooContentDisposition :: Maybe Text,
362− -- | Set to specify caching behavior for the object along the
363− -- request/reply chain.
364− pooCacheControl :: Maybe Text,
365− -- | Set to describe the language(s) intended for the audience.
366− pooContentLanguage :: Maybe Text,
367− -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
368− -- performance needs, storage class is @STANDARD@ by default (i.e
369− -- when Nothing is passed).
370− pooStorageClass :: Maybe Text,
371− -- | Set user defined metadata to store with the object.
372− pooUserMetadata :: [(Text, Text)],
373− -- | Set number of worker threads used to upload an object.
374− pooNumThreads :: Maybe Word,
375− -- | Set object encryption parameters for the request.
376− pooSSE :: Maybe SSE
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
377332 }
378333
379334-- | Provide default `PutObjectOptions`.
380335defaultPutObjectOptions :: PutObjectOptions
381336defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
382337
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+
383347pooToHeaders :: PutObjectOptions -> [HT.Header]
384−pooToHeaders poo =
385− userMetadata
386− ++ mapMaybe tupToMaybe (zip names values)
387− ++ maybe [] toPutObjectHeaders (pooSSE poo)
348+pooToHeaders poo = userMetadata
349+ ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
350+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
388351 where
389− tupToMaybe (k, Just v) = Just (k, v)
352+ tupToMaybe (k, Just v) = Just (k, v)
390353 tupToMaybe (_, Nothing) = Nothing
354+
391355 userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
392− names =
393− [ "content-type",
394− "content-encoding",
395− "content-disposition",
396− "content-language",
397− "cache-control",
398− "x-amz-storage-class"
399− ]
400− values =
401− map
402− (fmap encodeUtf8 . (poo &))
403− [ pooContentType,
404− pooContentEncoding,
405− pooContentDisposition,
406− pooContentLanguage,
407− pooCacheControl,
408− pooStorageClass
409− ]
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+
410368
411369-- |
412370-- BucketInfo returned for list buckets call
413−data BucketInfo = BucketInfo
414− { biName :: Bucket,
415− biCreationDate :: UTCTime
416− }
417− deriving stock (Show, Eq)
371+data BucketInfo = BucketInfo {
372+ biName :: Bucket
373+ , biCreationDate :: UTCTime
374+ } deriving (Show, Eq)
418375
419376-- | A type alias to represent a part-number for multipart upload
420377type PartNumber = Int16
421378
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−
445379-- | A type alias to represent an upload-id for multipart upload
446380type UploadId = Text
447381
@@ -450,116 +384,88 @@ type PartTuple = (PartNumber, ETag)
450384
451385-- | Represents result from a listing of object parts of an ongoing
452386-- multipart upload.
453−data ListPartsResult = ListPartsResult
454− { lprHasMore :: Bool,
455− lprNextPart :: Maybe Int,
456− lprParts :: [ObjectPartInfo]
457− }
458− deriving stock (Show, Eq)
387+data ListPartsResult = ListPartsResult {
388+ lprHasMore :: Bool
389+ , lprNextPart :: Maybe Int
390+ , lprParts :: [ObjectPartInfo]
391+ } deriving (Show, Eq)
459392
460393-- | Represents information about an object part in an ongoing
461394-- multipart upload.
462−data ObjectPartInfo = ObjectPartInfo
463− { opiNumber :: PartNumber,
464− opiETag :: ETag,
465− opiSize :: Int64,
466− opiModTime :: UTCTime
467− }
468− deriving stock (Show, Eq)
395+data ObjectPartInfo = ObjectPartInfo {
396+ opiNumber :: PartNumber
397+ , opiETag :: ETag
398+ , opiSize :: Int64
399+ , opiModTime :: UTCTime
400+ } deriving (Show, Eq)
469401
470402-- | Represents result from a listing of incomplete uploads to a
471403-- bucket.
472−data ListUploadsResult = ListUploadsResult
473− { lurHasMore :: Bool,
474− lurNextKey :: Maybe Text,
475− lurNextUpload :: Maybe Text,
476− lurUploads :: [(Object, UploadId, UTCTime)],
477− lurCPrefixes :: [Text]
478− }
479− deriving stock (Show, Eq)
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)
480411
481412-- | Represents information about a multipart upload.
482−data UploadInfo = UploadInfo
483− { uiKey :: Object,
484− uiUploadId :: UploadId,
485− uiInitTime :: UTCTime,
486− uiSize :: Int64
487− }
488− deriving stock (Show, Eq)
413+data UploadInfo = UploadInfo {
414+ uiKey :: Object
415+ , uiUploadId :: UploadId
416+ , uiInitTime :: UTCTime
417+ , uiSize :: Int64
418+ } deriving (Show, Eq)
489419
490420-- | Represents result from a listing of objects in a bucket.
491−data ListObjectsResult = ListObjectsResult
492− { lorHasMore :: Bool,
493− lorNextToken :: Maybe Text,
494− lorObjects :: [ObjectInfo],
495− lorCPrefixes :: [Text]
496− }
497− deriving stock (Show, Eq)
421+data ListObjectsResult = ListObjectsResult {
422+ lorHasMore :: Bool
423+ , lorNextToken :: Maybe Text
424+ , lorObjects :: [ObjectInfo]
425+ , lorCPrefixes :: [Text]
426+ } deriving (Show, Eq)
498427
499428-- | Represents result from a listing of objects version 1 in a bucket.
500−data ListObjectsV1Result = ListObjectsV1Result
501− { lorHasMore' :: Bool,
502− lorNextMarker :: Maybe Text,
503− lorObjects' :: [ObjectInfo],
504− lorCPrefixes' :: [Text]
505− }
506− deriving stock (Show, Eq)
429+data ListObjectsV1Result = ListObjectsV1Result {
430+ lorHasMore' :: Bool
431+ , lorNextMarker :: Maybe Text
432+ , lorObjects' :: [ObjectInfo]
433+ , lorCPrefixes' :: [Text]
434+ } deriving (Show, Eq)
507435
508436-- | Represents information about an object.
509437data ObjectInfo = ObjectInfo
510− { -- | Object key
511− oiObject :: Object,
512− -- | Modification time of the object
513− oiModTime :: UTCTime,
514− -- | ETag of the object
515− oiETag :: ETag,
516− -- | Size of the object in bytes
517− oiSize :: Int64,
518− -- | A map of user-metadata
519− -- pairs stored with an
520− -- object (keys will not
521− -- have the @X-Amz-Meta-@
522− -- prefix).
523− oiUserMetadata :: H.HashMap Text Text,
524− -- | A map of metadata
525− -- key-value pairs (not
526− -- including the
527− -- user-metadata pairs)
528− oiMetadata :: H.HashMap Text Text
529− }
530− deriving stock (Show, Eq)
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)
531445
532446-- | Represents source object in server-side copy object
533447data SourceInfo = SourceInfo
534− { -- | Bucket containing the source object
535− srcBucket :: Text,
536− -- | Source object key
537− srcObject :: Text,
538− -- | Source object
539− -- byte-range
540− -- (inclusive)
541− srcRange :: Maybe (Int64, Int64),
542− -- | ETag condition on source -
543− -- object is copied only if the
544− -- source object's ETag matches
545− -- this value.
546− srcIfMatch :: Maybe Text,
547− -- | ETag not match condition
548− -- on source - object is copied
549− -- if ETag does not match this
550− -- value.
551− srcIfNoneMatch :: Maybe Text,
552− -- | Copy source object only
553− -- if the source has been
554− -- modified since this time.
555− srcIfModifiedSince :: Maybe UTCTime,
556− -- | Copy source object only
557− -- if the source has been
558− -- un-modified since this
559− -- given time.
560− srcIfUnmodifiedSince :: Maybe UTCTime
561− }
562− deriving stock (Show, Eq)
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)
563469
564470-- | Provide a default for `SourceInfo`
565471defaultSourceInfo :: SourceInfo
@@ -567,12 +473,9 @@ defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
567473
568474-- | Represents destination object in server-side copy object
569475data DestinationInfo = DestinationInfo
570− { -- | Destination bucket
571− dstBucket :: Text,
572− -- | Destination object key
573− dstObject :: Text
574− }
575− deriving stock (Show, Eq)
476+ { dstBucket :: Text -- ^ Destination bucket
477+ , dstObject :: Text -- ^ Destination object key
478+ } deriving (Show, Eq)
576479
577480-- | Provide a default for `DestinationInfo`
578481defaultDestinationInfo :: DestinationInfo
@@ -581,106 +484,88 @@ defaultDestinationInfo = DestinationInfo "" ""
581484-- | Data type for options when getting an object from the
582485-- service. Start with the empty `defaultGetObjectOptions` and modify
583486-- it using the goo* functions.
584−data GetObjectOptions = GetObjectOptions
585− { -- | Set object's data of given offset begin and end,
487+data GetObjectOptions = GetObjectOptions {
488+ -- | Set object's data of given offset begin and end,
586489 -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
587− gooRange :: Maybe ByteRange,
490+ gooRange :: Maybe ByteRange
588491 -- | Set matching ETag condition, GetObject which matches the following
589492 -- ETag.
590− gooIfMatch :: Maybe ETag,
493+ , gooIfMatch :: Maybe ETag
591494 -- | Set matching ETag none condition, GetObject which does not match
592495 -- the following ETag.
593− gooIfNoneMatch :: Maybe ETag,
496+ , gooIfNoneMatch :: Maybe ETag
594497 -- | Set object unmodified condition, GetObject unmodified since given time.
595− gooIfUnmodifiedSince :: Maybe UTCTime,
498+ , gooIfUnmodifiedSince :: Maybe UTCTime
596499 -- | Set object modified condition, GetObject modified since given time.
597− gooIfModifiedSince :: Maybe UTCTime,
500+ , gooIfModifiedSince :: Maybe UTCTime
598501 -- | Specify SSE-C key
599− gooSSECKey :: Maybe SSECKey
502+ , gooSSECKey :: Maybe SSECKey
600503 }
601504
602505-- | Provide default `GetObjectOptions`.
603506defaultGetObjectOptions :: GetObjectOptions
604507defaultGetObjectOptions =
605− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
508+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
606509
607510gooToHeaders :: GetObjectOptions -> [HT.Header]
608−gooToHeaders goo =
609− rangeHdr
610− ++ zip names values
611− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
511+gooToHeaders goo = rangeHdr ++ zip names values
512+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
612513 where
613− names =
614− [ "If-Match",
615− "If-None-Match",
616− "If-Unmodified-Since",
617− "If-Modified-Since"
618− ]
619− values =
620− mapMaybe
621− (fmap encodeUtf8 . (goo &))
622− [ gooIfMatch,
623− gooIfNoneMatch,
624− fmap formatRFC1123 . gooIfUnmodifiedSince,
625− fmap formatRFC1123 . gooIfModifiedSince
626− ]
627− rangeHdr =
628− maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
629− gooRange goo
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− }
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+
639525
640526-- | A data-type for events that can occur in the object storage
641527-- server. Reference:
642528-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
643−data Event
644− = ObjectCreated
645− | ObjectCreatedPut
646− | ObjectCreatedPost
647− | ObjectCreatedCopy
648− | ObjectCreatedMultipartUpload
649− | ObjectRemoved
650− | ObjectRemovedDelete
651− | ObjectRemovedDeleteMarkerCreated
652− | ReducedRedundancyLostObject
653− deriving stock (Eq, Show)
654−
655−instance ToText Event where
656− toText ObjectCreated = "s3:ObjectCreated:*"
657− toText ObjectCreatedPut = "s3:ObjectCreated:Put"
658− toText ObjectCreatedPost = "s3:ObjectCreated:Post"
659− toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
660− toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
661− toText ObjectRemoved = "s3:ObjectRemoved:*"
662− toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
663− toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
664− toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
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"
665550
666551textToEvent :: Text -> Maybe Event
667552textToEvent t = case t of
668− "s3:ObjectCreated:*" -> Just ObjectCreated
669− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
670− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
671− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
672− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
673− "s3:ObjectRemoved:*" -> Just ObjectRemoved
674− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
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
675560 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
676− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
677− _ -> Nothing
561+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
562+ _ -> Nothing
563+
678564
679565-- | Filter data type - part of notification configuration
680−newtype Filter = Filter
566+data Filter = Filter
681567 { fFilter :: FilterKey
682− }
683− deriving stock (Show, Eq)
568+ } deriving (Show, Eq)
684569
685570-- | defaultFilter is empty, used to create a notification
686571-- configuration.
@@ -688,10 +573,9 @@ defaultFilter :: Filter
688573defaultFilter = Filter defaultFilterKey
689574
690575-- | FilterKey contains FilterRules, and is part of a Filter.
691−newtype FilterKey = FilterKey
576+data FilterKey = FilterKey
692577 { fkKey :: FilterRules
693− }
694− deriving stock (Show, Eq)
578+ } deriving (Show, Eq)
695579
696580-- | defaultFilterKey is empty, used to create notification
697581-- configuration.
@@ -699,16 +583,16 @@ defaultFilterKey :: FilterKey
699583defaultFilterKey = FilterKey defaultFilterRules
700584
701585-- | FilterRules represents a collection of `FilterRule`s.
702−newtype FilterRules = FilterRules
586+data FilterRules = FilterRules
703587 { frFilterRules :: [FilterRule]
704− }
705− deriving stock (Show, Eq)
588+ } deriving (Show, Eq)
706589
707590-- | defaultFilterRules is empty, used to create notification
708591-- configuration.
709592defaultFilterRules :: FilterRules
710593defaultFilterRules = FilterRules []
711594
595+
712596-- | A filter rule that can act based on the suffix or prefix of an
713597-- object. As an example, let's create two filter rules:
714598--
@@ -719,10 +603,9 @@ defaultFilterRules = FilterRules []
719603-- for objects having a suffix of ".jpg", and the @prefixRule@
720604-- restricts it to objects having a prefix of "images/".
721605data FilterRule = FilterRule
722− { frName :: Text,
723− frValue :: Text
724− }
725− deriving stock (Show, Eq)
606+ { frName :: Text
607+ , frValue :: Text
608+ } deriving (Show, Eq)
726609
727610-- | Arn is an alias of Text
728611type Arn = Text
@@ -731,12 +614,11 @@ type Arn = Text
731614-- notification system. It could represent a Queue, Topic or Lambda
732615-- Function configuration.
733616data NotificationConfig = NotificationConfig
734− { ncId :: Text,
735− ncArn :: Arn,
736− ncEvents :: [Event],
737− ncFilter :: Filter
738− }
739− deriving stock (Show, Eq)
617+ { ncId :: Text
618+ , ncArn :: Arn
619+ , ncEvents :: [Event]
620+ , ncFilter :: Filter
621+ } deriving (Show, Eq)
740622
741623-- | A data-type to represent bucket notification configuration. It is
742624-- a collection of queue, topic or lambda function configurations. The
@@ -744,16 +626,16 @@ data NotificationConfig = NotificationConfig
744626-- described at
745627-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
746628data Notification = Notification
747− { nQueueConfigurations :: [NotificationConfig],
748− nTopicConfigurations :: [NotificationConfig],
749− nCloudFunctionConfigurations :: [NotificationConfig]
750− }
751− deriving stock (Show, Eq)
629+ { nQueueConfigurations :: [NotificationConfig]
630+ , nTopicConfigurations :: [NotificationConfig]
631+ , nCloudFunctionConfigurations :: [NotificationConfig]
632+ } deriving (Eq, Show)
752633
753634-- | The default notification configuration is empty.
754635defaultNotification :: Notification
755636defaultNotification = Notification [] [] []
756637
638+
757639--------------------------------------------------------------------------
758640-- Select API Related Types
759641--------------------------------------------------------------------------
@@ -761,42 +643,38 @@ defaultNotification = Notification [] [] []
761643-- | SelectRequest represents the Select API call. Use the
762644-- `selectRequest` function to create a value of this type.
763645data SelectRequest = SelectRequest
764− { srExpression :: Text,
765− srExpressionType :: ExpressionType,
766− srInputSerialization :: InputSerialization,
767− srOutputSerialization :: OutputSerialization,
768− srRequestProgressEnabled :: Maybe Bool
769− }
770− deriving stock (Show, Eq)
646+ { srExpression :: Text
647+ , srExpressionType :: ExpressionType
648+ , srInputSerialization :: InputSerialization
649+ , srOutputSerialization :: OutputSerialization
650+ , srRequestProgressEnabled :: Maybe Bool
651+ } deriving (Eq, Show)
771652
772653data ExpressionType = SQL
773− deriving stock (Show, Eq)
654+ deriving (Eq, Show)
774655
775656-- | InputSerialization represents format information of the input
776657-- object being queried. Use one of the smart constructors such as
777658-- `defaultCsvInput` as a starting value, and add compression info
778659-- using `setInputCompressionType`
779660data InputSerialization = InputSerialization
780− { isCompressionType :: Maybe CompressionType,
781− isFormatInfo :: InputFormatInfo
782− }
783− deriving stock (Show, Eq)
661+ { isCompressionType :: Maybe CompressionType
662+ , isFormatInfo :: InputFormatInfo
663+ } deriving (Eq, Show)
784664
785665-- | Data type representing the compression setting in a Select
786666-- request.
787−data CompressionType
788− = CompressionTypeNone
789− | CompressionTypeGzip
790− | CompressionTypeBzip2
791− deriving stock (Show, Eq)
667+data CompressionType = CompressionTypeNone
668+ | CompressionTypeGzip
669+ | CompressionTypeBzip2
670+ deriving (Eq, Show)
792671
793672-- | Data type representing input object format information in a
794673-- Select request.
795−data InputFormatInfo
796− = InputFormatCSV CSVInputProp
797− | InputFormatJSON JSONInputProp
798− | InputFormatParquet
799− deriving stock (Show, Eq)
674+data InputFormatInfo = InputFormatCSV CSVInputProp
675+ | InputFormatJSON JSONInputProp
676+ | InputFormatParquet
677+ deriving (Eq, Show)
800678
801679-- | defaultCsvInput returns InputSerialization with default CSV
802680-- format, and without any compression setting.
@@ -806,18 +684,14 @@ defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
806684-- | linesJsonInput returns InputSerialization with JSON line based
807685-- format with no compression setting.
808686linesJsonInput :: InputSerialization
809−linesJsonInput =
810− InputSerialization
811− Nothing
812− (InputFormatJSON $ JSONInputProp JSONTypeLines)
687+linesJsonInput = InputSerialization Nothing
688+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
813689
814690-- | documentJsonInput returns InputSerialization with JSON document
815691-- based format with no compression setting.
816692documentJsonInput :: InputSerialization
817−documentJsonInput =
818− InputSerialization
819− Nothing
820− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
693+documentJsonInput = InputSerialization Nothing
694+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
821695
822696-- | defaultParquetInput returns InputSerialization with Parquet
823697-- format, and no compression setting.
@@ -826,14 +700,12 @@ defaultParquetInput = InputSerialization Nothing InputFormatParquet
826700
827701-- | setInputCompressionType sets the compression type for the input
828702-- of the SelectRequest
829−setInputCompressionType ::
830− CompressionType ->
831− SelectRequest ->
832− SelectRequest
703+setInputCompressionType :: CompressionType -> SelectRequest
704+ -> SelectRequest
833705setInputCompressionType c i =
834− let is = srInputSerialization i
835− is' = is {isCompressionType = Just c}
836− in i {srInputSerialization = is'}
706+ let is = srInputSerialization i
707+ is' = is { isCompressionType = Just c }
708+ in i { srInputSerialization = is' }
837709
838710-- | defaultCsvOutput returns OutputSerialization with default CSV
839711-- format.
@@ -850,42 +722,40 @@ defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
850722-- SelectRequest with the SQL query text given by @query@, the input
851723-- serialization settings (compression format and format information)
852724-- @inputSer@ and the output serialization settings @outputSer@.
853−selectRequest ::
854− Text ->
855− InputSerialization ->
856− OutputSerialization ->
857− SelectRequest
725+selectRequest :: Text -> InputSerialization -> OutputSerialization
726+ -> SelectRequest
858727selectRequest sqlQuery inputSer outputSer =
859− SelectRequest
860− { srExpression = sqlQuery,
861− srExpressionType = SQL,
862− srInputSerialization = inputSer,
863− srOutputSerialization = outputSer,
864− srRequestProgressEnabled = Nothing
865− }
728+ SelectRequest { srExpression = sqlQuery
729+ , srExpressionType = SQL
730+ , srInputSerialization = inputSer
731+ , srOutputSerialization = outputSer
732+ , srRequestProgressEnabled = Nothing
733+ }
866734
867735-- | setRequestProgressEnabled sets the flag for turning on progress
868736-- messages when the Select response is being streamed back to the
869737-- client.
870738setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
871739setRequestProgressEnabled enabled sr =
872− sr {srRequestProgressEnabled = Just enabled}
740+ sr { srRequestProgressEnabled = Just enabled }
873741
874742type CSVInputProp = CSVProp
875743
876744-- | CSVProp represents CSV format properties. It is built up using
877745-- the Monoid instance.
878−newtype CSVProp = CSVProp (H.HashMap Text Text)
879− deriving stock (Show, Eq)
746+data CSVProp = CSVProp (H.HashMap Text Text)
747+ deriving (Eq, Show)
880748
749+#if (__GLASGOW_HASKELL__ >= 804)
881750instance Semigroup CSVProp where
882− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
751+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
752+#endif
883753
884754instance Monoid CSVProp where
885− mempty = CSVProp mempty
886−
887−csvPropsList :: CSVProp -> [(Text, Text)]
888−csvPropsList (CSVProp h) = sort $ H.toList h
755+ mempty = CSVProp mempty
756+#if (__GLASGOW_HASKELL__ < 804)
757+ mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
758+#endif
889759
890760defaultCSVProp :: CSVProp
891761defaultCSVProp = mempty
@@ -909,21 +779,18 @@ quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
909779-- | FileHeaderInfo specifies information about column headers for CSV
910780-- format.
911781data FileHeaderInfo
912− = -- | No column headers are present
913− FileHeaderNone
914− | -- | Headers are present and they should be used
915− FileHeaderUse
916− | -- | Header are present, but should be ignored
917− FileHeaderIgnore
918− deriving stock (Show, Eq)
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)
919786
920787-- | Specify the CSV file header info property.
921788fileHeaderInfo :: FileHeaderInfo -> CSVProp
922−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
789+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
923790 where
924− toStr FileHeaderNone = "NONE"
925− toStr FileHeaderUse = "USE"
926− toStr FileHeaderIgnore = "IGNORE"
791+ toString FileHeaderNone = "NONE"
792+ toString FileHeaderUse = "USE"
793+ toString FileHeaderIgnore = "IGNORE"
927794
928795-- | Specify the CSV comment character property. Lines starting with
929796-- this character are ignored by the server.
@@ -936,69 +803,64 @@ allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter"
936803
937804-- | Set the CSV format properties in the InputSerialization.
938805setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
939−setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
806+setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }
940807
941808-- | Set the CSV format properties in the OutputSerialization.
942809outputCSVFromProps :: CSVProp -> OutputSerialization
943−outputCSVFromProps = OutputSerializationCSV
810+outputCSVFromProps p = OutputSerializationCSV p
944811
945−newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946− deriving stock (Show, Eq)
812+data JSONInputProp = JSONInputProp { jsonipType :: JSONType }
813+ deriving (Eq, Show)
947814
948815data JSONType = JSONTypeDocument | JSONTypeLines
949− deriving stock (Show, Eq)
816+ deriving (Eq, Show)
817+
950818
951819-- | OutputSerialization represents output serialization settings for
952820-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
953821-- a starting point.
954−data OutputSerialization
955− = OutputSerializationJSON JSONOutputProp
956− | OutputSerializationCSV CSVOutputProp
957− deriving stock (Show, Eq)
822+data OutputSerialization = OutputSerializationJSON JSONOutputProp
823+ | OutputSerializationCSV CSVOutputProp
824+ deriving (Eq, Show)
958825
959826type CSVOutputProp = CSVProp
960827
961828-- | quoteFields is an output serialization parameter
962829quoteFields :: QuoteFields -> CSVProp
963−quoteFields q = CSVProp $
964− H.singleton "QuoteFields" $
965− case q of
966− QuoteFieldsAsNeeded -> "ASNEEDED"
967− QuoteFieldsAlways -> "ALWAYS"
830+quoteFields q = CSVProp $ H.singleton "QuoteFields" $
831+ case q of
832+ QuoteFieldsAsNeeded -> "ASNEEDED"
833+ QuoteFieldsAlways -> "ALWAYS"
968834
969835-- | Represent the QuoteField setting.
970836data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
971− deriving stock (Show, Eq)
837+ deriving (Eq, Show)
972838
973−newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974− deriving stock (Show, Eq)
839+data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }
840+ deriving (Eq, Show)
975841
976842-- | Set the output record delimiter for JSON format
977843outputJSONFromRecordDelimiter :: Text -> OutputSerialization
978844outputJSONFromRecordDelimiter t =
979− OutputSerializationJSON (JSONOutputProp $ Just t)
845+ OutputSerializationJSON (JSONOutputProp $ Just t)
980846
981847-- Response related types
982848
983849-- | An EventMessage represents each kind of message received from the server.
984−data EventMessage
985− = ProgressEventMessage Progress
986− | StatsEventMessage Stats
987− | RequestLevelErrorMessage
988− Text
989− -- ^ Error code
990− Text
991− -- ^ Error message
992− | RecordPayloadEventMessage ByteString
993− deriving stock (Show, Eq)
994−
995−data MsgHeaderName
996− = MessageType
997− | EventType
998− | ContentType
999− | ErrorCode
1000− | ErrorMessage
1001− deriving stock (Show, Eq)
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)
1002864
1003865msgHeaderValueType :: Word8
1004866msgHeaderValueType = 7
@@ -1006,12 +868,11 @@ msgHeaderValueType = 7
1006868type MessageHeader = (MsgHeaderName, Text)
1007869
1008870-- | Represent the progress event returned in the Select response.
1009−data Progress = Progress
1010− { pBytesScanned :: Int64,
1011− pBytesProcessed :: Int64,
1012− pBytesReturned :: Int64
1013− }
1014− deriving stock (Show, Eq)
871+data Progress = Progress { pBytesScanned :: Int64
872+ , pBytesProcessed :: Int64
873+ , pBytesReturned :: Int64
874+ }
875+ deriving (Eq, Show)
1015876
1016877-- | Represent the stats event returned at the end of the Select
1017878-- response.
@@ -1024,89 +885,86 @@ type Stats = Progress
1024885-- | Represents different kinds of payload that are used with S3 API
1025886-- requests.
1026887data Payload
1027− = PayloadBS ByteString
1028− | PayloadH Handle Int64 Int64 -- file handle, offset and length
1029− | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
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
1030891
1031892defaultPayload :: Payload
1032893defaultPayload = PayloadBS ""
1033894
1034−data AdminReqInfo = AdminReqInfo
1035− { ariMethod :: Method,
1036− ariPayloadHash :: Maybe ByteString,
1037− ariPayload :: Payload,
1038− ariPath :: ByteString,
1039− ariHeaders :: [Header],
1040− ariQueryParams :: Query
895+data AdminReqInfo = AdminReqInfo {
896+ ariMethod :: Method
897+ , ariPayloadHash :: Maybe ByteString
898+ , ariPayload :: Payload
899+ , ariPath :: ByteString
900+ , ariHeaders :: [Header]
901+ , ariQueryParams :: Query
1041902 }
1042903
1043904data S3ReqInfo = S3ReqInfo
1044− { riMethod :: Method,
1045− riBucket :: Maybe Bucket,
1046− riObject :: Maybe Object,
1047− riQueryParams :: Query,
1048− riHeaders :: [Header],
1049− riPayload :: Payload,
1050− riPayloadHash :: Maybe ByteString,
1051− riRegion :: Maybe Region,
1052− riNeedsLocation :: Bool,
1053− riPresignExpirySecs :: Maybe UrlExpiry
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
1054914 }
1055915
1056916defaultS3ReqInfo :: S3ReqInfo
1057−defaultS3ReqInfo =
1058− S3ReqInfo
1059− HT.methodGet
1060− Nothing
1061− Nothing
1062− []
1063− []
1064− defaultPayload
1065− Nothing
1066− Nothing
1067− True
1068− Nothing
917+defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
918+ [] [] defaultPayload Nothing Nothing True
1069919
1070920getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
1071921getS3Path b o =
1072− let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073− in B.concat ["/", B.intercalate "/" segments]
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
1074929
1075−type RegionMap = H.HashMap Bucket Region
930+type RegionMap = Map.Map Bucket Region
1076931
1077932-- | The Minio Monad - all computations accessing object storage
1078933-- happens in it.
1079−newtype Minio a = Minio
1080− { unMinio :: ReaderT MinioConn (ResourceT IO) a
934+newtype Minio a = Minio {
935+ unMinio :: ReaderT MinioConn (ResourceT IO) a
1081936 }
1082− deriving newtype
1083− ( Functor,
1084− Applicative,
1085− Monad,
1086− MonadIO,
1087− MonadReader MinioConn,
1088− MonadResource,
1089− MonadUnliftIO
937+ deriving (
938+ Functor
939+ , Applicative
940+ , Monad
941+ , MonadIO
942+ , MonadReader MinioConn
943+ , MonadResource
1090944 )
1091945
946+instance MonadUnliftIO Minio where
947+ askUnliftIO = Minio $ ReaderT $ \r ->
948+ withUnliftIO $ \u ->
949+ return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))
950+
1092951-- | MinioConn holds connection info and a connection pool to allow
1093952-- for efficient resource re-use.
1094953data MinioConn = MinioConn
1095− { mcConnInfo :: ConnectInfo,
1096− mcConnManager :: NC.Manager,
1097− mcRegionMap :: MVar RegionMap
954+ { mcConnInfo :: ConnectInfo
955+ , mcConnManager :: NC.Manager
956+ , mcRegionMap :: MVar RegionMap
1098957 }
1099958
1100959class HasSvcNamespace env where
1101960 getSvcNamespace :: env -> Text
1102961
1103962instance HasSvcNamespace MinioConn where
1104− getSvcNamespace env =
1105− let host = connectHost $ mcConnInfo env
1106− in ( if host == "storage.googleapis.com"
1107− then "http://doc.s3.amazonaws.com/2006-03-01"
1108− else "http://s3.amazonaws.com/doc/2006-03-01/"
1109− )
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/"
1110968
1111969-- | Takes connection information and returns a connection object to
1112970-- be passed to 'runMinio'. The returned value can be kept in the
@@ -1114,16 +972,11 @@ instance HasSvcNamespace MinioConn where
1114972-- object storage is accessed.
1115973connect :: ConnectInfo -> IO MinioConn
1116974connect ci = do
1117− let settings
1118− | connectIsSecure ci && connectDisableTLSCertValidation ci =
1119− let badTlsSettings =
1120− case def of
1121− tlsSettings@Conn.TLSSettingsSimple {} ->
1122− tlsSettings {Conn.settingDisableCertificateValidation = True}
1123− _ -> def
1124− in TLS.mkManagerSettings badTlsSettings Nothing
1125− | connectIsSecure ci = NC.tlsManagerSettings
1126− | otherwise = defaultManagerSettings
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
1127980 mgr <- NC.newManager settings
1128981 mkMinioConn ci mgr
1129982
@@ -1131,61 +984,35 @@ connect ci = do
1131984-- `MinioConn`. This reuses connections, but otherwise it is similar
1132985-- to `runMinio`.
1133986runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
1134−runMinioWith conn m = runResourceT $ runMinioResWith conn m
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
1135999
11361000-- | Given `ConnectInfo` and a HTTP connection manager, create a
11371001-- `MinioConn`.
11381002mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
11391003mkMinioConn ci mgr = do
1140− rMapMVar <- M.newMVar H.empty
1141− return $ MinioConn ci mgr rMapMVar
1004+ rMapMVar <- M.newMVar Map.empty
1005+ return $ MinioConn ci mgr rMapMVar
11421006
11431007-- | Run the Minio action and return the result or an error.
11441008runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
11451009runMinio ci m = do
11461010 conn <- connect ci
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
1011+ runMinioWith conn m
11651012
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
1013+s3Name :: Text -> Text -> Name
1014+s3Name ns s = Name s (Just ns) Nothing
11721015
11731016-- | Format as per RFC 1123.
11741017formatRFC1123 :: UTCTime -> T.Text
11751018formatRFC1123 = 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