From 563036b66fcc78ffe1e18086289b89b457221cac Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 8 Aug 2014 18:54:04 -0400
Subject: WIP converting S3 special remote from hS3 to aws library

Currently, initremote works, but not the other operations. They should be
fairly easy to add from this base.

Also, https://github.com/aristidb/aws/issues/119 blocks internet archive
support.

Note that since http-conduit is used, this also adds https support to S3.
Although git-annex encrypts everything anyway, so that may not be extremely
useful. It is not enabled by default, because existing S3 special remotes
have port=80 in their config. Setting port=443 will enable it.

This commit was sponsored by Daniel Brockman.
---
 git-annex.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'git-annex.cabal')

diff --git a/git-annex.cabal b/git-annex.cabal
index 5154b27dd..70bd9c88b 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -137,7 +137,7 @@ Executable git-annex
     CPP-Options: -DWITH_CRYPTOHASH
 
   if flag(S3)
-    Build-Depends: hS3
+    Build-Depends: hS3, http-conduit, http-client, resourcet, http-types, aws
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-- 
cgit v1.2.3


From 620d1e4273310373f38866259f9f6b3bc6995a5e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 9 Aug 2014 15:31:12 -0400
Subject: deps

---
 debian/control  | 6 +++++-
 git-annex.cabal | 6 +++---
 2 files changed, 8 insertions(+), 4 deletions(-)

(limited to 'git-annex.cabal')

diff --git a/debian/control b/debian/control
index 522b7c5cc..7defd8a7c 100644
--- a/debian/control
+++ b/debian/control
@@ -13,7 +13,11 @@ Build-Depends:
 	libghc-cryptohash-dev,
 	libghc-dataenc-dev,
 	libghc-utf8-string-dev,
-	libghc-hs3-dev (>= 0.5.6),
+	libghc-aws-dev,
+	libghc-conduit-dev,
+	libghc-resourcet-dev,
+	libghc-http-conduit-dev,
+	libghc-http-client-dev,
 	libghc-dav-dev (>= 1.0) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc],
 	libghc-quickcheck2-dev,
 	libghc-monad-control-dev (>= 0.3),
diff --git a/git-annex.cabal b/git-annex.cabal
index 70bd9c88b..b05863b79 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -137,12 +137,12 @@ Executable git-annex
     CPP-Options: -DWITH_CRYPTOHASH
 
   if flag(S3)
-    Build-Depends: hS3, http-conduit, http-client, resourcet, http-types, aws
+    Build-Depends: aws, conduit, resourcet,
+     http-conduit, http-client, http-types
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-    Build-Depends: DAV (>= 1.0),
-     http-client, http-types
+    Build-Depends: DAV (>= 1.0), http-client, http-types
     CPP-Options: -DWITH_WEBDAV
 
   if flag(Assistant) && ! os(solaris)
-- 
cgit v1.2.3


From e9128138ef1e19a341d7edfda4db2d6b1f8f6b0a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 15 Aug 2014 17:17:19 -0400
Subject: Switched from the old haskell HTTP library to http-conduit.

The hoary old HTTP library was only used when checking if an url exists,
when curl was not available. It had many problems, including not supporting
https at all.

Now, this is done using http-conduit for all urls that it supports. Falls
back to curl for any url that http-conduit doesn't like (probably ftp etc,
but could also be an url that its parser chokes on for whatever reason).

This adds a new dependency on http-conduit, but webdav support already
indirectly depended on that, and the s3-aws branch also uses it.
---
 Utility/Url.hs   | 125 +++++++++++++++++++++++--------------------------------
 debian/changelog |   1 +
 debian/control   |   2 +-
 git-annex.cabal  |   9 ++--
 4 files changed, 57 insertions(+), 80 deletions(-)

(limited to 'git-annex.cabal')

diff --git a/Utility/Url.hs b/Utility/Url.hs
index 4137a5d8b..ebcae55ca 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -1,6 +1,6 @@
 {- Url downloading.
  -
- - Copyright 2011,2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}
@@ -21,10 +21,11 @@ module Utility.Url (
 
 import Common
 import Network.URI
-import qualified Network.Browser as Browser
-import Network.HTTP
-import Data.Either
+import Network.HTTP.Conduit
+import Network.HTTP.Types
 import Data.Default
+import qualified Data.CaseInsensitive as CI
+import qualified Data.ByteString.UTF8 as B8
 
 import qualified Build.SysConfig
 
@@ -60,33 +61,26 @@ check url expected_size = go <$$> exists url
 		Nothing -> (True, True)
 
 {- Checks that an url exists and could be successfully downloaded,
- - also returning its size if available. 
- -
- - For a file: url, check it directly.
- -
- - Uses curl otherwise, when available, since curl handles https better
- - than does Haskell's Network.Browser.
- -}
+ - also returning its size if available. -}
 exists :: URLString -> UrlOptions -> IO (Bool, Maybe Integer)
 exists url uo = case parseURIRelaxed url of
