Add Credentials module to use Assume Role API (#184)

This exports a new module for retrieving STS based credentials, however they are not yet convenient to use in the library - the session token needs to be included as a custom header and may not be possible with all APIs.
2022-12-23 07:53:27 -08:00 · 2022-12-23 07:53:27 -08:00 · f4ae55468e
commit f4ae55468e
parent d87d67b75b
11 changed files with 663 additions and 176 deletions
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@ -25,7 +25,7 @@ jobs:
    runs-on: ubuntu-latest
    steps:
      - uses: actions/checkout@v3
-      - uses: mrkkrp/ormolu-action@v6
+      - uses: mrkkrp/ormolu-action@v8

  hlint:
    runs-on: ubuntu-latest
--- a/examples/AssumeRole.hs
+++ b/examples/AssumeRole.hs
@ -0,0 +1,33 @@
+--
+-- MinIO Haskell SDK, (C) 2022 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 OverloadedStrings #-}
+
+import Network.Minio.Credentials
+import Prelude
+
+main :: IO ()
+main = do
+  res <-
+    retrieveCredentials
+      $ STSAssumeRole
+        "https://play.min.io"
+        ( CredentialValue
+            "Q3AM3UQ867SPQQA43P2F"
+            "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
+            Nothing
+        )
+      $ defaultSTSAssumeRoleOptions {saroLocation = Just "us-east-1"}
+  print res
--- a/minio-hs.cabal
+++ b/minio-hs.cabal
@ -128,6 +128,7 @@ common base-settings
                     , retry
                     , text >= 1.2
                     , time >= 1.9
+                     , time-units ^>= 1.0.0
                     , transformers >= 0.5
                     , unliftio >= 0.2 && < 0.3
                     , unliftio-core >= 0.2 && < 0.3
@ -140,6 +141,7 @@ 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
@ -339,3 +341,8 @@ executable SetConfig
  import:              examples-settings
  scope:               private
  main-is:             SetConfig.hs
+
+executable AssumeRole
+  import:              examples-settings
+  scope:               private
+  main-is:             AssumeRole.hs
--- a/src/Network/Minio/API.hs
+++ b/src/Network/Minio/API.hs
@ -34,6 +34,7 @@ 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
@ -44,6 +45,7 @@ import Lib.Prelude
 import qualified Network.HTTP.Client as NClient
 import Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
+import Network.HTTP.Types (simpleQueryToQuery)
 import qualified Network.HTTP.Types as HT
 import Network.HTTP.Types.Header (hHost)
 import Network.Minio.APICommon
@ -176,7 +178,8 @@ buildRequest ri = do
  let sp =
        SignParams
          (connectAccessKey ci')
-          (connectSecretKey ci')
+          (BA.convert (encodeUtf8 $ connectSecretKey ci' :: ByteString))
+          ServiceS3
          timeStamp
          (riRegion ri')
          (riPresignExpirySecs ri')
@ -198,8 +201,8 @@ buildRequest ri = do
      | isJust (riPresignExpirySecs ri') ->
          -- case 0 from above.
          do
-            let signPairs = signV4 sp baseRequest
-                qpToAdd = (fmap . fmap) Just signPairs
+            let signPairs = signV4QueryParams sp baseRequest
+                qpToAdd = simpleQueryToQuery signPairs
                existingQueryParams = HT.parseQuery (NC.queryString baseRequest)
                updatedQueryParams = existingQueryParams ++ qpToAdd
            return $ NClient.setQueryString updatedQueryParams baseRequest
@ -229,8 +232,7 @@ buildRequest ri = do
            return $
              baseRequest
                { NC.requestHeaders =
-                    NC.requestHeaders baseRequest
-                      ++ mkHeaderFromPairs signHeaders,
+                    NC.requestHeaders baseRequest ++ signHeaders,
                  NC.requestBody = getRequestBody (riPayload ri')
                }

--- a/src/Network/Minio/AdminAPI.hs
+++ b/src/Network/Minio/AdminAPI.hs
@ -70,6 +70,7 @@ 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
@ -95,9 +96,12 @@ data DriveInfo = DriveInfo
 instance FromJSON DriveInfo where
  parseJSON = withObject "DriveInfo" $ \v ->
    DriveInfo
-      <$> v .: "uuid"
-      <*> v .: "endpoint"
-      <*> v .: "state"
+      <$> v
+        .: "uuid"
+      <*> v
+        .: "endpoint"
+      <*> v
+        .: "state"

 data StorageClass = StorageClass
  { scParity :: Int,
@ -120,12 +124,16 @@ instance FromJSON ErasureInfo where
    offlineDisks <- v .: "OfflineDisks"
    stdClass <-
      StorageClass
-        <$> v .: "StandardSCData"
-        <*> v .: "StandardSCParity"
+        <$> v
+          .: "StandardSCData"
+        <*> v
+          .: "StandardSCParity"
    rrClass <-
      StorageClass
-        <$> v .: "RRSCData"
-        <*> v .: "RRSCParity"
+        <$> v
+          .: "RRSCData"
+        <*> v
+          .: "RRSCParity"
    sets <- v .: "Sets"
    return $ ErasureInfo onlineDisks offlineDisks stdClass rrClass sets

@ -151,8 +159,10 @@ data ConnStats = ConnStats
 instance FromJSON ConnStats where
  parseJSON = withObject "ConnStats" $ \v ->
    ConnStats
-      <$> v .: "transferred"
-      <*> v .: "received"
+      <$> v
+        .: "transferred"
+      <*> v
+        .: "received"

 data ServerProps = ServerProps
  { spUptime :: NominalDiffTime,
@ -182,8 +192,10 @@ data StorageInfo = StorageInfo
 instance FromJSON StorageInfo where
  parseJSON = withObject "StorageInfo" $ \v ->
    StorageInfo
-      <$> v .: "Used"
-      <*> v .: "Backend"
+      <$> v
+        .: "Used"
+      <*> v
+        .: "Backend"

 data CountNAvgTime = CountNAvgTime
  { caCount :: Int64,
@ -194,8 +206,10 @@ data CountNAvgTime = CountNAvgTime
 instance FromJSON CountNAvgTime where
  parseJSON = withObject "CountNAvgTime" $ \v ->
    CountNAvgTime
-      <$> v .: "count"
-      <*> v .: "avgDuration"
+      <$> v
+        .: "count"
+      <*> v
+        .: "avgDuration"

 data HttpStats = HttpStats
  { hsTotalHeads :: CountNAvgTime,
@ -214,16 +228,26 @@ data HttpStats = HttpStats
 instance FromJSON HttpStats where
  parseJSON = withObject "HttpStats" $ \v ->
    HttpStats
-      <$> v .: "totalHEADs"
-      <*> v .: "successHEADs"
-      <*> v .: "totalGETs"
-      <*> v .: "successGETs"
-      <*> v .: "totalPUTs"
-      <*> v .: "successPUTs"
-      <*> v .: "totalPOSTs"
-      <*> v .: "successPOSTs"
-      <*> v .: "totalDELETEs"
-      <*> v .: "successDELETEs"
+      <$> v
+        .: "totalHEADs"
+      <*> v
+        .: "successHEADs"
+      <*> v
+        .: "totalGETs"
+      <*> v
+        .: "successGETs"
+      <*> v
+        .: "totalPUTs"
+      <*> v
+        .: "successPUTs"
+      <*> v
+        .: "totalPOSTs"
+      <*> v
+        .: "successPOSTs"
+      <*> v
+        .: "totalDELETEs"
+      <*> v
+        .: "successDELETEs"

 data SIData = SIData
  { sdStorage :: StorageInfo,
@ -236,10 +260,14 @@ data SIData = SIData
 instance FromJSON SIData where
  parseJSON = withObject "SIData" $ \v ->
    SIData
-      <$> v .: "storage"
-      <*> v .: "network"
-      <*> v .: "http"
-      <*> v .: "server"
+      <$> v
+        .: "storage"
+      <*> v
+        .: "network"
+      <*> v
+        .: "http"
+      <*> v
+        .: "server"

 data ServerInfo = ServerInfo
  { siError :: Text,
@ -251,9 +279,12 @@ data ServerInfo = ServerInfo
 instance FromJSON ServerInfo where
  parseJSON = withObject "ServerInfo" $ \v ->
    ServerInfo
-      <$> v .: "error"
-      <*> v .: "addr"
-      <*> v .: "data"
+      <$> v
+        .: "error"
+      <*> v
+        .: "addr"
+      <*> v
+        .: "data"

 data ServerVersion = ServerVersion
  { svVersion :: Text,
@ -264,8 +295,10 @@ data ServerVersion = ServerVersion
 instance FromJSON ServerVersion where
  parseJSON = withObject "ServerVersion" $ \v ->
    ServerVersion
-      <$> v .: "version"
-      <*> v .: "commitID"
+      <$> v
+        .: "version"
+      <*> v
+        .: "commitID"

 data ServiceStatus = ServiceStatus
  { ssVersion :: ServerVersion,
@ -306,9 +339,12 @@ data HealStartResp = HealStartResp
 instance FromJSON HealStartResp where
  parseJSON = withObject "HealStartResp" $ \v ->
    HealStartResp
-      <$> v .: "clientToken"
-      <*> v .: "clientAddress"
-      <*> v .: "startTime"
+      <$> v
+        .: "clientToken"
+      <*> v
+        .: "clientAddress"
+      <*> v
+        .: "startTime"

 data HealOpts = HealOpts
  { hoRecursive :: Bool,
@ -325,8 +361,10 @@ instance ToJSON HealOpts where
 instance FromJSON HealOpts where
  parseJSON = withObject "HealOpts" $ \v ->
    HealOpts
-      <$> v .: "recursive"
-      <*> v .: "dryRun"
+      <$> v
+        .: "recursive"
+      <*> v
+        .: "dryRun"

 data HealItemType
  = HealItemMetadata
@ -353,9 +391,12 @@ data NodeSummary = NodeSummary
 instance FromJSON NodeSummary where
  parseJSON = withObject "NodeSummary" $ \v ->
    NodeSummary
-      <$> v .: "name"
-      <*> v .: "errSet"
-      <*> v .: "errMsg"
+      <$> v
+        .: "name"
+      <*> v
+        .: "errSet"
+      <*> v
+        .: "errMsg"

 data SetConfigResult = SetConfigResult
  { scrStatus :: Bool,
@ -366,8 +407,10 @@ data SetConfigResult = SetConfigResult
 instance FromJSON SetConfigResult where
  parseJSON = withObject "SetConfigResult" $ \v ->
    SetConfigResult
-      <$> v .: "status"
-      <*> v .: "nodeResults"
+      <$> v
+        .: "status"
+      <*> v
+        .: "nodeResults"

 data HealResultItem = HealResultItem
  { hriResultIdx :: Int,
@ -388,16 +431,26 @@ data HealResultItem = HealResultItem
 instance FromJSON HealResultItem where
  parseJSON = withObject "HealResultItem" $ \v ->
    HealResultItem
-      <$> v .: "resultId"
-      <*> v .: "type"
-      <*> v .: "bucket"
-      <*> v .: "object"
-      <*> v .: "detail"
-      <*> v .:? "parityBlocks"
-      <*> v .:? "dataBlocks"
-      <*> v .: "diskCount"
-      <*> v .: "setCount"
-      <*> v .: "objectSize"
+      <$> v
+        .: "resultId"
+      <*> v
+        .: "type"
+      <*> v
+        .: "bucket"
+      <*> v
+        .: "object"
+      <*> v
+        .: "detail"
+      <*> v
+        .:? "parityBlocks"
+      <*> v
+        .:? "dataBlocks"
+      <*> v
+        .: "diskCount"
+      <*> v
+        .: "setCount"
+      <*> v
+        .: "objectSize"
      <*> ( do
              before <- v .: "before"
              before .: "drives"
@ -420,12 +473,18 @@ data HealStatus = HealStatus
 instance FromJSON HealStatus where
  parseJSON = withObject "HealStatus" $ \v ->
    HealStatus
-      <$> v .: "Summary"
-      <*> v .: "StartTime"
-      <*> v .: "Settings"
-      <*> v .: "NumDisks"
-      <*> v .:? "Detail"
-      <*> v .: "Items"
+      <$> v
+        .: "Summary"
+      <*> v
+        .: "StartTime"
+      <*> v
+        .: "Settings"
+      <*> v
+        .: "NumDisks"
+      <*> v
+        .:? "Detail"
+      <*> v
+        .: "Items"

 healPath :: Maybe Bucket -> Maybe Text -> ByteString
 healPath bucket prefix = do
@ -620,7 +679,8 @@ buildAdminRequest areq = do
      sp =
        SignParams
          (connectAccessKey ci)
-          (connectSecretKey ci)
+          (BA.convert (encodeUtf8 $ connectSecretKey ci :: ByteString))
+          ServiceS3
          timeStamp
          Nothing
          Nothing
@ -630,7 +690,7 @@ buildAdminRequest areq = do
  -- Update signReq with Authorization header containing v4 signature
  return
    signReq
-      { NC.requestHeaders = ariHeaders newAreq ++ mkHeaderFromPairs signHeaders
+      { NC.requestHeaders = ariHeaders newAreq ++ signHeaders
      }
  where
    toRequest :: ConnectInfo -> AdminReqInfo -> NC.Request
--- a/src/Network/Minio/Credentials.hs
+++ b/src/Network/Minio/Credentials.hs
@ -0,0 +1,144 @@
+--
+-- MinIO Haskell SDK, (C) 2017-2022 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
+  ( CredentialValue (..),
+    CredentialProvider (..),
+    AccessKey,
+    SecretKey,
+    SessionToken,
+    defaultSTSAssumeRoleOptions,
+    STSAssumeRole (..),
+    STSAssumeRoleOptions (..),
+  )
+where
+
+import qualified Data.Time as Time
+import Data.Time.Units (Second)
+import Network.HTTP.Client (RequestBody (RequestBodyBS))
+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)
+
+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 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
+  }
+
+-- | Default STS Assume Role options
+defaultSTSAssumeRoleOptions :: STSAssumeRoleOptions
+defaultSTSAssumeRoleOptions =
+  STSAssumeRoleOptions
+    { saroDurationSeconds = Just defaultDurationSeconds,
+      saroPolicyJSON = Nothing,
+      saroLocation = Nothing,
+      saroRoleARN = Nothing,
+      saroRoleSessionName = Nothing,
+      saroHTTPManager = Nothing
+    }
+
+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
+            }
+
+    -- 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
--- a/src/Network/Minio/Data.hs
+++ b/src/Network/Minio/Data.hs
@ -232,16 +232,14 @@ isConnectInfoSecure = connectIsSecure
 disableTLSCertValidation :: ConnectInfo -> ConnectInfo
 disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}

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

 -- | Default Google Compute Storage ConnectInfo. Works only for
 -- "Simple Migration" use-case with interoperability mode enabled on
@ -1002,6 +1000,47 @@ 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
--- a/src/Network/Minio/PresignedOperations.hs
+++ b/src/Network/Minio/PresignedOperations.hs
@ -39,6 +39,7 @@ 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
@ -300,7 +301,7 @@ presignedPostPolicy p = do
  ci <- asks mcConnInfo
  signTime <- liftIO Time.getCurrentTime

-  let extraConditions =
+  let extraConditions signParams =
        [ PPCEquals "x-amz-date" (toText $ awsTimeFormat signTime),
          PPCEquals "x-amz-algorithm" "AWS4-HMAC-SHA256",
          PPCEquals
@ -308,23 +309,24 @@ presignedPostPolicy p = do
            ( T.intercalate
                "/"
                [ connectAccessKey ci,
-                  decodeUtf8 $ mkScope signTime region
+                  decodeUtf8 $ credentialScope signParams
                ]
            )
        ]
-      ppWithCreds =
+      ppWithCreds signParams =
        p
-          { conditions = conditions p ++ extraConditions
+          { conditions = conditions p ++ extraConditions signParams
          }
      sp =
        SignParams
          (connectAccessKey ci)
-          (connectSecretKey ci)
+          (BA.convert (encodeUtf8 $ connectSecretKey ci :: ByteString))
+          ServiceS3
          signTime
          (Just $ connectRegion ci)
          Nothing
          Nothing
-      signData = signV4PostPolicy (showPostPolicy ppWithCreds) sp
+      signData = signV4PostPolicy (showPostPolicy $ ppWithCreds sp) sp
      -- compute form-data
      mkPair (PPCStartsWith k v) = Just (k, v)
      mkPair (PPCEquals k v) = Just (k, v)
@ -334,12 +336,11 @@ presignedPostPolicy p = do
          H.fromList $
            mapMaybe
              mkPair
-              (conditions ppWithCreds)
+              (conditions $ ppWithCreds sp)
      formData = formFromPolicy `H.union` signData
      -- compute POST upload URL
      bucket = H.lookupDefault "" "bucket" formData
      scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci
-      region = connectRegion ci
      url =
        toStrictBS $
          toLazyByteString $
--- a/src/Network/Minio/Sign/V4.hs
+++ b/src/Network/Minio/Sign/V4.hs
@ -18,19 +18,22 @@
 module Network.Minio.Sign.V4 where

 import qualified Conduit as C
+import qualified Data.ByteArray as BA
 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
+import Data.List (partition)
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Time as Time
 import Lib.Prelude
 import qualified Network.HTTP.Conduit as NC
-import Network.HTTP.Types (Header, parseQuery)
+import Network.HTTP.Types (Header, SimpleQuery, hContentEncoding, parseQuery)
 import qualified Network.HTTP.Types as H
+import Network.HTTP.Types.Header (RequestHeaders)
 import Network.Minio.Data.ByteString
 import Network.Minio.Data.Crypto
 import Network.Minio.Data.Time
@ -60,9 +63,17 @@ data SignV4Data = SignV4Data
  }
  deriving stock (Show)

+data Service = ServiceS3 | ServiceSTS
+  deriving stock (Eq, Show)
+
+toByteString :: Service -> ByteString
+toByteString ServiceS3 = "s3"
+toByteString ServiceSTS = "sts"
+
 data SignParams = SignParams
  { spAccessKey :: Text,
-    spSecretKey :: Text,
+    spSecretKey :: BA.ScrubbedBytes,
+    spService :: Service,
    spTimeStamp :: UTCTime,
    spRegion :: Maybe Text,
    spExpirySecs :: Maybe UrlExpiry,
@ -102,6 +113,9 @@ mkAuthHeader accessKey scope signedHeaderKeys sign =
          ]
   in (H.hAuthorization, authValue)

+data IsStreaming = IsStreamingLength Int64 | NotStreaming
+  deriving stock (Eq, Show)
+
 -- | 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
@ -114,33 +128,19 @@ mkAuthHeader accessKey scope signedHeaderKeys sign =
 -- is being created. The expiry is interpreted as an integer number of
 -- seconds. The output will be the list of query-parameters to add to
 -- the request.
-signV4 :: SignParams -> NC.Request -> [(ByteString, ByteString)]
-signV4 !sp !req =
-  let region = fromMaybe "" $ spRegion sp
-      ts = spTimeStamp sp
-      scope = mkScope ts region
-      accessKey = encodeUtf8 $ spAccessKey sp
-      secretKey = encodeUtf8 $ spSecretKey sp
+signV4QueryParams :: SignParams -> NC.Request -> SimpleQuery
+signV4QueryParams !sp !req =
+  let scope = credentialScope sp
      expiry = spExpirySecs sp
-      sha256Hdr =
-        ( "x-amz-content-sha256",
-          fromMaybe "UNSIGNED-PAYLOAD" $ spPayloadHash sp
-        )
-      -- headers to be added to the request
-      datePair = ("X-Amz-Date", awsTimeFormatBS ts)
-      computedHeaders =
-        NC.requestHeaders req
-          ++ if isJust expiry
-            then []
-            else map (first mk) [datePair, sha256Hdr]
-      headersToSign = getHeadersToSign computedHeaders
+
+      headersToSign = getHeadersToSign $ NC.requestHeaders req
      signedHeaderKeys = B.intercalate ";" $ sort $ map fst headersToSign
      -- query-parameters to be added before signing for presigned URLs
      -- (i.e. when `isJust expiry`)
      authQP =
        [ ("X-Amz-Algorithm", "AWS4-HMAC-SHA256"),
-          ("X-Amz-Credential", B.concat [accessKey, "/", scope]),
-          datePair,
+          ("X-Amz-Credential", B.concat [encodeUtf8 $ spAccessKey sp, "/", scope]),
+          ("X-Amz-Date", awsTimeFormatBS $ spTimeStamp sp),
          ("X-Amz-Expires", maybe "" showBS expiry),
          ("X-Amz-SignedHeaders", signedHeaderKeys)
        ]
@ -156,40 +156,129 @@ signV4 !sp !req =
          sp
          (NC.setQueryString finalQP req)
          headersToSign
+
      -- 2. compute string to sign
-      stringToSign = mkStringToSign ts scope canonicalRequest
+      stringToSign = mkStringToSign (spTimeStamp sp) scope canonicalRequest
      -- 3.1 compute signing key
-      signingKey = mkSigningKey ts region secretKey
+      signingKey = getSigningKey sp
+      -- 3.2 compute signature
+      signature = computeSignature stringToSign signingKey
+   in ("X-Amz-Signature", signature) : authQP
+
+-- | 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 Authorization header, which
+-- includes the signature.
+--
+-- The output is the list of headers to be added to authenticate the request.
+signV4 :: SignParams -> NC.Request -> [Header]
+signV4 !sp !req =
+  let scope = credentialScope sp
+
+      -- extra headers to be added for signing purposes.
+      extraHeaders =
+        ("X-Amz-Date", awsTimeFormatBS $ spTimeStamp sp)
+          : ( -- payload hash is only used for S3 (not STS)
+              [ ( "x-amz-content-sha256",
+                  fromMaybe "UNSIGNED-PAYLOAD" $ spPayloadHash sp
+                )
+                | spService sp == ServiceS3
+              ]
+            )
+
+      -- 1. compute canonical request
+      reqHeaders = NC.requestHeaders req ++ extraHeaders
+      (canonicalRequest, signedHeaderKeys) =
+        getCanonicalRequestAndSignedHeaders
+          NotStreaming
+          sp
+          req
+          reqHeaders
+
+      -- 2. compute string to sign
+      stringToSign = mkStringToSign (spTimeStamp sp) scope canonicalRequest
+      -- 3.1 compute signing key
+      signingKey = getSigningKey sp
      -- 3.2 compute signature
      signature = computeSignature stringToSign signingKey
      -- 4. compute auth header
      authHeader = mkAuthHeader (spAccessKey sp) scope signedHeaderKeys signature
-      -- finally compute output pairs
-      output =
-        if isJust expiry
-          then ("X-Amz-Signature", signature) : authQP
-          else
-            [ first CI.foldedCase authHeader,
-              datePair,
-              sha256Hdr
-            ]
-   in output
+   in authHeader : extraHeaders

-mkScope :: UTCTime -> Text -> ByteString
-mkScope ts region =
-  B.intercalate
-    "/"
-    [ encodeUtf8 $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,
-      encodeUtf8 region,
-      "s3",
-      "aws4_request"
-    ]
+credentialScope :: SignParams -> ByteString
+credentialScope sp =
+  let region = fromMaybe "" $ spRegion sp
+   in B.intercalate
+        "/"
+        [ encodeUtf8 $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" $ spTimeStamp sp,
+          encodeUtf8 region,
+          toByteString $ spService sp,
+          "aws4_request"
+        ]

+-- Folds header name, trims whitespace in header values, skips ignored headers
+-- and sorts headers.
 getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
 getHeadersToSign !h =
  filter ((\hdr -> not $ Set.member hdr ignoredHeaders) . fst) $
    map (bimap CI.foldedCase stripBS) h

+-- | Given the list of headers in the request, computes the canonical headers
+-- and the signed headers strings.
+getCanonicalHeaders :: NonEmpty Header -> (ByteString, ByteString)
+getCanonicalHeaders h =
+  let -- Folds header name, trims spaces in header values, skips ignored
+      -- headers and sorts headers by name (we must not re-order multi-valued
+      -- headers).
+      headersToSign =
+        NE.toList $
+          NE.sortBy (\a b -> compare (fst a) (fst b)) $
+            NE.fromList $
+              NE.filter ((\hdr -> not $ Set.member hdr ignoredHeaders) . fst) $
+                NE.map (bimap CI.foldedCase stripBS) h
+
+      canonicalHeaders = mconcat $ map (\(a, b) -> a <> ":" <> b <> "\n") headersToSign
+      signedHeaderKeys = B.intercalate ";" $ map fst headersToSign
+   in (canonicalHeaders, signedHeaderKeys)
+
+getCanonicalRequestAndSignedHeaders ::
+  IsStreaming ->
+  SignParams ->
+  NC.Request ->
+  [Header] ->
+  (ByteString, ByteString)
+getCanonicalRequestAndSignedHeaders isStreaming sp req requestHeaders =
+  let httpMethod = NC.method req
+
+      canonicalUri = uriEncode False $ NC.path req
+
+      canonicalQueryString =
+        B.intercalate "&" $
+          map (\(x, y) -> B.concat [x, "=", y]) $
+            sort $
+              map
+                ( bimap (uriEncode True) (maybe "" (uriEncode True))
+                )
+                (parseQuery $ NC.queryString req)
+
+      (canonicalHeaders, signedHeaderKeys) = getCanonicalHeaders $ NE.fromList requestHeaders
+      payloadHashStr =
+        case isStreaming of
+          IsStreamingLength _ -> "STREAMING-AWS4-HMAC-SHA256-PAYLOAD"
+          NotStreaming -> fromMaybe "UNSIGNED-PAYLOAD" $ spPayloadHash sp
+
+      canonicalRequest =
+        B.intercalate
+          "\n"
+          [ httpMethod,
+            canonicalUri,
+            canonicalQueryString,
+            canonicalHeaders,
+            signedHeaderKeys,
+            payloadHashStr
+          ]
+   in (canonicalRequest, signedHeaderKeys)
+
 mkCanonicalRequest ::
  Bool ->
  SignParams ->
@ -197,10 +286,12 @@ mkCanonicalRequest ::
  [(ByteString, ByteString)] ->
  ByteString
 mkCanonicalRequest !isStreaming !sp !req !headersForSign =
-  let canonicalQueryString =
+  let httpMethod = NC.method req
+      canonicalUri = uriEncode False $ NC.path req
+      canonicalQueryString =
        B.intercalate "&" $
          map (\(x, y) -> B.concat [x, "=", y]) $
-            sort $
+            sortBy (\a b -> compare (fst a) (fst b)) $
              map
                ( bimap (uriEncode True) (maybe "" (uriEncode True))
                )
@ -216,8 +307,8 @@ mkCanonicalRequest !isStreaming !sp !req !headersForSign =
          else fromMaybe "UNSIGNED-PAYLOAD" $ spPayloadHash sp
   in B.intercalate
        "\n"
-        [ NC.method req,
-          uriEncode False $ NC.path req,
+        [ httpMethod,
+          canonicalUri,
          canonicalQueryString,
          canonicalHeaders,
          signedHeaders,
@ -234,13 +325,13 @@ mkStringToSign ts !scope !canonicalRequest =
      hashSHA256 canonicalRequest
    ]

-mkSigningKey :: UTCTime -> Text -> ByteString -> ByteString
-mkSigningKey ts region !secretKey =
+getSigningKey :: SignParams -> ByteString
+getSigningKey sp =
  hmacSHA256RawBS "aws4_request"
-    . hmacSHA256RawBS "s3"
-    . hmacSHA256RawBS (encodeUtf8 region)
-    . hmacSHA256RawBS (awsDateFormatBS ts)
-    $ B.concat ["AWS4", secretKey]
+    . hmacSHA256RawBS (toByteString $ spService sp)
+    . hmacSHA256RawBS (encodeUtf8 $ fromMaybe "" $ spRegion sp)
+    . hmacSHA256RawBS (awsDateFormatBS $ spTimeStamp sp)
+    $ B.concat ["AWS4", BA.convert $ spSecretKey sp]

 computeSignature :: ByteString -> ByteString -> ByteString
 computeSignature !toSign !key = digestToBase16 $ hmacSHA256 toSign key
@ -254,8 +345,7 @@ signV4PostPolicy ::
  Map.HashMap Text ByteString
 signV4PostPolicy !postPolicyJSON !sp =
  let stringToSign = Base64.encode postPolicyJSON
-      region = fromMaybe "" $ spRegion sp
-      signingKey = mkSigningKey (spTimeStamp sp) region $ encodeUtf8 $ spSecretKey sp
+      signingKey = getSigningKey sp
      signature = computeSignature stringToSign signingKey
   in Map.fromList
        [ ("x-amz-signature", signature),
@ -284,60 +374,59 @@ signedStreamLength dataLen =
      finalChunkSize = 1 + 17 + 64 + 2 + 2
   in numChunks * fullChunkSize + lastChunkSize + finalChunkSize

+-- For streaming S3, we need to update the content-encoding header.
+addContentEncoding :: [Header] -> [Header]
+addContentEncoding hs =
+  -- assume there is at most one content-encoding header.
+  let (ceHdrs, others) = partition ((== hContentEncoding) . fst) hs
+   in maybe
+        (hContentEncoding, "aws-chunked")
+        (\(k, v) -> (k, v <> ",aws-chunked"))
+        (listToMaybe ceHdrs)
+        : others
+
 signV4Stream ::
  Int64 ->
  SignParams ->
  NC.Request ->
  (C.ConduitT () ByteString (C.ResourceT IO) () -> NC.Request)
-- -> ([Header], C.ConduitT () ByteString (C.ResourceT IO) () -> NC.RequestBody)
 signV4Stream !payloadLength !sp !req =
  let ts = spTimeStamp sp
-      addContentEncoding hs =
-        let ceMay = find (\(x, _) -> x == "content-encoding") hs
-         in case ceMay of
-              Nothing -> ("content-encoding", "aws-chunked") : hs
-              Just (_, ce) ->
-                ("content-encoding", ce <> ",aws-chunked")
-                  : filter (\(x, _) -> x /= "content-encoding") hs
-      -- headers to be added to the request
-      datePair = ("X-Amz-Date", awsTimeFormatBS ts)
-      computedHeaders =
-        addContentEncoding $
-          datePair : NC.requestHeaders req
-      -- headers specific to streaming signature
+
+      -- compute the updated list of headers to be added for signing purposes.
      signedContentLength = signedStreamLength payloadLength
-      streamingHeaders :: [Header]
-      streamingHeaders =
-        [ ("x-amz-decoded-content-length", showBS payloadLength),
+      extraHeaders =
+        [ ("X-Amz-Date", awsTimeFormatBS $ spTimeStamp sp),
+          ("x-amz-decoded-content-length", showBS payloadLength),
          ("content-length", showBS signedContentLength),
          ("x-amz-content-sha256", "STREAMING-AWS4-HMAC-SHA256-PAYLOAD")
        ]
-      headersToSign = getHeadersToSign $ computedHeaders ++ streamingHeaders
-      signedHeaderKeys = B.intercalate ";" $ sort $ map fst headersToSign
-      finalQP = parseQuery (NC.queryString req)
+      requestHeaders =
+        addContentEncoding $
+          foldr setHeader (NC.requestHeaders req) extraHeaders
+
      -- 1. Compute Seed Signature
      -- 1.1 Canonical Request
-      canonicalReq =
-        mkCanonicalRequest
-          True
+      (canonicalReq, signedHeaderKeys) =
+        getCanonicalRequestAndSignedHeaders
+          (IsStreamingLength payloadLength)
          sp
-          (NC.setQueryString finalQP req)
-          headersToSign
-      region = fromMaybe "" $ spRegion sp
-      scope = mkScope ts region
+          req
+          requestHeaders
+
+      scope = credentialScope sp
      accessKey = spAccessKey sp
-      secretKey = spSecretKey sp
      -- 1.2 String toSign
      stringToSign = mkStringToSign ts scope canonicalReq
      -- 1.3 Compute signature
      -- 1.3.1 compute signing key
-      signingKey = mkSigningKey ts region $ encodeUtf8 secretKey
+      signingKey = getSigningKey sp
      -- 1.3.2 Compute signature
      seedSignature = computeSignature stringToSign signingKey
      -- 1.3.3 Compute Auth Header
      authHeader = mkAuthHeader accessKey scope signedHeaderKeys seedSignature
      -- 1.4 Updated headers for the request
-      finalReqHeaders = authHeader : (computedHeaders ++ streamingHeaders)
+      finalReqHeaders = authHeader : requestHeaders
      -- headersToAdd = authHeader : datePair : streamingHeaders

      toHexStr n = B8.pack $ printf "%x" n
@ -407,3 +496,9 @@ signV4Stream !payloadLength !sp !req =
              NC.requestBodySource signedContentLength $
                src C..| signerConduit numParts lastPSize seedSignature
          }
+
+-- "setHeader r hdr" adds the hdr to r, replacing it in r if it already exists.
+setHeader :: Header -> RequestHeaders -> RequestHeaders
+setHeader hdr r =
+  let r' = filter (\(name, _) -> name /= fst hdr) r
+   in hdr : r'
--- a/src/Network/Minio/XmlParser.hs
+++ b/src/Network/Minio/XmlParser.hs
@ -27,9 +27,11 @@ 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)
@ -220,8 +222,8 @@ parseListPartsResponse xmldata = do
 parseErrResponse :: (MonadIO m) => LByteString -> m ServiceErr
 parseErrResponse xmldata = do
  r <- parseRoot xmldata
-  let code = T.concat $ r $/ element "Code" &/ content
-      message = T.concat $ r $/ element "Message" &/ content
+  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
@ -269,3 +271,102 @@ 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
@ -279,7 +279,8 @@ lowLevelMultipartTest = funTestWithBucket "Low-level Multipart Test" $
    fGetObject bucket object destFile defaultGetObjectOptions
    gotSize <- withNewHandle destFile getFileSize
    liftIO $
-      gotSize == Right (Just mb15)
+      gotSize
+        == Right (Just mb15)
        @? "Wrong file size of put file after getting"

    step "Cleanup actions"
@ -303,7 +304,8 @@ putObjectSizeTest = funTestWithBucket "PutObject of conduit source with size" $
    fGetObject bucket obj destFile defaultGetObjectOptions
    gotSize <- withNewHandle destFile getFileSize
    liftIO $
-      gotSize == Right (Just mb1)
+      gotSize
+        == Right (Just mb1)
        @? "Wrong file size of put file after getting"

    step "Cleanup actions"
@ -327,7 +329,8 @@ putObjectNoSizeTest = funTestWithBucket "PutObject of conduit source with no siz
    fGetObject bucket obj destFile defaultGetObjectOptions
    gotSize <- withNewHandle destFile getFileSize
    liftIO $
-      gotSize == Right (Just mb70)
+      gotSize
+        == Right (Just mb70)
        @? "Wrong file size of put file after getting"

    step "Cleanup actions"
@ -569,6 +572,7 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $
        []
        []

+    print putUrl
    let size1 = 1000 :: Int64
    inputFile <- mkRandFile size1

@ -1176,7 +1180,8 @@ getNPutSSECTest =

        gotSize <- withNewHandle dstFile getFileSize
        liftIO $
-          gotSize == Right (Just mb1)
+          gotSize
+            == Right (Just mb1)
            @? "Wrong file size of object when getting"

        step "Cleanup"