diff options
author | 2011-03-29 18:09:22 -0400 | |
---|---|---|
committer | 2011-03-29 18:09:22 -0400 | |
commit | d8154eaad3f39e045d7abba187a7d2c1399b89dc (patch) | |
tree | 6b21f409c2946817ad068f77ed70e7ffc9330b47 | |
parent | 0782d7006365e82c0040b25364fa452b0e00e527 (diff) |
transfering content back from s3 works!
-rw-r--r-- | Remote/S3.hs | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs index 4e151e22f..3265ced78 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -70,7 +70,7 @@ genRemote r u c cst = this cost = cst, name = Git.repoDescribe r, storeKey = s3Store this, - retrieveKeyFile = error "TODO retrievekey", + retrieveKeyFile = s3Retrieve this, removeKey = error "TODO removekey", hasKey = s3CheckPresent this, hasKeyCheap = False, @@ -139,14 +139,13 @@ s3Action r a = do let bucket = fromJust $ M.lookup "bucket" $ fromJust $ config r a (conn, bucket) -s3File :: Key -> FilePath -s3File k = show k +bucketKey :: String -> Key -> L.ByteString -> S3Object +bucketKey bucket k content = S3Object bucket (show k) "" [] content s3CheckPresent :: Remote Annex -> Key -> Annex (Either IOException Bool) s3CheckPresent r k = s3Action r $ \(conn, bucket) -> do - let object = S3Object bucket (s3File k) "" [] L.empty showNote ("checking " ++ name r ++ "...") - res <- liftIO $ getObjectInfo conn object + res <- liftIO $ getObjectInfo conn $ bucketKey bucket k L.empty case res of Right _ -> return $ Right True Left (AWSError _ _) -> return $ Right False @@ -156,8 +155,7 @@ 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) "" [] content + let object = setStorageClass storageclass $ bucketKey bucket k content res <- liftIO $ sendObject conn object case res of Right _ -> return True @@ -169,3 +167,14 @@ s3Store r k = s3Action r $ \(conn, bucket) -> do case fromJust $ M.lookup "storageclass" $ fromJust $ config r of "REDUCED_REDUNDANCY" -> REDUCED_REDUNDANCY _ -> STANDARD + +s3Retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool +s3Retrieve r k f = s3Action r $ \(conn, bucket) -> do + res <- liftIO $ getObject conn $ bucketKey bucket k L.empty + case res of + Right o -> do + liftIO $ L.writeFile f (obj_data o) + return True + Left e -> do + warning $ prettyReqError e + return False |