-	Just u
-		| uriScheme u == "file:" -> do
-			s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u)
-			case s of
-				Just stat -> return (True, Just $ fromIntegral $ fileSize stat)
-				Nothing -> dne
-		| otherwise -> if Build.SysConfig.curl
-			then do
+	Just u -> case parseUrl (show u) of
+		Just req -> existsconduit req `catchNonAsync` const dne
+		-- http-conduit does not support file:, ftp:, etc urls,
+		-- so fall back to reading files and using curl.
+		Nothing
+			| uriScheme u == "file:" -> do
+				s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u)
+				case s of
+					Just stat -> return (True, Just $ fromIntegral $ fileSize stat)
+					Nothing -> dne
+			| Build.SysConfig.curl -> do
 				output <- catchDefaultIO "" $
 					readProcess "curl" $ toCommand curlparams
 				case lastMaybe (lines output) of
-					Just ('2':_:_) -> return (True, extractsize output)
+					Just ('2':_:_) -> return (True, extractlencurl output)
 					_ -> dne
-			else do
-				r <- request u HEAD uo
-				case rspCode r of
-					(2,_,_) -> return (True, size r)
-					_ -> return (False, Nothing)
+			| otherwise -> dne
 	Nothing -> dne
   where
 	dne = return (False, Nothing)
@@ -98,13 +92,28 @@ exists url uo = case parseURIRelaxed url of
 		, Param "-w", Param "%{http_code}"
 		] ++ concatMap (\h -> [Param "-H", Param h]) (reqHeaders uo) ++ (reqParams uo)
 
-	extractsize s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of
+	extractlencurl s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of
 		Just l -> case lastMaybe $ words l of
 			Just sz -> readish sz
 			_ -> Nothing
 		_ -> Nothing
-
-	size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders
+	
+	extractlen resp = readish . B8.toString =<< headMaybe lenheaders
+	  where
+		lenheaders = map snd $ 
+			filter (\(h, _) -> h == hContentLength)
+				(responseHeaders resp)
+	
+	existsconduit req = withManager $ \mgr -> do
+			let req' = (addUrlOptions uo req) { method = methodHead }
+			resp <- http req' mgr
+			-- forces processing the response before the
+			-- manager is closed
+			ret <- if responseStatus resp == ok200
+				then return (True, extractlen resp)
+				else liftIO dne
+			liftIO $ closeManager mgr
+			return ret
 
 -- works for both wget and curl commands
 addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam]
@@ -112,6 +121,20 @@ addUserAgent uo ps = case userAgent uo of
 	Nothing -> ps
 	Just ua -> ps ++ [Param "--user-agent", Param ua] 
 
+addUrlOptions :: UrlOptions -> Request -> Request
+addUrlOptions uo r = r { requestHeaders = requestHeaders r ++ uaheader ++ otherheaders}
+  where
+	uaheader = case userAgent uo of
+		Nothing -> []
+		Just ua -> [(hUserAgent, B8.fromString ua)]
+	otherheaders = map toheader (reqHeaders uo)
+	toheader s =
+		let (h, v) = separate (== ':') s
+		    h' = CI.mk (B8.fromString h)
+		in case v of
+			(' ':v') -> (h', B8.fromString v')
+			_ -> (h', B8.fromString v)
+
 {- Used to download large files, such as the contents of keys.
  -
  - Uses wget or curl program for its progress bar. (Wget has a better one,
@@ -161,52 +184,6 @@ download' quiet url file uo =
 		| quiet = [Param s]
 		| otherwise = []
 
-{- Uses Network.Browser to make a http request of an url.
- - For example, HEAD can be used to check if the url exists,
- - or GET used to get the url content (best for small urls).
- -
- - This does its own redirect following because Browser's is buggy for HEAD
- - requests.
- -
- - Unfortunately, does not handle https, so should only be used
- - when curl is not available.
- -}
-request :: URI -> RequestMethod -> UrlOptions -> IO (Response String)
-request url requesttype uo = go 5 url
-  where
-	go :: Int -> URI -> IO (Response String)
-	go 0 _ = error "Too many redirects "
-	go n u = do
-		rsp <- Browser.browse $ do
-			maybe noop Browser.setUserAgent (userAgent uo)
-			Browser.setErrHandler ignore
-			Browser.setOutHandler ignore
-			Browser.setAllowRedirects False
-			let req = mkRequest requesttype u :: Request_String
-			snd <$> Browser.request (addheaders req)
-		case rspCode rsp of
-			(3,0,x) | x /= 5 -> redir (n - 1) u rsp
-			_ -> return rsp
-	addheaders req = setHeaders req (rqHeaders req ++ userheaders)
-	userheaders = rights $ map parseHeader (reqHeaders uo)
-	ignore = const noop
-	redir n u rsp = case retrieveHeaders HdrLocation rsp of
-		[] -> return rsp
-		(Header _ newu:_) ->
-			case parseURIReference newu of
-				Nothing -> return rsp
-				Just newURI -> go n $
-#if defined VERSION_network
-#if ! MIN_VERSION_network(2,4,0)
-#define WITH_OLD_URI
-#endif
-#endif
-#ifdef WITH_OLD_URI
-					fromMaybe newURI (newURI `relativeTo` u)
-#else
-					newURI `relativeTo` u
-#endif
-
 {- Allows for spaces and other stuff in urls, properly escaping them. -}
 parseURIRelaxed :: URLString -> Maybe URI
 parseURIRelaxed = parseURI . escapeURIString isAllowedInURI
diff --git a/debian/changelog b/debian/changelog
index c55fbabd3..0d884cd81 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -39,6 +39,7 @@ git-annex (5.20140718) UNRELEASED; urgency=medium
   * git-annex-shell sendkey: Don't fail if a remote asks for a key to be sent
     that already has a transfer lock file indicating it's being sent to that
     remote. The remote may have moved between networks, or reconnected.
+  * Switched from the old haskell HTTP library to http-conduit.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 21 Jul 2014 14:41:26 -0400
 
diff --git a/debian/control b/debian/control
index 522b7c5cc..1106bc89d 100644
--- a/debian/control
+++ b/debian/control
@@ -46,6 +46,7 @@ Build-Depends:
 	libghc-dns-dev,
 	libghc-case-insensitive-dev,
 	libghc-http-types-dev,
+	libghc-http-conduit-dev,
 	libghc-blaze-builder-dev,
 	libghc-crypto-api-dev,
 	libghc-network-multicast-dev,
@@ -55,7 +56,6 @@ Build-Depends:
 	libghc-gnutls-dev (>= 0.1.4),
 	libghc-xml-types-dev,
 	libghc-async-dev,
-	libghc-http-dev,
 	libghc-feed-dev (>= 0.3.9.2),
 	libghc-regex-tdfa-dev [!mipsel !s390],
 	libghc-regex-compat-dev [mipsel s390],
diff --git a/git-annex.cabal b/git-annex.cabal
index 097fee4cb..58aac39b3 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -96,11 +96,11 @@ Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends: MissingH, hslogger, directory, filepath,
    containers, utf8-string, network (>= 2.0), mtl (>= 2),
-   bytestring, old-locale, time, HTTP, dataenc, SHA, process, json,
+   bytestring, old-locale, time, dataenc, SHA, process, json,
    base (>= 4.5 && < 4.9), monad-control, exceptions (>= 0.5), transformers,
    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
    SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3),
-   data-default, case-insensitive
+   data-default, case-insensitive, http-conduit, http-types
   CC-Options: -Wall
   GHC-Options: -Wall
   Extensions: PackageImports
@@ -141,8 +141,7 @@ Executable git-annex
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-    Build-Depends: DAV (>= 1.0),
-     http-client, http-types
+    Build-Depends: DAV (>= 1.0), http-client
     CPP-Options: -DWITH_WEBDAV
 
   if flag(Assistant) && ! os(solaris)
@@ -188,7 +187,7 @@ Executable git-annex
   if flag(Webapp)
     Build-Depends:
      yesod, yesod-default, yesod-static, yesod-form, yesod-core,
-     http-types, wai, wai-extra, warp, warp-tls,
+     wai, wai-extra, warp, warp-tls,
      blaze-builder, crypto-api, hamlet, clientsession,
      template-haskell, data-default, aeson, path-pieces,
      shakespeare
-- 
cgit v1.2.3


From b9343ca1d3e0c7e136f7894cd159edb1d0730a0a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 18 Aug 2014 15:26:18 -0400
Subject: update aws version requirements

---
 debian/control  | 2 +-
 git-annex.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

(limited to 'git-annex.cabal')

diff --git a/debian/control b/debian/control
index 89141a7e3..2b430b4dc 100644
--- a/debian/control
+++ b/debian/control
@@ -13,7 +13,7 @@ Build-Depends:
 	libghc-cryptohash-dev,
 	libghc-dataenc-dev,
 	libghc-utf8-string-dev,
-	libghc-aws-dev,
+	libghc-aws-dev (>= 0.10.2),
 	libghc-conduit-dev,
 	libghc-resourcet-dev,
 	libghc-dav-dev (>= 1.0) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc],
diff --git a/git-annex.cabal b/git-annex.cabal
index b0835f50a..6e57dd1f4 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -137,7 +137,7 @@ Executable git-annex
     CPP-Options: -DWITH_CRYPTOHASH
 
   if flag(S3)
-    Build-Depends: aws, conduit, resourcet
+    Build-Depends: aws (>= 0.10.2), conduit, resourcet
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-- 
cgit v1.2.3


From 737267c0a0c21823ec65d786e59589900859320d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 23 Oct 2014 16:39:55 -0400
Subject: add cabal flag for use with debian's older version of aws, which is
 now patched with the necessary stuff

---
 debian/control  |  2 +-
 debian/rules    |  4 ++++
 git-annex.cabal | 10 +++++++++-
 3 files changed, 14 insertions(+), 2 deletions(-)

(limited to 'git-annex.cabal')

diff --git a/debian/control b/debian/control
index 659ec05fa..55fc17448 100644
--- a/debian/control
+++ b/debian/control
@@ -14,7 +14,7 @@ Build-Depends:
 	libghc-cryptohash-dev,
 	libghc-dataenc-dev,
 	libghc-utf8-string-dev,
-	libghc-aws-dev (>= 0.10.2),
+	libghc-aws-dev (>= 0.9.2),
 	libghc-conduit-dev,
 	libghc-resourcet-dev,
 	libghc-dav-dev (>= 1.0) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc],
diff --git a/debian/rules b/debian/rules
index 7c8f8a560..22be48195 100755
--- a/debian/rules
+++ b/debian/rules
@@ -8,6 +8,10 @@ export RELEASE_BUILD=1
 %:
 	dh $@
 
+# Debian currently has a patched aws 0.9.2, rather than the newer 0.10.2.
+override_dh_auto_configure:
+	debian/cabal-wrapper configure -fPatchedAWS
+
 # Not intended for use by anyone except the author.
 announcedir:
 	@echo ${HOME}/src/git-annex/doc/news
diff --git a/git-annex.cabal b/git-annex.cabal
index 94b1ed3be..863f35cf8 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -34,6 +34,10 @@ Description:
 Flag S3
   Description: Enable S3 support
 
+Flag PatchedAWS
+  Description: Building on system, like Debian, with old AWS patched to support git-annex
+  Default: False
+
 Flag WebDAV
   Description: Enable WebDAV support
 
@@ -151,7 +155,11 @@ Executable git-annex
     CPP-Options: -DWITH_CRYPTOHASH
 
   if flag(S3)
-    Build-Depends: aws (>= 0.10.2), conduit, resourcet
+    Build-Depends: conduit, resourcet
+    if flag(PatchedAWS)
+      Build-Depends: aws (>= 0.9.2)
+    else
+      Build-Depends: aws (>= 0.10.2)
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-- 
cgit v1.2.3


From 9d7f923e5b3466a8fe3b34781483cb6a115fe5fc Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 28 Oct 2014 14:17:30 -0400
Subject: WIP multipart S3 upload

I'm a little stuck on getting the list of etags of the parts.
This seems to require taking the md5 of each part locally,
which doesn't get along well with lazily streaming in the part from the
file. It would need to read the file twice, or lose laziness and buffer a
whole part -- but parts might be quite large.

This seems to be a problem with the API provided; S3 is supposed to return
an etag, but that is not exposed. I have filed a bug:
https://github.com/aristidb/aws/issues/141
---
 Remote/S3.hs                | 48 ++++++++++++++++++++++++++++++++++++++++-----
 doc/special_remotes/S3.mdwn |  5 +++++
 git-annex.cabal             |  2 +-
 3 files changed, 49 insertions(+), 6 deletions(-)

(limited to 'git-annex.cabal')

diff --git a/Remote/S3.hs b/Remote/S3.hs
index bf130b7ae..9a618329a 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -40,6 +40,7 @@ import Creds
 import Annex.UUID
 import Logs.Web
 import Utility.Metered
+import Utility.DataUnits
 
 type BucketName = String
 
@@ -151,14 +152,46 @@ prepareS3 r info = resourcePrepare $ const $
 
 store :: Remote -> S3Handle -> Storer
 store r h = fileStorer $ \k f p -> do
-	rbody <- liftIO $ httpBodyStorer f p
-	void $ sendS3Handle h $ putObject h (bucketObject (hinfo h) k) rbody
-	
+	case partSize (hinfo h) of
+		Just sz -> do
+			fsz <- fromIntegral . fileSize <$> liftIO (getFileStatus f)
+			if fsz > sz
+				then multipartupload sz k f p
+				else singlepartupload k f p
+		Nothing -> singlepartupload k f p	
 	-- Store public URL to item in Internet Archive.
 	when (isIA (hinfo h) && not (isChunkKey k)) $
 		setUrlPresent k (iaKeyUrl r k)
-	
 	return True
+  where
+	singlepartupload k f p = do
+		rbody <- liftIO $ httpBodyStorer f p
+		void $ sendS3Handle h $ putObject h (bucketObject (hinfo h) k) rbody
+	multipartupload sz k f p = do
+#if MIN_VERSION_aws(0,10,4)
+		let info = hinfo h
+		let objects = bucketObject info h
+
+		uploadid <- S3.imurUploadId <$> sendS3Handle' h $ 
+			(S3.postInitiateMultipartUpload (bucket info) object)
+				{ S3.imuStorageClass = Just (storageClass info)
+				, S3.imuMetadata = metaHeaders info
+				, S3.imuAutoMakeBucket = isIA info
+				, S3.imuExpires = Nothing -- TODO set some reasonable expiry
+				}
+
+		-- TODO open file, read each part of size sz (streaming
+		-- it); send part to S3, and get a list of etags of all
+		-- the parts
+		
+
+		void $ sendS3Handle' h $
+			S3.postCompleteMultipartUpload (bucket info) object uploadid $
+				zip [1..] (map T.pack etags)
+#else
+		warning $ "Cannot do multipart upload (partsize " ++ show sz ++ "); built with too old a version of the aws library."
+		singlepartupload k f p
+#endif
 
 {- Implemented as a fileRetriever, that uses conduit to stream the chunks
  - out to the file. Would be better to implement a byteRetriever, but
@@ -373,6 +406,7 @@ data S3Info = S3Info
 	, storageClass :: S3.StorageClass
 	, bucketObject :: Key -> T.Text
 	, metaHeaders :: [(T.Text, T.Text)]
+	, partSize :: Maybe Integer
 	, isIA :: Bool
 	}
 
@@ -387,6 +421,7 @@ extractS3Info c = do
 		, storageClass = getStorageClass c
 		, bucketObject = T.pack . getBucketObject c
 		, metaHeaders = getMetaHeaders c
+		, partSize = getPartSize c
 		, isIA = configIA c
 		}
 
@@ -397,7 +432,10 @@ getStorageClass :: RemoteConfig -> S3.StorageClass
 getStorageClass c = case M.lookup "storageclass" c of
 	Just "REDUCED_REDUNDANCY" -> S3.ReducedRedundancy
 	_ -> S3.Standard
-	
+
+getPartSize :: RemoteConfig -> Maybe Integer
+getPartSize c = readSize dataUnits =<< M.lookup "partsize" c
+
 getMetaHeaders :: RemoteConfig -> [(T.Text, T.Text)]
 getMetaHeaders = map munge . filter ismetaheader . M.assocs
   where
diff --git a/doc/special_remotes/S3.mdwn b/doc/special_remotes/S3.mdwn
index 492c247cb..c7c6f76c5 100644
--- a/doc/special_remotes/S3.mdwn
+++ b/doc/special_remotes/S3.mdwn
@@ -21,6 +21,11 @@ the S3 remote.
 * `chunk` - Enables [[chunking]] when storing large files.
   `chunk=1MiB` is a good starting point for chunking.
 
+* `partsize` - Specifies the largest object to attempt to store in the
+  bucket. Multipart uploads will be used when storing larger objects.
+  This is not enabled by default, but can be enabled or changed at any
+  time. Setting `partsize=1GiB` is reasonable for S3.
+
 * `keyid` - Specifies the gpg key to use for [[encryption]].
 
 * `embedcreds` - Optional. Set to "yes" embed the login credentials inside
diff --git a/git-annex.cabal b/git-annex.cabal
index 27050d30c..d746dbf59 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -159,7 +159,7 @@ Executable git-annex
     if flag(PatchedAWS)
       Build-Depends: aws (>= 0.9.2)
     else
-      Build-Depends: aws (>= 0.10.2)
+      Build-Depends: aws (>= 0.10.4)
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-- 
cgit v1.2.3


From 6c707f63405d7c5e99aaa1a8dfd5333b5bc00e58 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 3 Nov 2014 17:23:46 -0400
Subject: fix build

---
 Remote/S3.hs    | 26 +++++++++++++++-----------
 git-annex.cabal |  2 +-
 2 files changed, 16 insertions(+), 12 deletions(-)

(limited to 'git-annex.cabal')

diff --git a/Remote/S3.hs b/Remote/S3.hs
index e9879b9f4..e5ed17c49 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -13,10 +13,6 @@ module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where
 import qualified Aws as AWS
 import qualified Aws.Core as AWS
 import qualified Aws.S3 as S3
-#if MIN_VERSION_aws(0,10,6)
-import qualified Aws.S3.Commands.Multipart as Multipart
-import qualified Data.Conduit.List as CL
-#endif
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString.Lazy as L
@@ -24,12 +20,18 @@ import qualified Data.ByteString as S
 import qualified Data.Map as M
 import Data.Char
 import Network.Socket (HostName)
