Add support for AssumeRole STS API (#188)

This change adds support for requesting temporary object storage credentials using the STS API. Some breaking changes are introduced to enable this support: - `Credentials` type has been removed. Use the `CredentialValue` type instead. Corresponding to this the type signature for `setCreds` has changed, though the functionality is the same. - The type alias `Provider` has been renamed to `CredentialLoader` to avoid naming confusion.
2023-05-03 17:52:46 -07:00 · 2023-05-03 17:52:46 -07:00 · fa62ed599a
commit fa62ed599a
parent 7ae8a8179d
21 changed files with 781 additions and 490 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -3,8 +3,18 @@ Changelog

 ## Version 1.7.0 -- Unreleased

-* Fix data type `EventMessage` to not export partial fields
-* Bump up min bound on time dep and fix deprecation warnings.
+* Fix data type `EventMessage` to not export partial fields (#179)
+* Bump up min bound on time dep and fix deprecation warnings (#181)
+* Add `dev` flag to cabal for building with warnings as errors (#182)
+* Fix AWS region map (#185)
+* Fix XML generator tests (#187)
+* Add support for STS Assume Role API (#188)
+
+### Breaking changes in 1.7.0
+
+* `Credentials` type has been removed. Use `CredentialValue` instead.
+* `Provider` type has been replaced with `CredentialLoader`.
+* `EventMessage` data type is updated.

 ## Version 1.6.0

--- a/README.md
+++ b/README.md
@ -1,4 +1,4 @@
-# MinIO Haskell Client SDK for Amazon S3 Compatible Cloud Storage [![Build Status](https://travis-ci.org/minio/minio-hs.svg?branch=master)](https://travis-ci.org/minio/minio-hs)[![Hackage](https://img.shields.io/hackage/v/minio-hs.svg)](https://hackage.haskell.org/package/minio-hs)[![Slack](https://slack.min.io/slack?type=svg)](https://slack.min.io)
+# MinIO Haskell Client SDK for Amazon S3 Compatible Cloud Storage [![CI](https://github.com/minio/minio-hs/actions/workflows/ci.yml/badge.svg)](https://github.com/minio/minio-hs/actions/workflows/ci.yml)[![Hackage](https://img.shields.io/hackage/v/minio-hs.svg)](https://hackage.haskell.org/package/minio-hs)[![Slack](https://slack.min.io/slack?type=svg)](https://slack.min.io)

 The MinIO Haskell Client SDK provides simple APIs to access [MinIO](https://min.io) and any Amazon S3 compatible object storage.

--- a/examples/AssumeRole.hs
+++ b/examples/AssumeRole.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2022 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -15,19 +15,33 @@
 --
 {-# LANGUAGE OverloadedStrings #-}

-import Network.Minio.Credentials
+import Control.Monad.IO.Class (liftIO)
+import Network.Minio
 import Prelude

 main :: IO ()
 main = do
-  res <-
-    retrieveCredentials
-      $ STSAssumeRole
-        "https://play.min.io"
-        ( CredentialValue
-            "Q3AM3UQ867SPQQA43P2F"
-            "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
-            Nothing
-        )
-      $ defaultSTSAssumeRoleOptions {saroLocation = Just "us-east-1"}
+  -- Use play credentials for example.
+  let assumeRole =
+        STSAssumeRole
+          ( CredentialValue
+              "Q3AM3UQ867SPQQA43P2F"
+              "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
+              Nothing
+          )
+          $ defaultSTSAssumeRoleOptions
+            { saroLocation = Just "us-east-1",
+              saroEndpoint = Just "https://play.min.io:9000"
+            }
+
+  -- Retrieve temporary credentials and print them.
+  cv <- requestSTSCredential assumeRole
+  print $ "Temporary credentials" ++ show (credentialValueText $ fst cv)
+  print $ "Expiry" ++ show (snd cv)
+
+  -- Configure 'ConnectInfo' to request temporary credentials on demand.
+  ci <- setSTSCredential assumeRole "https://play.min.io"
+  res <- runMinio ci $ do
+    buckets <- listBuckets
+    liftIO $ print $ "Top 5 buckets: " ++ show (take 5 buckets)
  print res
--- a/minio-hs.cabal
+++ b/minio-hs.cabal
@ -77,8 +77,6 @@ common base-settings
                     , RankNTypes
                     , ScopedTypeVariables
                     , TupleSections
-                     , TypeFamilies
-

  other-modules:       Lib.Prelude
                     , Network.Minio.API
@ -97,7 +95,11 @@ common base-settings
                     , Network.Minio.Utils
                     , Network.Minio.XmlGenerator
                     , Network.Minio.XmlParser
+                     , Network.Minio.XmlCommon
                     , Network.Minio.JsonParser
+                     , Network.Minio.Credentials.Types
+                     , Network.Minio.Credentials.AssumeRole
+                     , Network.Minio.Credentials

  mixins:              base hiding (Prelude)
                     , relude (Relude as Prelude)
@ -142,7 +144,6 @@ library
  exposed-modules:     Network.Minio
                     , Network.Minio.AdminAPI
                     , Network.Minio.S3API
-                     , Network.Minio.Credentials

 Flag live-test
  Description: Build the test suite that runs against a live MinIO server
@ -164,6 +165,7 @@ test-suite minio-hs-live-server-test
                     , Network.Minio.Utils.Test
                     , Network.Minio.XmlGenerator.Test
                     , Network.Minio.XmlParser.Test
+                     , Network.Minio.Credentials
  build-depends:       minio-hs
                     , raw-strings-qq
                     , tasty
@ -197,6 +199,7 @@ test-suite minio-hs-test
                     , Network.Minio.Utils.Test
                     , Network.Minio.XmlGenerator.Test
                     , Network.Minio.XmlParser.Test
+                     , Network.Minio.Credentials

 Flag examples
  Description: Build the examples
--- a/src/Network/Minio.hs
+++ b/src/Network/Minio.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -16,7 +16,7 @@

 -- |
 -- Module:      Network.Minio
-- Copyright:   (c) 2017-2019 MinIO Dev Team
+-- Copyright:   (c) 2017-2023 MinIO Dev Team
 -- License:     Apache 2.0
 -- Maintainer:  MinIO Dev Team <dev@min.io>
 --
@ -24,13 +24,17 @@
 -- storage servers like MinIO.
 module Network.Minio
  ( -- * Credentials
-    Credentials (..),
+    CredentialValue (..),
+    credentialValueText,
+    AccessKey (..),
+    SecretKey (..),
+    SessionToken (..),

-    -- ** Credential providers
+    -- ** Credential Loaders

-    -- | Run actions that retrieve 'Credentials' from the environment or
+    -- | Run actions that retrieve 'CredentialValue's from the environment or
    -- files or other custom sources.
-    Provider,
+    CredentialLoader,
    fromAWSConfigFile,
    fromAWSEnv,
    fromMinioEnv,
@ -54,6 +58,15 @@ module Network.Minio
    awsCI,
    gcsCI,

+    -- ** STS Credential types
+    STSAssumeRole (..),
+    STSAssumeRoleOptions (..),
+    defaultSTSAssumeRoleOptions,
+    requestSTSCredential,
+    setSTSCredential,
+    ExpiryTime (..),
+    STSCredentialProvider,
+
    -- * Minio Monad

    ----------------
@ -225,14 +238,15 @@ This module exports the high-level MinIO API for object storage.
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Binary as CB
 import qualified Data.Conduit.Combinators as CC
+import Network.Minio.API
 import Network.Minio.CopyObject
+import Network.Minio.Credentials
 import Network.Minio.Data
 import Network.Minio.Errors
 import Network.Minio.ListOps
 import Network.Minio.PutObject
 import Network.Minio.S3API
 import Network.Minio.SelectAPI
-import Network.Minio.Utils

 -- | Lists buckets.
 listBuckets :: Minio [BucketInfo]
--- a/src/Network/Minio/API.hs
+++ b/src/Network/Minio/API.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -26,6 +26,7 @@ module Network.Minio.API
    checkBucketNameValidity,
    isValidObjectName,
    checkObjectNameValidity,
+    requestSTSCredential,
  )
 where

@ -34,7 +35,6 @@ import Control.Retry
    limitRetriesByCumulativeDelay,
    retrying,
  )
-import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
 import qualified Data.Char as C
 import qualified Data.Conduit as C
@ -42,6 +42,7 @@ import qualified Data.HashMap.Strict as H
 import qualified Data.Text as T
 import qualified Data.Time.Clock as Time
 import Lib.Prelude
+import Network.HTTP.Client (defaultManagerSettings)
 import qualified Network.HTTP.Client as NClient
 import Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
@ -49,6 +50,7 @@ import Network.HTTP.Types (simpleQueryToQuery)
 import qualified Network.HTTP.Types as HT
 import Network.HTTP.Types.Header (hHost)
 import Network.Minio.APICommon
+import Network.Minio.Credentials
 import Network.Minio.Data
 import Network.Minio.Errors
 import Network.Minio.Sign.V4
@ -145,6 +147,20 @@ getHostPathRegion ri = do
          else return pathStyle
        )

+-- | requestSTSCredential requests temporary credentials using the Security Token
+-- Service API. The returned credential will include a populated 'SessionToken'
+-- and an 'ExpiryTime'.
+requestSTSCredential :: STSCredentialProvider p => p -> IO (CredentialValue, ExpiryTime)
+requestSTSCredential p = do
+  endpoint <- maybe (throwIO $ MErrValidation MErrVSTSEndpointNotFound) return $ getSTSEndpoint p
+  let endPt = NC.parseRequest_ $ toString endpoint
+      settings
+        | NC.secure endPt = NC.tlsManagerSettings
+        | otherwise = defaultManagerSettings
+
+  mgr <- NC.newManager settings
+  liftIO $ retrieveSTSCredentials p ("", 0, False) mgr
+
 buildRequest :: S3ReqInfo -> Minio NC.Request
 buildRequest ri = do
  maybe (return ()) checkBucketNameValidity $ riBucket ri
@ -175,10 +191,14 @@ buildRequest ri = do

  timeStamp <- liftIO Time.getCurrentTime

+  mgr <- asks mcConnManager
+  cv <- liftIO $ getCredential (connectCreds ci') (getEndpoint ci') mgr
+
  let sp =
        SignParams
-          (connectAccessKey ci')
-          (BA.convert (encodeUtf8 $ connectSecretKey ci' :: ByteString))
+          (coerce $ cvAccessKey cv)
+          (coerce $ cvSecretKey cv)
+          (coerce $ cvSessionToken cv)
          ServiceS3
          timeStamp
          (riRegion ri')
--- a/src/Network/Minio/AdminAPI.hs
+++ b/src/Network/Minio/AdminAPI.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2018 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2018-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -70,7 +70,6 @@ import Data.Aeson
  )
 import qualified Data.Aeson as A
 import Data.Aeson.Types (typeMismatch)
-import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as T
@ -81,6 +80,7 @@ import qualified Network.HTTP.Conduit as NC
 import qualified Network.HTTP.Types as HT
 import Network.HTTP.Types.Header (hHost)
 import Network.Minio.APICommon
+import Network.Minio.Credentials
 import Network.Minio.Data
 import Network.Minio.Errors
 import Network.Minio.Sign.V4
@ -666,6 +666,9 @@ buildAdminRequest areq = do

  timeStamp <- liftIO getCurrentTime

+  mgr <- asks mcConnManager
+  cv <- liftIO $ getCredential (connectCreds ci) (getEndpoint ci) mgr
+
  let hostHeader = (hHost, getHostAddr ci)
      newAreq =
        areq
@ -678,8 +681,9 @@ buildAdminRequest areq = do
      signReq = toRequest ci newAreq
      sp =
        SignParams
-          (connectAccessKey ci)
-          (BA.convert (encodeUtf8 $ connectSecretKey ci :: ByteString))
+          (coerce $ cvAccessKey cv)
+          (coerce $ cvSecretKey cv)
+          (coerce $ cvSessionToken cv)
          ServiceS3
          timeStamp
          Nothing
--- a/src/Network/Minio/Credentials.hs
+++ b/src/Network/Minio/Credentials.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017-2022 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -16,129 +16,62 @@

 module Network.Minio.Credentials
  ( CredentialValue (..),
-    CredentialProvider (..),
-    AccessKey,
-    SecretKey,
-    SessionToken,
+    credentialValueText,
+    STSCredentialProvider (..),
+    AccessKey (..),
+    SecretKey (..),
+    SessionToken (..),
+    ExpiryTime (..),
+    STSCredentialStore,
+    initSTSCredential,
+    getSTSCredential,
+    Creds (..),
+    getCredential,
+    Endpoint,
+
+    -- * STS Assume Role
    defaultSTSAssumeRoleOptions,
    STSAssumeRole (..),
    STSAssumeRoleOptions (..),
  )
 where

-import qualified Data.Time as Time
-import Data.Time.Units (Second)
-import Network.HTTP.Client (RequestBody (RequestBodyBS))
+import Data.Time (diffUTCTime, getCurrentTime)
 import qualified Network.HTTP.Client as NC
-import qualified Network.HTTP.Client.TLS as NC
-import Network.HTTP.Types (hContentType, methodPost, renderSimpleQuery)
-import Network.HTTP.Types.Header (hHost)
-import Network.Minio.Data
-import Network.Minio.Data.Crypto (hashSHA256)
-import Network.Minio.Sign.V4
-import Network.Minio.Utils (httpLbs)
-import Network.Minio.XmlParser (parseSTSAssumeRoleResult)
+import Network.Minio.Credentials.AssumeRole
+import Network.Minio.Credentials.Types
+import qualified UnliftIO.MVar as M

-class CredentialProvider p where
-  retrieveCredentials :: p -> IO CredentialValue
-
-stsVersion :: ByteString
-stsVersion = "2011-06-15"
-
-defaultDurationSeconds :: Second
-defaultDurationSeconds = 3600
-
-data STSAssumeRole = STSAssumeRole
-  { sarEndpoint :: Text,
-    sarCredentials :: CredentialValue,
-    sarOptions :: STSAssumeRoleOptions
+data STSCredentialStore = STSCredentialStore
+  { cachedCredentials :: M.MVar (CredentialValue, ExpiryTime),
+    refreshAction :: Endpoint -> NC.Manager -> IO (CredentialValue, ExpiryTime)
  }

-data STSAssumeRoleOptions = STSAssumeRoleOptions
-  { -- | Desired validity for the generated credentials.
-    saroDurationSeconds :: Maybe Second,
-    -- | IAM policy to apply for the generated credentials.
-    saroPolicyJSON :: Maybe ByteString,
-    -- | Location is usually required for AWS.
-    saroLocation :: Maybe Text,
-    saroRoleARN :: Maybe Text,
-    saroRoleSessionName :: Maybe Text,
-    -- | Optional HTTP connection manager
-    saroHTTPManager :: Maybe NC.Manager
-  }
+initSTSCredential :: STSCredentialProvider p => p -> IO STSCredentialStore
+initSTSCredential p = do
+  let action = retrieveSTSCredentials p
+  -- start with dummy credential, so that refresh happens for first request.
+  now <- getCurrentTime
+  mvar <- M.newMVar (CredentialValue mempty mempty mempty, coerce now)
+  return $
+    STSCredentialStore
+      { cachedCredentials = mvar,
+        refreshAction = action
+      }

-- | Default STS Assume Role options
-defaultSTSAssumeRoleOptions :: STSAssumeRoleOptions
-defaultSTSAssumeRoleOptions =
-  STSAssumeRoleOptions
-    { saroDurationSeconds = Just defaultDurationSeconds,
-      saroPolicyJSON = Nothing,
-      saroLocation = Nothing,
-      saroRoleARN = Nothing,
-      saroRoleSessionName = Nothing,
-      saroHTTPManager = Nothing
-    }
+getSTSCredential :: STSCredentialStore -> Endpoint -> NC.Manager -> IO (CredentialValue, Bool)
+getSTSCredential store ep mgr = M.modifyMVar (cachedCredentials store) $ \cc@(v, expiry) -> do
+  now <- getCurrentTime
+  if diffUTCTime now (coerce expiry) > 0
+    then do
+      res <- refreshAction store ep mgr
+      return (res, (fst res, True))
+    else return (cc, (v, False))

-instance CredentialProvider STSAssumeRole where
-  retrieveCredentials sar = do
-    -- Assemble STS request
-    let requiredParams =
-          [ ("Action", "AssumeRole"),
-            ("Version", stsVersion)
-          ]
-        opts = sarOptions sar
-        durSecs :: Int =
-          fromIntegral $
-            fromMaybe defaultDurationSeconds $
-              saroDurationSeconds opts
-        otherParams =
-          [ ("RoleArn",) . encodeUtf8 <$> saroRoleARN opts,
-            ("RoleSessionName",) . encodeUtf8 <$> saroRoleSessionName opts,
-            Just ("DurationSeconds", show durSecs),
-            ("Policy",) <$> saroPolicyJSON opts
-          ]
-        parameters = requiredParams ++ catMaybes otherParams
-        (host, port, isSecure) =
-          let endPt = NC.parseRequest_ $ toString $ sarEndpoint sar
-           in (NC.host endPt, NC.port endPt, NC.secure endPt)
-        reqBody = renderSimpleQuery False parameters
-        req =
-          NC.defaultRequest
-            { NC.host = host,
-              NC.port = port,
-              NC.secure = isSecure,
-              NC.method = methodPost,
-              NC.requestHeaders =
-                [ (hHost, getHostHeader (host, port)),
-                  (hContentType, "application/x-www-form-urlencoded")
-                ],
-              NC.requestBody = RequestBodyBS reqBody
-            }
+data Creds
+  = CredsStatic CredentialValue
+  | CredsSTS STSCredentialStore

-    -- Sign the STS request.
-    timeStamp <- liftIO Time.getCurrentTime
-    let sp =
-          SignParams
-            { spAccessKey = coerce $ cvAccessKey $ sarCredentials sar,
-              spSecretKey = coerce $ cvSecretKey $ sarCredentials sar,
-              spService = ServiceSTS,
-              spTimeStamp = timeStamp,
-              spRegion = saroLocation opts,
-              spExpirySecs = Nothing,
-              spPayloadHash = Just $ hashSHA256 reqBody
-            }
-        signHeaders = signV4 sp req
-        signedReq =
-          req
-            { NC.requestHeaders = NC.requestHeaders req ++ signHeaders
-            }
-        settings = bool NC.defaultManagerSettings NC.tlsManagerSettings isSecure
-
-    -- Make the STS request
-    mgr <- maybe (NC.newManager settings) return $ saroHTTPManager opts
-    resp <- httpLbs signedReq mgr
-    result <-
-      parseSTSAssumeRoleResult
-        (toStrict $ NC.responseBody resp)
-        "https://sts.amazonaws.com/doc/2011-06-15/"
-    return $ arcCredentials $ arrRoleCredentials result
+getCredential :: Creds -> Endpoint -> NC.Manager -> IO CredentialValue
+getCredential (CredsStatic v) _ _ = return v
+getCredential (CredsSTS s) ep mgr = fst <$> getSTSCredential s ep mgr
--- a/src/Network/Minio/Credentials/AssumeRole.hs
+++ b/src/Network/Minio/Credentials/AssumeRole.hs
@ -0,0 +1,264 @@
+--
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
+--
+-- Licensed under the Apache License, Version 2.0 (the "License");
+-- you may not use this file except in compliance with the License.
+-- You may obtain a copy of the License at
+--
+--     http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS,
+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+-- See the License for the specific language governing permissions and
+-- limitations under the License.
+--
+
+module Network.Minio.Credentials.AssumeRole where
+
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Text as T
+import qualified Data.Time as Time
+import Data.Time.Units (Second)
+import Lib.Prelude (UTCTime, throwIO)
+import Network.HTTP.Client (RequestBody (RequestBodyBS))
+import qualified Network.HTTP.Client as NC
+import Network.HTTP.Types (hContentType, methodPost, renderSimpleQuery)
+import Network.HTTP.Types.Header (hHost)
+import Network.Minio.Credentials.Types
+import Network.Minio.Data.Crypto (hashSHA256)
+import Network.Minio.Errors (MErrV (..))
+import Network.Minio.Sign.V4
+import Network.Minio.Utils (getHostHeader, httpLbs)
+import Network.Minio.XmlCommon
+import Text.XML.Cursor hiding (bool)
+
+stsVersion :: ByteString
+stsVersion = "2011-06-15"
+
+defaultDurationSeconds :: Second
+defaultDurationSeconds = 3600
+
+-- | Assume Role API argument.
+data STSAssumeRole = STSAssumeRole
+  { -- | Credentials to use in the AssumeRole STS API.
+    sarCredentials :: CredentialValue,
+    -- | Optional settings.
+    sarOptions :: STSAssumeRoleOptions
+  }
+
+-- | Options for STS Assume Role API.
+data STSAssumeRoleOptions = STSAssumeRoleOptions
+  { -- | STS endpoint to which the request will be made. For MinIO, this is the
+    -- same as the server endpoint. For AWS, this has to be the Security Token
+    -- Service endpoint. If using with 'setSTSCredential', this option can be
+    -- left as 'Nothing' and the endpoint in 'ConnectInfo' will be used.
+    saroEndpoint :: Maybe Text,
+    -- | Desired validity for the generated credentials.
+    saroDurationSeconds :: Maybe Second,
+    -- | IAM policy to apply for the generated credentials.
+    saroPolicyJSON :: Maybe ByteString,
+    -- | Location is usually required for AWS.
+    saroLocation :: Maybe Text,
+    saroRoleARN :: Maybe Text,
+    saroRoleSessionName :: Maybe Text
+  }
+
+-- | Default STS Assume Role options - all options are Nothing, except for
+-- duration which is set to 1 hour.
+defaultSTSAssumeRoleOptions :: STSAssumeRoleOptions
+defaultSTSAssumeRoleOptions =
+  STSAssumeRoleOptions
+    { saroEndpoint = Nothing,
+      saroDurationSeconds = Just 3600,
+      saroPolicyJSON = Nothing,
+      saroLocation = Nothing,
+      saroRoleARN = Nothing,
+      saroRoleSessionName = Nothing
+    }
+
+data AssumeRoleCredentials = AssumeRoleCredentials
+  { arcCredentials :: CredentialValue,
+    arcExpiration :: UTCTime
+  }
+  deriving stock (Show, Eq)
+
+data AssumeRoleResult = AssumeRoleResult
+  { arrSourceIdentity :: Text,
+    arrAssumedRoleArn :: Text,
+    arrAssumedRoleId :: Text,
+    arrRoleCredentials :: AssumeRoleCredentials
+  }
+  deriving stock (Show, Eq)
+
+-- | parseSTSAssumeRoleResult parses an XML response of the following form:
+--
+-- <AssumeRoleResponse xmlns="https://sts.amazonaws.com/doc/2011-06-15/">
+--   <AssumeRoleResult>
+--   <SourceIdentity>Alice</SourceIdentity>
+--     <AssumedRoleUser>
+--       <Arn>arn:aws:sts::123456789012:assumed-role/demo/TestAR</Arn>
+--       <AssumedRoleId>ARO123EXAMPLE123:TestAR</AssumedRoleId>
+--     </AssumedRoleUser>
+--     <Credentials>
+--       <AccessKeyId>ASIAIOSFODNN7EXAMPLE</AccessKeyId>
+--       <SecretAccessKey>wJalrXUtnFEMI/K7MDENG/bPxRfiCYzEXAMPLEKEY</SecretAccessKey>
+--       <SessionToken>
+--        AQoDYXdzEPT//////////wEXAMPLEtc764bNrC9SAPBSM22wDOk4x4HIZ8j4FZTwdQW
+--        LWsKWHGBuFqwAeMicRXmxfpSPfIeoIYRqTflfKD8YUuwthAx7mSEI/qkPpKPi/kMcGd
+--        QrmGdeehM4IC1NtBmUpp2wUE8phUZampKsburEDy0KPkyQDYwT7WZ0wq5VSXDvp75YU
+--        9HFvlRd8Tx6q6fE8YQcHNVXAkiY9q6d+xo0rKwT38xVqr7ZD0u0iPPkUL64lIZbqBAz
+--        +scqKmlzm8FDrypNC9Yjc8fPOLn9FX9KSYvKTr4rvx3iSIlTJabIQwj2ICCR/oLxBA==
+--       </SessionToken>
+--       <Expiration>2019-11-09T13:34:41Z</Expiration>
+--     </Credentials>
+--     <PackedPolicySize>6</PackedPolicySize>
+--   </AssumeRoleResult>
+--   <ResponseMetadata>
+--     <RequestId>c6104cbe-af31-11e0-8154-cbc7ccf896c7</RequestId>
+--   </ResponseMetadata>
+-- </AssumeRoleResponse>
+parseSTSAssumeRoleResult :: MonadIO m => ByteString -> Text -> m AssumeRoleResult
+parseSTSAssumeRoleResult xmldata namespace = do
+  r <- parseRoot $ LB.fromStrict xmldata
+  let s3Elem' = s3Elem namespace
+      sourceIdentity =
+        T.concat $
+          r
+            $/ s3Elem' "AssumeRoleResult"
+            &/ s3Elem' "SourceIdentity"
+            &/ content
+      roleArn =
+        T.concat $
+          r
+            $/ s3Elem' "AssumeRoleResult"
+            &/ s3Elem' "AssumedRoleUser"
+            &/ s3Elem' "Arn"
+            &/ content
+      roleId =
+        T.concat $
+          r
+            $/ s3Elem' "AssumeRoleResult"
+            &/ s3Elem' "AssumedRoleUser"
+            &/ s3Elem' "AssumedRoleId"
+            &/ content
+
+      convSB :: Text -> BA.ScrubbedBytes
+      convSB = BA.convert . (encodeUtf8 :: Text -> ByteString)
+
+      credsInfo = do
+        cr <-
+          maybe (Left $ MErrVXmlParse "No Credentials Element found") Right $
+            listToMaybe $
+              r $/ s3Elem' "AssumeRoleResult" &/ s3Elem' "Credentials"
+        let cur = fromNode $ node cr
+        return
+          ( CredentialValue
+              { cvAccessKey =
+                  coerce $
+                    T.concat $
+                      cur $/ s3Elem' "AccessKeyId" &/ content,
+                cvSecretKey =
+                  coerce $
+                    convSB $
+                      T.concat $
+                        cur
+                          $/ s3Elem' "SecretAccessKey"
+                          &/ content,
+                cvSessionToken =
+                  Just $
+                    coerce $
+                      convSB $
+                        T.concat $
+                          cur
+                            $/ s3Elem' "SessionToken"
+                            &/ content
+              },
+            T.concat $ cur $/ s3Elem' "Expiration" &/ content
+          )
+  creds <- either throwIO pure credsInfo
+  expiry <- parseS3XMLTime $ snd creds
+  let roleCredentials =
+        AssumeRoleCredentials
+          { arcCredentials = fst creds,
+            arcExpiration = expiry
+          }
+  return
+    AssumeRoleResult
+      { arrSourceIdentity = sourceIdentity,
+        arrAssumedRoleArn = roleArn,
+        arrAssumedRoleId = roleId,
+        arrRoleCredentials = roleCredentials
+      }
+
+instance STSCredentialProvider STSAssumeRole where
+  getSTSEndpoint = saroEndpoint . sarOptions
+  retrieveSTSCredentials sar (host', port', isSecure') mgr = do
+    -- Assemble STS request
+    let requiredParams =
+          [ ("Action", "AssumeRole"),
+            ("Version", stsVersion)
+          ]
+        opts = sarOptions sar
+
+        durSecs :: Int =
+          fromIntegral $
+            fromMaybe defaultDurationSeconds $
+              saroDurationSeconds opts
+        otherParams =
+          [ ("RoleArn",) . encodeUtf8 <$> saroRoleARN opts,
+            ("RoleSessionName",) . encodeUtf8 <$> saroRoleSessionName opts,
+            Just ("DurationSeconds", show durSecs),
+            ("Policy",) <$> saroPolicyJSON opts
+          ]
+        parameters = requiredParams ++ catMaybes otherParams
+        (host, port, isSecure) =
+          case getSTSEndpoint sar of
+            Just ep ->
+              let endPt = NC.parseRequest_ $ toString ep
+               in (NC.host endPt, NC.port endPt, NC.secure endPt)
+            Nothing -> (host', port', isSecure')
+        reqBody = renderSimpleQuery False parameters
+        req =
+          NC.defaultRequest
+            { NC.host = host,
+              NC.port = port,
+              NC.secure = isSecure,
+              NC.method = methodPost,
+              NC.requestHeaders =
+                [ (hHost, getHostHeader (host, port)),
+                  (hContentType, "application/x-www-form-urlencoded")
+                ],
+              NC.requestBody = RequestBodyBS reqBody
+            }
+
+    -- Sign the STS request.
+    timeStamp <- liftIO Time.getCurrentTime
+    let sp =
+          SignParams
+            { spAccessKey = coerce $ cvAccessKey $ sarCredentials sar,
+              spSecretKey = coerce $ cvSecretKey $ sarCredentials sar,
+              spSessionToken = coerce $ cvSessionToken $ sarCredentials sar,
+              spService = ServiceSTS,
+              spTimeStamp = timeStamp,
+              spRegion = saroLocation opts,
+              spExpirySecs = Nothing,
+              spPayloadHash = Just $ hashSHA256 reqBody
+            }
+        signHeaders = signV4 sp req
+        signedReq =
+          req
+            { NC.requestHeaders = NC.requestHeaders req ++ signHeaders
+            }
+
+    -- Make the STS request
+    resp <- httpLbs signedReq mgr
+    result <-
+      parseSTSAssumeRoleResult
+        (toStrict $ NC.responseBody resp)
+        "https://sts.amazonaws.com/doc/2011-06-15/"
+    return
+      ( arcCredentials $ arrRoleCredentials result,
+        coerce $ arcExpiration $ arrRoleCredentials result
+      )
--- a/src/Network/Minio/Credentials/Types.hs
+++ b/src/Network/Minio/Credentials/Types.hs
@ -0,0 +1,85 @@
+--
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
+--
+-- Licensed under the Apache License, Version 2.0 (the "License");
+-- you may not use this file except in compliance with the License.
+-- You may obtain a copy of the License at
+--
+--     http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS,
+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+-- See the License for the specific language governing permissions and
+-- limitations under the License.
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Network.Minio.Credentials.Types where
+
+import qualified Data.ByteArray as BA
+import Lib.Prelude (UTCTime)
+import qualified Network.HTTP.Client as NC
+
+-- | Access Key type.
+newtype AccessKey = AccessKey {unAccessKey :: Text}
+  deriving stock (Show)
+  deriving newtype (Eq, IsString, Semigroup, Monoid)
+
+-- | Secret Key type - has a show instance that does not print the value.
+newtype SecretKey = SecretKey {unSecretKey :: BA.ScrubbedBytes}
+  deriving stock (Show)
+  deriving newtype (Eq, IsString, Semigroup, Monoid)
+
+-- | Session Token type - has a show instance that does not print the value.
+newtype SessionToken = SessionToken {unSessionToken :: BA.ScrubbedBytes}
+  deriving stock (Show)
+  deriving newtype (Eq, IsString, Semigroup, Monoid)
+
+-- | Object storage credential data type. It has support for the optional
+-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_use-resources.html
+-- SessionToken> for using temporary credentials requested via STS.
+--
+-- The show instance for this type does not print the value of secrets for
+-- security.
+data CredentialValue = CredentialValue
+  { cvAccessKey :: AccessKey,
+    cvSecretKey :: SecretKey,
+    cvSessionToken :: Maybe SessionToken
+  }
+  deriving stock (Eq, Show)
+
+scrubbedToText :: BA.ScrubbedBytes -> Text
+scrubbedToText =
+  let b2t :: ByteString -> Text
+      b2t = decodeUtf8
+      s2b :: BA.ScrubbedBytes -> ByteString
+      s2b = BA.convert
+   in b2t . s2b
+
+-- | Convert a 'CredentialValue' to a text tuple. Use this to output the
+-- credential to files or other programs.
+credentialValueText :: CredentialValue -> (Text, Text, Maybe Text)
+credentialValueText cv =
+  ( coerce $ cvAccessKey cv,
+    (scrubbedToText . coerce) $ cvSecretKey cv,
+    scrubbedToText . coerce <$> cvSessionToken cv
+  )
+
+-- | Endpoint represented by host, port and TLS enabled flag.
+type Endpoint = (ByteString, Int, Bool)
+
+-- | Typeclass for STS credential providers.
+class STSCredentialProvider p where
+  retrieveSTSCredentials ::
+    p ->
+    -- | STS Endpoint (host, port, isSecure)
+    Endpoint ->
+    NC.Manager ->
+    IO (CredentialValue, ExpiryTime)
+  getSTSEndpoint :: p -> Maybe Text
+
+-- | 'ExpiryTime' represents a time at which a credential expires.
+newtype ExpiryTime = ExpiryTime {unExpiryTime :: UTCTime}
+  deriving stock (Show)
+  deriving newtype (Eq)
--- a/src/Network/Minio/Data.hs
+++ b/src/Network/Minio/Data.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -34,9 +34,9 @@ import qualified Data.Aeson as A
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
-import Data.CaseInsensitive (mk)
 import qualified Data.HashMap.Strict as H
 import qualified Data.Ini as Ini
+import qualified Data.List as List
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Data.Time (defaultTimeLocale, formatTime)
@ -53,6 +53,7 @@ import Network.HTTP.Types
    hRange,
  )
 import qualified Network.HTTP.Types as HT
+import Network.Minio.Credentials
 import Network.Minio.Data.Crypto
  ( encodeToBase64,
    hashMD5ToBase64,
@ -62,11 +63,12 @@ import Network.Minio.Errors
  ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
    MinioErr (..),
  )
+import Network.Minio.Utils
 import System.Directory (doesFileExist, getHomeDirectory)
 import qualified System.Environment as Env
 import System.FilePath.Posix (combine)
-import Text.XML (Name (Name))
 import qualified UnliftIO as U
+import qualified UnliftIO.MVar as UM

 -- | max obj size is 5TiB
 maxObjectSize :: Int64
@ -131,14 +133,15 @@ awsRegionMap =
 data ConnectInfo = ConnectInfo
  { connectHost :: Text,
    connectPort :: Int,
-    connectAccessKey :: Text,
-    connectSecretKey :: Text,
+    connectCreds :: Creds,
    connectIsSecure :: Bool,
    connectRegion :: Region,
    connectAutoDiscoverRegion :: Bool,
    connectDisableTLSCertValidation :: Bool
  }
-  deriving stock (Eq, Show)
+
+getEndpoint :: ConnectInfo -> Endpoint
+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)

 instance IsString ConnectInfo where
  fromString str =
@ -146,8 +149,7 @@ instance IsString ConnectInfo where
     in ConnectInfo
          { connectHost = TE.decodeUtf8 $ NC.host req,
            connectPort = NC.port req,
-            connectAccessKey = "",
-            connectSecretKey = "",
+            connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
            connectIsSecure = NC.secure req,
            connectRegion = "",
            connectAutoDiscoverRegion = True,
@ -161,20 +163,21 @@ data Credentials = Credentials
  }
  deriving stock (Eq, Show)

-- | A Provider is an action that may return Credentials. Providers
-- may be chained together using 'findFirst'.
-type Provider = IO (Maybe Credentials)
+-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
+-- Loaders may be chained together using 'findFirst'.
+type CredentialLoader = IO (Maybe CredentialValue)

-- | Combines the given list of providers, by calling each one in
-- order until Credentials are found.
-findFirst :: [Provider] -> Provider
+-- | Combines the given list of loaders, by calling each one in
+-- order until a 'CredentialValue' is returned.
+findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
 findFirst [] = return Nothing
 findFirst (f : fs) = do
  c <- f
  maybe (findFirst fs) (return . Just) c

-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
-fromAWSConfigFile :: Provider
+-- | This action returns a 'CredentialValue' populated from
+-- @~\/.aws\/credentials@
+fromAWSConfigFile :: CredentialLoader
 fromAWSConfigFile = do
  credsE <- runExceptT $ do
    homeDir <- lift getHomeDirectory
@ -190,29 +193,28 @@ fromAWSConfigFile = do
      ExceptT $
        return $
          Ini.lookupValue "default" "aws_secret_access_key" ini
-    return $ Credentials akey skey
+    return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
  return $ either (const Nothing) Just credsE

-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
-- @AWS_SECRET_ACCESS_KEY@ environment variables.
-fromAWSEnv :: Provider
+-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
+-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
+fromAWSEnv :: CredentialLoader
 fromAWSEnv = runMaybeT $ do
  akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
  skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
-  return $ Credentials (T.pack akey) (T.pack skey)
+  return $ CredentialValue (fromString akey) (fromString skey) Nothing

-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
-- @MINIO_SECRET_KEY@ environment variables.
-fromMinioEnv :: Provider
+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
+-- and @MINIO_SECRET_KEY@ environment variables.
+fromMinioEnv :: CredentialLoader
 fromMinioEnv = runMaybeT $ do
  akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
  skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
-  return $ Credentials (T.pack akey) (T.pack skey)
+  return $ CredentialValue (fromString akey) (fromString skey) Nothing

-- | setCredsFrom retrieves access credentials from the first
-- `Provider` form the given list that succeeds and sets it in the
-- `ConnectInfo`.
-setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
+-- | setCredsFrom retrieves access credentials from the first action in the
+-- given list that succeeds and sets it in the 'ConnectInfo'.
+setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
 setCredsFrom ps ci = do
  pMay <- findFirst ps
  maybe
@ -220,14 +222,21 @@ setCredsFrom ps ci = do
    (return . (`setCreds` ci))
    pMay

-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
-setCreds :: Credentials -> ConnectInfo -> ConnectInfo
-setCreds (Credentials accessKey secretKey) connInfo =
+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
+setCreds cv connInfo =
  connInfo
-    { connectAccessKey = accessKey,
-      connectSecretKey = secretKey
+    { connectCreds = CredsStatic cv
    }

+-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
+-- credentials via the STS API on demand. It is automatically refreshed on
+-- expiry.
+setSTSCredential :: STSCredentialProvider p => p -> ConnectInfo -> IO ConnectInfo
+setSTSCredential p ci = do
+  store <- initSTSCredential p
+  return ci {connectCreds = CredsSTS store}
+
 -- | Set the S3 region parameter in the `ConnectInfo`
 setRegion :: Region -> ConnectInfo -> ConnectInfo
 setRegion r connInfo =
@ -248,12 +257,6 @@ isConnectInfoSecure = connectIsSecure
 disableTLSCertValidation :: ConnectInfo -> ConnectInfo
 disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}

-getHostHeader :: (ByteString, Int) -> ByteString
-getHostHeader (host, port) =
-  if port == 80 || port == 443
-    then host
-    else host <> ":" <> show port
-
 getHostAddr :: ConnectInfo -> ByteString
 getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)

@ -278,7 +281,7 @@ awsCI = "https://s3.amazonaws.com"
 -- ConnectInfo. Credentials are already filled in.
 minioPlayCI :: ConnectInfo
 minioPlayCI =
-  let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
+  let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
   in setCreds playCreds $
        setRegion
          "us-east-1"
@ -380,24 +383,6 @@ data PutObjectOptions = PutObjectOptions
 defaultPutObjectOptions :: PutObjectOptions
 defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing

-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
-- stripped and a Just is returned.
-userMetadataHeaderNameMaybe :: Text -> Maybe Text
-userMetadataHeaderNameMaybe k =
-  let prefix = T.toCaseFold "X-Amz-Meta-"
-      n = T.length prefix
-   in if T.toCaseFold (T.take n k) == prefix
-        then Just (T.drop n k)
-        else Nothing
-
-addXAmzMetaPrefix :: Text -> Text
-addXAmzMetaPrefix s
-  | isJust (userMetadataHeaderNameMaybe s) = s
-  | otherwise = "X-Amz-Meta-" <> s
-
-mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
-mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix x, encodeUtf8 y))
-
 pooToHeaders :: PutObjectOptions -> [HT.Header]
 pooToHeaders poo =
  userMetadata
@ -437,6 +422,29 @@ data BucketInfo = BucketInfo
 -- | A type alias to represent a part-number for multipart upload
 type PartNumber = Int16

+-- | Select part sizes - the logic is that the minimum part-size will
+-- be 64MiB.
+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
+selectPartSizes size =
+  uncurry (List.zip3 [1 ..]) $
+    List.unzip $
+      loop 0 size
+  where
+    ceil :: Double -> Int64
+    ceil = ceiling
+    partSize =
+      max
+        minPartSize
+        ( ceil $
+            fromIntegral size
+              / fromIntegral maxMultipartParts
+        )
+    m = partSize
+    loop st sz
+      | st > sz = []
+      | st + m >= sz = [(st, sz - st)]
+      | otherwise = (st, m) : loop (st + m) sz
+
 -- | A type alias to represent an upload-id for multipart upload
 type UploadId = Text

@ -1016,47 +1024,6 @@ type Stats = Progress
 -- Select API Related Types End
 --------------------------------------------------------------------------

----------------------------------------
-- Credentials Start
----------------------------------------
-
-newtype AccessKey = AccessKey {unAccessKey :: Text}
-  deriving stock (Show)
-  deriving newtype (Eq, IsString)
-
-newtype SecretKey = SecretKey {unSecretKey :: BA.ScrubbedBytes}
-  deriving stock (Show)
-  deriving newtype (Eq, IsString)
-
-newtype SessionToken = SessionToken {unSessionToken :: BA.ScrubbedBytes}
-  deriving stock (Show)
-  deriving newtype (Eq, IsString)
-
-data CredentialValue = CredentialValue
-  { cvAccessKey :: AccessKey,
-    cvSecretKey :: SecretKey,
-    cvSessionToken :: Maybe SessionToken
-  }
-  deriving stock (Eq, Show)
-
-data AssumeRoleCredentials = AssumeRoleCredentials
-  { arcCredentials :: CredentialValue,
-    arcExpiration :: UTCTime
-  }
-  deriving stock (Show, Eq)
-
-data AssumeRoleResult = AssumeRoleResult
-  { arrSourceIdentity :: Text,
-    arrAssumedRoleArn :: Text,
-    arrAssumedRoleId :: Text,
-    arrRoleCredentials :: AssumeRoleCredentials
-  }
-  deriving stock (Show, Eq)
-
----------------------------------------
-- Credentials End
----------------------------------------
-
 -- | Represents different kinds of payload that are used with S3 API
 -- requests.
 data Payload
@ -1202,9 +1169,22 @@ runMinioRes ci m = do
  conn <- liftIO $ connect ci
  runMinioResWith conn m

-s3Name :: Text -> Text -> Name
-s3Name ns s = Name s (Just ns) Nothing
-
 -- | Format as per RFC 1123.
 formatRFC1123 :: UTCTime -> T.Text
 formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
+
+lookupRegionCache :: Bucket -> Minio (Maybe Region)
+lookupRegionCache b = do
+  rMVar <- asks mcRegionMap
+  rMap <- UM.readMVar rMVar
+  return $ H.lookup b rMap
+
+addToRegionCache :: Bucket -> Region -> Minio ()
+addToRegionCache b region = do
+  rMVar <- asks mcRegionMap
+  UM.modifyMVar_ rMVar $ return . H.insert b region
+
+deleteFromRegionCache :: Bucket -> Minio ()
+deleteFromRegionCache b = do
+  rMVar <- asks mcRegionMap
+  UM.modifyMVar_ rMVar $ return . H.delete b
--- a/src/Network/Minio/Errors.hs
+++ b/src/Network/Minio/Errors.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -49,6 +49,7 @@ data MErrV
  | MErrVInvalidEncryptionKeyLength
  | MErrVStreamingBodyUnexpectedEOF
  | MErrVUnexpectedPayload
+  | MErrVSTSEndpointNotFound
  deriving stock (Show, Eq)

 instance Exception MErrV
--- a/src/Network/Minio/PresignedOperations.hs
+++ b/src/Network/Minio/PresignedOperations.hs
@ -1,7 +1,5 @@
-{-# LANGUAGE CPP #-}
-
 --
-- MinIO Haskell SDK, (C) 2017 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -15,6 +13,7 @@
 -- See the License for the specific language governing permissions and
 -- limitations under the License.
 --
+{-# LANGUAGE CPP #-}

 module Network.Minio.PresignedOperations
  ( UrlExpiry,
@ -39,7 +38,6 @@ where

 import Data.Aeson ((.=))
 import qualified Data.Aeson as Json
-import qualified Data.ByteArray as BA
 import Data.ByteString.Builder (byteString, toLazyByteString)
 import qualified Data.HashMap.Strict as H
 import qualified Data.Text as T
@ -48,6 +46,7 @@ import Lib.Prelude
 import qualified Network.HTTP.Client as NClient
 import qualified Network.HTTP.Types as HT
 import Network.Minio.API (buildRequest)
+import Network.Minio.Credentials
 import Network.Minio.Data
 import Network.Minio.Data.Time
 import Network.Minio.Errors
@ -300,6 +299,8 @@ presignedPostPolicy ::
 presignedPostPolicy p = do
  ci <- asks mcConnInfo
  signTime <- liftIO Time.getCurrentTime
+  mgr <- asks mcConnManager
+  cv <- liftIO $ getCredential (connectCreds ci) (getEndpoint ci) mgr

  let extraConditions signParams =
        [ PPCEquals "x-amz-date" (toText $ awsTimeFormat signTime),
@ -308,7 +309,7 @@ presignedPostPolicy p = do
            "x-amz-credential"
            ( T.intercalate
                "/"
-                [ connectAccessKey ci,
+                [ coerce $ cvAccessKey cv,
                  decodeUtf8 $ credentialScope signParams
                ]
            )
@ -319,8 +320,9 @@ presignedPostPolicy p = do
          }
      sp =
        SignParams
-          (connectAccessKey ci)
-          (BA.convert (encodeUtf8 $ connectSecretKey ci :: ByteString))
+          (coerce $ cvAccessKey cv)
+          (coerce $ cvSecretKey cv)
+          (coerce $ cvSessionToken cv)
          ServiceS3
          signTime
          (Just $ connectRegion ci)
--- a/src/Network/Minio/S3API.hs
+++ b/src/Network/Minio/S3API.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -14,6 +14,14 @@
 -- limitations under the License.
 --

+-- |
+-- Module:      Network.Minio.S3API
+-- Copyright:   (c) 2017-2023 MinIO Dev Team
+-- License:     Apache 2.0
+-- Maintainer:  MinIO Dev Team <dev@min.io>
+--
+-- Lower-level API for S3 compatible object stores. Start with @Network.Minio@
+-- and use this only if needed.
 module Network.Minio.S3API
  ( Region,
    getLocation,
--- a/src/Network/Minio/Sign/V4.hs
+++ b/src/Network/Minio/Sign/V4.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -15,7 +15,16 @@
 --
 {-# LANGUAGE BangPatterns #-}

-module Network.Minio.Sign.V4 where
+module Network.Minio.Sign.V4
+  ( SignParams (..),
+    signV4QueryParams,
+    signV4,
+    signV4PostPolicy,
+    signV4Stream,
+    Service (..),
+    credentialScope,
+  )
+where

 import qualified Conduit as C
 import qualified Data.ByteArray as BA
@ -23,6 +32,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as LB
+import Data.CaseInsensitive (mk)
 import qualified Data.CaseInsensitive as CI
 import qualified Data.HashMap.Strict as Map
 import qualified Data.HashSet as Set
@ -52,17 +62,6 @@ ignoredHeaders =
        H.hUserAgent
      ]

-data SignV4Data = SignV4Data
-  { sv4SignTime :: UTCTime,
-    sv4Scope :: ByteString,
-    sv4CanonicalRequest :: ByteString,
-    sv4HeadersToSign :: [(ByteString, ByteString)],
-    sv4Output :: [(ByteString, ByteString)],
-    sv4StringToSign :: ByteString,
-    sv4SigningKey :: ByteString
-  }
-  deriving stock (Show)
-
 data Service = ServiceS3 | ServiceSTS
  deriving stock (Eq, Show)

@ -73,6 +72,7 @@ toByteString ServiceSTS = "sts"
 data SignParams = SignParams
  { spAccessKey :: Text,
    spSecretKey :: BA.ScrubbedBytes,
+    spSessionToken :: Maybe BA.ScrubbedBytes,
    spService :: Service,
    spTimeStamp :: UTCTime,
    spRegion :: Maybe Text,
@ -81,23 +81,6 @@ data SignParams = SignParams
  }
  deriving stock (Show)

-debugPrintSignV4Data :: SignV4Data -> IO ()
-debugPrintSignV4Data (SignV4Data t s cr h2s o sts sk) = do
-  B8.putStrLn "SignV4Data:"
-  B8.putStr "Timestamp: " >> print t
-  B8.putStr "Scope: " >> B8.putStrLn s
-  B8.putStrLn "Canonical Request:"
-  B8.putStrLn cr
-  B8.putStr "Headers to Sign: " >> print h2s
-  B8.putStr "Output: " >> print o
-  B8.putStr "StringToSign: " >> B8.putStrLn sts
-  B8.putStr "SigningKey: " >> printBytes sk
-  B8.putStrLn "END of SignV4Data ========="
-  where
-    printBytes b = do
-      mapM_ (\x -> B.putStr $ B.singleton x <> " ") $ B.unpack b
-      B8.putStrLn ""
-
 mkAuthHeader :: Text -> ByteString -> ByteString -> ByteString -> H.Header
 mkAuthHeader accessKey scope signedHeaderKeys sign =
  let authValue =
@ -116,6 +99,9 @@ mkAuthHeader accessKey scope signedHeaderKeys sign =
 data IsStreaming = IsStreamingLength Int64 | NotStreaming
  deriving stock (Eq, Show)

+amzSecurityToken :: ByteString
+amzSecurityToken = "X-Amz-Security-Token"
+
 -- | Given SignParams and request details, including request method,
 -- request path, headers, query params and payload hash, generates an
 -- updated set of headers, including the x-amz-date header and the
@ -144,6 +130,7 @@ signV4QueryParams !sp !req =
          ("X-Amz-Expires", maybe "" showBS expiry),
          ("X-Amz-SignedHeaders", signedHeaderKeys)
        ]
+          ++ maybeToList ((amzSecurityToken,) . BA.convert <$> spSessionToken sp)
      finalQP =
        parseQuery (NC.queryString req)
          ++ if isJust expiry
@ -185,6 +172,7 @@ signV4 !sp !req =
                | spService sp == ServiceS3
              ]
            )
+          ++ maybeToList ((mk amzSecurityToken,) . BA.convert <$> spSessionToken sp)

      -- 1. compute canonical request
      reqHeaders = NC.requestHeaders req ++ extraHeaders
@ -347,10 +335,11 @@ signV4PostPolicy !postPolicyJSON !sp =
  let stringToSign = Base64.encode postPolicyJSON
      signingKey = getSigningKey sp
      signature = computeSignature stringToSign signingKey
-   in Map.fromList
+   in Map.fromList $
        [ ("x-amz-signature", signature),
          ("policy", stringToSign)
        ]
+          ++ maybeToList ((decodeUtf8 amzSecurityToken,) . BA.convert <$> spSessionToken sp)

 chunkSizeConstant :: Int
 chunkSizeConstant = 64 * 1024
@ -401,6 +390,7 @@ signV4Stream !payloadLength !sp !req =
          ("content-length", showBS signedContentLength),
          ("x-amz-content-sha256", "STREAMING-AWS4-HMAC-SHA256-PAYLOAD")
        ]
+          ++ maybeToList ((mk amzSecurityToken,) . BA.convert <$> spSessionToken sp)
      requestHeaders =
        addContentEncoding $
          foldr setHeader (NC.requestHeaders req) extraHeaders
--- a/src/Network/Minio/Utils.hs
+++ b/src/Network/Minio/Utils.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -24,7 +24,6 @@ import qualified Data.ByteString.Lazy as LB
 import Data.CaseInsensitive (mk, original)
 import qualified Data.Conduit.Binary as CB
 import qualified Data.HashMap.Strict as H
-import qualified Data.List as List
 import qualified Data.Text as T
 import Data.Text.Read (decimal)
 import Data.Time
@ -37,14 +36,12 @@ import Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
 import qualified Network.HTTP.Types as HT
 import qualified Network.HTTP.Types.Header as Hdr
-import Network.Minio.Data
 import Network.Minio.Data.ByteString
 import Network.Minio.JsonParser (parseErrResponseJSON)
-import Network.Minio.XmlParser (parseErrResponse)
+import Network.Minio.XmlCommon (parseErrResponse)
 import qualified System.IO as IO
 import qualified UnliftIO as U
 import qualified UnliftIO.Async as A
-import qualified UnliftIO.MVar as UM

 allocateReadFile ::
  (MonadUnliftIO m, R.MonadResource m) =>
@ -115,6 +112,16 @@ getMetadata :: [HT.Header] -> [(Text, Text)]
 getMetadata =
  map (\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y))

+-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
+-- stripped and a Just is returned.
+userMetadataHeaderNameMaybe :: Text -> Maybe Text
+userMetadataHeaderNameMaybe k =
+  let prefix = T.toCaseFold "X-Amz-Meta-"
+      n = T.length prefix
+   in if T.toCaseFold (T.take n k) == prefix
+        then Just (T.drop n k)
+        else Nothing
+
 toMaybeMetadataHeader :: (Text, Text) -> Maybe (Text, Text)
 toMaybeMetadataHeader (k, v) =
  (,v) <$> userMetadataHeaderNameMaybe k
@ -128,6 +135,14 @@ getNonUserMetadataMap =
          . fst
      )

+addXAmzMetaPrefix :: Text -> Text
+addXAmzMetaPrefix s
+  | isJust (userMetadataHeaderNameMaybe s) = s
+  | otherwise = "X-Amz-Meta-" <> s
+
+mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
+mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix x, encodeUtf8 y))
+
 -- | This function collects all headers starting with `x-amz-meta-`
 -- and strips off this prefix, and returns a map.
 getUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text
@ -135,6 +150,12 @@ getUserMetadataMap =
  H.fromList
    . mapMaybe toMaybeMetadataHeader

+getHostHeader :: (ByteString, Int) -> ByteString
+getHostHeader (host_, port_) =
+  if port_ == 80 || port_ == 443
+    then host_
+    else host_ <> ":" <> show port_
+
 getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
 getLastModifiedHeader hs = do
  modTimebs <- decodeUtf8Lenient <$> lookupHeader Hdr.hLastModified hs
@ -262,42 +283,3 @@ chunkBSConduit (s : ss) = do
      | B.length bs == s -> C.yield bs >> chunkBSConduit ss
      | B.length bs > 0 -> C.yield bs
      | otherwise -> return ()
-
-- | Select part sizes - the logic is that the minimum part-size will
-- be 64MiB.
-selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
-selectPartSizes size =
-  uncurry (List.zip3 [1 ..]) $
-    List.unzip $
-      loop 0 size
-  where
-    ceil :: Double -> Int64
-    ceil = ceiling
-    partSize =
-      max
-        minPartSize
-        ( ceil $
-            fromIntegral size
-              / fromIntegral maxMultipartParts
-        )
-    m = partSize
-    loop st sz
-      | st > sz = []
-      | st + m >= sz = [(st, sz - st)]
-      | otherwise = (st, m) : loop (st + m) sz
-
-lookupRegionCache :: Bucket -> Minio (Maybe Region)
-lookupRegionCache b = do
-  rMVar <- asks mcRegionMap
-  rMap <- UM.readMVar rMVar
-  return $ H.lookup b rMap
-
-addToRegionCache :: Bucket -> Region -> Minio ()
-addToRegionCache b region = do
-  rMVar <- asks mcRegionMap
-  UM.modifyMVar_ rMVar $ return . H.insert b region
-
-deleteFromRegionCache :: Bucket -> Minio ()
-deleteFromRegionCache b = do
-  rMVar <- asks mcRegionMap
-  UM.modifyMVar_ rMVar $ return . H.delete b
--- a/src/Network/Minio/XmlCommon.hs
+++ b/src/Network/Minio/XmlCommon.hs
@ -0,0 +1,65 @@
+--
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
+--
+-- Licensed under the Apache License, Version 2.0 (the "License");
+-- you may not use this file except in compliance with the License.
+-- You may obtain a copy of the License at
+--
+--     http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS,
+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+-- See the License for the specific language governing permissions and
+-- limitations under the License.
+--
+
+module Network.Minio.XmlCommon where
+
+import qualified Data.Text as T
+import Data.Text.Read (decimal)
+import Data.Time (UTCTime)
+import Data.Time.Format.ISO8601 (iso8601ParseM)
+import Lib.Prelude (throwIO)
+import Network.Minio.Errors
+import Text.XML (Name (Name), def, parseLBS)
+import Text.XML.Cursor (Axis, Cursor, content, element, fromDocument, laxElement, ($/), (&/))
+
+s3Name :: Text -> Text -> Name
+s3Name ns s = Name s (Just ns) Nothing
+
+uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
+uncurry4 f (a, b, c, d) = f a b c d
+
+uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
+uncurry6 f (a, b, c, d, e, g) = f a b c d e g
+
+-- | Parse time strings from XML
+parseS3XMLTime :: MonadIO m => Text -> m UTCTime
+parseS3XMLTime t =
+  maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $
+    iso8601ParseM $
+      toString t
+
+parseDecimal :: (MonadIO m, Integral a) => Text -> m a
+parseDecimal numStr =
+  either (throwIO . MErrVXmlParse . show) return $
+    fst <$> decimal numStr
+
+parseDecimals :: (MonadIO m, Integral a) => [Text] -> m [a]
+parseDecimals numStr = forM numStr parseDecimal
+
+s3Elem :: Text -> Text -> Axis
+s3Elem ns = element . s3Name ns
+
+parseRoot :: (MonadIO m) => LByteString -> m Cursor
+parseRoot =
+  either (throwIO . MErrVXmlParse . show) (return . fromDocument)
+    . parseLBS def
+
+parseErrResponse :: (MonadIO m) => LByteString -> m ServiceErr
+parseErrResponse xmldata = do
+  r <- parseRoot xmldata
+  let code = T.concat $ r $/ laxElement "Code" &/ content
+      message = T.concat $ r $/ laxElement "Message" &/ content
+  return $ toServiceErr code message
--- a/src/Network/Minio/XmlGenerator.hs
+++ b/src/Network/Minio/XmlGenerator.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -25,6 +25,7 @@ where
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as T
 import Network.Minio.Data
+import Network.Minio.XmlCommon
 import Text.XML

 -- | Create a bucketConfig request body XML
--- a/src/Network/Minio/XmlParser.hs
+++ b/src/Network/Minio/XmlParser.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -27,54 +27,18 @@ module Network.Minio.XmlParser
    parseErrResponse,
    parseNotification,
    parseSelectProgress,
-    parseSTSAssumeRoleResult,
  )
 where

-import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.HashMap.Strict as H
 import Data.List (zip4, zip6)
 import qualified Data.Text as T
-import Data.Text.Read (decimal)
 import Data.Time
-import Data.Time.Format.ISO8601 (iso8601ParseM)
-import Lib.Prelude
 import Network.Minio.Data
-import Network.Minio.Errors
-import Text.XML
+import Network.Minio.XmlCommon
 import Text.XML.Cursor hiding (bool)

-- | Helper functions.
-uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
-uncurry4 f (a, b, c, d) = f a b c d
-
-uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
-uncurry6 f (a, b, c, d, e, g) = f a b c d e g
-
-- | Parse time strings from XML
-parseS3XMLTime :: MonadIO m => Text -> m UTCTime
-parseS3XMLTime t =
-  maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $
-    iso8601ParseM $
-      toString t
-
-parseDecimal :: (MonadIO m, Integral a) => Text -> m a
-parseDecimal numStr =
-  either (throwIO . MErrVXmlParse . show) return $
-    fst <$> decimal numStr
-
-parseDecimals :: (MonadIO m, Integral a) => [Text] -> m [a]
-parseDecimals numStr = forM numStr parseDecimal
-
-s3Elem :: Text -> Text -> Axis
-s3Elem ns = element . s3Name ns
-
-parseRoot :: (MonadIO m) => LByteString -> m Cursor
-parseRoot =
-  either (throwIO . MErrVXmlParse . show) (return . fromDocument)
-    . parseLBS def
-
 -- | Parse the response XML of a list buckets call.
 parseListBuckets :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m [BucketInfo]
 parseListBuckets xmldata = do
@ -219,13 +183,6 @@ parseListPartsResponse xmldata = do

  return $ ListPartsResult hasMore (listToMaybe nextPartNum) partInfos

-parseErrResponse :: (MonadIO m) => LByteString -> m ServiceErr
-parseErrResponse xmldata = do
-  r <- parseRoot xmldata
-  let code = T.concat $ r $/ laxElement "Code" &/ content
-      message = T.concat $ r $/ laxElement "Message" &/ content
-  return $ toServiceErr code message
-
 parseNotification :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m Notification
 parseNotification xmldata = do
  r <- parseRoot xmldata
@ -271,102 +228,3 @@ parseSelectProgress xmldata = do
    <$> parseDecimal bScanned
    <*> parseDecimal bProcessed
    <*> parseDecimal bReturned
-
-- <AssumeRoleResponse xmlns="https://sts.amazonaws.com/doc/2011-06-15/">
--   <AssumeRoleResult>
--   <SourceIdentity>Alice</SourceIdentity>
--     <AssumedRoleUser>
--       <Arn>arn:aws:sts::123456789012:assumed-role/demo/TestAR</Arn>
--       <AssumedRoleId>ARO123EXAMPLE123:TestAR</AssumedRoleId>
--     </AssumedRoleUser>
--     <Credentials>
--       <AccessKeyId>ASIAIOSFODNN7EXAMPLE</AccessKeyId>
--       <SecretAccessKey>wJalrXUtnFEMI/K7MDENG/bPxRfiCYzEXAMPLEKEY</SecretAccessKey>
--       <SessionToken>
--        AQoDYXdzEPT//////////wEXAMPLEtc764bNrC9SAPBSM22wDOk4x4HIZ8j4FZTwdQW
--        LWsKWHGBuFqwAeMicRXmxfpSPfIeoIYRqTflfKD8YUuwthAx7mSEI/qkPpKPi/kMcGd
--        QrmGdeehM4IC1NtBmUpp2wUE8phUZampKsburEDy0KPkyQDYwT7WZ0wq5VSXDvp75YU
--        9HFvlRd8Tx6q6fE8YQcHNVXAkiY9q6d+xo0rKwT38xVqr7ZD0u0iPPkUL64lIZbqBAz
--        +scqKmlzm8FDrypNC9Yjc8fPOLn9FX9KSYvKTr4rvx3iSIlTJabIQwj2ICCR/oLxBA==
--       </SessionToken>
--       <Expiration>2019-11-09T13:34:41Z</Expiration>
--     </Credentials>
--     <PackedPolicySize>6</PackedPolicySize>
--   </AssumeRoleResult>
--   <ResponseMetadata>
--     <RequestId>c6104cbe-af31-11e0-8154-cbc7ccf896c7</RequestId>
--   </ResponseMetadata>
-- </AssumeRoleResponse>
-
-parseSTSAssumeRoleResult :: MonadIO m => ByteString -> Text -> m AssumeRoleResult
-parseSTSAssumeRoleResult xmldata namespace = do
-  r <- parseRoot $ LB.fromStrict xmldata
-  let s3Elem' = s3Elem namespace
-      sourceIdentity =
-        T.concat $
-          r
-            $/ s3Elem' "AssumeRoleResult"
-            &/ s3Elem' "SourceIdentity"
-            &/ content
-      roleArn =
-        T.concat $
-          r
-            $/ s3Elem' "AssumeRoleResult"
-            &/ s3Elem' "AssumedRoleUser"
-            &/ s3Elem' "Arn"
-            &/ content
-      roleId =
-        T.concat $
-          r
-            $/ s3Elem' "AssumeRoleResult"
-            &/ s3Elem' "AssumedRoleUser"
-            &/ s3Elem' "AssumedRoleId"
-            &/ content
-
-      convSB :: Text -> BA.ScrubbedBytes
-      convSB = BA.convert . (encodeUtf8 :: Text -> ByteString)
-
-      credsInfo = do
-        cr <-
-          maybe (Left $ MErrVXmlParse "No Credentials Element found") Right $
-            listToMaybe $
-              r $/ s3Elem' "AssumeRoleResult" &/ s3Elem' "Credentials"
-        let cur = fromNode $ node cr
-        return
-          ( CredentialValue
-              { cvAccessKey =
-                  coerce $
-                    T.concat $
-                      cur $/ s3Elem' "AccessKeyId" &/ content,
-                cvSecretKey =
-                  coerce $
-                    convSB $
-                      T.concat $
-                        cur
-                          $/ s3Elem' "SecretAccessKey"
-                          &/ content,
-                cvSessionToken =
-                  Just $
-                    coerce $
-                      convSB $
-                        T.concat $
-                          cur
-                            $/ s3Elem' "SessionToken"
-                            &/ content
-              },
-            T.concat $ cur $/ s3Elem' "Expiration" &/ content
-          )
-  creds <- either throwIO pure credsInfo
-  expiry <- parseS3XMLTime $ snd creds
-  let roleCredentials =
-        AssumeRoleCredentials
-          { arcCredentials = fst creds,
-            arcExpiration = expiry
-          }
-  return
-    AssumeRoleResult
-      { arrSourceIdentity = sourceIdentity,
-        arrAssumedRoleArn = roleArn,
-        arrAssumedRoleId = roleId,
-        arrRoleCredentials = roleCredentials
-      }
--- a/test/LiveServer.hs
+++ b/test/LiveServer.hs
@ -1,7 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 --
-- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -32,6 +30,7 @@ import qualified Network.HTTP.Client.MultipartFormData as Form
 import qualified Network.HTTP.Conduit as NC
 import qualified Network.HTTP.Types as HT
 import Network.Minio
+import Network.Minio.Credentials (Creds (CredsStatic))
 import Network.Minio.Data
 import Network.Minio.Data.Crypto
 import Network.Minio.S3API
@ -77,15 +76,35 @@ mkRandFile size = do
 funTestBucketPrefix :: Text
 funTestBucketPrefix = "miniohstest-"

-loadTestServer :: IO ConnectInfo
-loadTestServer = do
+loadTestServerConnInfo :: IO ConnectInfo
+loadTestServerConnInfo = do
  val <- Env.lookupEnv "MINIO_LOCAL"
  isSecure <- Env.lookupEnv "MINIO_SECURE"
  return $ case (val, isSecure) of
-    (Just _, Just _) -> setCreds (Credentials "minio" "minio123") "https://localhost:9000"
-    (Just _, Nothing) -> setCreds (Credentials "minio" "minio123") "http://localhost:9000"
+    (Just _, Just _) -> setCreds (CredentialValue "minio" "minio123" mempty) "https://localhost:9000"
+    (Just _, Nothing) -> setCreds (CredentialValue "minio" "minio123" mempty) "http://localhost:9000"
    (Nothing, _) -> minioPlayCI

+loadTestServerConnInfoSTS :: IO ConnectInfo
+loadTestServerConnInfoSTS = do
+  val <- Env.lookupEnv "MINIO_LOCAL"
+  isSecure <- Env.lookupEnv "MINIO_SECURE"
+  let cv = CredentialValue "minio" "minio123" mempty
+      assumeRole =
+        STSAssumeRole
+          { sarCredentials = cv,
+            sarOptions = defaultSTSAssumeRoleOptions
+          }
+  case (val, isSecure) of
+    (Just _, Just _) -> setSTSCredential assumeRole "https://localhost:9000"
+    (Just _, Nothing) -> setSTSCredential assumeRole "http://localhost:9000"
+    (Nothing, _) -> do
+      cv' <- case connectCreds minioPlayCI of
+        CredsStatic c -> return c
+        _ -> error "unexpected play creds"
+      let assumeRole' = assumeRole {sarCredentials = cv'}
+      setSTSCredential assumeRole' minioPlayCI
+
 funTestWithBucket ::
  TestName ->
  (([Char] -> Minio ()) -> Bucket -> Minio ()) ->
@ -95,7 +114,7 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do
  bktSuffix <- liftIO $ generate $ Q.vectorOf 10 (Q.choose ('a', 'z'))
  let b = T.concat [funTestBucketPrefix, T.pack bktSuffix]
      liftStep = liftIO . step
-  connInfo <- loadTestServer
+  connInfo <- loadTestServerConnInfo
  ret <- runMinio connInfo $ do
    liftStep $ "Creating bucket for test - " ++ t
    foundBucket <- bucketExists b
@ -105,6 +124,17 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do
    deleteBucket b
  isRight ret @? ("Functional test " ++ t ++ " failed => " ++ show ret)

+  connInfoSTS <- loadTestServerConnInfoSTS
+  let t' = t ++ " (with AssumeRole Credentials)"
+  ret' <- runMinio connInfoSTS $ do
+    liftStep $ "Creating bucket for test - " ++ t'
+    foundBucket <- bucketExists b
+    liftIO $ foundBucket @?= False
+    makeBucket b Nothing
+    minioTest liftStep b
+    deleteBucket b
+  isRight ret' @? ("Functional test " ++ t' ++ " failed => " ++ show ret')
+
 liveServerUnitTests :: TestTree
 liveServerUnitTests =
  testGroup
@ -125,7 +155,8 @@ liveServerUnitTests =
      presignedUrlFunTest,
      presignedPostPolicyFunTest,
      bucketPolicyFunTest,
-      getNPutSSECTest
+      getNPutSSECTest,
+      assumeRoleRequestTest
    ]

 basicTests :: TestTree
@ -1187,3 +1218,30 @@ getNPutSSECTest =
        step "Cleanup"
        deleteObject bucket obj
      else step "Skipping encryption test as server is not using TLS"
+
+assumeRoleRequestTest :: TestTree
+assumeRoleRequestTest = testCaseSteps "Assume Role STS API" $ \step -> do
+  step "Load credentials"
+  val <- Env.lookupEnv "MINIO_LOCAL"
+  isSecure <- Env.lookupEnv "MINIO_SECURE"
+  let localMinioCred = Just $ CredentialValue "minio" "minio123" mempty
+      playCreds =
+        case connectCreds minioPlayCI of
+          CredsStatic c -> Just c
+          _ -> Nothing
+      (cvMay, loc) =
+        case (val, isSecure) of
+          (Just _, Just _) -> (localMinioCred, "https://localhost:9000")
+          (Just _, Nothing) -> (localMinioCred, "http://localhost:9000")
+          (Nothing, _) -> (playCreds, "https://play.min.io:9000")
+  cv <- maybe (assertFailure "bad creds") return cvMay
+  let assumeRole =
+        STSAssumeRole cv $
+          defaultSTSAssumeRoleOptions
+            { saroLocation = Just "us-east-1",
+              saroEndpoint = Just loc
+            }
+  step "AssumeRole request"
+  res <- requestSTSCredential assumeRole
+  let v = credentialValueText $ fst res
+  print (v, snd res)
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -1,5 +1,5 @@
 --
-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
 --
 -- Licensed under the Apache License, Version 2.0 (the "License");
 -- you may not use this file except in compliance with the License.
@ -20,7 +20,6 @@ import Lib.Prelude
 import Network.Minio.API.Test
 import Network.Minio.CopyObject
 import Network.Minio.Data
-import Network.Minio.PutObject
 import Network.Minio.Utils.Test
 import Network.Minio.XmlGenerator.Test
 import Network.Minio.XmlParser.Test