From aa2382b2e9503a16d00e9c71f2f2d0ebb14186c4 Mon Sep 17 00:00:00 2001 From: Aditya Manthramurthy Date: Mon, 8 Mar 2021 16:35:52 -0800 Subject: [PATCH] Use region specific endpoints for AWS S3 in presigned Urls (#164) - Also update standard S3 endpoints - Unify code that determines if path style or virtual style must be used for regular and presigned requests Fixes #160 --- minio-hs.cabal | 1 + src/Network/Minio/API.hs | 116 ++++++++++++++++------- src/Network/Minio/APICommon.hs | 8 ++ src/Network/Minio/Data.hs | 37 ++++---- src/Network/Minio/Data/Time.hs | 5 + src/Network/Minio/PresignedOperations.hs | 53 ++++------- src/Network/Minio/Sign/V4.hs | 2 +- test/LiveServer.hs | 1 - 8 files changed, 132 insertions(+), 91 deletions(-) diff --git a/minio-hs.cabal b/minio-hs.cabal index de76b9e..3cda739 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -77,6 +77,7 @@ common base-settings , http-types >= 0.12 , ini , memory >= 0.14 + , network-uri , raw-strings-qq >= 1 , resourcet >= 1.2 , retry diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index eb8d113..2d9d49b 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -19,6 +19,7 @@ module Network.Minio.API S3ReqInfo (..), runMinio, executeRequest, + buildRequest, mkStreamRequest, getLocation, isValidBucketName, @@ -40,6 +41,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 qualified Network.HTTP.Client as NClient import Network.HTTP.Conduit (Response) import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT @@ -78,6 +80,7 @@ discoverRegion ri = runMaybeT $ do return regionMay +-- | Returns the region to be used for the request. getRegion :: S3ReqInfo -> Minio (Maybe Region) getRegion ri = do ci <- asks mcConnInfo @@ -104,6 +107,42 @@ getRegionHost r = do (H.lookup r awsRegionMap) else return $ connectHost ci +-- | Computes the appropriate host, path and region for the request. +-- +-- For AWS, always use virtual bucket style, unless bucket has periods. For +-- MinIO and other non-AWS, default to path style. +getHostPathRegion :: S3ReqInfo -> Minio (Text, ByteString, Maybe Region) +getHostPathRegion ri = do + ci <- asks mcConnInfo + regionMay <- getRegion ri + case riBucket ri of + Nothing -> + -- Implies a ListBuckets request. + return (connectHost ci, "/", regionMay) + Just bucket -> do + regionHost <- case regionMay of + Nothing -> return $ connectHost ci + Just "" -> return $ connectHost ci + Just r -> getRegionHost r + let pathStyle = + ( regionHost, + getS3Path (riBucket ri) (riObject ri), + regionMay + ) + virtualStyle = + ( ( bucket <> "." <> regionHost, + encodeUtf8 $ "/" <> fromMaybe "" (riObject ri), + regionMay + ) + ) + if + | isAWSConnectInfo ci -> + return $ + if bucketHasPeriods bucket + then pathStyle + else virtualStyle + | otherwise -> return pathStyle + buildRequest :: S3ReqInfo -> Minio NC.Request buildRequest ri = do maybe (return ()) checkBucketNameValidity $ riBucket ri @@ -111,17 +150,15 @@ buildRequest ri = do ci <- asks mcConnInfo - regionMay <- getRegion ri + (host, path, regionMay) <- getHostPathRegion ri - regionHost <- maybe (return $ connectHost ci) getRegionHost regionMay - - let ri' = + let ci' = ci {connectHost = host} + hostHeader = (hHost, getHostAddr ci') + ri' = ri { riHeaders = hostHeader : riHeaders ri, riRegion = regionMay } - ci' = ci {connectHost = regionHost} - hostHeader = (hHost, getHostAddr ci') -- Does not contain body and auth info. baseRequest = NC.defaultRequest @@ -129,7 +166,7 @@ buildRequest ri = do NC.secure = connectIsSecure ci', NC.host = encodeUtf8 $ connectHost ci', NC.port = connectPort ci', - NC.path = getS3Path (riBucket ri') (riObject ri'), + NC.path = path, NC.requestHeaders = riHeaders ri', NC.queryString = HT.renderQuery False $ riQueryParams ri' } @@ -142,11 +179,13 @@ buildRequest ri = do (connectSecretKey ci') timeStamp (riRegion ri') - Nothing + (riPresignExpirySecs ri') Nothing -- Cases to handle: -- + -- 0. Handle presign URL case. + -- -- 1. Connection is secure: use unsigned payload -- -- 2. Insecure connection, streaming signature is enabled via use of @@ -155,33 +194,44 @@ buildRequest ri = do -- 3. Insecure connection, non-conduit payload: compute payload -- sha256hash, buffer request in memory and perform request. - -- case 2 from above. if - | isStreamingPayload (riPayload ri') - && (not $ connectIsSecure ci') -> do - (pLen, pSrc) <- case riPayload ri of - PayloadC l src -> return (l, src) - _ -> throwIO MErrVUnexpectedPayload - let reqFn = signV4Stream pLen sp baseRequest - return $ reqFn pSrc - | otherwise -> do - -- case 1 described above. - sp' <- - if - | connectIsSecure ci' -> return sp - -- case 3 described above. - | otherwise -> do - pHash <- getPayloadSHA256Hash $ riPayload ri' - return $ sp {spPayloadHash = Just pHash} + | isJust (riPresignExpirySecs ri') -> + -- case 0 from above. + do + let signPairs = signV4 sp baseRequest + qpToAdd = (fmap . fmap) Just signPairs + existingQueryParams = HT.parseQuery (NC.queryString baseRequest) + updatedQueryParams = existingQueryParams ++ qpToAdd + return $ NClient.setQueryString updatedQueryParams baseRequest + | isStreamingPayload (riPayload ri') && (not $ connectIsSecure ci') -> + -- case 2 from above. + do + (pLen, pSrc) <- case riPayload ri of + PayloadC l src -> return (l, src) + _ -> throwIO MErrVUnexpectedPayload + let reqFn = signV4Stream pLen sp baseRequest + return $ reqFn pSrc + | otherwise -> + do + sp' <- + if + | connectIsSecure ci' -> + -- case 1 described above. + return sp + | otherwise -> + -- case 3 described above. + do + pHash <- getPayloadSHA256Hash $ riPayload ri' + return $ sp {spPayloadHash = Just pHash} - let signHeaders = signV4 sp' baseRequest - return $ - baseRequest - { NC.requestHeaders = - NC.requestHeaders baseRequest - ++ mkHeaderFromPairs signHeaders, - NC.requestBody = getRequestBody (riPayload ri') - } + let signHeaders = signV4 sp' baseRequest + return $ + baseRequest + { NC.requestHeaders = + NC.requestHeaders baseRequest + ++ mkHeaderFromPairs signHeaders, + NC.requestBody = getRequestBody (riPayload ri') + } retryAPIRequest :: Minio a -> Minio a retryAPIRequest apiCall = do diff --git a/src/Network/Minio/APICommon.hs b/src/Network/Minio/APICommon.hs index 6ea8717..992a9b5 100644 --- a/src/Network/Minio/APICommon.hs +++ b/src/Network/Minio/APICommon.hs @@ -20,6 +20,7 @@ import qualified Conduit as C import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LB import Data.Conduit.Binary (sourceHandleRange) +import qualified Data.Text as T import Lib.Prelude import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT @@ -70,3 +71,10 @@ mkStreamingPayload payload = isStreamingPayload :: Payload -> Bool isStreamingPayload (PayloadC _ _) = True isStreamingPayload _ = False + +-- | Checks if the connect info is for Amazon S3. +isAWSConnectInfo :: ConnectInfo -> Bool +isAWSConnectInfo ci = ".amazonaws.com" `T.isSuffixOf` connectHost ci + +bucketHasPeriods :: Bucket -> Bool +bucketHasPeriods b = isJust $ T.find (== '.') b diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 1584e3d..389efb9 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -49,6 +49,7 @@ import Network.HTTP.Types ) import qualified Network.HTTP.Types as HT import Network.Minio.Data.Crypto +import Network.Minio.Data.Time import Network.Minio.Errors import System.Directory (doesFileExist, getHomeDirectory) import qualified System.Environment as Env @@ -79,20 +80,20 @@ maxMultipartParts = 10000 awsRegionMap :: H.HashMap Text Text awsRegionMap = H.fromList - [ ("us-east-1", "s3.amazonaws.com"), - ("us-east-2", "s3-us-east-2.amazonaws.com"), - ("us-west-1", "s3-us-west-1.amazonaws.com"), - ("us-west-2", "s3-us-west-2.amazonaws.com"), - ("ca-central-1", "s3-ca-central-1.amazonaws.com"), - ("ap-south-1", "s3-ap-south-1.amazonaws.com"), - ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com"), - ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com"), - ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com"), - ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com"), - ("eu-west-1", "s3-eu-west-1.amazonaws.com"), - ("eu-west-2", "s3-eu-west-2.amazonaws.com"), - ("eu-central-1", "s3-eu-central-1.amazonaws.com"), - ("sa-east-1", "s3-sa-east-1.amazonaws.com") + [ ("us-east-1", "s3.us-east-1.amazonaws.com"), + ("us-east-2", "s3.us-east-2.amazonaws.com"), + ("us-west-1", "s3.us-west-1.amazonaws.com"), + ("us-west-2", "s3.us-west-2.amazonaws.com"), + ("ca-central-1", "s3.ca-central-1.amazonaws.com"), + ("ap-south-1", "s3.ap-south-1.amazonaws.com"), + ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"), + ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"), + ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"), + ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"), + ("eu-west-1", "s3.eu-west-1.amazonaws.com"), + ("eu-west-2", "s3.eu-west-2.amazonaws.com"), + ("eu-central-1", "s3.eu-central-1.amazonaws.com"), + ("sa-east-1", "s3.sa-east-1.amazonaws.com") ] -- | Connection Info data type. To create a 'ConnectInfo' value, @@ -1022,7 +1023,8 @@ data S3ReqInfo = S3ReqInfo riPayload :: Payload, riPayloadHash :: Maybe ByteString, riRegion :: Maybe Region, - riNeedsLocation :: Bool + riNeedsLocation :: Bool, + riPresignExpirySecs :: Maybe UrlExpiry } defaultS3ReqInfo :: S3ReqInfo @@ -1037,16 +1039,13 @@ defaultS3ReqInfo = Nothing Nothing True + Nothing getS3Path :: Maybe Bucket -> Maybe Object -> ByteString getS3Path b o = let segments = map toUtf8 $ catMaybes $ b : bool [] [o] (isJust b) in B.concat ["/", B.intercalate "/" segments] --- | Time to expire for a presigned URL. It interpreted as a number of --- seconds. The maximum duration that can be specified is 7 days. -type UrlExpiry = Int - type RegionMap = H.HashMap Bucket Region -- | The Minio Monad - all computations accessing object storage diff --git a/src/Network/Minio/Data/Time.hs b/src/Network/Minio/Data/Time.hs index aec713d..c2699e4 100644 --- a/src/Network/Minio/Data/Time.hs +++ b/src/Network/Minio/Data/Time.hs @@ -21,6 +21,7 @@ module Network.Minio.Data.Time awsDateFormatBS, awsParseTime, iso8601TimeFormat, + UrlExpiry, ) where @@ -28,6 +29,10 @@ import Data.ByteString.Char8 (pack) import qualified Data.Time as Time import Lib.Prelude +-- | Time to expire for a presigned URL. It interpreted as a number of +-- seconds. The maximum duration that can be specified is 7 days. +type UrlExpiry = Int + awsTimeFormat :: UTCTime -> [Char] awsTimeFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%dT%H%M%SZ" diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index 81bafa8..8e753ea 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -42,13 +42,14 @@ import qualified Data.HashMap.Strict as H import qualified Data.Text as T import qualified Data.Time as Time import Lib.Prelude -import qualified Network.HTTP.Conduit as NC +import qualified Network.HTTP.Client as NClient import qualified Network.HTTP.Types as HT -import Network.HTTP.Types.Header (hHost) +import Network.Minio.API (buildRequest) import Network.Minio.Data import Network.Minio.Data.Time import Network.Minio.Errors import Network.Minio.Sign.V4 +import Network.URI (uriToString) -- | Generate a presigned URL. This function allows for advanced usage -- - for simple cases prefer the `presigned*Url` functions. @@ -72,44 +73,22 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do throwIO $ MErrVInvalidUrlExpiry expiry - ci <- asks mcConnInfo - - let hostHeader = (hHost, getHostAddr ci) - req = - NC.defaultRequest - { NC.method = method, - NC.secure = connectIsSecure ci, - NC.host = encodeUtf8 $ connectHost ci, - NC.port = connectPort ci, - NC.path = getS3Path bucket object, - NC.requestHeaders = hostHeader : extraHeaders, - NC.queryString = HT.renderQuery True extraQuery + let s3ri = + defaultS3ReqInfo + { riPresignExpirySecs = Just expiry, + riMethod = method, + riBucket = bucket, + riObject = object, + riRegion = region, + riQueryParams = extraQuery, + riHeaders = extraHeaders } - ts <- liftIO Time.getCurrentTime - let sp = - SignParams - (connectAccessKey ci) - (connectSecretKey ci) - ts - region - (Just expiry) - Nothing - signPairs = signV4 sp req - qpToAdd = (fmap . fmap) Just signPairs - queryStr = - HT.renderQueryBuilder - True - ((HT.parseQuery $ NC.queryString req) ++ qpToAdd) - scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci + req <- buildRequest s3ri + let uri = NClient.getUri req + uriString = uriToString identity uri "" - return $ - toStrictBS $ - toLazyByteString $ - scheme - <> byteString (getHostAddr ci) - <> byteString (getS3Path bucket object) - <> queryStr + return $ toUtf8 uriString -- | Generate a URL with authentication signature to PUT (upload) an -- object. Any extra headers if passed, are signed, and so they are diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 923d946..0d183c5 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -65,7 +65,7 @@ data SignParams = SignParams spSecretKey :: Text, spTimeStamp :: UTCTime, spRegion :: Maybe Text, - spExpirySecs :: Maybe Int, + spExpirySecs :: Maybe UrlExpiry, spPayloadHash :: Maybe ByteString } deriving (Show) diff --git a/test/LiveServer.hs b/test/LiveServer.hs index b07fcc2..8f31058 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -34,7 +34,6 @@ import qualified Network.HTTP.Types as HT import Network.Minio import Network.Minio.Data import Network.Minio.Data.Crypto -import Network.Minio.PutObject import Network.Minio.S3API import Network.Minio.Utils import System.Directory (getTemporaryDirectory)