Merge branch 'master' into s3-aws

Conflicts:
	Remote/S3.hs
This commit is contained in:
Joey Hess 2014-10-22 17:14:38 -04:00
commit 35551d0ed0
502 changed files with 7127 additions and 2453 deletions

View file

@ -5,9 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE TypeFamilies #-}
module Remote.S3 (remote, iaHost, configIA, isIAHost, iaItemUrl) where
module Remote.S3 (remote, iaHost, configIA, isIA, iaItemUrl) where
import qualified Aws as AWS
import qualified Aws.Core as AWS
@ -83,16 +81,21 @@ gen r u c gc = do
readonly = False,
availability = GloballyAvailable,
remotetype = remote,
mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc
mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,
getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes
[ Just ("bucket", fromMaybe "unknown" (getBucket c))
, if isIA c
then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucket c)
else Nothing
]
}
s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
s3Setup mu mcreds c = do
u <- maybe (liftIO genUUID) return mu
c' <- setRemoteCredPair c (AWS.creds u) mcreds
s3Setup' u c'
s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
s3Setup' u c = if configIA c then archiveorg else defaulthost
s3Setup' u mcreds c
s3Setup' :: UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
s3Setup' u mcreds c = if isIA c then archiveorg else defaulthost
where
remotename = fromJust (M.lookup "name" c)
defbucket = remotename ++ "-" ++ fromUUID u
@ -109,25 +112,27 @@ s3Setup' u c = if configIA c then archiveorg else defaulthost
return (fullconfig, u)
defaulthost = do
c' <- encryptionSetup c
let fullconfig = c' `M.union` defaults
(c', encsetup) <- encryptionSetup c
c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
let fullconfig = c'' `M.union` defaults
genBucket fullconfig u
use fullconfig
archiveorg = do
showNote "Internet Archive mode"
c' <- setRemoteCredPair noEncryptionUsed c (AWS.creds u) mcreds
-- Ensure user enters a valid bucket name, since
-- this determines the name of the archive.org item.
let validbucket = replace " " "-" $ map toLower $
fromMaybe (error "specify bucket=") $
getBucketName c
getBucketName c'
let archiveconfig =
-- IA acdepts x-amz-* as an alias for x-archive-*
M.mapKeys (replace "x-archive-" "x-amz-") $
-- encryption does not make sense here
M.insert "encryption" "none" $
M.insert "bucket" validbucket $
M.union c $
M.union c' $
-- special constraints on key names
M.insert "mungekeys" "ia" defaults
info <- extractS3Info archiveconfig