Add Credentials module to use Assume Role API

.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

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

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

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')
                 }