diff --git a/Aws/Aws.hs b/Aws/Aws.hs index 0fb36daa..fd7f20a2 100644 --- a/Aws/Aws.hs +++ b/Aws/Aws.hs @@ -239,6 +239,7 @@ unsafeAwsRef cfg info manager metadataRef request = do logDebug $ "Host: " ++ show (HTTP.host httpRequest) logDebug $ "Path: " ++ show (HTTP.path httpRequest) logDebug $ "Query string: " ++ show (HTTP.queryString httpRequest) + logDebug $ "Header: " ++ show (HTTP.requestHeaders httpRequest) case HTTP.requestBody httpRequest of HTTP.RequestBodyLBS lbs -> logDebug $ "Body: " ++ show (L.take 1000 lbs) HTTP.RequestBodyBS bs -> logDebug $ "Body: " ++ show (B.take 1000 bs) diff --git a/Aws/Core.hs b/Aws/Core.hs index 22228db3..9f6549ee 100644 --- a/Aws/Core.hs +++ b/Aws/Core.hs @@ -50,7 +50,10 @@ module Aws.Core , AuthorizationHash(..) , amzHash , signature +, credentialV4 , authorizationV4 +, authorizationV4' +, signatureV4 -- ** Query construction helpers , queryList , awsBool @@ -601,6 +604,23 @@ signature cr ah input = Base64.encode sig computeSig :: HashAlgorithm a => a -> ByteString computeSig t = toBytes (hmacAlg t (secretAccessKey cr) input) +-- | Generates the Credential string, required for V4 signatures. +credentialV4 :: SignatureData + -> B.ByteString -- ^ region, e.g. us-east-1 + -> B.ByteString -- ^ service, e.g. dynamodb + -> B.ByteString +credentialV4 sd region service = + B.concat [ accessKeyID (signatureCredentials sd) + , "/" + , date + , "/" + , region + , "/" + , service + , "/aws4_request" + ] + where date = fmtTime "%Y%m%d" $ signatureTime sd + -- | Use this to create the Authorization header to set into 'sqAuthorization'. -- See : you must create the -- canonical request as explained by Step 1 and this function takes care of Steps 2 and 3. @@ -663,20 +683,80 @@ authorizationV4 sd ah region service headers canonicalRequest = do -- finally, return the header return $ B.concat [ alg , " Credential=" - , accessKeyID (signatureCredentials sd) - , "/" - , date - , "/" - , region - , "/" - , service - , "/aws4_request," - , "SignedHeaders=" + , credentialV4 sd region service + , ",SignedHeaders=" , headers , ",Signature=" , sig ] +-- | Compute the signature for V4 +signatureV4 :: SignatureData + -> AuthorizationHash + -> B.ByteString -- ^ region, e.g. us-east-1 + -> B.ByteString -- ^ service, e.g. dynamodb + -> B.ByteString -- ^ canonicalRequest (before hashing) + -> B.ByteString +signatureV4 sd ah region service canonicalRequest = do + let date = fmtTime "%Y%m%d" $ signatureTime sd + mkHmac k i = case ah of + HmacSHA1 -> toBytes (hmac k i :: HMAC SHA1) + HmacSHA256 -> toBytes (hmac k i :: HMAC SHA256) + mkHash i = case ah of + HmacSHA1 -> toBytes (hash i :: Digest SHA1) + HmacSHA256 -> toBytes (hash i :: Digest SHA256) + alg = case ah of + HmacSHA1 -> "AWS4-HMAC-SHA1" + HmacSHA256 -> "AWS4-HMAC-SHA256" + + -- create a new signing key + let key = let secretKey = secretAccessKey $ signatureCredentials sd + kDate = mkHmac ("AWS4" <> secretKey) date + kRegion = mkHmac kDate region + kService = mkHmac kRegion service + kSigning = mkHmac kService "aws4_request" + in kSigning + + -- now do the signature + let canonicalRequestHash = Base16.encode $ mkHash canonicalRequest + stringToSign = B.concat [ alg + , "\n" + , fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime sd + , "\n" + , date + , "/" + , region + , "/" + , service + , "/aws4_request\n" + , canonicalRequestHash + ] + Base16.encode $ mkHmac key stringToSign + +-- | IO free version of @authorizationV4@, us this if you need +-- to compute the signature outside of IO. +authorizationV4' :: SignatureData + -> AuthorizationHash + -> B.ByteString -- ^ region, e.g. us-east-1 + -> B.ByteString -- ^ service, e.g. dynamodb + -> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target + -> B.ByteString -- ^ canonicalRequest (before hashing) + -> B.ByteString +authorizationV4' sd ah region service headers canonicalRequest = do + let alg = case ah of + HmacSHA1 -> "AWS4-HMAC-SHA1" + HmacSHA256 -> "AWS4-HMAC-SHA256" + + -- finally, return the header + B.concat [ alg + , " Credential=" + , credentialV4 sd region service + , ",SignedHeaders=" + , headers + , ",Signature=" + , signatureV4 sd ah region service canonicalRequest + ] + -- | Default configuration for a specific service. class DefaultServiceConfiguration config where -- | Default service configuration. diff --git a/Aws/S3/Commands/PutObject.hs b/Aws/S3/Commands/PutObject.hs index d413145d..846fd99e 100644 --- a/Aws/S3/Commands/PutObject.hs +++ b/Aws/S3/Commands/PutObject.hs @@ -7,6 +7,8 @@ import Aws.S3.Core import Control.Applicative import Control.Arrow (second) import Crypto.Hash +import Data.Byteable +import qualified Data.ByteString.Base16 as Base16 import Data.ByteString.Char8 ({- IsString -}) import Data.Maybe import qualified Data.ByteString.Char8 as B @@ -23,6 +25,7 @@ data PutObject = PutObject { poContentDisposition :: Maybe T.Text, poContentEncoding :: Maybe T.Text, poContentMD5 :: Maybe (Digest MD5), + poContentSHA256 :: Maybe (Digest SHA256), poExpires :: Maybe Int, poAcl :: Maybe CannedAcl, poStorageClass :: Maybe StorageClass, @@ -43,7 +46,7 @@ putObject :: Bucket -> T.Text -> HTTP.RequestBody -> PutObject #else putObject :: Bucket -> T.Text -> HTTP.RequestBody (C.ResourceT IO) -> PutObject #endif -putObject bucket obj body = PutObject obj bucket Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing body [] False False +putObject bucket obj body = PutObject obj bucket Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing body [] False False data PutObjectResponse = PutObjectResponse { @@ -61,13 +64,13 @@ instance SignQuery PutObject where , s3QQuery = [] , s3QContentType = poContentType , s3QContentMd5 = poContentMD5 - , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [ + , s3QAmzHeaders = sha256Header:(map (second T.encodeUtf8) $ catMaybes [ ("x-amz-acl",) <$> writeCannedAcl <$> poAcl , ("x-amz-storage-class",) <$> writeStorageClass <$> poStorageClass , ("x-amz-website-redirect-location",) <$> poWebsiteRedirectLocation , ("x-amz-server-side-encryption",) <$> writeServerSideEncryption <$> poServerSideEncryption , if poAutoMakeBucket then Just ("x-amz-auto-make-bucket", "1") else Nothing - ] ++ map( \x -> (CI.mk . T.encodeUtf8 $ T.concat ["x-amz-meta-", fst x], snd x)) poMetadata + ] ++ map( \x -> (CI.mk . T.encodeUtf8 $ T.concat ["x-amz-meta-", fst x], snd x)) poMetadata) , s3QOtherHeaders = map (second T.encodeUtf8) $ catMaybes [ ("Expires",) . T.pack . show <$> poExpires , ("Cache-Control",) <$> poCacheControl @@ -80,6 +83,7 @@ instance SignQuery PutObject where , s3QRequestBody = Just poRequestBody , s3QObject = Just $ T.encodeUtf8 poObjectName } + where sha256Header = (hAmzContentSha256, fromMaybe "UNSIGNED-PAYLOAD" (Base16.encode . toBytes <$> poContentSHA256)) instance ResponseConsumer PutObject PutObjectResponse where type ResponseMetadata PutObjectResponse = S3Metadata diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs index 78f27474..cfbadf83 100644 --- a/Aws/S3/Core.hs +++ b/Aws/S3/Core.hs @@ -50,10 +50,17 @@ data RequestStyle | VHostStyle deriving (Show) +-- identical to DynamoDb.Core.Region +data Region = Region { + rUri :: B.ByteString + , rName :: B.ByteString + } deriving (Eq,Show,Read,Typeable) + data S3Configuration qt = S3Configuration { s3Protocol :: Protocol - , s3Endpoint :: B.ByteString + , s3Region :: Region + -- ^ The regional endpoint. Ex: 's3UsEast1' , s3RequestStyle :: RequestStyle , s3Port :: Int , s3ServerSideEncryption :: Maybe ServerSideEncryption @@ -63,40 +70,51 @@ data S3Configuration qt deriving (Show) instance DefaultServiceConfiguration (S3Configuration NormalQuery) where - defServiceConfig = s3 HTTPS s3EndpointUsClassic False - - debugServiceConfig = s3 HTTP s3EndpointUsClassic False + defServiceConfig = s3 HTTPS s3UsEast1 False + debugServiceConfig = s3 HTTP s3UsEast1 False instance DefaultServiceConfiguration (S3Configuration UriOnlyQuery) where - defServiceConfig = s3 HTTPS s3EndpointUsClassic True - debugServiceConfig = s3 HTTP s3EndpointUsClassic True + defServiceConfig = s3 HTTPS s3UsEast1 True + debugServiceConfig = s3 HTTP s3UsEast1 True + +-------------------------------------------------------------------------------- +-- | S3 Regions + +s3UsEast1 :: Region -- ^ US East (N. Virginia) +s3UsEast1 = Region "s3-external-1.amazonaws.com" "us-east-1" -s3EndpointUsClassic :: B.ByteString -s3EndpointUsClassic = "s3.amazonaws.com" +s3UsWest1 :: Region -- ^ US West (N. California) +s3UsWest1 = Region "s3-us-west-1.amazonaws.com" "us-west-1" -s3EndpointUsWest :: B.ByteString -s3EndpointUsWest = "s3-us-west-1.amazonaws.com" +s3UsWest2 :: Region -- ^ US West (Oregon) +s3UsWest2 = Region "s3-us-west-2.amazonaws.com" "us-west-2" -s3EndpointUsWest2 :: B.ByteString -s3EndpointUsWest2 = "s3-us-west-2.amazonaws.com" +s3EuWest1 :: Region -- ^ EU (Ireland) +s3EuWest1 = Region "s3-eu-west-1.amazonaws.com" "eu-west-1" -s3EndpointEu :: B.ByteString -s3EndpointEu = "s3-eu-west-1.amazonaws.com" +s3EuCentral1 :: Region -- ^ EU (Frankfurt) +s3EuCentral1 = Region "s3-eu-central-1.amazonaws.com" "eu-central-1" -s3EndpointApSouthEast :: B.ByteString -s3EndpointApSouthEast = "s3-ap-southeast-1.amazonaws.com" +s3ApNe1 :: Region -- ^ Asia Pacific (Tokyo) +s3ApNe1 = Region "s3-ap-northeast-1.amazonaws.com" "ap-northeast-1" -s3EndpointApSouthEast2 :: B.ByteString -s3EndpointApSouthEast2 = "s3-ap-southeast-2.amazonaws.com" +s3ApNe2 :: Region -- ^ Asia Pacific (Seoul) +s3ApNe2 = Region "s3-ap-northeast-2.amazonaws.com" "ap-northeast-2" -s3EndpointApNorthEast :: B.ByteString -s3EndpointApNorthEast = "s3-ap-northeast-1.amazonaws.com" +s3ApSe1 :: Region -- ^ Asia Pacific (Singapore) +s3ApSe1 = Region "s3-ap-southeast-1.amazonaws.com" "ap-southeast-1" -s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration qt -s3 protocol endpoint uri +s3ApSe2 :: Region -- ^ Asia Pacific (Sydney) +s3ApSe2 = Region "s3-ap-southeast-2.amazonaws.com" "ap-southeast-2" + +s3SaEast1 :: Region -- ^ South America (São Paulo) +s3SaEast1 = Region "s3-sa-east-1.amazonaws.com" "sa-east-1" + +s3 :: Protocol -> Region -> Bool -> S3Configuration qt +s3 protocol region uri = S3Configuration { s3Protocol = protocol - , s3Endpoint = endpoint + , s3Region = region , s3RequestStyle = BucketStyle , s3Port = defaultPort protocol , s3ServerSideEncryption = Nothing @@ -149,6 +167,7 @@ data S3Query , s3QQuery :: HTTP.Query , s3QContentType :: Maybe B.ByteString , s3QContentMd5 :: Maybe (Digest MD5) + -- ^ The Content-MD5 header value. , s3QAmzHeaders :: HTTP.RequestHeaders , s3QOtherHeaders :: HTTP.RequestHeaders #if MIN_VERSION_http_conduit(2, 0, 0) @@ -167,15 +186,27 @@ instance Show S3Query where " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") ++ "]" +hAmzDate, hAmzContentSha256, hAmzAlgorithm, hAmzCredential, hAmzExpires, hAmzSignature, hAmzSecurityToken :: HTTP.HeaderName +hAmzDate = "X-Amz-Date" +hAmzContentSha256 = "X-Amz-content-Sha256" +hAmzAlgorithm = "X-Amz-Algorithm" +hAmzCredential = "X-Amz-Credential" +hAmzExpires = "X-Amz-Expires" +hAmzSignedHeaders = "X-Amz-SignedHeaders" +hAmzSignature = "X-Amz-Signature" +hAmzSecurityToken = "X-Amz-Security-Token" + +-- | For signature v4 signing see +-- s3SignQuery :: S3Query -> S3Configuration qt -> SignatureData -> SignedQuery -s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..} +s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..} = SignedQuery { sqMethod = s3QMethod , sqProtocol = s3Protocol , sqHost = B.intercalate "." $ catMaybes host , sqPort = s3Port , sqPath = mconcat $ catMaybes path - , sqQuery = sortedSubresources ++ s3QQuery ++ authQuery :: HTTP.Query + , sqQuery = sortedSubresources ++ s3QQuery ++ (fmap (\(x, y) -> (CI.original x, Just y)) authQuery) :: HTTP.Query , sqDate = Just signatureTime , sqAuthorization = authorization , sqContentType = s3QContentType @@ -186,46 +217,102 @@ s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..} , sqStringToSign = stringToSign } where - amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders ++ (fmap (\(k, v) -> (CI.mk k, v)) iamTok)) + credentials = signatureCredentials + + -- hash of an empty string + emptyBodyHash = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" + + -- needs to match th eone produces in the @authorizationV4@ + sigTime = fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime + + -- inject date and an empty content sha256, if not given. + s3QAmzHeaders' = (hAmzDate, sigTime):case lookup hAmzContentSha256 s3QAmzHeaders of + Just _ -> s3QAmzHeaders + Nothing -> (hAmzContentSha256, emptyBodyHash):s3QAmzHeaders + + amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders' ++ iamTok) where merge (x1@(k1,v1):x2@(k2,v2):xs) | k1 == k2 = merge ((k1, B8.intercalate "," [v1, v2]) : xs) | otherwise = x1 : merge (x2 : xs) merge xs = xs urlEncodedS3QObject = HTTP.urlEncode False <$> s3QObject (host, path) = case s3RequestStyle of - PathStyle -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket, urlEncodedS3QObject]) - BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/", urlEncodedS3QObject]) - VHostStyle -> ([Just $ fromMaybe s3Endpoint s3QBucket], [Just "/", urlEncodedS3QObject]) + PathStyle -> ([Just (rUri s3Region)], [Just "/", fmap (`B8.snoc` '/') s3QBucket, urlEncodedS3QObject]) + BucketStyle -> ([s3QBucket, Just (rUri s3Region)], [Just "/", urlEncodedS3QObject]) + VHostStyle -> ([Just $ fromMaybe (rUri s3Region) s3QBucket], [Just "/", urlEncodedS3QObject]) sortedSubresources = sort s3QSubresources - canonicalizedResource = Blaze8.fromChar '/' `mappend` - maybe mempty (\s -> Blaze.copyByteString s `mappend` Blaze8.fromChar '/') s3QBucket `mappend` - maybe mempty Blaze.copyByteString urlEncodedS3QObject `mappend` - HTTP.renderQueryBuilder True sortedSubresources + ti = case (s3UseUri, signatureTimeInfo) of (False, ti') -> ti' (True, AbsoluteTimestamp time) -> AbsoluteExpires $ s3DefaultExpiry `addUTCTime` time (True, AbsoluteExpires time) -> AbsoluteExpires time - sig = signature signatureCredentials HmacSHA1 stringToSign - iamTok = maybe [] (\x -> [("x-amz-security-token", x)]) (iamToken signatureCredentials) - stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat $ - [[Blaze.copyByteString $ httpMethod s3QMethod] - , [maybe mempty (Blaze.copyByteString . Base64.encode . toBytes) s3QContentMd5] - , [maybe mempty Blaze.copyByteString s3QContentType] - , [Blaze.copyByteString $ case ti of - AbsoluteTimestamp time -> fmtRfc822Time time - AbsoluteExpires time -> fmtTimeEpochSeconds time] - , map amzHeader amzHeaders - , [canonicalizedResource] + + iamTok = maybe [] (\x -> [(hAmzSecurityToken, x)]) (iamToken signatureCredentials) + + -- must provide host in the canonical headers. + canonicalHeaders = sortBy (compare `on` fst) $ amzHeaders ++ catMaybes + [Just ("host", B.intercalate "." $ catMaybes host) + , ("content-type",) <$> s3QContentType + ] + -- string to sign depends on the use case: + -- The general structure is: + -- + -- + -- + -- + -- + -- + -- + -- 1) Generate an Authentication Header + -- GET + -- /text.txt + -- + -- host:bucket.region.amazonaws.com + -- x-amz-content-sha256:e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 + -- x-amz-date:20130524T000000Z + -- + -- host;x-amz-content-sha256;x-amz-date + -- e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 + -- + -- 2) Generating a signed link with an expirydate + -- GET + -- /test.txt + -- X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIAIOSFODNN7EXAMPLE%2F20130524%2Fus-east-1%2Fs3%2Faws4_request&X-Amz-Date=20130524T000000Z&X-Amz-Expires=86400&X-Amz-SignedHeaders=host + -- host:examplebucket.s3.amazonaws.com + -- + -- host + -- UNSIGNED-PAYLOAD + -- + stringToSign = B.concat $ intercalate ["\n"] $ + [ [httpMethod s3QMethod] -- method + , [mconcat . catMaybes $ path] -- path + , [HTTP.renderQuery False queryString] -- query string + ] ++ + map (\(a,b) -> [CI.foldedCase a,":",b]) headers ++ + [ [] -- end headers + , intersperse ";" (map (CI.foldedCase . fst) headers) + , [payloadHash] ] - where amzHeader (k, v) = Blaze.copyByteString (CI.foldedCase k) `mappend` Blaze8.fromChar ':' `mappend` Blaze.copyByteString v + + (payloadHash, queryString, headers) = case ti of + AbsoluteTimestamp _ -> (fromMaybe emptyBodyHash $ lookup hAmzContentSha256 amzHeaders, [], canonicalHeaders) + AbsoluteExpires time -> ("UNSIGNED-PAYLOAD", HTTP.toQuery . fmap (\(x,y) -> (CI.original x, y)) $ makeAuthQuery time, [("host", B.intercalate "." $ catMaybes host)]) + + auth = authorizationV4' sd HmacSHA256 (rName s3Region) "s3" + (B.concat (intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders))) + stringToSign + sig = signatureV4 sd HmacSHA256 (rName s3Region) "s3" stringToSign + (authorization, authQuery) = case ti of - AbsoluteTimestamp _ -> (Just $ return $ B.concat ["AWS ", accessKeyID signatureCredentials, ":", sig], []) - AbsoluteExpires time -> (Nothing, HTTP.toQuery $ makeAuthQuery time) + AbsoluteTimestamp _ -> (Just . return $ auth, []) + AbsoluteExpires time -> (Nothing, (hAmzSignature, sig):makeAuthQuery time) + makeAuthQuery time - = [("Expires" :: B8.ByteString, fmtTimeEpochSeconds time) - , ("AWSAccessKeyId", accessKeyID signatureCredentials) - , ("SignatureMethod", "HmacSHA256") - , ("Signature", sig)] ++ iamTok + = [ (hAmzAlgorithm, "AWS4-HMAC-SHA256") + , (hAmzCredential, credentialV4 sd (rName s3Region) "s3") + , (hAmzDate, sigTime) + , (hAmzExpires, B8.pack . show . floor $ diffUTCTime time signatureTime) + , (hAmzSignedHeaders, "host") ] ++ iamTok s3ResponseConsumer :: HTTPResponseConsumer a -> IORef S3Metadata diff --git a/Examples/PutBucketNearLine.hs b/Examples/PutBucketNearLine.hs index de51eafe..1a27b2ec 100644 --- a/Examples/PutBucketNearLine.hs +++ b/Examples/PutBucketNearLine.hs @@ -26,7 +26,7 @@ main = do - Storage endpoint. -} Just creds <- Aws.loadCredentialsFromEnv let cfg = Aws.Configuration Aws.Timestamp creds (Aws.defaultLog Aws.Debug) - let s3cfg = S3.s3 Aws.HTTP "storage.googleapis.com" False + let s3cfg = S3.s3 Aws.HTTP (S3.Region "storage.googleapis.com" "US") False {- Set up a ResourceT region with an available HTTP manager. -} withManager $ \mgr -> do