UI for enabling special remotes
Now other repositories can configure special remotes, and when their configuration has propigated out, they'll appear in the webapp's list of repositories, with a link to enable them. Added support for enabling rsync special remotes, and directory special remotes that are on removable drives. However, encrypted directory special remotes are not supported yet. The removable drive configuator doesn't support them yet anyway.
This commit is contained in:
parent
df337bb63b
commit
74906ed13f
10 changed files with 253 additions and 89 deletions
|
@ -19,9 +19,12 @@ import Utility.Yesod
|
|||
import qualified Remote
|
||||
import qualified Types.Remote as Remote
|
||||
import Annex.UUID (getUUID)
|
||||
import Logs.Remote
|
||||
import Logs.Trust
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Map as M
|
||||
|
||||
{- The main configuration screen. -}
|
||||
getConfigR :: Handler RepHtml
|
||||
|
@ -38,26 +41,45 @@ getRepositoriesR :: Handler RepHtml
|
|||
getRepositoriesR = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Repositories"
|
||||
repolist <- lift repoList
|
||||
repolist <- lift $ repoList False
|
||||
$(widgetFile "configurators/repositories")
|
||||
|
||||
{- A numbered list of known repositories, including the current one. -}
|
||||
repoList :: Handler [(String, String)]
|
||||
repoList = do
|
||||
rs <- filter (not . Remote.readonly) . knownRemotes <$>
|
||||
(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
|
||||
l <- runAnnex [] $ do
|
||||
u <- getUUID
|
||||
Remote.prettyListUUIDs $ nub $ u : map Remote.uuid rs
|
||||
return $ zip counter l
|
||||
repoList :: Bool -> Handler [(String, String, Maybe (Route WebApp))]
|
||||
repoList onlyconfigured
|
||||
| onlyconfigured = list =<< configured
|
||||
| otherwise = list =<< (++) <$> configured <*> unconfigured
|
||||
where
|
||||
configured = do
|
||||
rs <- filter (not . Remote.readonly) . knownRemotes <$>
|
||||
(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
|
||||
runAnnex [] $ do
|
||||
u <- getUUID
|
||||
return $ zip (u : map Remote.uuid rs) (repeat Nothing)
|
||||
unconfigured = runAnnex [] $ do
|
||||
m <- readRemoteLog
|
||||
catMaybes . map (findtype m) . snd
|
||||
<$> (trustPartition DeadTrusted $ M.keys m)
|
||||
findtype m u = case M.lookup u m of
|
||||
Nothing -> Nothing
|
||||
Just c -> case M.lookup "type" c of
|
||||
Just "rsync" -> u `enableswith` EnableRsyncR
|
||||
Just "directory" -> u `enableswith` EnableDirectoryR
|
||||
_ -> Nothing
|
||||
u `enableswith` r = Just (u, Just $ r u)
|
||||
list l = runAnnex [] $ do
|
||||
let l' = nubBy (\x y -> fst x == fst y) l
|
||||
zip3
|
||||
<$> pure counter
|
||||
<*> Remote.prettyListUUIDs (map fst l')
|
||||
<*> pure (map snd l')
|
||||
counter = map show ([1..] :: [Int])
|
||||
|
||||
{- An intro message, list of repositories, and nudge to make more. -}
|
||||
introDisplay :: Text -> Widget
|
||||
introDisplay ident = do
|
||||
webapp <- lift getYesod
|
||||
repolist <- lift repoList
|
||||
repolist <- lift $ repoList True
|
||||
let n = length repolist
|
||||
let numrepos = show n
|
||||
let notenough = n < enough
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue