-- -- Minio Haskell SDK, (C) 2017 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.Sign.V4 ( signV4 , signV4AtTime , signV4PostPolicy , mkScope , getHeadersToSign , mkCanonicalRequest , mkStringToSign , mkSigningKey , computeSignature , SignV4Data(..) , 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 Lib.Prelude import Network.Minio.Data import Network.Minio.Data.ByteString import Network.Minio.Data.Crypto import Network.Minio.Data.Time -- these headers are not included in the string to sign when signing a -- request ignoredHeaders :: Set ByteString ignoredHeaders = Set.fromList $ map CI.foldedCase [ H.hAuthorization , H.hContentType , H.hContentLength , H.hUserAgent ] data SignV4Data = SignV4Data { sv4SignTime :: UTCTime , sv4Scope :: ByteString , sv4CanonicalRequest :: ByteString , sv4HeadersToSign :: [(ByteString, ByteString)] , sv4Output :: [(ByteString, ByteString)] , sv4StringToSign :: ByteString , sv4SigningKey :: ByteString } deriving (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.concat [show x, " "]) $ B.unpack b B8.putStrLn "" -- | Given MinioClient 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. -- -- 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 = let region = maybe (connectRegion ci) identity $ riRegion ri scope = mkScope ts region accessKey = toS $ connectAccessKey ci secretKey = toS $ connectSecretKey ci -- headers to be added to the request datePair = ("X-Amz-Date", awsTimeFormatBS ts) computedHeaders = riHeaders ri ++ if isJust expiry then [] else [(\(x, y) -> (mk x, y)) datePair] headersToSign = getHeadersToSign computedHeaders signedHeaderKeys = B.intercalate ";" $ sort $ map fst headersToSign -- query-parameters to be added before signing for presigned URLs -- (i.e. when `isJust expiry`) authQP = [ ("X-Amz-Algorithm", "AWS4-HMAC-SHA256") , ("X-Amz-Credential", B.concat [accessKey, "/", scope]) , datePair , ("X-Amz-Expires", maybe "" show expiry) , ("X-Amz-SignedHeaders", signedHeaderKeys) ] finalQP = riQueryParams ri ++ if isJust expiry then (fmap . fmap) Just authQP else [] -- 1. compute canonical request canonicalRequest = mkCanonicalRequest (ri {riQueryParams = finalQP}) headersToSign -- 2. compute string to sign stringToSign = mkStringToSign ts scope canonicalRequest -- 3.1 compute signing key signingKey = mkSigningKey ts region secretKey -- 3.2 compute signature signature = computeSignature stringToSign signingKey -- 4. compute auth header authValue = B.concat [ "AWS4-HMAC-SHA256 Credential=" , accessKey , "/" , scope , ", SignedHeaders=" , signedHeaderKeys , ", Signature=" , signature ] authHeader = (H.hAuthorization, authValue) -- finally compute output pairs output = if isJust expiry then ("X-Amz-Signature", signature) : authQP else [(\(x, y) -> (CI.foldedCase x, y)) authHeader, datePair] in SignV4Data ts scope canonicalRequest headersToSign output stringToSign signingKey mkScope :: UTCTime -> Region -> ByteString mkScope ts region = B.intercalate "/" [ toS $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts , toS region , "s3" , "aws4_request" ] getHeadersToSign :: [Header] -> [(ByteString, ByteString)] getHeadersToSign !h = filter (flip Set.notMember ignoredHeaders . fst) $ map (\(x, y) -> (CI.foldedCase x, stripBS y)) h mkCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] -> ByteString mkCanonicalRequest !ri !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 sortedHeaders = sort headersForSign canonicalHeaders = B.concat $ map (\(x, y) -> B.concat [x, ":", y, "\n"]) sortedHeaders signedHeaders = B.intercalate ";" $ map fst sortedHeaders in B.intercalate "\n" [ riMethod ri , uriEncode False $ getPathFromRI ri , canonicalQueryString , canonicalHeaders , signedHeaders , maybe "UNSIGNED-PAYLOAD" identity $ riPayloadHash ri ] mkStringToSign :: UTCTime -> ByteString -> ByteString -> ByteString mkStringToSign ts !scope !canonicalRequest = B.intercalate "\n" [ "AWS4-HMAC-SHA256" , awsTimeFormatBS ts , scope , hashSHA256 canonicalRequest ] mkSigningKey :: UTCTime -> Region -> ByteString -> ByteString mkSigningKey ts region !secretKey = hmacSHA256RawBS "aws4_request" . hmacSHA256RawBS "s3" . hmacSHA256RawBS (toS region) . hmacSHA256RawBS (awsDateFormatBS ts) $ B.concat ["AWS4", secretKey] computeSignature :: ByteString -> ByteString -> ByteString 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 -> Map.Map Text ByteString signV4PostPolicy !postPolicyJSON !signTime !ci = let stringToSign = Base64.encode postPolicyJSON region = connectRegion ci signingKey = mkSigningKey signTime region $ toS $ connectSecretKey ci signature = computeSignature stringToSign signingKey in Map.fromList [ ("x-amz-signature", signature) , ("policy", stringToSign) ]