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