@@ -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,6 +16,7 @@
1616{-# LANGUAGE CPP #-}
1717{-# LANGUAGE GADTs #-}
1818{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19+{-# LANGUAGE StrictData #-}
1920{-# LANGUAGE TypeFamilies #-}
2021
2122module Network.Minio.Data where
@@ -34,9 +35,10 @@ import qualified Data.Aeson as A
3435import qualified Data.ByteArray as BA
3536import qualified Data.ByteString as B
3637import qualified Data.ByteString.Lazy as LB
37−import Data.CaseInsensitive (mk)
38+import Data.Default.Class (def)
3839import qualified Data.HashMap.Strict as H
3940import qualified Data.Ini as Ini
41+import qualified Data.List as List
4042import qualified Data.Text as T
4143import qualified Data.Text.Encoding as TE
4244import Data.Time (defaultTimeLocale, formatTime)
@@ -53,6 +55,7 @@ import Network.HTTP.Types
5355 hRange,
5456 )
5557import qualified Network.HTTP.Types as HT
58+import Network.Minio.Credentials
5659import Network.Minio.Data.Crypto
5760 ( encodeToBase64,
5861 hashMD5ToBase64,
@@ -62,11 +65,12 @@ import Network.Minio.Errors
6265 ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
6366 MinioErr (..),
6467 )
68+import Network.Minio.Utils
6569import System.Directory (doesFileExist, getHomeDirectory)
6670import qualified System.Environment as Env
6771import System.FilePath.Posix (combine)
68−import Text.XML (Name (Name))
6972import qualified UnliftIO as U
73+import qualified UnliftIO.MVar as UM
7074
7175-- | max obj size is 5TiB
7276maxObjectSize :: Int64
@@ -97,13 +101,29 @@ awsRegionMap =
97101 ("us-west-2", "s3.us-west-2.amazonaws.com"),
98102 ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
99103 ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104+ ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
100105 ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
101106 ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107+ ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
102108 ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
103109 ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110+ ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
104111 ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
105112 ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113+ ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
106114 ("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"),
107127 ("sa-east-1", "s3.sa-east-1.amazonaws.com")
108128 ]
109129
@@ -115,14 +135,15 @@ awsRegionMap =
115135data ConnectInfo = ConnectInfo
116136 { connectHost :: Text,
117137 connectPort :: Int,
118− connectAccessKey :: Text,
119− connectSecretKey :: Text,
138+ connectCreds :: Creds,
120139 connectIsSecure :: Bool,
121140 connectRegion :: Region,
122141 connectAutoDiscoverRegion :: Bool,
123142 connectDisableTLSCertValidation :: Bool
124143 }
125− deriving stock (Eq, Show)
144+
145+getEndpoint :: ConnectInfo -> Endpoint
146+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
126147
127148instance IsString ConnectInfo where
128149 fromString str =
@@ -130,38 +151,33 @@ instance IsString ConnectInfo where
130151 in ConnectInfo
131152 { connectHost = TE.decodeUtf8 $ NC.host req,
132153 connectPort = NC.port req,
133− connectAccessKey = "",
134− connectSecretKey = "",
154+ connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
135155 connectIsSecure = NC.secure req,
136156 connectRegion = "",
137157 connectAutoDiscoverRegion = True,
138158 connectDisableTLSCertValidation = False
139159 }
140160
141−-- | Contains access key and secret key to access object storage.
142−data Credentials = Credentials
143− { cAccessKey :: Text,
144− cSecretKey :: Text
145− }
146− deriving stock (Eq, Show)
147−
148−-- | A Provider is an action that may return Credentials. Providers
149−-- may be chained together using 'findFirst'.
150−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)
151166
152−-- | Combines the given list of providers, by calling each one in
153−-- order until Credentials are found.
154−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)
155170findFirst [] = return Nothing
156171findFirst (f : fs) = do
157172 c <- f
158173 maybe (findFirst fs) (return . Just) c
159174
160−-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
161−fromAWSConfigFile :: Provider
175+-- | This action returns a 'CredentialValue' populated from
176+-- @~\/.aws\/credentials@
177+fromAWSConfigFile :: CredentialLoader
162178fromAWSConfigFile = do
163179 credsE <- runExceptT $ do
164− homeDir <- lift $ getHomeDirectory
180+ homeDir <- lift getHomeDirectory
165181 let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
166182 fileExists <- lift $ doesFileExist awsCredsFile
167183 bool (throwE "FileNotFound") (return ()) fileExists
@@ -174,44 +190,50 @@ fromAWSConfigFile = do
174190 ExceptT $
175191 return $
176192 Ini.lookupValue "default" "aws_secret_access_key" ini
177− return $ Credentials akey skey
193+ return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
178194 return $ either (const Nothing) Just credsE
179195
180−-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
181−-- @AWS_SECRET_ACCESS_KEY@ environment variables.
182−fromAWSEnv :: Provider
196+-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
197+-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
198+fromAWSEnv :: CredentialLoader
183199fromAWSEnv = runMaybeT $ do
184200 akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
185201 skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
186− return $ Credentials (T.pack akey) (T.pack skey)
202+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
187203
188−-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
189−-- @MINIO_SECRET_KEY@ environment variables.
190−fromMinioEnv :: Provider
204+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205+-- and @MINIO_SECRET_KEY@ environment variables.
206+fromMinioEnv :: CredentialLoader
191207fromMinioEnv = runMaybeT $ do
192208 akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
193209 skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
194− return $ Credentials (T.pack akey) (T.pack skey)
210+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
195211
196−-- | setCredsFrom retrieves access credentials from the first
197−-- `Provider` form the given list that succeeds and sets it in the
198−-- `ConnectInfo`.
199−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
200215setCredsFrom ps ci = do
201216 pMay <- findFirst ps
202217 maybe
203218 (throwIO MErrVMissingCredentials)
204− (return . (flip setCreds ci))
219+ (return . (`setCreds` ci))
205220 pMay
206221
207−-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
208−setCreds :: Credentials -> ConnectInfo -> ConnectInfo
209−setCreds (Credentials accessKey secretKey) connInfo =
222+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224+setCreds cv connInfo =
210225 connInfo
211− { connectAccessKey = accessKey,
212− connectSecretKey = secretKey
226+ { connectCreds = CredsStatic cv
213227 }
214228
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+
215237-- | Set the S3 region parameter in the `ConnectInfo`
216238setRegion :: Region -> ConnectInfo -> ConnectInfo
217239setRegion r connInfo =
@@ -233,15 +255,7 @@ disableTLSCertValidation :: ConnectInfo -> ConnectInfo
233255disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
234256
235257getHostAddr :: ConnectInfo -> ByteString
236−getHostAddr ci =
237− if
238− | port == 80 || port == 443 -> encodeUtf8 host
239− | otherwise ->
240− encodeUtf8 $
241− T.concat [host, ":", show port]
242− where
243− port = connectPort ci
244− host = connectHost ci
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
245259
246260-- | Default Google Compute Storage ConnectInfo. Works only for
247261-- "Simple Migration" use-case with interoperability mode enabled on
@@ -264,7 +278,7 @@ awsCI = "https://s3.amazonaws.com"
264278-- ConnectInfo. Credentials are already filled in.
265279minioPlayCI :: ConnectInfo
266280minioPlayCI =
267− let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
281+ let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
268282 in setCreds playCreds $
269283 setRegion
270284 "us-east-1"
@@ -291,7 +305,7 @@ newtype SSECKey = SSECKey BA.ScrubbedBytes
291305
292306-- | Validates that the given ByteString is 32 bytes long and creates
293307-- an encryption key.
294−mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
308+mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
295309mkSSECKey keyBytes
296310 | B.length keyBytes /= 32 =
297311 throwM MErrVInvalidEncryptionKeyLength
@@ -308,7 +322,7 @@ data SSE where
308322 -- argument is the optional KMS context that must have a
309323 -- `A.ToJSON` instance - please refer to the AWS S3 documentation
310324 -- for detailed information.
311− SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
325+ SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
312326 -- | Specifies server-side encryption with customer provided
313327 -- key. The argument is the encryption key to be used.
314328 SSEC :: SSECKey -> SSE
@@ -366,28 +380,10 @@ data PutObjectOptions = PutObjectOptions
366380defaultPutObjectOptions :: PutObjectOptions
367381defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
368382
369−-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
370−-- stripped and a Just is returned.
371−userMetadataHeaderNameMaybe :: Text -> Maybe Text
372−userMetadataHeaderNameMaybe k =
373− let prefix = T.toCaseFold "X-Amz-Meta-"
374− n = T.length prefix
375− in if T.toCaseFold (T.take n k) == prefix
376− then Just (T.drop n k)
377− else Nothing
378−
379−addXAmzMetaPrefix :: Text -> Text
380−addXAmzMetaPrefix s
381− | isJust (userMetadataHeaderNameMaybe s) = s
382− | otherwise = "X-Amz-Meta-" <> s
383−
384−mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
385−mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y))
386−
387383pooToHeaders :: PutObjectOptions -> [HT.Header]
388384pooToHeaders poo =
389385 userMetadata
390− ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))
386+ ++ mapMaybe tupToMaybe (zip names values)
391387 ++ maybe [] toPutObjectHeaders (pooSSE poo)
392388 where
393389 tupToMaybe (k, Just v) = Just (k, v)
@@ -423,6 +419,29 @@ data BucketInfo = BucketInfo
423419-- | A type alias to represent a part-number for multipart upload
424420type PartNumber = Int16
425421
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+
426445-- | A type alias to represent an upload-id for multipart upload
427446type UploadId = Text
428447
@@ -587,7 +606,8 @@ defaultGetObjectOptions =
587606
588607gooToHeaders :: GetObjectOptions -> [HT.Header]
589608gooToHeaders goo =
590− rangeHdr ++ zip names values
609+ rangeHdr
610+ ++ zip names values
591611 ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
592612 where
593613 names =
@@ -657,7 +677,7 @@ textToEvent t = case t of
657677 _ -> Nothing
658678
659679-- | Filter data type - part of notification configuration
660−data Filter = Filter
680+newtype Filter = Filter
661681 { fFilter :: FilterKey
662682 }
663683 deriving stock (Show, Eq)
@@ -668,7 +688,7 @@ defaultFilter :: Filter
668688defaultFilter = Filter defaultFilterKey
669689
670690-- | FilterKey contains FilterRules, and is part of a Filter.
671−data FilterKey = FilterKey
691+newtype FilterKey = FilterKey
672692 { fkKey :: FilterRules
673693 }
674694 deriving stock (Show, Eq)
@@ -679,7 +699,7 @@ defaultFilterKey :: FilterKey
679699defaultFilterKey = FilterKey defaultFilterRules
680700
681701-- | FilterRules represents a collection of `FilterRule`s.
682−data FilterRules = FilterRules
702+newtype FilterRules = FilterRules
683703 { frFilterRules :: [FilterRule]
684704 }
685705 deriving stock (Show, Eq)
@@ -855,21 +875,15 @@ type CSVInputProp = CSVProp
855875
856876-- | CSVProp represents CSV format properties. It is built up using
857877-- the Monoid instance.
858−data CSVProp = CSVProp (H.HashMap Text Text)
878+newtype CSVProp = CSVProp (H.HashMap Text Text)
859879 deriving stock (Show, Eq)
860880
861−#if (__GLASGOW_HASKELL__ >= 804)
862881instance Semigroup CSVProp where
863− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
864−#endif
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
865883
866884instance Monoid CSVProp where
867885 mempty = CSVProp mempty
868886
869−#if (__GLASGOW_HASKELL__ < 804)
870− mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)
871−#endif
872−
873887csvPropsList :: CSVProp -> [(Text, Text)]
874888csvPropsList (CSVProp h) = sort $ H.toList h
875889
@@ -926,9 +940,9 @@ setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
926940
927941-- | Set the CSV format properties in the OutputSerialization.
928942outputCSVFromProps :: CSVProp -> OutputSerialization
929−outputCSVFromProps p = OutputSerializationCSV p
943+outputCSVFromProps = OutputSerializationCSV
930944
931−data JSONInputProp = JSONInputProp {jsonipType :: JSONType}
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
932946 deriving stock (Show, Eq)
933947
934948data JSONType = JSONTypeDocument | JSONTypeLines
@@ -956,7 +970,7 @@ quoteFields q = CSVProp $
956970data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
957971 deriving stock (Show, Eq)
958972
959−data JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
960974 deriving stock (Show, Eq)
961975
962976-- | Set the output record delimiter for JSON format
@@ -968,13 +982,14 @@ outputJSONFromRecordDelimiter t =
968982
969983-- | An EventMessage represents each kind of message received from the server.
970984data EventMessage
971− = ProgressEventMessage {emProgress :: Progress}
972− | StatsEventMessage {emStats :: Stats}
985+ = ProgressEventMessage Progress
986+ | StatsEventMessage Stats
973987 | RequestLevelErrorMessage
974− { emErrorCode :: Text,
975− emErrorMessage :: Text
976− }
977− | RecordPayloadEventMessage {emPayloadBytes :: ByteString}
988+ Text
989+ -- ^ Error code
990+ Text
991+ -- ^ Error message
992+ | RecordPayloadEventMessage ByteString
978993 deriving stock (Show, Eq)
979994
980995data MsgHeaderName
@@ -1088,11 +1103,10 @@ class HasSvcNamespace env where
10881103instance HasSvcNamespace MinioConn where
10891104 getSvcNamespace env =
10901105 let host = connectHost $ mcConnInfo env
1091− in if
1092− | host == "storage.googleapis.com" ->
1093− "http://doc.s3.amazonaws.com/2006-03-01"
1094− | otherwise ->
1095− "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+ )
10961110
10971111-- | Takes connection information and returns a connection object to
10981112-- be passed to 'runMinio'. The returned value can be kept in the
@@ -1102,7 +1116,11 @@ connect :: ConnectInfo -> IO MinioConn
11021116connect ci = do
11031117 let settings
11041118 | connectIsSecure ci && connectDisableTLSCertValidation ci =
1105− let badTlsSettings = Conn.TLSSettingsSimple True False False
1119+ let badTlsSettings =
1120+ case def of
1121+ tlsSettings@Conn.TLSSettingsSimple {} ->
1122+ tlsSettings {Conn.settingDisableCertificateValidation = True}
1123+ _ -> def
11061124 in TLS.mkManagerSettings badTlsSettings Nothing
11071125 | connectIsSecure ci = NC.tlsManagerSettings
11081126 | otherwise = defaultManagerSettings
@@ -1152,9 +1170,22 @@ runMinioRes ci m = do
11521170 conn <- liftIO $ connect ci
11531171 runMinioResWith conn m
11541172
1155−s3Name :: Text -> Text -> Name
1156−s3Name ns s = Name s (Just ns) Nothing
1157−
11581173-- | Format as per RFC 1123.
11591174formatRFC1123 :: UTCTime -> T.Text
11601175formatRFC1123 = 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