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

add internet archive item url to info

Browse source
This commit is contained in:
Joey Hess 2014-10-21 15:34:32 -04:00
parent 42ee1c4ba5
commit 1b90838bbd
3 changed files with 10 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
Assistant/WebApp/Configurators/AWS.hs
View file

@ -162,7 +162,7 @@ getEnableS3R :: UUID -> Handler Html
#ifdef WITH_S3 #ifdef WITH_S3
getEnableS3R uuid = do getEnableS3R uuid = do
m <- liftAnnex readRemoteLog m <- liftAnnex readRemoteLog
if isIARemoteConfig $ fromJust $ M.lookup uuid m if maybe False S3.isIA (M.lookup uuid m)
then redirect $ EnableIAR uuid then redirect $ EnableIAR uuid
else postEnableS3R uuid else postEnableS3R uuid
#else #else
@ -220,12 +220,9 @@ getRepoInfo c = [whamlet|S3 remote using bucket: #{bucket}|]
bucket = fromMaybe "" $ M.lookup "bucket" c bucket = fromMaybe "" $ M.lookup "bucket" c
#ifdef WITH_S3 #ifdef WITH_S3
isIARemoteConfig :: RemoteConfig -> Bool
isIARemoteConfig = S3.isIAHost . fromMaybe "" . M.lookup "host"
previouslyUsedAWSCreds :: Annex (Maybe CredPair) previouslyUsedAWSCreds :: Annex (Maybe CredPair)
previouslyUsedAWSCreds = getM gettype [S3.remote, Glacier.remote] previouslyUsedAWSCreds = getM gettype [S3.remote, Glacier.remote]
where where
gettype t = previouslyUsedCredPair AWS.creds t $ gettype t = previouslyUsedCredPair AWS.creds t $
not . isIARemoteConfig . Remote.config not . S3.isIA . Remote.config
#endif #endif

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

@ -107,7 +107,7 @@ iaCredsAForm defcreds = AWS.AWSCreds
#ifdef WITH_S3 #ifdef WITH_S3
previouslyUsedIACreds :: Annex (Maybe CredPair) previouslyUsedIACreds :: Annex (Maybe CredPair)
previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $ previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $
AWS.isIARemoteConfig . Remote.config S3.isIA . Remote.config
#endif #endif
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text

10
Remote/S3.hs
View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Remote.S3 (remote, iaHost, isIA, isIAHost, iaItemUrl) where module Remote.S3 (remote, iaHost, isIA, iaItemUrl) where
import Network.AWS.AWSConnection import Network.AWS.AWSConnection
import Network.AWS.S3Object hiding (getStorageClass) import Network.AWS.S3Object hiding (getStorageClass)
@ -72,8 +72,12 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
availability = GloballyAvailable, availability = GloballyAvailable,
remotetype = remote, 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) getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes
[ ("bucket", fromMaybe "unknown" (getBucket c)) ] [ 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 :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)