add internet archive item url to info

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

View file

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

View file

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

View file

@ -5,7 +5,7 @@
- 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.S3Object hiding (getStorageClass)
@ -72,8 +72,12 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
availability = GloballyAvailable,
remotetype = remote,
mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,
getInfo = includeCredsInfo c (AWS.creds u)
[ ("bucket", fromMaybe "unknown" (getBucket c)) ]
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)