-import Network.HTTP.Conduit (Manager, newManager, closeManager)
+import Network.HTTP.Conduit (Manager, newManager, closeManager, withManager)
 import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseStatus, responseBody, RequestBody(..))
 import Network.HTTP.Types
 import Control.Monad.Trans.Resource
 import Control.Monad.Catch
 import Data.Conduit
+#if MIN_VERSION_aws(0,10,6)
+import qualified Aws.S3.Commands.Multipart as Multipart
+import qualified Data.Conduit.List as CL
+import qualified Data.Conduit.Binary as CB
+import Network.HTTP.Conduit (withManager)
+#endif
 
 import Common.Annex
 import Types.Remote
@@ -175,22 +177,24 @@ store r h = fileStorer $ \k f p -> do
 	multipartupload sz k f p = do
 #if MIN_VERSION_aws(0,10,6)
 		let info = hinfo h
-		let object = bucketObject info h
+		let object = bucketObject info k
 
-		uploadid <- S3.imurUploadId <$> sendS3Handle' h $ 
-			(S3.postInitiateMultipartUpload (bucket info) object)
+		let req = (S3.postInitiateMultipartUpload (bucket info) object)
 				{ S3.imuStorageClass = Just (storageClass info)
 				, S3.imuMetadata = metaHeaders info
 				, S3.imuAutoMakeBucket = isIA info
 				, S3.imuExpires = Nothing -- TODO set some reasonable expiry
 				}
+		uploadid <- S3.imurUploadId <$> sendS3Handle h req
 
-		etags <- sourceFile f
+		-- TODO: progress display
+		etags <- liftIO $ withManager $ \mgr -> 
+			CB.sourceFile f
 			$= Multipart.chunkedConduit sz
-			$= Multipart.putConduit (hawscfg h) (hs3cfg h) (hmanager h) (bucket info) object uploadid
+			$= Multipart.putConduit (hawscfg h) (hs3cfg h) mgr (bucket info) object uploadid
 			$$ CL.consume
 
-		void $ sendS3Handle' h $ S3.postCompleteMultipartUpload
+		void $ sendS3Handle h $ S3.postCompleteMultipartUpload
 			(bucket info) object uploadid (zip [1..] etags)
 #else
 		warning $ "Cannot do multipart upload (partsize " ++ show sz ++ "); built with too old a version of the aws library."
diff --git a/git-annex.cabal b/git-annex.cabal
index d746dbf59..ad50552e4 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -155,7 +155,7 @@ Executable git-annex
     CPP-Options: -DWITH_CRYPTOHASH
 
   if flag(S3)
-    Build-Depends: conduit, resourcet
+    Build-Depends: conduit, resourcet, conduit-extra
     if flag(PatchedAWS)
       Build-Depends: aws (>= 0.9.2)
     else
-- 
cgit v1.2.3