summaryrefslogtreecommitdiff
path: root/Remote/S3.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-03-29 17:57:20 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-03-29 17:57:20 -0400
commit0782d7006365e82c0040b25364fa452b0e00e527 (patch)
treedf405b78e2551df52652083e7bb36a18241a1a23 /Remote/S3.hs
parent72f94cc42eca1a6aaa7cc95daf423915761805ff (diff)
copy --to S3 works
Diffstat (limited to 'Remote/S3.hs')
-rw-r--r--Remote/S3.hs55
1 files changed, 28 insertions, 27 deletions
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