Fix Aws.S3.Commands.GetObject.goResponse.... breaks signed URLs

[HanStolpo]

When you supply one of the goResponse.. record members in Aws.S3.Commands.GetObject with a value which is not already URI encoded then the signature for a pre-signed URL is calculated incorrectly.

For example signature for an URL constructed as follows is incorrect

import qualified Data.Text as T
import qualified Aws.Core as AWS
import qualified Aws.S3 as S3
import Data.Time.Clock (UTCTime)

signUrl :: B8.ByteString -> B8.ByteString -> S3.Bucket -> T.Text -> UTCTime -> IO B8.ByteString
signUrl awsKey awsSecret bucket objectKey expiresAt = do
  cred <- AWS.makeCredentials awsKey awsSecret
  signature <- AWS.signatureData (AWS.ExpiresAt expiresAt) cred
  pure
     (AWS.queryToUri
        (AWS.signQuery
           ((S3.getObject bucket objectKey)
            { S3.goResponseExpires = Just . T.pack . show $ expiresAt
            }
            )
           (AWS.defServiceConfig :: S3.S3Configuration AWS.UriOnlyQuery)
           signature))

The reason is that query parameters related to overriding response headers should not be URI encoded when calculating the signature (http://docs.aws.amazon.com/AmazonS3/latest/dev/RESTAuthentication.html#ConstructingTheCanonicalizedResourceElement).

If the request specifies query string parameters overriding the response header values (see Get Object), append the query string parameters and their values. When signing, you do not encode these values; however, when making the request, you must encode these parameter values. The query string parameters in a GET request include response-content-type, response-content-language, response-expires, response-cache-control, response-content-disposition, and response-content-encoding.

This pull request modifies the way the query parameters are encoded so that the specified parameters skip URI encoding.

Here is a little sanity check for the modification (the modified encoding should probably be lifted out to a helper function and tested thoroughly)

module Main where

import qualified Network.HTTP.Types.URI as HTTP
import Network.HTTP.Types (toQuery)
import qualified Blaze.ByteString.Builder       as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Data.ByteString.Char8          as B8
import Data.List (intersperse)
import Data.Maybe (maybe)

encodeQuerySign :: HTTP.Query -> Blaze.Builder
encodeQuerySign qs =
    let ceq = Blaze8.fromChar '='
        cqt = Blaze8.fromChar '?'
        camp = Blaze8.fromChar '&'
        overrideParams = map B8.pack ["response-content-type", "response-content-language", "response-expires", "response-cache-control", "response-content-disposition", "response-content-encoding"]
        encItem (k, mv) =
            let enc = if k `elem` overrideParams then Blaze.copyByteString else HTTP.urlEncodeBuilder True
            in  enc k `mappend` maybe mempty (mappend ceq . enc) mv
    in case intersperse camp (map encItem qs) of
         [] -> mempty
         qs' -> mconcat (cqt :qs')

check :: Bool -> HTTP.Query -> IO ()
check same q =
  let blz = B8.unpack (Blaze.toByteString (HTTP.renderQueryBuilder True q))
      enc = B8.unpack (Blaze.toByteString (encodeQuerySign q))
      same' = if same then " " else " not "
      correct = if same == (blz == enc) then "which is correct" else "!!!!NO ITS A LIE!!!"
  in putStrLn ("if (q='" ++ show q ++ "')" ++
                "'\n\tthen (renderQueryBuilder True q='" ++ blz  ++ "')" ++
                "'\n\tshould" ++ same' ++ "equal (encodeQuerySign q='" ++ enc ++ "')" ++
                "'\n\t" ++ correct)

main :: IO ()
main = do
  check True (toQuery ([]::[(String, String)]))
  check True (toQuery [("good","bad")])
  check True (toQuery [("good","bad"), ("make my day","no i wont")])
  check False (toQuery [("response-expires","at the end of time"), ("make my day","no i wont")])
  check True (toQuery [("response-expires","ok"), ("maybe","no")])

λ> main
if (q='[]')'
    then (renderQueryBuilder True q='')'
    should equal (encodeQuerySign q='')'
    which is correct
if (q='[("good",Just "bad")]')'
    then (renderQueryBuilder True q='?good=bad')'
    should equal (encodeQuerySign q='?good=bad')'
    which is correct
if (q='[("good",Just "bad"),("make my day",Just "no i wont")]')'
    then (renderQueryBuilder True q='?good=bad&make%20my%20day=no%20i%20wont')'
    should equal (encodeQuerySign q='?good=bad&make%20my%20day=no%20i%20wont')'
    which is correct
if (q='[("response-expires",Just "at the end of time"),("make my day",Just "no i wont")]')'
    then (renderQueryBuilder True q='?response-expires=at%20the%20end%20of%20time&make%20my%20day=no%20i%20wont')'
    should not equal (encodeQuerySign q='?response-expires=at the end of time&make%20my%20day=no%20i%20wont')'
    which is correct
if (q='[("response-expires",Just "ok"),("maybe",Just "no")]')'
    then (renderQueryBuilder True q='?response-expires=ok&maybe=no')'
    should equal (encodeQuerySign q='?response-expires=ok&maybe=no')'
    which is correct

Note the issue is only related AWS auth verion 2 and the weird requirement is not present in the newer auth version 4.