From fa62ed599a108f005e2c4e40b0859838c346aa24 Mon Sep 17 00:00:00 2001 From: Aditya Manthramurthy Date: Wed, 3 May 2023 17:52:46 -0700 Subject: [PATCH] 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. --- CHANGELOG.md | 14 +- README.md | 2 +- examples/AssumeRole.hs | 38 ++- minio-hs.cabal | 9 +- src/Network/Minio.hs | 28 ++- src/Network/Minio/API.hs | 28 ++- src/Network/Minio/AdminAPI.hs | 12 +- src/Network/Minio/Credentials.hs | 161 ++++-------- src/Network/Minio/Credentials/AssumeRole.hs | 264 ++++++++++++++++++++ src/Network/Minio/Credentials/Types.hs | 85 +++++++ src/Network/Minio/Data.hs | 186 ++++++-------- src/Network/Minio/Errors.hs | 3 +- src/Network/Minio/PresignedOperations.hs | 16 +- src/Network/Minio/S3API.hs | 10 +- src/Network/Minio/Sign/V4.hs | 52 ++-- src/Network/Minio/Utils.hs | 70 ++---- src/Network/Minio/XmlCommon.hs | 65 +++++ src/Network/Minio/XmlGenerator.hs | 3 +- src/Network/Minio/XmlParser.hs | 146 +---------- test/LiveServer.hs | 76 +++++- test/Spec.hs | 3 +- 21 files changed, 781 insertions(+), 490 deletions(-) create mode 100644 src/Network/Minio/Credentials/AssumeRole.hs create mode 100644 src/Network/Minio/Credentials/Types.hs create mode 100644 src/Network/Minio/XmlCommon.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 7c18bee..31e3336 100644 --- 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 diff --git a/README.md b/README.md index a6703c8..1553931 100644 --- 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. diff --git a/examples/AssumeRole.hs b/examples/AssumeRole.hs index 649f517..a053ddf 100644 --- 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 diff --git a/minio-hs.cabal b/minio-hs.cabal index bdb2242..620ef4c 100644 --- 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 diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 0a882c9..3cfd9bf 100644 --- 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 -- @@ -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] diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 60a676c..34f45dd 100644 --- 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') diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs index c12db15..fc3ed46 100644 --- 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 diff --git a/src/Network/Minio/Credentials.hs b/src/Network/Minio/Credentials.hs index ccbf179..2920370 100644 --- 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 diff --git a/src/Network/Minio/Credentials/AssumeRole.hs b/src/Network/Minio/Credentials/AssumeRole.hs new file mode 100644 index 0000000..0328ec6 --- /dev/null +++ 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: +-- +-- +-- +-- Alice +-- +-- arn:aws:sts::123456789012:assumed-role/demo/TestAR +-- ARO123EXAMPLE123:TestAR +-- +-- +-- ASIAIOSFODNN7EXAMPLE +-- wJalrXUtnFEMI/K7MDENG/bPxRfiCYzEXAMPLEKEY +-- +-- AQoDYXdzEPT//////////wEXAMPLEtc764bNrC9SAPBSM22wDOk4x4HIZ8j4FZTwdQW +-- LWsKWHGBuFqwAeMicRXmxfpSPfIeoIYRqTflfKD8YUuwthAx7mSEI/qkPpKPi/kMcGd +-- QrmGdeehM4IC1NtBmUpp2wUE8phUZampKsburEDy0KPkyQDYwT7WZ0wq5VSXDvp75YU +-- 9HFvlRd8Tx6q6fE8YQcHNVXAkiY9q6d+xo0rKwT38xVqr7ZD0u0iPPkUL64lIZbqBAz +-- +scqKmlzm8FDrypNC9Yjc8fPOLn9FX9KSYvKTr4rvx3iSIlTJabIQwj2ICCR/oLxBA== +-- +-- 2019-11-09T13:34:41Z +-- +-- 6 +-- +-- +-- c6104cbe-af31-11e0-8154-cbc7ccf896c7 +-- +-- +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 + ) diff --git a/src/Network/Minio/Credentials/Types.hs b/src/Network/Minio/Credentials/Types.hs new file mode 100644 index 0000000..a9c33bc --- /dev/null +++ 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 +-- 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) diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 53b2823..6e53d5a 100644 --- 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 diff --git a/src/Network/Minio/Errors.hs b/src/Network/Minio/Errors.hs index 91c6860..fa6ac0b 100644 --- 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 diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index f651deb..631f302 100644 --- 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) diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 80555f0..f628b48 100644 --- 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 +-- +-- Lower-level API for S3 compatible object stores. Start with @Network.Minio@ +-- and use this only if needed. module Network.Minio.S3API ( Region, getLocation, diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 73f9f2a..f822e44 100644 --- 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 diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index 2ecab7c..f985ddc 100644 --- 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 diff --git a/src/Network/Minio/XmlCommon.hs b/src/Network/Minio/XmlCommon.hs new file mode 100644 index 0000000..6c428ce --- /dev/null +++ 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 diff --git a/src/Network/Minio/XmlGenerator.hs b/src/Network/Minio/XmlGenerator.hs index 730def0..a7f8c31 100644 --- 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 diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index ae55d48..46e4bcf 100644 --- 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 - --- --- --- Alice --- --- arn:aws:sts::123456789012:assumed-role/demo/TestAR --- ARO123EXAMPLE123:TestAR --- --- --- ASIAIOSFODNN7EXAMPLE --- wJalrXUtnFEMI/K7MDENG/bPxRfiCYzEXAMPLEKEY --- --- AQoDYXdzEPT//////////wEXAMPLEtc764bNrC9SAPBSM22wDOk4x4HIZ8j4FZTwdQW --- LWsKWHGBuFqwAeMicRXmxfpSPfIeoIYRqTflfKD8YUuwthAx7mSEI/qkPpKPi/kMcGd --- QrmGdeehM4IC1NtBmUpp2wUE8phUZampKsburEDy0KPkyQDYwT7WZ0wq5VSXDvp75YU --- 9HFvlRd8Tx6q6fE8YQcHNVXAkiY9q6d+xo0rKwT38xVqr7ZD0u0iPPkUL64lIZbqBAz --- +scqKmlzm8FDrypNC9Yjc8fPOLn9FX9KSYvKTr4rvx3iSIlTJabIQwj2ICCR/oLxBA== --- --- 2019-11-09T13:34:41Z --- --- 6 --- --- --- c6104cbe-af31-11e0-8154-cbc7ccf896c7 --- --- - -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 - } diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 613caf3..7f73070 100644 --- 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) diff --git a/test/Spec.hs b/test/Spec.hs index e851043..5eadd5b 100644 --- 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