From 43cb1574b79af3832481c1ea9eb4af625c01e313 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 12:14:53 +0800
Subject: [PATCH 01/16] Adds Region (DynamoDb) Datatype to S3

This adds the `Region` datatype, as found in DynamoDb to S3, and
adds all regions as of today with a similar naming scheme, as used
in DynamoDb.

This change lays the basis for Signature V4 signing; it *does* break
backwards compatibility!
---
 Aws/S3/Core.hs | 70 +++++++++++++++++++++++++++++++-------------------
 1 file changed, 44 insertions(+), 26 deletions(-)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index 78f27474..1f374d49 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"
+
+s3UsWest1 :: Region -- ^ US West (N. California)
+s3UsWest1 = Region "s3-us-west-1.amazonaws.com" "us-west-1"
+
+s3UsWest2 :: Region -- ^ US West (Oregon)
+s3UsWest2 = Region "s3-us-west-2.amazonaws.com" "us-west-2"
 
-s3EndpointUsClassic :: B.ByteString
-s3EndpointUsClassic = "s3.amazonaws.com"
+s3EuWest1 :: Region -- ^ EU (Ireland)
+s3EuWest1 = Region "s3-eu-west-1.amazonaws.com" "eu-west-1"
 
-s3EndpointUsWest :: B.ByteString
-s3EndpointUsWest = "s3-us-west-1.amazonaws.com"
+s3EuCentral1 :: Region -- ^ EU (Frankfurt)
+s3EuCentral1 = Region "s3-eu-central-1.amazonaws.com" "eu-central-1"
 
-s3EndpointUsWest2 :: B.ByteString
-s3EndpointUsWest2 = "s3-us-west-2.amazonaws.com"
+s3ApNe1 :: Region -- ^ Asia Pacific (Tokyo)
+s3ApNe1 = Region "s3-ap-northeast-1.amazonaws.com" "ap-northeast-1"
 
-s3EndpointEu :: B.ByteString
-s3EndpointEu = "s3-eu-west-1.amazonaws.com"
+s3ApNe2 :: Region -- ^ Asia Pacific (Seoul)
+s3ApNe2 = Region "s3-ap-northeast-2.amazonaws.com" "ap-northeast-2"
 
-s3EndpointApSouthEast :: B.ByteString
-s3EndpointApSouthEast = "s3-ap-southeast-1.amazonaws.com"
+s3ApSe1 :: Region -- ^ Asia Pacific (Singapore)
+s3ApSe1 = Region "s3-ap-southeast-1.amazonaws.com" "ap-southeast-1"
 
-s3EndpointApSouthEast2 :: B.ByteString
-s3EndpointApSouthEast2 = "s3-ap-southeast-2.amazonaws.com"
+s3ApSe2 :: Region -- ^ Asia Pacific (Sydney)
+s3ApSe2 = Region "s3-ap-southeast-2.amazonaws.com" "ap-southeast-2"
 
-s3EndpointApNorthEast :: B.ByteString
-s3EndpointApNorthEast = "s3-ap-northeast-1.amazonaws.com"
+s3SaEast1 :: Region -- ^ South America (São Paulo)
+s3SaEast1 = Region "s3-sa-east-1.amazonaws.com" "sa-east-1"
 
-s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration qt
-s3 protocol endpoint uri
+s3 :: Protocol -> Region -> Bool -> S3Configuration qt
+s3 protocol region uri
     = S3Configuration {
          s3Protocol = protocol
-       , s3Endpoint = endpoint
+       , s3Region = region
        , s3RequestStyle = BucketStyle
        , s3Port = defaultPort protocol
        , s3ServerSideEncryption = Nothing
@@ -193,9 +211,9 @@ s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..}
 
       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`

From 3cac96157c1b642a7ddade420e02039502a174de Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 16:52:34 +0800
Subject: [PATCH 02/16] Show requestHeaders in debug mode.

---
 Aws/Aws.hs | 1 +
 1 file changed, 1 insertion(+)

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)

From cbdb8d4704db06880629a38aea14e29386194f65 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 17:39:18 +0800
Subject: [PATCH 03/16] Sign using V4 instead of V2

Changes the signature method to version 4 to support the buckets
in China (Beijing) or EU (Frankfurt).
Fixes #167
---
 Aws/S3/Commands/CopyObject.hs        |  2 +-
 Aws/S3/Commands/DeleteBucket.hs      |  2 +-
 Aws/S3/Commands/DeleteObject.hs      |  2 +-
 Aws/S3/Commands/DeleteObjects.hs     |  2 +-
 Aws/S3/Commands/GetBucket.hs         |  2 +-
 Aws/S3/Commands/GetBucketLocation.hs |  2 +-
 Aws/S3/Commands/GetObject.hs         |  2 +-
 Aws/S3/Commands/GetService.hs        |  4 +-
 Aws/S3/Commands/HeadObject.hs        |  2 +-
 Aws/S3/Commands/Multipart.hs         | 10 ++---
 Aws/S3/Commands/PutBucket.hs         |  2 +-
 Aws/S3/Commands/PutObject.hs         |  4 +-
 Aws/S3/Core.hs                       | 61 +++++++++++++++++++---------
 13 files changed, 59 insertions(+), 38 deletions(-)

diff --git a/Aws/S3/Commands/CopyObject.hs b/Aws/S3/Commands/CopyObject.hs
index b23c8a3a..9a32d3e4 100644
--- a/Aws/S3/Commands/CopyObject.hs
+++ b/Aws/S3/Commands/CopyObject.hs
@@ -59,7 +59,7 @@ instance SignQuery CopyObject where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = coContentType
-                               , s3QContentMd5 = Nothing
+                               , s3QContentSha256 = Nothing
                                , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                    Just ("x-amz-copy-source",
                                          oidBucket `T.append` "/" `T.append` oidObject `T.append`
diff --git a/Aws/S3/Commands/DeleteBucket.hs b/Aws/S3/Commands/DeleteBucket.hs
index ebecdb13..55e7a35c 100644
--- a/Aws/S3/Commands/DeleteBucket.hs
+++ b/Aws/S3/Commands/DeleteBucket.hs
@@ -22,7 +22,7 @@ instance SignQuery DeleteBucket where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = Nothing
-                               , s3QContentMd5 = Nothing
+                               , s3QContentSha256 = Nothing
                                , s3QAmzHeaders = []
                                , s3QOtherHeaders = []
                                , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/DeleteObject.hs b/Aws/S3/Commands/DeleteObject.hs
index 707f563c..9398b470 100644
--- a/Aws/S3/Commands/DeleteObject.hs
+++ b/Aws/S3/Commands/DeleteObject.hs
@@ -24,7 +24,7 @@ instance SignQuery DeleteObject where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = Nothing
-                               , s3QContentMd5 = Nothing
+                               , s3QContentSha256 = Nothing
                                , s3QAmzHeaders = []
                                , s3QOtherHeaders = []
                                , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/DeleteObjects.hs b/Aws/S3/Commands/DeleteObjects.hs
index 9ec35892..9f0f630f 100644
--- a/Aws/S3/Commands/DeleteObjects.hs
+++ b/Aws/S3/Commands/DeleteObjects.hs
@@ -70,7 +70,7 @@ instance SignQuery DeleteObjects where
       , s3QSubresources = HTTP.toQuery [("delete" :: B.ByteString, Nothing :: Maybe B.ByteString)]
       , s3QQuery        = []
       , s3QContentType  = Nothing
-      , s3QContentMd5   = Just $ hashlazy dosBody
+      , s3QContentSha256= Just $ hashlazy dosBody
       , s3QObject       = Nothing
       , s3QAmzHeaders   = maybeToList $ (("x-amz-mfa", ) . T.encodeUtf8) <$> dosMultiFactorAuthentication
       , s3QOtherHeaders = []
diff --git a/Aws/S3/Commands/GetBucket.hs b/Aws/S3/Commands/GetBucket.hs
index d978993e..5fed3dcc 100644
--- a/Aws/S3/Commands/GetBucket.hs
+++ b/Aws/S3/Commands/GetBucket.hs
@@ -63,7 +63,7 @@ instance SignQuery GetBucket where
                                             , ("prefix",) <$> gbPrefix
                                             ]
                                , s3QContentType = Nothing
-                               , s3QContentMd5 = Nothing
+                               , s3QContentSha256 = Nothing
                                , s3QAmzHeaders = []
                                , s3QOtherHeaders = []
                                , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/GetBucketLocation.hs b/Aws/S3/Commands/GetBucketLocation.hs
index f729f04b..4d73ccee 100644
--- a/Aws/S3/Commands/GetBucketLocation.hs
+++ b/Aws/S3/Commands/GetBucketLocation.hs
@@ -35,7 +35,7 @@ instance SignQuery GetBucketLocation where
                                      , s3QSubresources = [("location" :: B8.ByteString, Nothing :: Maybe B8.ByteString)]
                                      , s3QQuery = HTTP.toQuery ([] :: [(B8.ByteString, T.Text)]) 
                                      , s3QContentType = Nothing
-                                     , s3QContentMd5 = Nothing
+                                     , s3QContentSha256 = Nothing
                                      , s3QAmzHeaders = []
                                      , s3QOtherHeaders = []
                                      , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/GetObject.hs b/Aws/S3/Commands/GetObject.hs
index 773256b2..d40e60ca 100644
--- a/Aws/S3/Commands/GetObject.hs
+++ b/Aws/S3/Commands/GetObject.hs
@@ -66,7 +66,7 @@ instance SignQuery GetObject where
                                                      ]
                                  , s3QQuery = []
                                  , s3QContentType = Nothing
-                                 , s3QContentMd5 = Nothing
+                                 , s3QContentSha256 = Nothing
                                  , s3QAmzHeaders = []
                                  , s3QOtherHeaders = catMaybes [
                                                        decodeRange <$> goResponseContentRange
diff --git a/Aws/S3/Commands/GetService.hs b/Aws/S3/Commands/GetService.hs
index 52776f72..7e0e8e54 100644
--- a/Aws/S3/Commands/GetService.hs
+++ b/Aws/S3/Commands/GetService.hs
@@ -50,7 +50,7 @@ instance SignQuery GetService where
                               , s3QSubresources = []
                               , s3QQuery = []
                               , s3QContentType = Nothing
-                              , s3QContentMd5 = Nothing
+                              , s3QContentSha256 = Nothing
                               , s3QAmzHeaders = []
                               , s3QOtherHeaders = []
                               , s3QRequestBody = Nothing
@@ -60,4 +60,4 @@ instance Transaction GetService GetServiceResponse
 
 instance AsMemoryResponse GetServiceResponse where
   type MemoryResponse GetServiceResponse = GetServiceResponse
-  loadToMemory = return
\ No newline at end of file
+  loadToMemory = return
diff --git a/Aws/S3/Commands/HeadObject.hs b/Aws/S3/Commands/HeadObject.hs
index d58baf41..ab71b396 100644
--- a/Aws/S3/Commands/HeadObject.hs
+++ b/Aws/S3/Commands/HeadObject.hs
@@ -49,7 +49,7 @@ instance SignQuery HeadObject where
                                                      ]
                                  , s3QQuery = []
                                  , s3QContentType = Nothing
-                                 , s3QContentMd5 = Nothing
+                                 , s3QContentSha256 = Nothing
                                  , s3QAmzHeaders = []
                                  , s3QOtherHeaders = catMaybes [
                                                        ("if-match",) . T.encodeUtf8 <$> hoIfMatch
diff --git a/Aws/S3/Commands/Multipart.hs b/Aws/S3/Commands/Multipart.hs
index 176ffbd6..7e4dfd24 100644
--- a/Aws/S3/Commands/Multipart.hs
+++ b/Aws/S3/Commands/Multipart.hs
@@ -79,7 +79,7 @@ instance SignQuery InitiateMultipartUpload where
       , s3QSubresources = HTTP.toQuery[ ("uploads" :: B8.ByteString , Nothing :: Maybe B8.ByteString)]
       , s3QQuery = []
       , s3QContentType = T.encodeUtf8 <$> imuContentType
-      , s3QContentMd5 = Nothing
+      , s3QContentSha256 = Nothing
       , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
           ("x-amz-acl",) <$> writeCannedAcl <$> imuAcl
         , ("x-amz-storage-class",) <$> writeStorageClass <$> imuStorageClass
@@ -127,7 +127,7 @@ data UploadPart = UploadPart {
   , upPartNumber :: Integer
   , upUploadId :: T.Text
   , upContentType :: Maybe B8.ByteString
-  , upContentMD5 :: Maybe (Digest MD5)
+  , upContentSha256 :: Maybe (Digest SHA256)
   , upServerSideEncryption :: Maybe ServerSideEncryption
   , upRequestBody  :: HTTP.RequestBody
   , upExpect100Continue :: Bool -- ^ Note: Requires http-client >= 0.4.10
@@ -158,7 +158,7 @@ instance SignQuery UploadPart where
                                  ]
                                , s3QQuery = []
                                , s3QContentType = upContentType
-                               , s3QContentMd5 = upContentMD5
+                               , s3QContentSha256 = upContentSha256
                                , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                    ("x-amz-server-side-encryption",) <$> writeServerSideEncryption <$> upServerSideEncryption
                                  ]
@@ -223,7 +223,7 @@ instance SignQuery CompleteMultipartUpload where
         ]
       , s3QQuery = []
       , s3QContentType = Nothing
-      , s3QContentMd5 = Nothing
+      , s3QContentSha256 = Nothing
       , s3QAmzHeaders = catMaybes [ ("x-amz-expiration",) <$> (T.encodeUtf8 <$> cmuExpiration)
                                   , ("x-amz-server-side-encryption",) <$> (T.encodeUtf8 <$> cmuServerSideEncryption)
                                   , ("x-amz-server-side-encryption-customer-algorithm",)
@@ -309,7 +309,7 @@ instance SignQuery AbortMultipartUpload where
         ]
       , s3QQuery = []
       , s3QContentType = Nothing
-      , s3QContentMd5 = Nothing
+      , s3QContentSha256 = Nothing
       , s3QAmzHeaders = []
       , s3QOtherHeaders = []
       , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/PutBucket.hs b/Aws/S3/Commands/PutBucket.hs
index 84cca909..d9721a22 100644
--- a/Aws/S3/Commands/PutBucket.hs
+++ b/Aws/S3/Commands/PutBucket.hs
@@ -36,7 +36,7 @@ instance SignQuery PutBucket where
                                            , s3QSubresources = []
                                            , s3QQuery        = []
                                            , s3QContentType  = Nothing
-                                           , s3QContentMd5   = Nothing
+                                           , s3QContentSha256= Nothing
                                            , s3QObject       = Nothing
                                            , s3QAmzHeaders   = case pbCannedAcl of
                                                                  Nothing -> []
diff --git a/Aws/S3/Commands/PutObject.hs b/Aws/S3/Commands/PutObject.hs
index d413145d..06a29c58 100644
--- a/Aws/S3/Commands/PutObject.hs
+++ b/Aws/S3/Commands/PutObject.hs
@@ -22,7 +22,7 @@ data PutObject = PutObject {
   poCacheControl :: Maybe T.Text,
   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,
@@ -60,7 +60,7 @@ instance SignQuery PutObject where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = poContentType
-                               , s3QContentMd5 = poContentMD5
+                               , s3QContentSha256 = poContentSha256
                                , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                               ("x-amz-acl",) <$> writeCannedAcl <$> poAcl
                                             , ("x-amz-storage-class",) <$> writeStorageClass <$> poStorageClass
diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index 1f374d49..ff3f369e 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -166,7 +166,7 @@ data S3Query
       , s3QSubresources :: HTTP.Query
       , s3QQuery :: HTTP.Query
       , s3QContentType :: Maybe B.ByteString
-      , s3QContentMd5 :: Maybe (Digest MD5)
+      , s3QContentSha256 :: Maybe (Digest SHA256)
       , s3QAmzHeaders :: HTTP.RequestHeaders
       , s3QOtherHeaders :: HTTP.RequestHeaders
 #if MIN_VERSION_http_conduit(2, 0, 0)
@@ -184,9 +184,10 @@ instance Show S3Query where
                        " ; query: " ++ show s3QQuery ++
                        " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") ++
                        "]"
-
+-- | For signature v4 signing see
+-- <http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html>
 s3SignQuery :: S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
-s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..}
+s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
     = SignedQuery {
         sqMethod = s3QMethod
       , sqProtocol = s3Protocol
@@ -197,14 +198,25 @@ s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..}
       , sqDate = Just signatureTime
       , sqAuthorization = authorization
       , sqContentType = s3QContentType
-      , sqContentMd5 = s3QContentMd5
+      , sqContentMd5 = Nothing -- s3QContentSHA256
       , sqAmzHeaders = amzHeaders
       , sqOtherHeaders = s3QOtherHeaders
       , sqBody = s3QRequestBody
       , 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"
+      bodyHash = fromMaybe emptyBodyHash (Base64.encode . toBytes <$> s3QContentSha256)
+
+      -- needs to match th eone produces in the @authorizationV4@
+      sigTime = fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime
+      amzSigHeaders = [("x-amz-date", sigTime)
+                      ,("x-amz-content-sha256", bodyHash)]
+      
+      amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders ++ (fmap (\(k, v) -> (CI.mk k, v)) (amzSigHeaders ++ 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
@@ -215,29 +227,38 @@ s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..}
                        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]
+      
+      -- must provide host in the canonical headers.
+      canonicalHeaders = sortBy (compare `on` fst) $ amzHeaders ++ catMaybes
+                         [Just ("host", B.intercalate "." $ catMaybes host)
+                         , ("content-type",) <$> s3QContentType
+                         ]
+
+      stringToSign = B.concat $ intercalate ["\n"] $
+                       [ [httpMethod s3QMethod]             -- method
+                       , [mconcat . catMaybes $ path]       -- path
+                       , []                                 -- query string
+                       ] ++
+                       map (\(a,b) -> [CI.foldedCase a,":",b]) canonicalHeaders ++
+                       [ [] -- end headers
+--                       , [Blaze.copyByteString $ case ti of
+--                                                   AbsoluteTimestamp time -> fmtRfc822Time time
+--                                                   AbsoluteExpires time -> fmtTimeEpochSeconds time]
+                       , intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders)
+                       , [bodyHash]
                        ]
-          where amzHeader (k, v) = Blaze.copyByteString (CI.foldedCase k) `mappend` Blaze8.fromChar ':' `mappend` Blaze.copyByteString v
       (authorization, authQuery) = case ti of
-                                 AbsoluteTimestamp _ -> (Just $ return $ B.concat ["AWS ", accessKeyID signatureCredentials, ":", sig], [])
+                                 AbsoluteTimestamp _ -> (Just $ authorizationV4 sd HmacSHA256 (rName s3Region) "s3"
+                                                         (B.concat (intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders)))
+                                                         stringToSign,
+                                                         [])
                                  AbsoluteExpires time -> (Nothing, HTTP.toQuery $ makeAuthQuery time)
       makeAuthQuery time
           = [("Expires" :: B8.ByteString, fmtTimeEpochSeconds time)

From 4f3d0c5552a8c9e5669fffaa8f29386966f35c3e Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 18:15:59 +0800
Subject: [PATCH 04/16] Adds SHA256 fied.

---
 Aws/S3/Core.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index ff3f369e..8138e11a 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -166,7 +166,10 @@ data S3Query
       , s3QSubresources :: HTTP.Query
       , s3QQuery :: HTTP.Query
       , s3QContentType :: Maybe B.ByteString
+      , s3QContentMd5 :: Maybe (Digest MD5)
+      -- ^ The Content-MD5 header value.
       , s3QContentSha256 :: Maybe (Digest SHA256)
+      -- ^ The SHA256 of the payload. Empty payload is assumed by default.
       , s3QAmzHeaders :: HTTP.RequestHeaders
       , s3QOtherHeaders :: HTTP.RequestHeaders
 #if MIN_VERSION_http_conduit(2, 0, 0)
@@ -198,7 +201,7 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
       , sqDate = Just signatureTime
       , sqAuthorization = authorization
       , sqContentType = s3QContentType
-      , sqContentMd5 = Nothing -- s3QContentSHA256
+      , sqContentMd5 = s3QContentMd5
       , sqAmzHeaders = amzHeaders
       , sqOtherHeaders = s3QOtherHeaders
       , sqBody = s3QRequestBody

From a4ccbc14a60524adb88924f94377520726457022 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 18:18:57 +0800
Subject: [PATCH 05/16] Revert "Sign using V4 instead of V2"

This reverts commit cbdb8d4704db06880629a38aea14e29386194f65.
---
 Aws/S3/Commands/CopyObject.hs        |  2 +-
 Aws/S3/Commands/DeleteBucket.hs      |  2 +-
 Aws/S3/Commands/DeleteObject.hs      |  2 +-
 Aws/S3/Commands/DeleteObjects.hs     |  2 +-
 Aws/S3/Commands/GetBucket.hs         |  2 +-
 Aws/S3/Commands/GetBucketLocation.hs |  2 +-
 Aws/S3/Commands/GetObject.hs         |  2 +-
 Aws/S3/Commands/GetService.hs        |  4 ++--
 Aws/S3/Commands/HeadObject.hs        |  2 +-
 Aws/S3/Commands/Multipart.hs         | 10 +++++-----
 Aws/S3/Commands/PutBucket.hs         |  2 +-
 Aws/S3/Commands/PutObject.hs         |  4 ++--
 12 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/Aws/S3/Commands/CopyObject.hs b/Aws/S3/Commands/CopyObject.hs
index 9a32d3e4..b23c8a3a 100644
--- a/Aws/S3/Commands/CopyObject.hs
+++ b/Aws/S3/Commands/CopyObject.hs
@@ -59,7 +59,7 @@ instance SignQuery CopyObject where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = coContentType
-                               , s3QContentSha256 = Nothing
+                               , s3QContentMd5 = Nothing
                                , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                    Just ("x-amz-copy-source",
                                          oidBucket `T.append` "/" `T.append` oidObject `T.append`
diff --git a/Aws/S3/Commands/DeleteBucket.hs b/Aws/S3/Commands/DeleteBucket.hs
index 55e7a35c..ebecdb13 100644
--- a/Aws/S3/Commands/DeleteBucket.hs
+++ b/Aws/S3/Commands/DeleteBucket.hs
@@ -22,7 +22,7 @@ instance SignQuery DeleteBucket where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = Nothing
-                               , s3QContentSha256 = Nothing
+                               , s3QContentMd5 = Nothing
                                , s3QAmzHeaders = []
                                , s3QOtherHeaders = []
                                , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/DeleteObject.hs b/Aws/S3/Commands/DeleteObject.hs
index 9398b470..707f563c 100644
--- a/Aws/S3/Commands/DeleteObject.hs
+++ b/Aws/S3/Commands/DeleteObject.hs
@@ -24,7 +24,7 @@ instance SignQuery DeleteObject where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = Nothing
-                               , s3QContentSha256 = Nothing
+                               , s3QContentMd5 = Nothing
                                , s3QAmzHeaders = []
                                , s3QOtherHeaders = []
                                , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/DeleteObjects.hs b/Aws/S3/Commands/DeleteObjects.hs
index 9f0f630f..9ec35892 100644
--- a/Aws/S3/Commands/DeleteObjects.hs
+++ b/Aws/S3/Commands/DeleteObjects.hs
@@ -70,7 +70,7 @@ instance SignQuery DeleteObjects where
       , s3QSubresources = HTTP.toQuery [("delete" :: B.ByteString, Nothing :: Maybe B.ByteString)]
       , s3QQuery        = []
       , s3QContentType  = Nothing
-      , s3QContentSha256= Just $ hashlazy dosBody
+      , s3QContentMd5   = Just $ hashlazy dosBody
       , s3QObject       = Nothing
       , s3QAmzHeaders   = maybeToList $ (("x-amz-mfa", ) . T.encodeUtf8) <$> dosMultiFactorAuthentication
       , s3QOtherHeaders = []
diff --git a/Aws/S3/Commands/GetBucket.hs b/Aws/S3/Commands/GetBucket.hs
index 5fed3dcc..d978993e 100644
--- a/Aws/S3/Commands/GetBucket.hs
+++ b/Aws/S3/Commands/GetBucket.hs
@@ -63,7 +63,7 @@ instance SignQuery GetBucket where
                                             , ("prefix",) <$> gbPrefix
                                             ]
                                , s3QContentType = Nothing
-                               , s3QContentSha256 = Nothing
+                               , s3QContentMd5 = Nothing
                                , s3QAmzHeaders = []
                                , s3QOtherHeaders = []
                                , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/GetBucketLocation.hs b/Aws/S3/Commands/GetBucketLocation.hs
index 4d73ccee..f729f04b 100644
--- a/Aws/S3/Commands/GetBucketLocation.hs
+++ b/Aws/S3/Commands/GetBucketLocation.hs
@@ -35,7 +35,7 @@ instance SignQuery GetBucketLocation where
                                      , s3QSubresources = [("location" :: B8.ByteString, Nothing :: Maybe B8.ByteString)]
                                      , s3QQuery = HTTP.toQuery ([] :: [(B8.ByteString, T.Text)]) 
                                      , s3QContentType = Nothing
-                                     , s3QContentSha256 = Nothing
+                                     , s3QContentMd5 = Nothing
                                      , s3QAmzHeaders = []
                                      , s3QOtherHeaders = []
                                      , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/GetObject.hs b/Aws/S3/Commands/GetObject.hs
index d40e60ca..773256b2 100644
--- a/Aws/S3/Commands/GetObject.hs
+++ b/Aws/S3/Commands/GetObject.hs
@@ -66,7 +66,7 @@ instance SignQuery GetObject where
                                                      ]
                                  , s3QQuery = []
                                  , s3QContentType = Nothing
-                                 , s3QContentSha256 = Nothing
+                                 , s3QContentMd5 = Nothing
                                  , s3QAmzHeaders = []
                                  , s3QOtherHeaders = catMaybes [
                                                        decodeRange <$> goResponseContentRange
diff --git a/Aws/S3/Commands/GetService.hs b/Aws/S3/Commands/GetService.hs
index 7e0e8e54..52776f72 100644
--- a/Aws/S3/Commands/GetService.hs
+++ b/Aws/S3/Commands/GetService.hs
@@ -50,7 +50,7 @@ instance SignQuery GetService where
                               , s3QSubresources = []
                               , s3QQuery = []
                               , s3QContentType = Nothing
-                              , s3QContentSha256 = Nothing
+                              , s3QContentMd5 = Nothing
                               , s3QAmzHeaders = []
                               , s3QOtherHeaders = []
                               , s3QRequestBody = Nothing
@@ -60,4 +60,4 @@ instance Transaction GetService GetServiceResponse
 
 instance AsMemoryResponse GetServiceResponse where
   type MemoryResponse GetServiceResponse = GetServiceResponse
-  loadToMemory = return
+  loadToMemory = return
\ No newline at end of file
diff --git a/Aws/S3/Commands/HeadObject.hs b/Aws/S3/Commands/HeadObject.hs
index ab71b396..d58baf41 100644
--- a/Aws/S3/Commands/HeadObject.hs
+++ b/Aws/S3/Commands/HeadObject.hs
@@ -49,7 +49,7 @@ instance SignQuery HeadObject where
                                                      ]
                                  , s3QQuery = []
                                  , s3QContentType = Nothing
-                                 , s3QContentSha256 = Nothing
+                                 , s3QContentMd5 = Nothing
                                  , s3QAmzHeaders = []
                                  , s3QOtherHeaders = catMaybes [
                                                        ("if-match",) . T.encodeUtf8 <$> hoIfMatch
diff --git a/Aws/S3/Commands/Multipart.hs b/Aws/S3/Commands/Multipart.hs
index 7e4dfd24..176ffbd6 100644
--- a/Aws/S3/Commands/Multipart.hs
+++ b/Aws/S3/Commands/Multipart.hs
@@ -79,7 +79,7 @@ instance SignQuery InitiateMultipartUpload where
       , s3QSubresources = HTTP.toQuery[ ("uploads" :: B8.ByteString , Nothing :: Maybe B8.ByteString)]
       , s3QQuery = []
       , s3QContentType = T.encodeUtf8 <$> imuContentType
-      , s3QContentSha256 = Nothing
+      , s3QContentMd5 = Nothing
       , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
           ("x-amz-acl",) <$> writeCannedAcl <$> imuAcl
         , ("x-amz-storage-class",) <$> writeStorageClass <$> imuStorageClass
@@ -127,7 +127,7 @@ data UploadPart = UploadPart {
   , upPartNumber :: Integer
   , upUploadId :: T.Text
   , upContentType :: Maybe B8.ByteString
-  , upContentSha256 :: Maybe (Digest SHA256)
+  , upContentMD5 :: Maybe (Digest MD5)
   , upServerSideEncryption :: Maybe ServerSideEncryption
   , upRequestBody  :: HTTP.RequestBody
   , upExpect100Continue :: Bool -- ^ Note: Requires http-client >= 0.4.10
@@ -158,7 +158,7 @@ instance SignQuery UploadPart where
                                  ]
                                , s3QQuery = []
                                , s3QContentType = upContentType
-                               , s3QContentSha256 = upContentSha256
+                               , s3QContentMd5 = upContentMD5
                                , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                    ("x-amz-server-side-encryption",) <$> writeServerSideEncryption <$> upServerSideEncryption
                                  ]
@@ -223,7 +223,7 @@ instance SignQuery CompleteMultipartUpload where
         ]
       , s3QQuery = []
       , s3QContentType = Nothing
-      , s3QContentSha256 = Nothing
+      , s3QContentMd5 = Nothing
       , s3QAmzHeaders = catMaybes [ ("x-amz-expiration",) <$> (T.encodeUtf8 <$> cmuExpiration)
                                   , ("x-amz-server-side-encryption",) <$> (T.encodeUtf8 <$> cmuServerSideEncryption)
                                   , ("x-amz-server-side-encryption-customer-algorithm",)
@@ -309,7 +309,7 @@ instance SignQuery AbortMultipartUpload where
         ]
       , s3QQuery = []
       , s3QContentType = Nothing
-      , s3QContentSha256 = Nothing
+      , s3QContentMd5 = Nothing
       , s3QAmzHeaders = []
       , s3QOtherHeaders = []
       , s3QRequestBody = Nothing
diff --git a/Aws/S3/Commands/PutBucket.hs b/Aws/S3/Commands/PutBucket.hs
index d9721a22..84cca909 100644
--- a/Aws/S3/Commands/PutBucket.hs
+++ b/Aws/S3/Commands/PutBucket.hs
@@ -36,7 +36,7 @@ instance SignQuery PutBucket where
                                            , s3QSubresources = []
                                            , s3QQuery        = []
                                            , s3QContentType  = Nothing
-                                           , s3QContentSha256= Nothing
+                                           , s3QContentMd5   = Nothing
                                            , s3QObject       = Nothing
                                            , s3QAmzHeaders   = case pbCannedAcl of
                                                                  Nothing -> []
diff --git a/Aws/S3/Commands/PutObject.hs b/Aws/S3/Commands/PutObject.hs
index 06a29c58..d413145d 100644
--- a/Aws/S3/Commands/PutObject.hs
+++ b/Aws/S3/Commands/PutObject.hs
@@ -22,7 +22,7 @@ data PutObject = PutObject {
   poCacheControl :: Maybe T.Text,
   poContentDisposition :: Maybe T.Text,
   poContentEncoding :: Maybe T.Text,
-  poContentSha256 :: Maybe (Digest SHA256),
+  poContentMD5 :: Maybe (Digest MD5),
   poExpires :: Maybe Int,
   poAcl :: Maybe CannedAcl,
   poStorageClass :: Maybe StorageClass,
@@ -60,7 +60,7 @@ instance SignQuery PutObject where
                                , s3QSubresources = []
                                , s3QQuery = []
                                , s3QContentType = poContentType
-                               , s3QContentSha256 = poContentSha256
+                               , s3QContentMd5 = poContentMD5
                                , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                               ("x-amz-acl",) <$> writeCannedAcl <$> poAcl
                                             , ("x-amz-storage-class",) <$> writeStorageClass <$> poStorageClass

From 6db0222fb9255ca5b6b6095c4a3ffbb5c8f52594 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 18:31:24 +0800
Subject: [PATCH 06/16] Drop superfluous field.

---
 Aws/S3/Core.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index 8138e11a..a8cf45bb 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -168,8 +168,6 @@ data S3Query
       , s3QContentType :: Maybe B.ByteString
       , s3QContentMd5 :: Maybe (Digest MD5)
       -- ^ The Content-MD5 header value.
-      , s3QContentSha256 :: Maybe (Digest SHA256)
-      -- ^ The SHA256 of the payload. Empty payload is assumed by default.
       , s3QAmzHeaders :: HTTP.RequestHeaders
       , s3QOtherHeaders :: HTTP.RequestHeaders
 #if MIN_VERSION_http_conduit(2, 0, 0)

From f8260d80e1c8643ce29b4b6f8819edfaeff9a6d4 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 18:31:35 +0800
Subject: [PATCH 07/16] Add Amz header

---
 Aws/S3/Core.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index a8cf45bb..e89301a8 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -185,6 +185,11 @@ instance Show S3Query where
                        " ; query: " ++ show s3QQuery ++
                        " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") ++
                        "]"
+
+hAmzDate, hAMZContentSha256 :: HeaderName
+hAmzDate = "x-amz-date"
+hAmzContentSha256 = "x-amz-content-sha256"
+
 -- | For signature v4 signing see
 -- <http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html>
 s3SignQuery :: S3Query -> S3Configuration qt -> SignatureData -> SignedQuery

From d802f421d7157d0225c0de8caaa18f8aa59a2031 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 8 Apr 2016 18:31:51 +0800
Subject: [PATCH 08/16] rewrite header logic.

---
 Aws/S3/Core.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index e89301a8..de388ff6 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -219,10 +219,13 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
 
       -- needs to match th eone produces in the @authorizationV4@
       sigTime = fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime
-      amzSigHeaders = [("x-amz-date", sigTime)
-                      ,("x-amz-content-sha256", bodyHash)]
+
+      -- inject date and an empty content sha256, if not given.
+      s3QAmzHeaders' = (hAMZDate, sigTime):case lookup hAmzContentSha256 s3QAmzHeaders of
+        Just bodyHash -> s3QAmzHeaders
+        Nothing -> (hAmzContentSha256, emptyBodyHash)s3QAmzHeaders
       
-      amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders ++ (fmap (\(k, v) -> (CI.mk k, v)) (amzSigHeaders ++ iamTok)))
+      amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders' ++ amzSigHeaders ++ (fmap (\(k, v) -> (CI.mk k, v)) 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

From 3449e2d7205c77a6e9f5528eca0128a668db6847 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 11:50:05 +0800
Subject: [PATCH 09/16] Extract credentialV4 from authorizationV4

credentialV4 is useful outside of authorizationV4 as well. It is used to build the signed S3 URI link, whe the credentialV4 string is embedded in the canonical request.
---
 Aws/Core.hs | 29 ++++++++++++++++++++---------
 1 file changed, 20 insertions(+), 9 deletions(-)

diff --git a/Aws/Core.hs b/Aws/Core.hs
index 22228db3..6ef27f21 100644
--- a/Aws/Core.hs
+++ b/Aws/Core.hs
@@ -50,6 +50,7 @@ module Aws.Core
 , AuthorizationHash(..)
 , amzHash
 , signature
+, credentialV4
 , authorizationV4
   -- ** Query construction helpers
 , queryList
@@ -601,6 +602,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 <http://docs.aws.amazon.com/general/latest/gr/signature-version-4.html>: you must create the
 -- canonical request as explained by Step 1 and this function takes care of Steps 2 and 3.
@@ -663,15 +681,8 @@ 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

From 631cecba3f80be9f693d28ab47ad941775641c0d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 12:32:12 +0800
Subject: [PATCH 10/16] Adds a pure version of `authorizationV4`.

---
 Aws/Core.hs | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)

diff --git a/Aws/Core.hs b/Aws/Core.hs
index 6ef27f21..db562878 100644
--- a/Aws/Core.hs
+++ b/Aws/Core.hs
@@ -52,6 +52,7 @@ module Aws.Core
 , signature
 , credentialV4
 , authorizationV4
+, authorizationV4'
   -- ** Query construction helpers
 , queryList
 , awsBool
@@ -688,6 +689,62 @@ authorizationV4 sd ah region service headers canonicalRequest = do
                       , sig
                       ]
 
+-- | 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 ref = v4SigningKeys $ signatureCredentials sd
+        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
+                                ]
+        sig = Base16.encode $ mkHmac key stringToSign
+
+    -- finally, return the header
+    B.concat [ alg
+             , " Credential="
+             , credentialV4 sd region service
+             , ",SignedHeaders="
+             , headers
+             , ",Signature="
+             , sig
+             ]
+
 -- | Default configuration for a specific service.
 class DefaultServiceConfiguration config where
     -- | Default service configuration.

From 276b8245e45228a5d987c84f923cf822c2682443 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 13:48:35 +0800
Subject: [PATCH 11/16] Extract signatureV4 from authorizationV4'

---
 Aws/Core.hs | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)

diff --git a/Aws/Core.hs b/Aws/Core.hs
index db562878..9f6549ee 100644
--- a/Aws/Core.hs
+++ b/Aws/Core.hs
@@ -53,6 +53,7 @@ module Aws.Core
 , credentialV4
 , authorizationV4
 , authorizationV4'
+, signatureV4
   -- ** Query construction helpers
 , queryList
 , awsBool
@@ -689,18 +690,15 @@ authorizationV4 sd ah region service headers canonicalRequest = do
                       , sig
                       ]
 
--- | 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 ref = v4SigningKeys $ signatureCredentials sd
-        date = fmtTime "%Y%m%d" $ signatureTime sd
+-- | 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)
@@ -733,7 +731,21 @@ authorizationV4' sd ah region service headers canonicalRequest = do
                                 , "/aws4_request\n"
                                 , canonicalRequestHash
                                 ]
-        sig = Base16.encode $ mkHmac key stringToSign
+    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
@@ -742,7 +754,7 @@ authorizationV4' sd ah region service headers canonicalRequest = do
              , ",SignedHeaders="
              , headers
              , ",Signature="
-             , sig
+             , signatureV4 sd ah region service canonicalRequest
              ]
 
 -- | Default configuration for a specific service.

From 5b689a99f0e2e6f994b88a27608ad583600b6df3 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 13:48:59 +0800
Subject: [PATCH 12/16] Fix link generation.

---
 Aws/S3/Core.hs | 100 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 70 insertions(+), 30 deletions(-)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index de388ff6..ccf401cb 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -7,6 +7,7 @@ import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Resource   (MonadThrow, throwM)
 import           Crypto.Hash
+import           Data.Bifunctor                 (bimap)
 import           Data.Byteable
 import           Data.Conduit                   (($$+-))
 import           Data.Function
@@ -186,9 +187,15 @@ instance Show S3Query where
                        " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") ++
                        "]"
 
-hAmzDate, hAMZContentSha256 :: HeaderName
-hAmzDate = "x-amz-date"
-hAmzContentSha256 = "x-amz-content-sha256"
+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
 -- <http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html>
@@ -200,7 +207,7 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
       , sqHost = B.intercalate "." $ catMaybes host
       , sqPort = s3Port
       , sqPath = mconcat $ catMaybes path
-      , sqQuery = sortedSubresources ++ s3QQuery ++ authQuery :: HTTP.Query
+      , sqQuery = sortedSubresources ++ s3QQuery ++ (fmap (bimap CI.original Just) authQuery) :: HTTP.Query
       , sqDate = Just signatureTime
       , sqAuthorization = authorization
       , sqContentType = s3QContentType
@@ -215,17 +222,16 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
 
       -- hash of an empty string
       emptyBodyHash = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
-      bodyHash = fromMaybe emptyBodyHash (Base64.encode . toBytes <$> s3QContentSha256)
 
       -- 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 bodyHash -> s3QAmzHeaders
-        Nothing -> (hAmzContentSha256, emptyBodyHash)s3QAmzHeaders
+      s3QAmzHeaders' = (hAmzDate, sigTime):case lookup hAmzContentSha256 s3QAmzHeaders of
+        Just _ -> s3QAmzHeaders
+        Nothing -> (hAmzContentSha256, emptyBodyHash):s3QAmzHeaders
       
-      amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders' ++ amzSigHeaders ++ (fmap (\(k, v) -> (CI.mk k, v)) iamTok))
+      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
@@ -241,39 +247,73 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
              (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)
+
+      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:
+      --    <method>
+      --    <path>
+      --    <query string>
+      --    <canonical headers - header1:value1\nheader2:value2...\n>
+      --    <signed headers - header1;header2...>
+      --    <hashed payload - sha256>
+      --
+      -- 1) Generate an Authentication Header <http://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html>
+      --    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 <http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html>
+      --    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
-                       , []                                 -- query string
+                       [ [httpMethod s3QMethod]               -- method
+                       , [mconcat . catMaybes $ path]         -- path
+                       , [HTTP.renderQuery False queryString] -- query string
                        ] ++
-                       map (\(a,b) -> [CI.foldedCase a,":",b]) canonicalHeaders ++
+                       map (\(a,b) -> [CI.foldedCase a,":",b]) headers ++
                        [ [] -- end headers
---                       , [Blaze.copyByteString $ case ti of
---                                                   AbsoluteTimestamp time -> fmtRfc822Time time
---                                                   AbsoluteExpires time -> fmtTimeEpochSeconds time]
-                       , intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders)
-                       , [bodyHash]
+                       , intersperse ";" (map (CI.foldedCase . fst) headers)
+                       , [payloadHash]
                        ]
+
+      (payloadHash, queryString, headers) = case ti of
+        AbsoluteTimestamp _  -> (fromMaybe emptyBodyHash $ lookup hAmzContentSha256 amzHeaders, [], canonicalHeaders)
+        AbsoluteExpires time -> ("UNSIGNED-PAYLOAD", HTTP.toQuery . fmap (bimap CI.original id) $ 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 $ authorizationV4 sd HmacSHA256 (rName s3Region) "s3"
-                                                         (B.concat (intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders)))
-                                                         stringToSign,
-                                                         [])
-                                 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

From fb27dbd2908cb2620677988f4f5fd72e840d4933 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 15:14:41 +0800
Subject: [PATCH 13/16] Add PutObject SHA256 support.

---
 Aws/S3/Commands/PutObject.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/Aws/S3/Commands/PutObject.hs b/Aws/S3/Commands/PutObject.hs
index d413145d..351fafc5 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.Base64   as Base64
 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" (Base64.encode . toBytes <$> poContentSHA256))
 
 instance ResponseConsumer PutObject PutObjectResponse where
     type ResponseMetadata PutObjectResponse = S3Metadata

From 0f5cb521d71c5295c082b80207392af745c6dfc6 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 15:50:35 +0800
Subject: [PATCH 14/16] Base 16, not 64.

---
 Aws/S3/Commands/PutObject.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Aws/S3/Commands/PutObject.hs b/Aws/S3/Commands/PutObject.hs
index 351fafc5..846fd99e 100644
--- a/Aws/S3/Commands/PutObject.hs
+++ b/Aws/S3/Commands/PutObject.hs
@@ -8,7 +8,7 @@ import           Control.Applicative
 import           Control.Arrow         (second)
 import           Crypto.Hash
 import           Data.Byteable
-import qualified Data.ByteString.Base64   as Base64
+import qualified Data.ByteString.Base16 as Base16
 import           Data.ByteString.Char8 ({- IsString -})
 import           Data.Maybe
 import qualified Data.ByteString.Char8 as B
@@ -83,7 +83,7 @@ instance SignQuery PutObject where
                                , s3QRequestBody = Just poRequestBody
                                , s3QObject = Just $ T.encodeUtf8 poObjectName
                                }
-      where sha256Header = (hAmzContentSha256, fromMaybe "UNSIGNED-PAYLOAD" (Base64.encode . toBytes <$> poContentSHA256))
+      where sha256Header = (hAmzContentSha256, fromMaybe "UNSIGNED-PAYLOAD" (Base16.encode . toBytes <$> poContentSHA256))
 
 instance ResponseConsumer PutObject PutObjectResponse where
     type ResponseMetadata PutObjectResponse = S3Metadata

From 3969689e98d09724e390f448c210d5200408601b Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 16:16:45 +0800
Subject: [PATCH 15/16] Drop bimap

---
 Aws/S3/Core.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs
index ccf401cb..cfbadf83 100644
--- a/Aws/S3/Core.hs
+++ b/Aws/S3/Core.hs
@@ -7,7 +7,6 @@ import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Resource   (MonadThrow, throwM)
 import           Crypto.Hash
-import           Data.Bifunctor                 (bimap)
 import           Data.Byteable
 import           Data.Conduit                   (($$+-))
 import           Data.Function
@@ -207,7 +206,7 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
       , sqHost = B.intercalate "." $ catMaybes host
       , sqPort = s3Port
       , sqPath = mconcat $ catMaybes path
-      , sqQuery = sortedSubresources ++ s3QQuery ++ (fmap (bimap CI.original Just) authQuery) :: HTTP.Query
+      , sqQuery = sortedSubresources ++ s3QQuery ++ (fmap (\(x, y) -> (CI.original x, Just y)) authQuery) :: HTTP.Query
       , sqDate = Just signatureTime
       , sqAuthorization = authorization
       , sqContentType = s3QContentType
@@ -297,7 +296,7 @@ s3SignQuery S3Query{..} S3Configuration{..} sd@SignatureData{..}
 
       (payloadHash, queryString, headers) = case ti of
         AbsoluteTimestamp _  -> (fromMaybe emptyBodyHash $ lookup hAmzContentSha256 amzHeaders, [], canonicalHeaders)
-        AbsoluteExpires time -> ("UNSIGNED-PAYLOAD", HTTP.toQuery . fmap (bimap CI.original id) $ makeAuthQuery time, [("host", B.intercalate "." $ catMaybes host)])
+        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)))

From c83f22f3f0eaa5b6844a2ea9143577be16b7cd3a Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 9 Apr 2016 17:49:30 +0800
Subject: [PATCH 16/16] Fix Typesignature.

---
 Examples/PutBucketNearLine.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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