Make signature V4 independent of S3ReqInfo (#88)
- Rename RequestInfo to S3ReqInfo
This commit is contained in:
Krishnan Parthasarathi
Aditya Manthramurthy
parent
56856e82e0
commit
a946dfd305
@ -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
|
||||
|
||||
@ -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]
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user