mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

auto-create IA buckets

Browse source 
Needs my patch to aws which will hopefully be accepted soon.
This commit is contained in:
Joey Hess 2014-08-09 22:17:40 -04:00
parent 445f04472c
commit 5fc54cb182
2 changed files with 9 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Assistant/WebApp/Configurators/Edit.hs
View file

@ -235,7 +235,7 @@ getRepoInfo :: Maybe Remote.Remote -> Maybe Remote.RemoteConfig -> Widget
getRepoInfo (Just r) (Just c) = case M.lookup "type" c of getRepoInfo (Just r) (Just c) = case M.lookup "type" c of
Just "S3" Just "S3"
#ifdef WITH_S3 #ifdef WITH_S3
| S3.isIA c -> IA.getRepoInfo c | S3.configIA c -> IA.getRepoInfo c
#endif #endif
| otherwise -> AWS.getRepoInfo c | otherwise -> AWS.getRepoInfo c
Just t Just t

16
Remote/S3.hs
View file

@ -7,7 +7,7 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Remote.S3 (remote, iaHost, isIA, isIAHost, iaItemUrl) where module Remote.S3 (remote, iaHost, configIA, isIAHost, iaItemUrl) where
import qualified Aws as AWS import qualified Aws as AWS
import qualified Aws.Core as AWS import qualified Aws.Core as AWS
@ -128,9 +128,7 @@ s3Setup' u c = if configIA c then archiveorg else defaulthost
M.insert "bucket" validbucket $ M.insert "bucket" validbucket $
M.union c $ M.union c $
-- special constraints on key names -- special constraints on key names
M.insert "mungekeys" "ia" $ M.insert "mungekeys" "ia" defaults
-- bucket created only when files are uploaded
M.insert "x-amz-auto-make-bucket" "1" defaults
info <- extractS3Info archiveconfig info <- extractS3Info archiveconfig
withS3Handle archiveconfig u info $ withS3Handle archiveconfig u info $
writeUUIDFile archiveconfig u writeUUIDFile archiveconfig u
@ -283,12 +281,14 @@ checkUUIDFile c u h = tryNonAsync $ check <$> get
uuidFile :: RemoteConfig -> FilePath uuidFile :: RemoteConfig -> FilePath
uuidFile c = getFilePrefix c ++ "annex-uuid" uuidFile c = getFilePrefix c ++ "annex-uuid"
-- TODO: auto-create bucket when hIsIA.
putObject :: S3Handle -> T.Text -> RequestBody -> S3.PutObject putObject :: S3Handle -> T.Text -> RequestBody -> S3.PutObject
putObject h file rbody = (S3.putObject (bucket (hinfo h)) file rbody) putObject h file rbody = (S3.putObject (bucket info) file rbody)
{ S3.poStorageClass = Just (storageClass (hinfo h)) { S3.poStorageClass = Just (storageClass info)
, S3.poMetadata = metaHeaders (hinfo h) , S3.poMetadata = metaHeaders info
, S3.poAutoMakeBucket = isIA info
} }
where
info = hinfo h
data S3Handle = S3Handle data S3Handle = S3Handle
{ hmanager :: Manager { hmanager :: Manager