From c83faab80214096645edbc6b7b6d3a9f3a7394b1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 27 Apr 2013 15:16:06 -0400 Subject: webapp: Now automatically fills in any creds used by an existing remote when creating a new remote of the same type. Done for Internet Archive, S3, Glacier, and Box.com remotes. --- Assistant/MakeRemote.hs | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) (limited to 'Assistant') diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 2ef35a7b9..6cd542231 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -1,6 +1,6 @@ {- git-annex assistant remote creation utilities - - - Copyright 2012 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -22,6 +22,7 @@ import Logs.Remote import Git.Remote import Config import Config.Cost +import Creds import qualified Data.Text as T import qualified Data.Map as M @@ -125,3 +126,25 @@ uniqueRemoteName basename n r | n == 0 = legalbasename | otherwise = legalbasename ++ show n legalbasename = makeLegalName basename + +{- Finds a CredPair belonging to any Remote that is of a given type + - and matches some other criteria. + - + - This can be used as a default when another repository is being set up + - using the same service. + - + - A function must be provided that returns the CredPairStorage + - to use for a particular Remote's uuid. + -} +previouslyUsedCredPair + :: (UUID -> CredPairStorage) + -> RemoteType + -> (Remote -> Bool) + -> Annex (Maybe CredPair) +previouslyUsedCredPair getstorage remotetype criteria = + getM fromstorage =<< filter criteria . filter sametype <$> remoteList + where + sametype r = R.typename (R.remotetype r) == R.typename remotetype + fromstorage r = do + let storage = getstorage (R.uuid r) + getRemoteCredPair (R.config r) storage -- cgit v1.2.3