@@ -1,5 +1,5 @@
11--
2−-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
2+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
33--
44-- Licensed under the Apache License, Version 2.0 (the "License");
55-- you may not use this file except in compliance with the License.
@@ -16,26 +16,33 @@
1616{-# LANGUAGE CPP #-}
1717{-# LANGUAGE GADTs #-}
1818{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19+{-# LANGUAGE StrictData #-}
1920{-# LANGUAGE TypeFamilies #-}
2021
2122module Network.Minio.Data where
2223
2324import qualified Conduit as C
2425import qualified Control.Concurrent.MVar as M
26+import Control.Monad.Trans.Except (throwE)
2527import Control.Monad.Trans.Resource
28+ ( MonadResource,
29+ MonadThrow (..),
30+ MonadUnliftIO,
31+ ResourceT,
32+ runResourceT,
33+ )
2634import qualified Data.Aeson as A
2735import qualified Data.ByteArray as BA
2836import qualified Data.ByteString as B
2937import qualified Data.ByteString.Lazy as LB
30−import Data.CaseInsensitive (mk)
38+import Data.Default.Class (def)
3139import qualified Data.HashMap.Strict as H
3240import qualified Data.Ini as Ini
33−import Data.String (IsString (..))
41+import qualified Data.List as List
3442import qualified Data.Text as T
3543import qualified Data.Text.Encoding as TE
3644import Data.Time (defaultTimeLocale, formatTime)
37−import GHC.Show (Show (show))
38−import Lib.Prelude
45+import Lib.Prelude (UTCTime, throwIO)
3946import qualified Network.Connection as Conn
4047import Network.HTTP.Client (defaultManagerSettings)
4148import qualified Network.HTTP.Client.TLS as TLS
@@ -48,13 +55,22 @@ import Network.HTTP.Types
4855 hRange,
4956 )
5057import qualified Network.HTTP.Types as HT
58+import Network.Minio.Credentials
5159import Network.Minio.Data.Crypto
60+ ( encodeToBase64,
61+ hashMD5ToBase64,
62+ )
63+import Network.Minio.Data.Time (UrlExpiry)
5264import Network.Minio.Errors
65+ ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
66+ MinioErr (..),
67+ )
68+import Network.Minio.Utils
5369import System.Directory (doesFileExist, getHomeDirectory)
5470import qualified System.Environment as Env
5571import System.FilePath.Posix (combine)
56−import Text.XML
5772import qualified UnliftIO as U
73+import qualified UnliftIO.MVar as UM
5874
5975-- | max obj size is 5TiB
6076maxObjectSize :: Int64
@@ -79,20 +95,36 @@ maxMultipartParts = 10000
7995awsRegionMap :: H.HashMap Text Text
8096awsRegionMap =
8197 H.fromList
82− [ ("us-east-1", "s3.amazonaws.com"),
83− ("us-east-2", "s3-us-east-2.amazonaws.com"),
84− ("us-west-1", "s3-us-west-1.amazonaws.com"),
85− ("us-west-2", "s3-us-west-2.amazonaws.com"),
86− ("ca-central-1", "s3-ca-central-1.amazonaws.com"),
87− ("ap-south-1", "s3-ap-south-1.amazonaws.com"),
88− ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com"),
89− ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com"),
90− ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com"),
91− ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com"),
92− ("eu-west-1", "s3-eu-west-1.amazonaws.com"),
93− ("eu-west-2", "s3-eu-west-2.amazonaws.com"),
94− ("eu-central-1", "s3-eu-central-1.amazonaws.com"),
95− ("sa-east-1", "s3-sa-east-1.amazonaws.com")
98+ [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
99+ ("us-east-2", "s3.us-east-2.amazonaws.com"),
100+ ("us-west-1", "s3.us-west-1.amazonaws.com"),
101+ ("us-west-2", "s3.us-west-2.amazonaws.com"),
102+ ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
103+ ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104+ ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
105+ ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
106+ ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107+ ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
108+ ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
109+ ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110+ ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
111+ ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
112+ ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113+ ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
114+ ("eu-central-1", "s3.eu-central-1.amazonaws.com"),
115+ ("eu-central-2", "s3.eu-central-2.amazonaws.com"),
116+ ("eu-south-1", "s3.eu-south-1.amazonaws.com"),
117+ ("eu-south-2", "s3.eu-south-2.amazonaws.com"),
118+ ("af-south-1", "s3.af-south-1.amazonaws.com"),
119+ ("ap-east-1", "s3.ap-east-1.amazonaws.com"),
120+ ("cn-north-1", "s3.cn-north-1.amazonaws.com.cn"),
121+ ("cn-northwest-1", "s3.cn-northwest-1.amazonaws.com.cn"),
122+ ("eu-north-1", "s3.eu-north-1.amazonaws.com"),
123+ ("me-south-1", "s3.me-south-1.amazonaws.com"),
124+ ("me-central-1", "s3.me-central-1.amazonaws.com"),
125+ ("us-gov-east-1", "s3.us-gov-east-1.amazonaws.com"),
126+ ("us-gov-west-1", "s3.us-gov-west-1.amazonaws.com"),
127+ ("sa-east-1", "s3.sa-east-1.amazonaws.com")
96128 ]
97129
98130-- | Connection Info data type. To create a 'ConnectInfo' value,
@@ -103,14 +135,15 @@ awsRegionMap =
103135data ConnectInfo = ConnectInfo
104136 { connectHost :: Text,
105137 connectPort :: Int,
106− connectAccessKey :: Text,
107− connectSecretKey :: Text,
138+ connectCreds :: Creds,
108139 connectIsSecure :: Bool,
109140 connectRegion :: Region,
110141 connectAutoDiscoverRegion :: Bool,
111142 connectDisableTLSCertValidation :: Bool
112143 }
113− deriving (Eq, Show)
144+
145+getEndpoint :: ConnectInfo -> Endpoint
146+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
114147
115148instance IsString ConnectInfo where
116149 fromString str =
@@ -118,86 +151,89 @@ instance IsString ConnectInfo where
118151 in ConnectInfo
119152 { connectHost = TE.decodeUtf8 $ NC.host req,
120153 connectPort = NC.port req,
121− connectAccessKey = "",
122− connectSecretKey = "",
154+ connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
123155 connectIsSecure = NC.secure req,
124156 connectRegion = "",
125157 connectAutoDiscoverRegion = True,
126158 connectDisableTLSCertValidation = False
127159 }
128160
129−-- | Contains access key and secret key to access object storage.
130−data Credentials = Credentials
131− { cAccessKey :: Text,
132− cSecretKey :: Text
133− }
134− deriving (Eq, Show)
135−
136−-- | A Provider is an action that may return Credentials. Providers
137−-- may be chained together using 'findFirst'.
138−type Provider = IO (Maybe Credentials)
161+-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
162+-- Loaders may be chained together using 'findFirst'.
163+--
164+-- @since 1.7.0
165+type CredentialLoader = IO (Maybe CredentialValue)
139166
140−-- | Combines the given list of providers, by calling each one in
141−-- order until Credentials are found.
142−findFirst :: [Provider] -> Provider
167+-- | Combines the given list of loaders, by calling each one in
168+-- order until a 'CredentialValue' is returned.
169+findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
143170findFirst [] = return Nothing
144171findFirst (f : fs) = do
145172 c <- f
146173 maybe (findFirst fs) (return . Just) c
147174
148−-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
149−fromAWSConfigFile :: Provider
175+-- | This action returns a 'CredentialValue' populated from
176+-- @~\/.aws\/credentials@
177+fromAWSConfigFile :: CredentialLoader
150178fromAWSConfigFile = do
151179 credsE <- runExceptT $ do
152− homeDir <- lift $ getHomeDirectory
180+ homeDir <- lift getHomeDirectory
153181 let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
154182 fileExists <- lift $ doesFileExist awsCredsFile
155183 bool (throwE "FileNotFound") (return ()) fileExists
156184 ini <- ExceptT $ Ini.readIniFile awsCredsFile
157185 akey <-
158− ExceptT $ return $
159− Ini.lookupValue "default" "aws_access_key_id" ini
186+ ExceptT $
187+ return $
188+ Ini.lookupValue "default" "aws_access_key_id" ini
160189 skey <-
161− ExceptT $ return $
162− Ini.lookupValue "default" "aws_secret_access_key" ini
163− return $ Credentials akey skey
164− return $ hush credsE
165−
166−-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
167−-- @AWS_SECRET_ACCESS_KEY@ environment variables.
168−fromAWSEnv :: Provider
190+ ExceptT $
191+ return $
192+ Ini.lookupValue "default" "aws_secret_access_key" ini
193+ return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
194+ return $ either (const Nothing) Just credsE
195+
196+-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
197+-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
198+fromAWSEnv :: CredentialLoader
169199fromAWSEnv = runMaybeT $ do
170200 akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
171201 skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
172− return $ Credentials (T.pack akey) (T.pack skey)
202+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
173203
174−-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
175−-- @MINIO_SECRET_KEY@ environment variables.
176−fromMinioEnv :: Provider
204+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205+-- and @MINIO_SECRET_KEY@ environment variables.
206+fromMinioEnv :: CredentialLoader
177207fromMinioEnv = runMaybeT $ do
178208 akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
179209 skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
180− return $ Credentials (T.pack akey) (T.pack skey)
210+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
181211
182−-- | setCredsFrom retrieves access credentials from the first
183−-- `Provider` form the given list that succeeds and sets it in the
184−-- `ConnectInfo`.
185−setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
212+-- | setCredsFrom retrieves access credentials from the first action in the
213+-- given list that succeeds and sets it in the 'ConnectInfo'.
214+setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
186215setCredsFrom ps ci = do
187216 pMay <- findFirst ps
188217 maybe
189218 (throwIO MErrVMissingCredentials)
190− (return . (flip setCreds ci))
219+ (return . (`setCreds` ci))
191220 pMay
192221
193−-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
194−setCreds :: Credentials -> ConnectInfo -> ConnectInfo
195−setCreds (Credentials accessKey secretKey) connInfo =
222+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224+setCreds cv connInfo =
196225 connInfo
197− { connectAccessKey = accessKey,
198− connectSecretKey = secretKey
226+ { connectCreds = CredsStatic cv
199227 }
200228
229+-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230+-- credentials via the STS API on demand. It is automatically refreshed on
231+-- expiry.
232+setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233+setSTSCredential p ci = do
234+ store <- initSTSCredential p
235+ return ci {connectCreds = CredsSTS store}
236+
201237-- | Set the S3 region parameter in the `ConnectInfo`
202238setRegion :: Region -> ConnectInfo -> ConnectInfo
203239setRegion r connInfo =
@@ -219,15 +255,7 @@ disableTLSCertValidation :: ConnectInfo -> ConnectInfo
219255disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
220256
221257getHostAddr :: ConnectInfo -> ByteString
222−getHostAddr ci =
223− if
224− | port == 80 || port == 443 -> toUtf8 host
225− | otherwise ->
226− toUtf8 $
227− T.concat [host, ":", Lib.Prelude.show port]
228− where
229− port = connectPort ci
230− host = connectHost ci
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
231259
232260-- | Default Google Compute Storage ConnectInfo. Works only for
233261-- "Simple Migration" use-case with interoperability mode enabled on
@@ -250,7 +278,7 @@ awsCI = "https://s3.amazonaws.com"
250278-- ConnectInfo. Credentials are already filled in.
251279minioPlayCI :: ConnectInfo
252280minioPlayCI =
253− let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
281+ let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
254282 in setCreds playCreds $
255283 setRegion
256284 "us-east-1"
@@ -273,16 +301,16 @@ type ETag = Text
273301-- | Data type to represent an object encryption key. Create one using
274302-- the `mkSSECKey` function.
275303newtype SSECKey = SSECKey BA.ScrubbedBytes
276− deriving (Eq, Show)
304+ deriving stock (Eq, Show)
277305
278306-- | Validates that the given ByteString is 32 bytes long and creates
279307-- an encryption key.
280−mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
308+mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
281309mkSSECKey keyBytes
282310 | B.length keyBytes /= 32 =
283− throwM MErrVInvalidEncryptionKeyLength
311+ throwM MErrVInvalidEncryptionKeyLength
284312 | otherwise =
285− return $ SSECKey $ BA.convert keyBytes
313+ return $ SSECKey $ BA.convert keyBytes
286314
287315-- | Data type to represent Server-Side-Encryption settings
288316data SSE where
@@ -294,7 +322,7 @@ data SSE where
294322 -- argument is the optional KMS context that must have a
295323 -- `A.ToJSON` instance - please refer to the AWS S3 documentation
296324 -- for detailed information.
297− SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
325+ SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
298326 -- | Specifies server-side encryption with customer provided
299327 -- key. The argument is the encryption key to be used.
300328 SSEC :: SSECKey -> SSE
@@ -352,28 +380,10 @@ data PutObjectOptions = PutObjectOptions
352380defaultPutObjectOptions :: PutObjectOptions
353381defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
354382
355−-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
356−-- stripped and a Just is returned.
357−userMetadataHeaderNameMaybe :: Text -> Maybe Text
358−userMetadataHeaderNameMaybe k =
359− let prefix = T.toCaseFold "X-Amz-Meta-"
360− n = T.length prefix
361− in if T.toCaseFold (T.take n k) == prefix
362− then Just (T.drop n k)
363− else Nothing
364−
365−addXAmzMetaPrefix :: Text -> Text
366−addXAmzMetaPrefix s
367− | isJust (userMetadataHeaderNameMaybe s) = s
368− | otherwise = "X-Amz-Meta-" <> s
369−
370−mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
371−mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y))
372−
373383pooToHeaders :: PutObjectOptions -> [HT.Header]
374384pooToHeaders poo =
375385 userMetadata
376− ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
386+ ++ mapMaybe tupToMaybe (zip names values)
377387 ++ maybe [] toPutObjectHeaders (pooSSE poo)
378388 where
379389 tupToMaybe (k, Just v) = Just (k, v)
@@ -404,11 +414,34 @@ data BucketInfo = BucketInfo
404414 { biName :: Bucket,
405415 biCreationDate :: UTCTime
406416 }
407− deriving (Show, Eq)
417+ deriving stock (Show, Eq)
408418
409419-- | A type alias to represent a part-number for multipart upload
410420type PartNumber = Int16
411421
422+-- | Select part sizes - the logic is that the minimum part-size will
423+-- be 64MiB.
424+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
425+selectPartSizes size =
426+ uncurry (List.zip3 [1 ..]) $
427+ List.unzip $
428+ loop 0 size
429+ where
430+ ceil :: Double -> Int64
431+ ceil = ceiling
432+ partSize =
433+ max
434+ minPartSize
435+ ( ceil $
436+ fromIntegral size
437+ / fromIntegral maxMultipartParts
438+ )
439+ m = partSize
440+ loop st sz
441+ | st > sz = []
442+ | st + m >= sz = [(st, sz - st)]
443+ | otherwise = (st, m) : loop (st + m) sz
444+
412445-- | A type alias to represent an upload-id for multipart upload
413446type UploadId = Text
414447
@@ -422,7 +455,7 @@ data ListPartsResult = ListPartsResult
422455 lprNextPart :: Maybe Int,
423456 lprParts :: [ObjectPartInfo]
424457 }
425− deriving (Show, Eq)
458+ deriving stock (Show, Eq)
426459
427460-- | Represents information about an object part in an ongoing
428461-- multipart upload.
@@ -432,7 +465,7 @@ data ObjectPartInfo = ObjectPartInfo
432465 opiSize :: Int64,
433466 opiModTime :: UTCTime
434467 }
435− deriving (Show, Eq)
468+ deriving stock (Show, Eq)
436469
437470-- | Represents result from a listing of incomplete uploads to a
438471-- bucket.
@@ -443,7 +476,7 @@ data ListUploadsResult = ListUploadsResult
443476 lurUploads :: [(Object, UploadId, UTCTime)],
444477 lurCPrefixes :: [Text]
445478 }
446− deriving (Show, Eq)
479+ deriving stock (Show, Eq)
447480
448481-- | Represents information about a multipart upload.
449482data UploadInfo = UploadInfo
@@ -452,7 +485,7 @@ data UploadInfo = UploadInfo
452485 uiInitTime :: UTCTime,
453486 uiSize :: Int64
454487 }
455− deriving (Show, Eq)
488+ deriving stock (Show, Eq)
456489
457490-- | Represents result from a listing of objects in a bucket.
458491data ListObjectsResult = ListObjectsResult
@@ -461,7 +494,7 @@ data ListObjectsResult = ListObjectsResult
461494 lorObjects :: [ObjectInfo],
462495 lorCPrefixes :: [Text]
463496 }
464− deriving (Show, Eq)
497+ deriving stock (Show, Eq)
465498
466499-- | Represents result from a listing of objects version 1 in a bucket.
467500data ListObjectsV1Result = ListObjectsV1Result
@@ -470,7 +503,7 @@ data ListObjectsV1Result = ListObjectsV1Result
470503 lorObjects' :: [ObjectInfo],
471504 lorCPrefixes' :: [Text]
472505 }
473− deriving (Show, Eq)
506+ deriving stock (Show, Eq)
474507
475508-- | Represents information about an object.
476509data ObjectInfo = ObjectInfo
@@ -494,7 +527,7 @@ data ObjectInfo = ObjectInfo
494527 -- user-metadata pairs)
495528 oiMetadata :: H.HashMap Text Text
496529 }
497− deriving (Show, Eq)
530+ deriving stock (Show, Eq)
498531
499532-- | Represents source object in server-side copy object
500533data SourceInfo = SourceInfo
@@ -526,7 +559,7 @@ data SourceInfo = SourceInfo
526559 -- given time.
527560 srcIfUnmodifiedSince :: Maybe UTCTime
528561 }
529− deriving (Show, Eq)
562+ deriving stock (Show, Eq)
530563
531564-- | Provide a default for `SourceInfo`
532565defaultSourceInfo :: SourceInfo
@@ -539,7 +572,7 @@ data DestinationInfo = DestinationInfo
539572 -- | Destination object key
540573 dstObject :: Text
541574 }
542− deriving (Show, Eq)
575+ deriving stock (Show, Eq)
543576
544577-- | Provide a default for `DestinationInfo`
545578defaultDestinationInfo :: DestinationInfo
@@ -573,7 +606,8 @@ defaultGetObjectOptions =
573606
574607gooToHeaders :: GetObjectOptions -> [HT.Header]
575608gooToHeaders goo =
576− rangeHdr ++ zip names values
609+ rangeHdr
610+ ++ zip names values
577611 ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
578612 where
579613 names =
@@ -616,18 +650,18 @@ data Event
616650 | ObjectRemovedDelete
617651 | ObjectRemovedDeleteMarkerCreated
618652 | ReducedRedundancyLostObject
619− deriving (Eq)
620−
621−instance Show Event where
622− show ObjectCreated = "s3:ObjectCreated:*"
623− show ObjectCreatedPut = "s3:ObjectCreated:Put"
624− show ObjectCreatedPost = "s3:ObjectCreated:Post"
625− show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
626− show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
627− show ObjectRemoved = "s3:ObjectRemoved:*"
628− show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
629− show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
630− show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
653+ deriving stock (Eq, Show)
654+
655+instance ToText Event where
656+ toText ObjectCreated = "s3:ObjectCreated:*"
657+ toText ObjectCreatedPut = "s3:ObjectCreated:Put"
658+ toText ObjectCreatedPost = "s3:ObjectCreated:Post"
659+ toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
660+ toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
661+ toText ObjectRemoved = "s3:ObjectRemoved:*"
662+ toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
663+ toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
664+ toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
631665
632666textToEvent :: Text -> Maybe Event
633667textToEvent t = case t of
@@ -643,10 +677,10 @@ textToEvent t = case t of
643677 _ -> Nothing
644678
645679-- | Filter data type - part of notification configuration
646−data Filter = Filter
680+newtype Filter = Filter
647681 { fFilter :: FilterKey
648682 }
649− deriving (Show, Eq)
683+ deriving stock (Show, Eq)
650684
651685-- | defaultFilter is empty, used to create a notification
652686-- configuration.
@@ -654,10 +688,10 @@ defaultFilter :: Filter
654688defaultFilter = Filter defaultFilterKey
655689
656690-- | FilterKey contains FilterRules, and is part of a Filter.
657−data FilterKey = FilterKey
691+newtype FilterKey = FilterKey
658692 { fkKey :: FilterRules
659693 }
660− deriving (Show, Eq)
694+ deriving stock (Show, Eq)
661695
662696-- | defaultFilterKey is empty, used to create notification
663697-- configuration.
@@ -665,10 +699,10 @@ defaultFilterKey :: FilterKey
665699defaultFilterKey = FilterKey defaultFilterRules
666700
667701-- | FilterRules represents a collection of `FilterRule`s.
668−data FilterRules = FilterRules
702+newtype FilterRules = FilterRules
669703 { frFilterRules :: [FilterRule]
670704 }
671− deriving (Show, Eq)
705+ deriving stock (Show, Eq)
672706
673707-- | defaultFilterRules is empty, used to create notification
674708-- configuration.
@@ -688,7 +722,7 @@ data FilterRule = FilterRule
688722 { frName :: Text,
689723 frValue :: Text
690724 }
691− deriving (Show, Eq)
725+ deriving stock (Show, Eq)
692726
693727-- | Arn is an alias of Text
694728type Arn = Text
@@ -702,7 +736,7 @@ data NotificationConfig = NotificationConfig
702736 ncEvents :: [Event],
703737 ncFilter :: Filter
704738 }
705− deriving (Show, Eq)
739+ deriving stock (Show, Eq)
706740
707741-- | A data-type to represent bucket notification configuration. It is
708742-- a collection of queue, topic or lambda function configurations. The
@@ -714,7 +748,7 @@ data Notification = Notification
714748 nTopicConfigurations :: [NotificationConfig],
715749 nCloudFunctionConfigurations :: [NotificationConfig]
716750 }
717− deriving (Eq, Show)
751+ deriving stock (Show, Eq)
718752
719753-- | The default notification configuration is empty.
720754defaultNotification :: Notification
@@ -733,10 +767,10 @@ data SelectRequest = SelectRequest
733767 srOutputSerialization :: OutputSerialization,
734768 srRequestProgressEnabled :: Maybe Bool
735769 }
736− deriving (Eq, Show)
770+ deriving stock (Show, Eq)
737771
738772data ExpressionType = SQL
739− deriving (Eq, Show)
773+ deriving stock (Show, Eq)
740774
741775-- | InputSerialization represents format information of the input
742776-- object being queried. Use one of the smart constructors such as
@@ -746,7 +780,7 @@ data InputSerialization = InputSerialization
746780 { isCompressionType :: Maybe CompressionType,
747781 isFormatInfo :: InputFormatInfo
748782 }
749− deriving (Eq, Show)
783+ deriving stock (Show, Eq)
750784
751785-- | Data type representing the compression setting in a Select
752786-- request.
@@ -754,7 +788,7 @@ data CompressionType
754788 = CompressionTypeNone
755789 | CompressionTypeGzip
756790 | CompressionTypeBzip2
757− deriving (Eq, Show)
791+ deriving stock (Show, Eq)
758792
759793-- | Data type representing input object format information in a
760794-- Select request.
@@ -762,7 +796,7 @@ data InputFormatInfo
762796 = InputFormatCSV CSVInputProp
763797 | InputFormatJSON JSONInputProp
764798 | InputFormatParquet
765− deriving (Eq, Show)
799+ deriving stock (Show, Eq)
766800
767801-- | defaultCsvInput returns InputSerialization with default CSV
768802-- format, and without any compression setting.
@@ -841,20 +875,17 @@ type CSVInputProp = CSVProp
841875
842876-- | CSVProp represents CSV format properties. It is built up using
843877-- the Monoid instance.
844−data CSVProp = CSVProp (H.HashMap Text Text)
845− deriving (Eq, Show)
878+newtype CSVProp = CSVProp (H.HashMap Text Text)
879+ deriving stock (Show, Eq)
846880
847−#if (__GLASGOW_HASKELL__ >= 804)
848881instance Semigroup CSVProp where
849− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
850−#endif
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
851883
852884instance Monoid CSVProp where
853885 mempty = CSVProp mempty
854886
855−#if (__GLASGOW_HASKELL__ < 804)
856− mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
857−#endif
887+csvPropsList :: CSVProp -> [(Text, Text)]
888+csvPropsList (CSVProp h) = sort $ H.toList h
858889
859890defaultCSVProp :: CSVProp
860891defaultCSVProp = mempty
@@ -884,15 +915,15 @@ data FileHeaderInfo
884915 FileHeaderUse
885916 | -- | Header are present, but should be ignored
886917 FileHeaderIgnore
887− deriving (Eq, Show)
918+ deriving stock (Show, Eq)
888919
889920-- | Specify the CSV file header info property.
890921fileHeaderInfo :: FileHeaderInfo -> CSVProp
891−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString
922+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
892923 where
893− toString FileHeaderNone = "NONE"
894− toString FileHeaderUse = "USE"
895− toString FileHeaderIgnore = "IGNORE"
924+ toStr FileHeaderNone = "NONE"
925+ toStr FileHeaderUse = "USE"
926+ toStr FileHeaderIgnore = "IGNORE"
896927
897928-- | Specify the CSV comment character property. Lines starting with
898929-- this character are ignored by the server.
@@ -909,13 +940,13 @@ setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
909940
910941-- | Set the CSV format properties in the OutputSerialization.
911942outputCSVFromProps :: CSVProp -> OutputSerialization
912−outputCSVFromProps p = OutputSerializationCSV p
943+outputCSVFromProps = OutputSerializationCSV
913944
914−data JSONInputProp = JSONInputProp {jsonipType :: JSONType}
915− deriving (Eq, Show)
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946+ deriving stock (Show, Eq)
916947
917948data JSONType = JSONTypeDocument | JSONTypeLines
918− deriving (Eq, Show)
949+ deriving stock (Show, Eq)
919950
920951-- | OutputSerialization represents output serialization settings for
921952-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
@@ -923,23 +954,24 @@ data JSONType = JSONTypeDocument | JSONTypeLines
923954data OutputSerialization
924955 = OutputSerializationJSON JSONOutputProp
925956 | OutputSerializationCSV CSVOutputProp
926− deriving (Eq, Show)
957+ deriving stock (Show, Eq)
927958
928959type CSVOutputProp = CSVProp
929960
930961-- | quoteFields is an output serialization parameter
931962quoteFields :: QuoteFields -> CSVProp
932−quoteFields q = CSVProp $ H.singleton "QuoteFields" $
933− case q of
934− QuoteFieldsAsNeeded -> "ASNEEDED"
935− QuoteFieldsAlways -> "ALWAYS"
963+quoteFields q = CSVProp $
964+ H.singleton "QuoteFields" $
965+ case q of
966+ QuoteFieldsAsNeeded -> "ASNEEDED"
967+ QuoteFieldsAlways -> "ALWAYS"
936968
937969-- | Represent the QuoteField setting.
938970data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
939− deriving (Eq, Show)
971+ deriving stock (Show, Eq)
940972
941−data JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
942− deriving (Eq, Show)
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974+ deriving stock (Show, Eq)
943975
944976-- | Set the output record delimiter for JSON format
945977outputJSONFromRecordDelimiter :: Text -> OutputSerialization
@@ -950,14 +982,15 @@ outputJSONFromRecordDelimiter t =
950982
951983-- | An EventMessage represents each kind of message received from the server.
952984data EventMessage
953− = ProgressEventMessage {emProgress :: Progress}
954− | StatsEventMessage {emStats :: Stats}
985+ = ProgressEventMessage Progress
986+ | StatsEventMessage Stats
955987 | RequestLevelErrorMessage
956− { emErrorCode :: Text,
957− emErrorMessage :: Text
958− }
959− | RecordPayloadEventMessage {emPayloadBytes :: ByteString}
960− deriving (Eq, Show)
988+ Text
989+ -- ^ Error code
990+ Text
991+ -- ^ Error message
992+ | RecordPayloadEventMessage ByteString
993+ deriving stock (Show, Eq)
961994
962995data MsgHeaderName
963996 = MessageType
@@ -965,7 +998,7 @@ data MsgHeaderName
965998 | ContentType
966999 | ErrorCode
9671000 | ErrorMessage
968− deriving (Eq, Show)
1001+ deriving stock (Show, Eq)
9691002
9701003msgHeaderValueType :: Word8
9711004msgHeaderValueType = 7
@@ -978,7 +1011,7 @@ data Progress = Progress
9781011 pBytesProcessed :: Int64,
9791012 pBytesReturned :: Int64
9801013 }
981− deriving (Eq, Show)
1014+ deriving stock (Show, Eq)
9821015
9831016-- | Represent the stats event returned at the end of the Select
9841017-- response.
@@ -1016,7 +1049,8 @@ data S3ReqInfo = S3ReqInfo
10161049 riPayload :: Payload,
10171050 riPayloadHash :: Maybe ByteString,
10181051 riRegion :: Maybe Region,
1019− riNeedsLocation :: Bool
1052+ riNeedsLocation :: Bool,
1053+ riPresignExpirySecs :: Maybe UrlExpiry
10201054 }
10211055
10221056defaultS3ReqInfo :: S3ReqInfo
@@ -1031,16 +1065,13 @@ defaultS3ReqInfo =
10311065 Nothing
10321066 Nothing
10331067 True
1068+ Nothing
10341069
10351070getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
10361071getS3Path b o =
1037− let segments = map toUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1072+ let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
10381073 in B.concat ["/", B.intercalate "/" segments]
10391074
1040−-- | Time to expire for a presigned URL. It interpreted as a number of
1041−-- seconds. The maximum duration that can be specified is 7 days.
1042−type UrlExpiry = Int
1043−
10441075type RegionMap = H.HashMap Bucket Region
10451076
10461077-- | The Minio Monad - all computations accessing object storage
@@ -1048,7 +1079,7 @@ type RegionMap = H.HashMap Bucket Region
10481079newtype Minio a = Minio
10491080 { unMinio :: ReaderT MinioConn (ResourceT IO) a
10501081 }
1051− deriving
1082+ deriving newtype
10521083 ( Functor,
10531084 Applicative,
10541085 Monad,
@@ -1072,11 +1103,10 @@ class HasSvcNamespace env where
10721103instance HasSvcNamespace MinioConn where
10731104 getSvcNamespace env =
10741105 let host = connectHost $ mcConnInfo env
1075− in if
1076− | host == "storage.googleapis.com" ->
1077− "http://doc.s3.amazonaws.com/2006-03-01"
1078− | otherwise ->
1079− "http://s3.amazonaws.com/doc/2006-03-01/"
1106+ in ( if host == "storage.googleapis.com"
1107+ then "http://doc.s3.amazonaws.com/2006-03-01"
1108+ else "http://s3.amazonaws.com/doc/2006-03-01/"
1109+ )
10801110
10811111-- | Takes connection information and returns a connection object to
10821112-- be passed to 'runMinio'. The returned value can be kept in the
@@ -1086,8 +1116,12 @@ connect :: ConnectInfo -> IO MinioConn
10861116connect ci = do
10871117 let settings
10881118 | connectIsSecure ci && connectDisableTLSCertValidation ci =
1089− let badTlsSettings = Conn.TLSSettingsSimple True False False
1090− in TLS.mkManagerSettings badTlsSettings Nothing
1119+ let badTlsSettings =
1120+ case def of
1121+ tlsSettings@Conn.TLSSettingsSimple {} ->
1122+ tlsSettings {Conn.settingDisableCertificateValidation = True}
1123+ _ -> def
1124+ in TLS.mkManagerSettings badTlsSettings Nothing
10911125 | connectIsSecure ci = NC.tlsManagerSettings
10921126 | otherwise = defaultManagerSettings
10931127 mgr <- NC.newManager settings
@@ -1136,9 +1170,22 @@ runMinioRes ci m = do
11361170 conn <- liftIO $ connect ci
11371171 runMinioResWith conn m
11381172
1139−s3Name :: Text -> Text -> Name
1140−s3Name ns s = Name s (Just ns) Nothing
1141−
11421173-- | Format as per RFC 1123.
11431174formatRFC1123 :: UTCTime -> T.Text
11441175formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1176+
1177+lookupRegionCache :: Bucket -> Minio (Maybe Region)
1178+lookupRegionCache b = do
1179+ rMVar <- asks mcRegionMap
1180+ rMap <- UM.readMVar rMVar
1181+ return $ H.lookup b rMap
1182+
1183+addToRegionCache :: Bucket -> Region -> Minio ()
1184+addToRegionCache b region = do
1185+ rMVar <- asks mcRegionMap
1186+ UM.modifyMVar_ rMVar $ return . H.insert b region
1187+
1188+deleteFromRegionCache :: Bucket -> Minio ()
1189+deleteFromRegionCache b = do
1190+ rMVar <- asks mcRegionMap
1191+ UM.modifyMVar_ rMVar $ return . H.delete b