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