refactor
This commit is contained in:
parent
e259c86975
commit
79c74bf27d
1 changed files with 20 additions and 16 deletions
|
@ -73,21 +73,7 @@ s3Setup u c = do
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
let fullconfig = M.union c' defaults
|
let fullconfig = M.union c' defaults
|
||||||
|
|
||||||
-- check bucket location to see if the bucket exists, and create it
|
genBucket fullconfig
|
||||||
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
|
|
||||||
|
|
||||||
gitConfigSpecialRemote u fullconfig "s3" "true"
|
gitConfigSpecialRemote u fullconfig "s3" "true"
|
||||||
s3SetCreds fullconfig
|
s3SetCreds fullconfig
|
||||||
where
|
where
|
||||||
|
@ -126,7 +112,7 @@ storeHelper (conn, bucket) r k file = do
|
||||||
size <- maybe getsize (return . fromIntegral) $ keySize k
|
size <- maybe getsize (return . fromIntegral) $ keySize k
|
||||||
let object = setStorageClass storageclass $
|
let object = setStorageClass storageclass $
|
||||||
S3Object bucket (show k) ""
|
S3Object bucket (show k) ""
|
||||||
[("Content-Length",(show size))] content
|
[("Content-Length",(show size)), ("x-amz-auto-make-bucket","1")] content
|
||||||
sendObject conn object
|
sendObject conn object
|
||||||
where
|
where
|
||||||
storageclass =
|
storageclass =
|
||||||
|
@ -199,6 +185,24 @@ s3Action r noconn action = do
|
||||||
bucketKey :: String -> Key -> S3Object
|
bucketKey :: String -> Key -> S3Object
|
||||||
bucketKey bucket k = S3Object bucket (show k) "" [] L.empty
|
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 :: RemoteConfig -> Annex AWSConnection
|
||||||
s3ConnectionRequired c =
|
s3ConnectionRequired c =
|
||||||
maybe (error "Cannot connect to S3") return =<< s3Connection c
|
maybe (error "Cannot connect to S3") return =<< s3Connection c
|
||||||
|
|
Loading…
Add table
Reference in a new issue