f56594af9e
Flipped all comparisons. When a TrustLevel list was wanted from Trusted downwards, used Down to compare it in that order. This commit was sponsored by mo on Patreon.
91 lines
2.7 KiB
Haskell
91 lines
2.7 KiB
Haskell
{- git-annex special remote configuration
|
|
-
|
|
- Copyright 2011-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.SpecialRemote where
|
|
|
|
import Annex.Common
|
|
import Remote (remoteTypes, remoteMap)
|
|
import Types.Remote (RemoteConfig, RemoteConfigKey, SetupStage(..), typename, setup)
|
|
import Types.GitConfig
|
|
import Logs.Remote
|
|
import Logs.Trust
|
|
import qualified Git.Config
|
|
import Git.Types (RemoteName)
|
|
|
|
import qualified Data.Map as M
|
|
import Data.Ord
|
|
|
|
{- See if there's an existing special remote with this name.
|
|
-
|
|
- Prefer remotes that are not dead when a name appears multiple times. -}
|
|
findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig))
|
|
findExisting name = do
|
|
t <- trustMap
|
|
headMaybe
|
|
. sortBy (comparing $ \(u, _c) -> Down $ M.lookup u t)
|
|
. findByName name
|
|
<$> Logs.Remote.readRemoteLog
|
|
|
|
newConfig :: RemoteName -> RemoteConfig
|
|
newConfig = M.singleton nameKey
|
|
|
|
findByName :: RemoteName -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig)]
|
|
findByName n = filter (matching . snd) . M.toList
|
|
where
|
|
matching c = case M.lookup nameKey c of
|
|
Nothing -> False
|
|
Just n'
|
|
| n' == n -> True
|
|
| otherwise -> False
|
|
|
|
specialRemoteMap :: Annex (M.Map UUID RemoteName)
|
|
specialRemoteMap = do
|
|
m <- Logs.Remote.readRemoteLog
|
|
return $ M.fromList $ mapMaybe go (M.toList m)
|
|
where
|
|
go (u, c) = case M.lookup nameKey c of
|
|
Nothing -> Nothing
|
|
Just n -> Just (u, n)
|
|
|
|
{- find the specified remote type -}
|
|
findType :: RemoteConfig -> Either String RemoteType
|
|
findType config = maybe unspecified specified $ M.lookup typeKey config
|
|
where
|
|
unspecified = Left "Specify the type of remote with type="
|
|
specified s = case filter (findtype s) remoteTypes of
|
|
[] -> Left $ "Unknown remote type " ++ s
|
|
(t:_) -> Right t
|
|
findtype s i = typename i == s
|
|
|
|
{- The name of a configured remote is stored in its config using this key. -}
|
|
nameKey :: RemoteConfigKey
|
|
nameKey = "name"
|
|
|
|
{- The type of a remote is stored in its config using this key. -}
|
|
typeKey :: RemoteConfigKey
|
|
typeKey = "type"
|
|
|
|
autoEnableKey :: RemoteConfigKey
|
|
autoEnableKey = "autoenable"
|
|
|
|
autoEnable :: Annex ()
|
|
autoEnable = do
|
|
remotemap <- M.filter configured <$> readRemoteLog
|
|
enabled <- remoteMap id
|
|
forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do
|
|
case (M.lookup nameKey c, findType c) of
|
|
(Just name, Right t) -> whenM (canenable u) $ do
|
|
showSideAction $ "Auto enabling special remote " ++ name
|
|
dummycfg <- liftIO dummyRemoteGitConfig
|
|
tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case
|
|
Left e -> warning (show e)
|
|
Right _ -> return ()
|
|
_ -> return ()
|
|
where
|
|
configured rc = fromMaybe False $
|
|
Git.Config.isTrue =<< M.lookup autoEnableKey rc
|
|
canenable u = (/= DeadTrusted) <$> lookupTrust u
|