From a946dfd3056532641fbaa8347bccd31a10e066c9 Mon Sep 17 00:00:00 2001 From: Krishnan Parthasarathi Date: Wed, 30 May 2018 13:50:15 -0700 Subject: [PATCH] Make signature V4 independent of S3ReqInfo (#88) - Rename RequestInfo to S3ReqInfo --- src/Network/Minio/API.hs | 45 +++++---- src/Network/Minio/Data.hs | 15 ++- src/Network/Minio/PresignedOperations.hs | 45 +++++---- src/Network/Minio/Sign/V4.hs | 112 ++++++++++++----------- 4 files changed, 118 insertions(+), 99 deletions(-) diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 6bbe297..908fe98 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -16,7 +16,7 @@ module Network.Minio.API ( connect - , RequestInfo(..) + , S3ReqInfo(..) , runMinio , executeRequest , mkStreamRequest @@ -35,6 +35,7 @@ import Data.Conduit.Binary (sourceHandleRange) import Data.Default (def) import qualified Data.Map as Map import qualified Data.Text as T +import qualified Data.Time.Clock as Time import Network.HTTP.Conduit (Response) import qualified Network.HTTP.Conduit as NC @@ -82,7 +83,7 @@ getLocation bucket = do -- | Looks for region in RegionMap and updates it using getLocation if -- absent. -discoverRegion :: RequestInfo -> Minio (Maybe Region) +discoverRegion :: S3ReqInfo -> Minio (Maybe Region) discoverRegion ri = runMaybeT $ do bucket <- MaybeT $ return $ riBucket ri regionMay <- lift $ lookupRegionCache bucket @@ -93,7 +94,7 @@ discoverRegion ri = runMaybeT $ do ) return regionMay -buildRequest :: RequestInfo -> Minio NC.Request +buildRequest :: S3ReqInfo -> Minio NC.Request buildRequest ri = do maybe (return ()) checkBucketNameValidity $ riBucket ri maybe (return ()) checkObjectNameValidity $ riObject ri @@ -128,6 +129,8 @@ buildRequest ri = do -- otherwise compute sha256 | otherwise -> getPayloadSHA256Hash (riPayload ri) + timeStamp <- liftIO Time.getCurrentTime + let hostHeader = (hHost, getHostAddr ci) newRi = ri { riPayloadHash = Just sha256Hash , riHeaders = hostHeader @@ -136,28 +139,36 @@ buildRequest ri = do , riRegion = region } newCi = ci { connectHost = regionHost } + signReq = toRequest newCi newRi + sp = SignParams (connectAccessKey ci) (connectSecretKey ci) + timeStamp (riRegion newRi) Nothing (riPayloadHash newRi) + let signHeaders = signV4 sp signReq - signHeaders <- liftIO $ signV4 newCi newRi Nothing + -- Update signReq with Authorization header containing v4 signature + return signReq { + NC.requestHeaders = riHeaders newRi ++ mkHeaderFromPairs signHeaders + } + where + toRequest :: ConnectInfo -> S3ReqInfo -> NC.Request + toRequest ci s3Req = NC.defaultRequest { + NC.method = riMethod s3Req + , NC.secure = connectIsSecure ci + , NC.host = encodeUtf8 $ connectHost ci + , NC.port = connectPort ci + , NC.path = getS3Path (riBucket s3Req) (riObject s3Req) + , NC.requestHeaders = riHeaders s3Req + , NC.queryString = HT.renderQuery False $ riQueryParams s3Req + , NC.requestBody = getRequestBody (riPayload s3Req) + } - return NC.defaultRequest { - NC.method = riMethod newRi - , NC.secure = connectIsSecure newCi - , NC.host = encodeUtf8 $ connectHost newCi - , NC.port = connectPort newCi - , NC.path = getPathFromRI newRi - , NC.queryString = HT.renderQuery False $ riQueryParams newRi - , NC.requestHeaders = riHeaders newRi ++ mkHeaderFromPairs signHeaders - , NC.requestBody = getRequestBody (riPayload newRi) - } - -executeRequest :: RequestInfo -> Minio (Response LByteString) +executeRequest :: S3ReqInfo -> Minio (Response LByteString) executeRequest ri = do req <- buildRequest ri mgr <- asks mcConnManager httpLbs req mgr -mkStreamRequest :: RequestInfo +mkStreamRequest :: S3ReqInfo -> Minio (Response (C.ConduitM () ByteString Minio ())) mkStreamRequest ri = do req <- buildRequest ri diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index ebcfb27..7d0879a 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -472,7 +472,7 @@ data Payload = PayloadBS ByteString instance Default Payload where def = PayloadBS "" -data RequestInfo = RequestInfo { +data S3ReqInfo = S3ReqInfo { riMethod :: Method , riBucket :: Maybe Bucket , riObject :: Maybe Object @@ -484,15 +484,12 @@ data RequestInfo = RequestInfo { , riNeedsLocation :: Bool } -instance Default RequestInfo where - def = RequestInfo HT.methodGet def def def def def Nothing def True +instance Default S3ReqInfo where + def = S3ReqInfo HT.methodGet def def def def def Nothing def True -getPathFromRI :: RequestInfo -> ByteString -getPathFromRI ri = - let - b = riBucket ri - o = riObject ri - segments = map toS $ catMaybes $ b : bool [] [o] (isJust b) +getS3Path :: Maybe Bucket -> Maybe Object -> ByteString +getS3Path b o = + let segments = map toS $ catMaybes $ b : bool [] [o] (isJust b) in B.concat ["/", B.intercalate "/" segments] diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index 21f4715..92a9c80 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -39,10 +39,10 @@ module Network.Minio.PresignedOperations import Data.Aeson ((.=)) import qualified Data.Aeson as Json import Data.ByteString.Builder (byteString, toLazyByteString) -import Data.Default (def) import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Time as Time +import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT import Network.HTTP.Types.Header (hHost) @@ -72,24 +72,31 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do let hostHeader = (hHost, getHostAddr ci) - ri = def { riMethod = method - , riBucket = bucket - , riObject = object - , riQueryParams = extraQuery - , riHeaders = hostHeader : extraHeaders - , riRegion = Just $ maybe (connectRegion ci) identity region - } + 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 + } + ts <- liftIO Time.getCurrentTime - signPairs <- liftIO $ signV4 ci ri (Just expiry) + let sp = SignParams (connectAccessKey ci) (connectSecretKey ci) + ts region (Just expiry) Nothing - let - qpToAdd = (fmap . fmap) Just signPairs - queryStr = HT.renderQueryBuilder True (riQueryParams ri ++ qpToAdd) - scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci + signPairs = signV4 sp req - return $ toS $ toLazyByteString $ - scheme <> byteString (getHostAddr ci) <> byteString (getPathFromRI ri) <> - queryStr + qpToAdd = (fmap . fmap) Just signPairs + queryStr = HT.renderQueryBuilder True + ((HT.parseQuery $ NC.queryString req) ++ qpToAdd) + scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci + + return $ toS $ toLazyByteString $ scheme + <> byteString (getHostAddr ci) + <> byteString (getS3Path bucket object) + <> queryStr -- | Generate a URL with authentication signature to PUT (upload) an -- object. Any extra headers if passed, are signed, and so they are @@ -258,8 +265,10 @@ presignedPostPolicy p = do ppWithCreds = p { conditions = conditions p ++ extraConditions } - signData = signV4PostPolicy (showPostPolicy ppWithCreds) - signTime ci + sp = SignParams (connectAccessKey ci) (connectSecretKey ci) + signTime (Just $ connectRegion ci) Nothing Nothing + signData = signV4PostPolicy (showPostPolicy ppWithCreds) sp + -- compute form-data mkPair (PPCStartsWith k v) = Just (k, v) diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 44ef1b1..4758187 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -17,7 +17,6 @@ module Network.Minio.Sign.V4 ( signV4 - , signV4AtTime , signV4PostPolicy , mkScope , getHeadersToSign @@ -26,21 +25,24 @@ module Network.Minio.Sign.V4 , mkSigningKey , computeSignature , SignV4Data(..) + , SignParams(..) , debugPrintSignV4Data ) where -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import Data.CaseInsensitive (mk) -import qualified Data.CaseInsensitive as CI -import qualified Data.Set as Set -import qualified Data.Time as Time -import qualified Data.ByteString.Base64 as Base64 -import qualified Data.Map.Strict as Map -import Network.HTTP.Types (Header) -import qualified Network.HTTP.Types.Header as H +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Char8 as B8 +import Data.CaseInsensitive (mk) +import qualified Data.CaseInsensitive as CI +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Time as Time +import qualified Network.HTTP.Conduit as NC +import Network.HTTP.Types (Header, parseQuery) +import qualified Network.HTTP.Types.Header as H import Lib.Prelude + import Network.Minio.Data import Network.Minio.Data.ByteString import Network.Minio.Data.Crypto @@ -57,14 +59,23 @@ ignoredHeaders = Set.fromList $ map CI.foldedCase ] data SignV4Data = SignV4Data { - sv4SignTime :: UTCTime - , sv4Scope :: ByteString - , sv4CanonicalRequest :: ByteString - , sv4HeadersToSign :: [(ByteString, ByteString)] - , sv4Output :: [(ByteString, ByteString)] - , sv4StringToSign :: ByteString - , sv4SigningKey :: ByteString - } deriving (Show) + sv4SignTime :: UTCTime + , sv4Scope :: ByteString + , sv4CanonicalRequest :: ByteString + , sv4HeadersToSign :: [(ByteString, ByteString)] + , sv4Output :: [(ByteString, ByteString)] + , sv4StringToSign :: ByteString + , sv4SigningKey :: ByteString + } deriving (Show) + +data SignParams = SignParams { + spAccessKey :: Text + , spSecretKey :: Text + , spTimeStamp :: UTCTime + , spRegion :: Maybe Region + , spExpirySecs :: Maybe Int + , spPayloadHash :: Maybe ByteString + } deriving (Show) debugPrintSignV4Data :: SignV4Data -> IO () debugPrintSignV4Data (SignV4Data t s cr h2s o sts sk) = do @@ -83,40 +94,33 @@ debugPrintSignV4Data (SignV4Data t s cr h2s o sts sk) = do mapM_ (\x -> B.putStr $ B.concat [show x, " "]) $ B.unpack b B8.putStrLn "" --- | Given MinioClient and request details, including request method, +-- | 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. -signV4 :: ConnectInfo -> RequestInfo -> Maybe Int - -> IO [(ByteString, ByteString)] -signV4 !ci !ri !expiry = do - timestamp <- Time.getCurrentTime - let signData = signV4AtTime timestamp ci ri expiry - -- debugPrintSignV4Data signData - return $ sv4Output signData - --- | Takes a timestamp, server params and request params and generates --- AWS Sign V4 data. For normal requests (i.e. without an expiry --- time), the output is the list of headers to add to authenticate the --- request. +-- +-- For normal requests (i.e. without an expiry time), the output is +-- the list of headers to add to authenticate the request. -- -- If `expiry` is not Nothing, it is assumed that a presigned request -- 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. -signV4AtTime :: UTCTime -> ConnectInfo -> RequestInfo -> Maybe Int - -> SignV4Data -signV4AtTime ts ci ri expiry = + +signV4 :: SignParams -> NC.Request -> [(ByteString, ByteString)] +signV4 !sp !req = let - region = maybe (connectRegion ci) identity $ riRegion ri + region = fromMaybe "" $ spRegion sp + ts = spTimeStamp sp scope = mkScope ts region - accessKey = toS $ connectAccessKey ci - secretKey = toS $ connectSecretKey ci + accessKey = toS $ spAccessKey sp + secretKey = toS $ spSecretKey sp + expiry = spExpirySecs sp -- headers to be added to the request datePair = ("X-Amz-Date", awsTimeFormatBS ts) - computedHeaders = riHeaders ri ++ - if isJust expiry + computedHeaders = NC.requestHeaders req ++ + if isJust $ expiry then [] else [(\(x, y) -> (mk x, y)) datePair] headersToSign = getHeadersToSign computedHeaders @@ -130,13 +134,13 @@ signV4AtTime ts ci ri expiry = , ("X-Amz-Expires", maybe "" show expiry) , ("X-Amz-SignedHeaders", signedHeaderKeys) ] - finalQP = riQueryParams ri ++ + finalQP = parseQuery (NC.queryString req) ++ if isJust expiry then (fmap . fmap) Just authQP else [] -- 1. compute canonical request - canonicalRequest = mkCanonicalRequest (ri {riQueryParams = finalQP}) + canonicalRequest = mkCanonicalRequest sp (NC.setQueryString finalQP req) headersToSign -- 2. compute string to sign @@ -167,9 +171,7 @@ signV4AtTime ts ci ri expiry = else [(\(x, y) -> (CI.foldedCase x, y)) authHeader, datePair] - in - SignV4Data ts scope canonicalRequest headersToSign output - stringToSign signingKey + in output mkScope :: UTCTime -> Region -> ByteString @@ -185,15 +187,15 @@ getHeadersToSign !h = filter (flip Set.notMember ignoredHeaders . fst) $ map (\(x, y) -> (CI.foldedCase x, stripBS y)) h -mkCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] +mkCanonicalRequest :: SignParams -> NC.Request -> [(ByteString, ByteString)] -> ByteString -mkCanonicalRequest !ri !headersForSign = +mkCanonicalRequest !sp !req !headersForSign = let canonicalQueryString = B.intercalate "&" $ map (\(x, y) -> B.concat [x, "=", y]) $ sort $ map (\(x, y) -> (uriEncode True x, maybe "" (uriEncode True) y)) $ - riQueryParams ri + (parseQuery $ NC.queryString req) sortedHeaders = sort headersForSign @@ -204,12 +206,12 @@ mkCanonicalRequest !ri !headersForSign = in B.intercalate "\n" - [ riMethod ri - , uriEncode False $ getPathFromRI ri + [ NC.method req + , uriEncode False $ NC.path req , canonicalQueryString , canonicalHeaders , signedHeaders - , maybe "UNSIGNED-PAYLOAD" identity $ riPayloadHash ri + , maybe "UNSIGNED-PAYLOAD" identity $ spPayloadHash sp ] mkStringToSign :: UTCTime -> ByteString -> ByteString -> ByteString @@ -233,13 +235,13 @@ computeSignature !toSign !key = digestToBase16 $ hmacSHA256 toSign key -- | Takes a validated Post Policy JSON bytestring, the signing time, -- and ConnInfo and returns form-data for the POST upload containing -- just the signature and the encoded post-policy. -signV4PostPolicy :: ByteString -> UTCTime -> ConnectInfo +signV4PostPolicy :: ByteString -> SignParams -> Map.Map Text ByteString -signV4PostPolicy !postPolicyJSON !signTime !ci = +signV4PostPolicy !postPolicyJSON !sp = let stringToSign = Base64.encode postPolicyJSON - region = connectRegion ci - signingKey = mkSigningKey signTime region $ toS $ connectSecretKey ci + region = fromMaybe "" $ spRegion sp + signingKey = mkSigningKey (spTimeStamp sp) region $ toS $ spSecretKey sp signature = computeSignature stringToSign signingKey in Map.fromList [ ("x-amz-signature", signature)