copy --to S3 works

2 files changed, 45 insertions, 51 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index e5f2aa62d..984f9c88f 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -14,9 +14,7 @@ import Control.Exception.Extensible
 import Control.Monad.State (liftIO)
 import qualified Data.Map as M
 import System.Cmd.Utils
-import Control.Monad (filterM, liftM, when)
-import Data.String.Utils
-import Maybe
+import Control.Monad (filterM)
 
 import RemoteClass
 import Types
@@ -35,40 +33,35 @@ import Config
 remote :: RemoteType Annex
 remote = RemoteType {
 	typename = "git",
-	generator = gen,
+	enumerate = list,
+	generate = gen,
 	setup = error "not supported"
 }
 
-gen :: Annex [Remote Annex]
-gen = do
+list :: Annex [Git.Repo]
+list = do
 	g <- Annex.gitRepo
-	allremotes <- filterM remoteNotIgnored $ Git.remotes g
+	filterM remoteNotIgnored $ Git.remotes g
 
+gen :: Git.Repo -> Maybe (M.Map String String) -> Annex (Remote Annex)
+gen repo _ = do
  	{- It's assumed to be cheap to read the config of non-URL remotes,
 	 - so this is done each time git-annex is run. Conversely,
 	 - the config of an URL remote is only read when there is no
 	 - cached UUID value. -}
-	let cheap = filter (not . Git.repoIsUrl) allremotes
-	let expensive = filter Git.repoIsUrl allremotes
-	expensive_todo <- filterM noCachedUUID expensive
-	let skip = filter (`notElem` expensive_todo) expensive
-	let todo = cheap++expensive_todo
-
-	when (not $ null expensive_todo) $
-		showNote $ "getting UUID for " ++ (join ", " $
-			map Git.repoDescribe expensive_todo)
-	done <- mapM tryGitConfigRead todo
-
-	generated <- mapM genRemote $ skip ++ done
-	return $ catMaybes generated
-	where
-		noCachedUUID r = liftM null $ getUUID r
+	let cheap = not $ Git.repoIsUrl repo
+	u <- getUUID repo
+	repo' <- case (cheap, u) of
+		(True, _) -> tryGitConfigRead repo
+		(False, "") -> tryGitConfigRead repo
+		_ -> return repo
+	genRemote repo'
 	
-genRemote :: Git.Repo -> Annex (Maybe (Remote Annex))
+genRemote :: Git.Repo -> Annex (Remote Annex)
 genRemote r = do
 	u <- getUUID r
 	c <- remoteCost r
-	return $ Just $ Remote {
+	return $ Remote {
 		uuid = u,
 		cost = c,
 		name = Git.repoDescribe r,
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 887b19e73..4e151e22f 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -28,20 +28,20 @@ import UUID
 import Config
 import Utility
 import Messages
+import Locations
 
 remote :: RemoteType Annex
 remote = RemoteType {
 	typename = "S3",
-	generator = gen,
+	enumerate = s3List,
+	generate = s3Gen,
 	setup = s3Setup
 }
 
-gen :: Annex [Remote Annex]
-gen = do
+s3List :: Annex [Git.Repo]
+s3List = do
 	g <- Annex.gitRepo
-	l <- filterM remoteNotIgnored $ findS3Remotes g
-	generated <- mapM genRemote l
-	return $ catMaybes generated
+	filterM remoteNotIgnored $ findS3Remotes g
 
 {- S3 remotes have a remote.<name>.annex-s3 config setting.
  - Git.Repo does not normally generate remotes for things that
@@ -55,28 +55,27 @@ findS3Remotes r = map construct remotepairs
 		construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
 		s3remote k = startswith "remote." k && endswith ".annex-s3" k
 
-genRemote :: Git.Repo -> Annex (Maybe (Remote Annex))
-genRemote r = do
+s3Gen :: Git.Repo -> Maybe (M.Map String String) -> Annex (Remote Annex)
+s3Gen r c = do
 	u <- getUUID r
-	if (u == "")
-		then return Nothing
-		else do
-			c <- remoteCost r
-			return $ Just $ newremote u c
+	cst <- remoteCost r
+	return $ genRemote r u c cst
 	where
-		newremote u c = this
-			where
-				this = Remote {
-					uuid = u,
-					cost = c,
-					name = Git.repoDescribe r,
-			 		storeKey = s3Store this,
-					retrieveKeyFile = error "TODO retrievekey",
-					removeKey = error "TODO removekey",
-					hasKey = s3CheckPresent this,
-					hasKeyCheap = False,
-					config = Nothing
-				}
+
+genRemote :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Int -> Remote Annex
+genRemote r u c cst = this
+	where
+		this = Remote {
+			uuid = u,
+			cost = cst,
+			name = Git.repoDescribe r,
+	 		storeKey = s3Store this,
+			retrieveKeyFile = error "TODO retrievekey",
+			removeKey = error "TODO removekey",
+			hasKey = s3CheckPresent this,
+			hasKeyCheap = False,
+			config = c
+		}
 
 s3Connection :: M.Map String String -> IO AWSConnection
 s3Connection c = do
@@ -155,8 +154,10 @@ s3CheckPresent r k = s3Action r $ \(conn, bucket) -> do
 
 s3Store :: Remote Annex -> Key -> Annex Bool
 s3Store r k = s3Action r $ \(conn, bucket) -> do
+	g <- Annex.gitRepo
+	content <- liftIO $ L.readFile $ gitAnnexLocation g k
 	let object = setStorageClass storageclass $
-		S3Object bucket (s3File k) "" [] (error "read content here")
+		S3Object bucket (s3File k) "" [] content
 	res <- liftIO $ sendObject conn object
 	case res of
 		Right _ -> return True