summaryrefslogtreecommitdiff
path: root/Remote/S3real.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-05-16 09:42:54 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-05-16 09:42:54 -0400
commit79c74bf27dfb9795ad35bc4e4c2061004212621d (patch)
tree74ea08ed16fefbcf37d6421050ba0712c4b79634 /Remote/S3real.hs
parente259c86975a6ec1ab604811684dec7166f57b7bb (diff)
refactor
Diffstat (limited to 'Remote/S3real.hs')
-rw-r--r--Remote/S3real.hs36
1 files changed, 20 insertions, 16 deletions
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index eaa6590b1..e8c700e2c 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -73,21 +73,7 @@ s3Setup u c = do
c' <- encryptionSetup c
let fullconfig = M.union c' defaults
- -- check bucket location to see if the bucket exists, and create it
- let datacenter = fromJust $ M.lookup "datacenter" fullconfig
- conn <- s3ConnectionRequired fullconfig
- showNote "checking bucket"
- loc <- liftIO $ getBucketLocation conn bucket
- case loc of
- Right _ -> return ()
- Left err@(NetworkError _) -> s3Error err
- Left (AWSError _ _) -> do
- showNote $ "creating bucket in " ++ datacenter
- res <- liftIO $ createBucketIn conn bucket datacenter
- case res of
- Right _ -> return ()
- Left err -> s3Error err
-
+ genBucket fullconfig
gitConfigSpecialRemote u fullconfig "s3" "true"
s3SetCreds fullconfig
where
@@ -126,7 +112,7 @@ storeHelper (conn, bucket) r k file = do
size <- maybe getsize (return . fromIntegral) $ keySize k
let object = setStorageClass storageclass $
S3Object bucket (show k) ""
- [("Content-Length",(show size))] content
+ [("Content-Length",(show size)), ("x-amz-auto-make-bucket","1")] content
sendObject conn object
where
storageclass =
@@ -199,6 +185,24 @@ s3Action r noconn action = do
bucketKey :: String -> Key -> S3Object
bucketKey bucket k = S3Object bucket (show k) "" [] L.empty
+genBucket :: RemoteConfig -> Annex ()
+genBucket c = do
+ conn <- s3ConnectionRequired c
+ showNote "checking bucket"
+ loc <- liftIO $ getBucketLocation conn bucket
+ case loc of
+ Right _ -> return ()
+ Left err@(NetworkError _) -> s3Error err
+ Left (AWSError _ _) -> do
+ showNote $ "creating bucket in " ++ datacenter
+ res <- liftIO $ createBucketIn conn bucket datacenter
+ case res of
+ Right _ -> return ()
+ Left err -> s3Error err
+ where
+ bucket = fromJust $ M.lookup "bucket" c
+ datacenter = fromJust $ M.lookup "datacenter" c
+
s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
s3ConnectionRequired c =
maybe (error "Cannot connect to S3") return =<< s3Connection c