@@ -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.
@@ -34,9 +34,9 @@ import qualified Data.Aeson as A
3434import qualified Data.ByteArray as BA
3535import qualified Data.ByteString as B
3636import qualified Data.ByteString.Lazy as LB
37−import Data.CaseInsensitive (mk)
3837import qualified Data.HashMap.Strict as H
3938import qualified Data.Ini as Ini
39+import qualified Data.List as List
4040import qualified Data.Text as T
4141import qualified Data.Text.Encoding as TE
4242import Data.Time (defaultTimeLocale, formatTime)
@@ -53,6 +53,7 @@ import Network.HTTP.Types
5353 hRange,
5454 )
5555import qualified Network.HTTP.Types as HT
56+import Network.Minio.Credentials
5657import Network.Minio.Data.Crypto
5758 ( encodeToBase64,
5859 hashMD5ToBase64,
@@ -62,11 +63,12 @@ import Network.Minio.Errors
6263 ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
6364 MinioErr (..),
6465 )
66+import Network.Minio.Utils
6567import System.Directory (doesFileExist, getHomeDirectory)
6668import qualified System.Environment as Env
6769import System.FilePath.Posix (combine)
68−import Text.XML (Name (Name))
6970import qualified UnliftIO as U
71+import qualified UnliftIO.MVar as UM
7072
7173-- | max obj size is 5TiB
7274maxObjectSize :: Int64
@@ -131,14 +133,15 @@ awsRegionMap =
131133data ConnectInfo = ConnectInfo
132134 { connectHost :: Text,
133135 connectPort :: Int,
134− connectAccessKey :: Text,
135− connectSecretKey :: Text,
136+ connectCreds :: Creds,
136137 connectIsSecure :: Bool,
137138 connectRegion :: Region,
138139 connectAutoDiscoverRegion :: Bool,
139140 connectDisableTLSCertValidation :: Bool
140141 }
141− deriving stock (Eq, Show)
142+
143+getEndpoint :: ConnectInfo -> Endpoint
144+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
142145
143146instance IsString ConnectInfo where
144147 fromString str =
@@ -146,8 +149,7 @@ instance IsString ConnectInfo where
146149 in ConnectInfo
147150 { connectHost = TE.decodeUtf8 $ NC.host req,
148151 connectPort = NC.port req,
149− connectAccessKey = "",
150− connectSecretKey = "",
152+ connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
151153 connectIsSecure = NC.secure req,
152154 connectRegion = "",
153155 connectAutoDiscoverRegion = True,
@@ -161,20 +163,21 @@ data Credentials = Credentials
161163 }
162164 deriving stock (Eq, Show)
163165
164−-- | A Provider is an action that may return Credentials. Providers
165−-- may be chained together using 'findFirst'.
166−type Provider = IO (Maybe Credentials)
166+-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
167+-- Loaders may be chained together using 'findFirst'.
168+type CredentialLoader = IO (Maybe CredentialValue)
167169
168−-- | Combines the given list of providers, by calling each one in
169−-- order until Credentials are found.
170−findFirst :: [Provider] -> Provider
170+-- | Combines the given list of loaders, by calling each one in
171+-- order until a 'CredentialValue' is returned.
172+findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
171173findFirst [] = return Nothing
172174findFirst (f : fs) = do
173175 c <- f
174176 maybe (findFirst fs) (return . Just) c
175177
176−-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
177−fromAWSConfigFile :: Provider
178+-- | This action returns a 'CredentialValue' populated from
179+-- @~\/.aws\/credentials@
180+fromAWSConfigFile :: CredentialLoader
178181fromAWSConfigFile = do
179182 credsE <- runExceptT $ do
180183 homeDir <- lift getHomeDirectory
@@ -190,29 +193,28 @@ fromAWSConfigFile = do
190193 ExceptT $
191194 return $
192195 Ini.lookupValue "default" "aws_secret_access_key" ini
193− return $ Credentials akey skey
196+ return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
194197 return $ either (const Nothing) Just credsE
195198
196−-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
197−-- @AWS_SECRET_ACCESS_KEY@ environment variables.
198−fromAWSEnv :: Provider
199+-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
200+-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
201+fromAWSEnv :: CredentialLoader
199202fromAWSEnv = runMaybeT $ do
200203 akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
201204 skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
202− return $ Credentials (T.pack akey) (T.pack skey)
205+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
203206
204−-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
205−-- @MINIO_SECRET_KEY@ environment variables.
206−fromMinioEnv :: Provider
207+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
208+-- and @MINIO_SECRET_KEY@ environment variables.
209+fromMinioEnv :: CredentialLoader
207210fromMinioEnv = runMaybeT $ do
208211 akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
209212 skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
210− return $ Credentials (T.pack akey) (T.pack skey)
213+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
211214
212−-- | setCredsFrom retrieves access credentials from the first
213−-- `Provider` form the given list that succeeds and sets it in the
214−-- `ConnectInfo`.
215−setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
215+-- | setCredsFrom retrieves access credentials from the first action in the
216+-- given list that succeeds and sets it in the 'ConnectInfo'.
217+setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
216218setCredsFrom ps ci = do
217219 pMay <- findFirst ps
218220 maybe
@@ -220,14 +222,21 @@ setCredsFrom ps ci = do
220222 (return . (`setCreds` ci))
221223 pMay
222224
223−-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
224−setCreds :: Credentials -> ConnectInfo -> ConnectInfo
225−setCreds (Credentials accessKey secretKey) connInfo =
225+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
226+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
227+setCreds cv connInfo =
226228 connInfo
227− { connectAccessKey = accessKey,
228− connectSecretKey = secretKey
229+ { connectCreds = CredsStatic cv
229230 }
230231
232+-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
233+-- credentials via the STS API on demand. It is automatically refreshed on
234+-- expiry.
235+setSTSCredential :: STSCredentialProvider p => p -> ConnectInfo -> IO ConnectInfo
236+setSTSCredential p ci = do
237+ store <- initSTSCredential p
238+ return ci {connectCreds = CredsSTS store}
239+
231240-- | Set the S3 region parameter in the `ConnectInfo`
232241setRegion :: Region -> ConnectInfo -> ConnectInfo
233242setRegion r connInfo =
@@ -248,12 +257,6 @@ isConnectInfoSecure = connectIsSecure
248257disableTLSCertValidation :: ConnectInfo -> ConnectInfo
249258disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
250259
251−getHostHeader :: (ByteString, Int) -> ByteString
252−getHostHeader (host, port) =
253− if port == 80 || port == 443
254− then host
255− else host <> ":" <> show port
256−
257260getHostAddr :: ConnectInfo -> ByteString
258261getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
259262
@@ -278,7 +281,7 @@ awsCI = "https://s3.amazonaws.com"
278281-- ConnectInfo. Credentials are already filled in.
279282minioPlayCI :: ConnectInfo
280283minioPlayCI =
281− let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
284+ let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
282285 in setCreds playCreds $
283286 setRegion
284287 "us-east-1"
@@ -380,24 +383,6 @@ data PutObjectOptions = PutObjectOptions
380383defaultPutObjectOptions :: PutObjectOptions
381384defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
382385
383−-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
384−-- stripped and a Just is returned.
385−userMetadataHeaderNameMaybe :: Text -> Maybe Text
386−userMetadataHeaderNameMaybe k =
387− let prefix = T.toCaseFold "X-Amz-Meta-"
388− n = T.length prefix
389− in if T.toCaseFold (T.take n k) == prefix
390− then Just (T.drop n k)
391− else Nothing
392−
393−addXAmzMetaPrefix :: Text -> Text
394−addXAmzMetaPrefix s
395− | isJust (userMetadataHeaderNameMaybe s) = s
396− | otherwise = "X-Amz-Meta-" <> s
397−
398−mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
399−mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix x, encodeUtf8 y))
400−
401386pooToHeaders :: PutObjectOptions -> [HT.Header]
402387pooToHeaders poo =
403388 userMetadata
@@ -437,6 +422,29 @@ data BucketInfo = BucketInfo
437422-- | A type alias to represent a part-number for multipart upload
438423type PartNumber = Int16
439424
425+-- | Select part sizes - the logic is that the minimum part-size will
426+-- be 64MiB.
427+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
428+selectPartSizes size =
429+ uncurry (List.zip3 [1 ..]) $
430+ List.unzip $
431+ loop 0 size
432+ where
433+ ceil :: Double -> Int64
434+ ceil = ceiling
435+ partSize =
436+ max
437+ minPartSize
438+ ( ceil $
439+ fromIntegral size
440+ / fromIntegral maxMultipartParts
441+ )
442+ m = partSize
443+ loop st sz
444+ | st > sz = []
445+ | st + m >= sz = [(st, sz - st)]
446+ | otherwise = (st, m) : loop (st + m) sz
447+
440448-- | A type alias to represent an upload-id for multipart upload
441449type UploadId = Text
442450
@@ -1016,47 +1024,6 @@ type Stats = Progress
10161024-- Select API Related Types End
10171025--------------------------------------------------------------------------
10181026
1019−----------------------------------------
1020−-- Credentials Start
1021−----------------------------------------
1022−
1023−newtype AccessKey = AccessKey {unAccessKey :: Text}
1024− deriving stock (Show)
1025− deriving newtype (Eq, IsString)
1026−
1027−newtype SecretKey = SecretKey {unSecretKey :: BA.ScrubbedBytes}
1028− deriving stock (Show)
1029− deriving newtype (Eq, IsString)
1030−
1031−newtype SessionToken = SessionToken {unSessionToken :: BA.ScrubbedBytes}
1032− deriving stock (Show)
1033− deriving newtype (Eq, IsString)
1034−
1035−data CredentialValue = CredentialValue
1036− { cvAccessKey :: AccessKey,
1037− cvSecretKey :: SecretKey,
1038− cvSessionToken :: Maybe SessionToken
1039− }
1040− deriving stock (Eq, Show)
1041−
1042−data AssumeRoleCredentials = AssumeRoleCredentials
1043− { arcCredentials :: CredentialValue,
1044− arcExpiration :: UTCTime
1045− }
1046− deriving stock (Show, Eq)
1047−
1048−data AssumeRoleResult = AssumeRoleResult
1049− { arrSourceIdentity :: Text,
1050− arrAssumedRoleArn :: Text,
1051− arrAssumedRoleId :: Text,
1052− arrRoleCredentials :: AssumeRoleCredentials
1053− }
1054− deriving stock (Show, Eq)
1055−
1056−----------------------------------------
1057−-- Credentials End
1058−----------------------------------------
1059−
10601027-- | Represents different kinds of payload that are used with S3 API
10611028-- requests.
10621029data Payload
@@ -1202,9 +1169,22 @@ runMinioRes ci m = do
12021169 conn <- liftIO $ connect ci
12031170 runMinioResWith conn m
12041171
1205−s3Name :: Text -> Text -> Name
1206−s3Name ns s = Name s (Just ns) Nothing
1207−
12081172-- | Format as per RFC 1123.
12091173formatRFC1123 :: UTCTime -> T.Text
12101174formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1175+
1176+lookupRegionCache :: Bucket -> Minio (Maybe Region)
1177+lookupRegionCache b = do
1178+ rMVar <- asks mcRegionMap
1179+ rMap <- UM.readMVar rMVar
1180+ return $ H.lookup b rMap
1181+
1182+addToRegionCache :: Bucket -> Region -> Minio ()
1183+addToRegionCache b region = do
1184+ rMVar <- asks mcRegionMap
1185+ UM.modifyMVar_ rMVar $ return . H.insert b region
1186+
1187+deleteFromRegionCache :: Bucket -> Minio ()
1188+deleteFromRegionCache b = do
1189+ rMVar <- asks mcRegionMap
1190+ UM.modifyMVar_ rMVar $ return . H.delete b