From 86fb1305dc623865ef672d499e1559a2608c5be6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 31 Aug 2012 15:17:12 -0400 Subject: split out local repo configurators --- Assistant/Threads/WebApp.hs | 2 + Assistant/WebApp/Configurators.hs | 298 +----------------------------- Assistant/WebApp/Configurators/Local.hs | 318 ++++++++++++++++++++++++++++++++ Assistant/WebApp/Configurators/Ssh.hs | 44 +++++ Assistant/WebApp/routes | 1 + 5 files changed, 367 insertions(+), 296 deletions(-) create mode 100644 Assistant/WebApp/Configurators/Local.hs create mode 100644 Assistant/WebApp/Configurators/Ssh.hs (limited to 'Assistant') diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index e203d50ba..6733e5a40 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -16,6 +16,8 @@ import Assistant.WebApp.DashBoard import Assistant.WebApp.SideBar import Assistant.WebApp.Notifications import Assistant.WebApp.Configurators +import Assistant.WebApp.Configurators.Local +import Assistant.WebApp.Configurators.Ssh import Assistant.WebApp.Documentation import Assistant.ThreadedMonad import Assistant.DaemonStatus diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index ad29459a9..94c84c03a 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -13,31 +13,15 @@ import Assistant.Common import Assistant.WebApp import Assistant.WebApp.SideBar import Assistant.DaemonStatus -import Assistant.Threads.MountWatcher (handleMount) +import Assistant.WebApp.Configurators.Local +import Assistant.WebApp.Configurators.Ssh import Utility.Yesod import qualified Remote import qualified Types.Remote as Remote -import Remote.List import Annex.UUID (getUUID) -import Init -import qualified Git -import qualified Git.Construct -import qualified Git.Config -import qualified Git.Command -import qualified Annex -import Locations.UserConfig -import Utility.FreeDesktop -import Utility.Mounts -import Utility.DiskFree -import Utility.DataUnits -import Utility.Network import Yesod import Data.Text (Text) -import qualified Data.Text as T -import Data.Char -import System.Posix.Directory -import qualified Control.Exception as E {- The main configuration screen. -} getConfigR :: Handler RepHtml @@ -83,281 +67,3 @@ introDisplay ident = do lift $ modifyWebAppState $ \s -> s { showIntro = False } where enough = 2 - -data RepositoryPath = RepositoryPath Text - deriving Show - -{- Custom field display for a RepositoryPath, with an icon etc. - - - - Validates that the path entered is not empty, and is a safe value - - to use as a repository. -} -repositoryPathField :: forall sub. Bool -> Field sub WebApp Text -repositoryPathField autofocus = Field { fieldParse = parse, fieldView = view } - where - view idAttr nameAttr attrs val isReq = - [whamlet||] - - parse [path] - | T.null path = nopath - | otherwise = liftIO $ checkRepositoryPath path - parse [] = return $ Right Nothing - parse _ = nopath - - nopath = return $ Left "Enter a location for the repository" - -{- As well as checking the path for a lot of silly things, tilde is - - expanded in the returned path. -} -checkRepositoryPath :: Text -> IO (Either (SomeMessage WebApp) (Maybe Text)) -checkRepositoryPath p = do - home <- myHomeDir - let basepath = expandTilde home $ T.unpack p - path <- absPath basepath - let parent = parentDir path - problems <- catMaybes <$> mapM runcheck - [ (return $ path == "/", "Enter the full path to use for the repository.") - , (return $ all isSpace basepath, "A blank path? Seems unlikely.") - , (doesFileExist path, "A file already exists with that name.") - , (return $ path == home, "Sorry, using git-annex for your whole home directory is not currently supported.") - , (not <$> doesDirectoryExist parent, "Parent directory does not exist.") - , (not <$> canWrite path, "Cannot write a repository there.") - , (not <$> canMakeSymlink path, "That directory is on a filesystem that does not support symlinks. Try a different location.") - ] - return $ - case headMaybe problems of - Nothing -> Right $ Just $ T.pack basepath - Just prob -> Left prob - where - runcheck (chk, msg) = ifM (chk) - ( return $ Just msg - , return Nothing - ) - expandTilde home ('~':'/':path) = home path - expandTilde _ path = path - - -{- On first run, if run in the home directory, default to putting it in - - ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise. - - - - If run in another directory, the user probably wants to put it there. -} -defaultRepositoryPath :: Bool -> IO FilePath -defaultRepositoryPath firstrun = do - cwd <- liftIO $ getCurrentDirectory - home <- myHomeDir - if home == cwd && firstrun - then do - desktop <- userDesktopDir - ifM (doesDirectoryExist desktop) - (relHome (desktop "annex"), return "~/annex") - else return cwd - -localRepositoryForm :: Form RepositoryPath -localRepositoryForm msg = do - path <- T.pack . addTrailingPathSeparator - <$> (liftIO . defaultRepositoryPath =<< lift inFirstRun) - (pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path) - let (err, errmsg) = case pathRes of - FormMissing -> (False, "") - FormFailure l -> (True, concat $ map T.unpack l) - FormSuccess _ -> (False, "") - let form = do - webAppFormAuthToken - $(widgetFile "configurators/localrepositoryform") - return (RepositoryPath <$> pathRes, form) - -{- Making the first repository, when starting the webapp for the first time. -} -getFirstRepositoryR :: Handler RepHtml -getFirstRepositoryR = bootstrap (Just Config) $ do - sideBarDisplay - setTitle "Getting started" - ((res, form), enctype) <- lift $ runFormGet localRepositoryForm - case res of - FormSuccess (RepositoryPath p) -> lift $ - startFullAssistant $ T.unpack p - _ -> $(widgetFile "configurators/firstrepository") - -data RemovableDrive = RemovableDrive - { diskFree :: Maybe Integer - , mountPoint :: Text - } - deriving (Show, Eq, Ord) - -selectDriveForm :: [RemovableDrive] -> Maybe RemovableDrive -> Form RemovableDrive -selectDriveForm drives def = renderBootstrap $ RemovableDrive - <$> pure Nothing - <*> areq (selectFieldList pairs) "Select drive:" (mountPoint <$> def) - where - pairs = zip (map describe drives) (map mountPoint drives) - describe drive = case diskFree drive of - Nothing -> mountPoint drive - Just free -> - let sz = roughSize storageUnits True free - in T.unwords - [ mountPoint drive - , T.concat ["(", T.pack sz] - , "free)" - ] - -{- Adding a removable drive. -} -getAddDriveR :: Handler RepHtml -getAddDriveR = bootstrap (Just Config) $ do - sideBarDisplay - setTitle "Add a removable drive" - removabledrives <- liftIO $ driveList - writabledrives <- liftIO $ - filterM (canWrite . T.unpack . mountPoint) removabledrives - ((res, form), enctype) <- lift $ runFormGet $ - selectDriveForm (sort writabledrives) Nothing - case res of - FormSuccess (RemovableDrive { mountPoint = d }) -> lift $ do - go $ T.unpack d - setMessage $ toHtml $ T.unwords ["Added", d] - redirect RepositoriesR - _ -> do - let authtoken = webAppFormAuthToken - $(widgetFile "configurators/adddrive") - where - go mountpoint = do - liftIO $ makerepo dir - liftIO $ initRepo dir $ Just remotename - addremotes dir remotename - webapp <- getYesod - liftIO $ syncrepo dir webapp - where - dir = mountpoint "annex" - remotename = takeFileName mountpoint - {- The repo may already exist, when adding removable media - - that has already been used elsewhere. -} - makerepo dir = liftIO $ do - r <- E.try (inDir dir $ return True) :: IO (Either E.SomeException Bool) - case r of - Right _ -> noop - Left _e -> do - createDirectoryIfMissing True dir - bare <- not <$> canMakeSymlink dir - makeRepo dir bare - {- Synthesize a mount event of the new git repository. - - This will sync it, and queue file transfers. -} - syncrepo dir webapp = - handleMount - (fromJust $ threadState webapp) - (daemonStatus webapp) - (scanRemotes webapp) - dir - {- Each repository is made a remote of the other. -} - addremotes dir name = runAnnex () $ do - hostname <- maybe "host" id <$> liftIO getHostname - hostlocation <- fromRepo Git.repoLocation - void $ liftIO $ inDir dir $ - addremote hostname hostlocation - whenM (addremote name dir) $ - void $ remoteListRefresh - {- Adds a remote only if there is not already one with - - the location. -} - addremote name location = inRepo $ \r -> - if (null $ filter samelocation $ Git.remotes r) - then do - let name' = uniqueremotename r name (0 :: Int) - Git.Command.runBool "remote" - [Param "add", Param name', Param location] r - else return False - where - samelocation x = Git.repoLocation x == location - {- Generate an unused name for a remote, adding a number if - - necessary. -} - uniqueremotename r basename n - | null namecollision = name - | otherwise = uniqueremotename r basename (succ n) - where - namecollision = filter samename (Git.remotes r) - samename x = Git.remoteName x == Just name - name - | n == 0 = basename - | otherwise = basename ++ show n - -{- List of removable drives. -} -driveList :: IO [RemovableDrive] -driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts - where - gen dir = RemovableDrive - <$> getDiskFree dir - <*> pure (T.pack dir) - -- filter out some things that are surely not removable drives - sane Mntent { mnt_dir = dir, mnt_fsname = dev } - {- We want real disks like /dev/foo, not - - dummy mount points like proc or tmpfs or - - gvfs-fuse-daemon. -} - | not ('/' `elem` dev) = False - {- Just in case: These mount points are surely not - - removable disks. -} - | dir == "/" = False - | dir == "/tmp" = False - | dir == "/run/shm" = False - | dir == "/run/lock" = False - | otherwise = True - -{- Bootstraps from first run mode to a fully running assistant in a - - repository, by running the postFirstRun callback, which returns the - - url to the new webapp. -} -startFullAssistant :: FilePath -> Handler () -startFullAssistant path = do - webapp <- getYesod - url <- liftIO $ do - makeRepo path False - initRepo path Nothing - addAutoStart path - changeWorkingDirectory path - fromJust $ postFirstRun webapp - redirect $ T.pack url - -{- Makes a new git-annex repository. -} -makeRepo :: FilePath -> Bool -> IO () -makeRepo path bare = do - unlessM (boolSystem "git" params) $ - error "git init failed!" - where - baseparams = [Param "init", Param "--quiet"] - params - | bare = baseparams ++ [Param "--bare", File path] - | otherwise = baseparams ++ [File path] - -{- Runs an action in the git-annex repository in the specified directory. -} -inDir :: FilePath -> Annex a -> IO a -inDir dir a = do - state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir - Annex.eval state a - -{- Initializes a git-annex repository in a directory with a description. -} -initRepo :: FilePath -> Maybe String -> IO () -initRepo dir desc = inDir dir $ - unlessM isInitialized $ - initialize desc - -{- Adds a directory to the autostart file. -} -addAutoStart :: FilePath -> IO () -addAutoStart path = do - autostart <- autoStartFile - createDirectoryIfMissing True (parentDir autostart) - appendFile autostart $ path ++ "\n" - -{- Checks if the user can write to a directory. - - - - The directory may be in the process of being created; if so - - the parent directory is checked instead. -} -canWrite :: FilePath -> IO Bool -canWrite dir = do - tocheck <- ifM (doesDirectoryExist dir) - (return dir, return $ parentDir dir) - catchBoolIO $ fileAccess tocheck False True False - -{- Checks if a directory is on a filesystem that supports symlinks. -} -canMakeSymlink :: FilePath -> IO Bool -canMakeSymlink dir = ifM (doesDirectoryExist dir) - ( catchBoolIO $ test dir - , canMakeSymlink (parentDir dir) - ) - where - test d = do - let link = d "delete.me" - createSymbolicLink link link - removeLink link - return True diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs new file mode 100644 index 000000000..04345f731 --- /dev/null +++ b/Assistant/WebApp/Configurators/Local.hs @@ -0,0 +1,318 @@ +{- git-annex assistant webapp configurators for making local repositories + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} + +module Assistant.WebApp.Configurators.Local where + +import Assistant.Common +import Assistant.WebApp +import Assistant.WebApp.SideBar +import Assistant.DaemonStatus +import Assistant.Threads.MountWatcher (handleMount) +import Utility.Yesod +import qualified Remote +import qualified Types.Remote as Remote +import Remote.List +import Annex.UUID (getUUID) +import Init +import qualified Git +import qualified Git.Construct +import qualified Git.Config +import qualified Git.Command +import qualified Annex +import Locations.UserConfig +import Utility.FreeDesktop +import Utility.Mounts +import Utility.DiskFree +import Utility.DataUnits +import Utility.Network + +import Yesod +import Data.Text (Text) +import qualified Data.Text as T +import Data.Char +import System.Posix.Directory +import qualified Control.Exception as E + +data RepositoryPath = RepositoryPath Text + deriving Show + +{- Custom field display for a RepositoryPath, with an icon etc. + - + - Validates that the path entered is not empty, and is a safe value + - to use as a repository. -} +repositoryPathField :: forall sub. Bool -> Field sub WebApp Text +repositoryPathField autofocus = Field { fieldParse = parse, fieldView = view } + where + view idAttr nameAttr attrs val isReq = + [whamlet||] + + parse [path] + | T.null path = nopath + | otherwise = liftIO $ checkRepositoryPath path + parse [] = return $ Right Nothing + parse _ = nopath + + nopath = return $ Left "Enter a location for the repository" + +{- As well as checking the path for a lot of silly things, tilde is + - expanded in the returned path. -} +checkRepositoryPath :: Text -> IO (Either (SomeMessage WebApp) (Maybe Text)) +checkRepositoryPath p = do + home <- myHomeDir + let basepath = expandTilde home $ T.unpack p + path <- absPath basepath + let parent = parentDir path + problems <- catMaybes <$> mapM runcheck + [ (return $ path == "/", "Enter the full path to use for the repository.") + , (return $ all isSpace basepath, "A blank path? Seems unlikely.") + , (doesFileExist path, "A file already exists with that name.") + , (return $ path == home, "Sorry, using git-annex for your whole home directory is not currently supported.") + , (not <$> doesDirectoryExist parent, "Parent directory does not exist.") + , (not <$> canWrite path, "Cannot write a repository there.") + , (not <$> canMakeSymlink path, "That directory is on a filesystem that does not support symlinks. Try a different location.") + ] + return $ + case headMaybe problems of + Nothing -> Right $ Just $ T.pack basepath + Just prob -> Left prob + where + runcheck (chk, msg) = ifM (chk) + ( return $ Just msg + , return Nothing + ) + expandTilde home ('~':'/':path) = home path + expandTilde _ path = path + + +{- On first run, if run in the home directory, default to putting it in + - ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise. + - + - If run in another directory, the user probably wants to put it there. -} +defaultRepositoryPath :: Bool -> IO FilePath +defaultRepositoryPath firstrun = do + cwd <- liftIO $ getCurrentDirectory + home <- myHomeDir + if home == cwd && firstrun + then do + desktop <- userDesktopDir + ifM (doesDirectoryExist desktop) + (relHome (desktop "annex"), return "~/annex") + else return cwd + +localRepositoryForm :: Form RepositoryPath +localRepositoryForm msg = do + path <- T.pack . addTrailingPathSeparator + <$> (liftIO . defaultRepositoryPath =<< lift inFirstRun) + (pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path) + let (err, errmsg) = case pathRes of + FormMissing -> (False, "") + FormFailure l -> (True, concat $ map T.unpack l) + FormSuccess _ -> (False, "") + let form = do + webAppFormAuthToken + $(widgetFile "configurators/localrepositoryform") + return (RepositoryPath <$> pathRes, form) + +{- Making the first repository, when starting the webapp for the first time. -} +getFirstRepositoryR :: Handler RepHtml +getFirstRepositoryR = bootstrap (Just Config) $ do + sideBarDisplay + setTitle "Getting started" + ((res, form), enctype) <- lift $ runFormGet localRepositoryForm + case res of + FormSuccess (RepositoryPath p) -> lift $ + startFullAssistant $ T.unpack p + _ -> $(widgetFile "configurators/firstrepository") + +data RemovableDrive = RemovableDrive + { diskFree :: Maybe Integer + , mountPoint :: Text + } + deriving (Show, Eq, Ord) + +selectDriveForm :: [RemovableDrive] -> Maybe RemovableDrive -> Form RemovableDrive +selectDriveForm drives def = renderBootstrap $ RemovableDrive + <$> pure Nothing + <*> areq (selectFieldList pairs) "Select drive:" (mountPoint <$> def) + where + pairs = zip (map describe drives) (map mountPoint drives) + describe drive = case diskFree drive of + Nothing -> mountPoint drive + Just free -> + let sz = roughSize storageUnits True free + in T.unwords + [ mountPoint drive + , T.concat ["(", T.pack sz] + , "free)" + ] + +{- Adding a removable drive. -} +getAddDriveR :: Handler RepHtml +getAddDriveR = bootstrap (Just Config) $ do + sideBarDisplay + setTitle "Add a removable drive" + removabledrives <- liftIO $ driveList + writabledrives <- liftIO $ + filterM (canWrite . T.unpack . mountPoint) removabledrives + ((res, form), enctype) <- lift $ runFormGet $ + selectDriveForm (sort writabledrives) Nothing + case res of + FormSuccess (RemovableDrive { mountPoint = d }) -> lift $ do + go $ T.unpack d + setMessage $ toHtml $ T.unwords ["Added", d] + redirect RepositoriesR + _ -> do + let authtoken = webAppFormAuthToken + $(widgetFile "configurators/adddrive") + where + go mountpoint = do + liftIO $ makerepo dir + liftIO $ initRepo dir $ Just remotename + addremotes dir remotename + webapp <- getYesod + liftIO $ syncrepo dir webapp + where + dir = mountpoint "annex" + remotename = takeFileName mountpoint + {- The repo may already exist, when adding removable media + - that has already been used elsewhere. -} + makerepo dir = liftIO $ do + r <- E.try (inDir dir $ return True) :: IO (Either E.SomeException Bool) + case r of + Right _ -> noop + Left _e -> do + createDirectoryIfMissing True dir + bare <- not <$> canMakeSymlink dir + makeRepo dir bare + {- Synthesize a mount event of the new git repository. + - This will sync it, and queue file transfers. -} + syncrepo dir webapp = + handleMount + (fromJust $ threadState webapp) + (daemonStatus webapp) + (scanRemotes webapp) + dir + {- Each repository is made a remote of the other. -} + addremotes dir name = runAnnex () $ do + hostname <- maybe "host" id <$> liftIO getHostname + hostlocation <- fromRepo Git.repoLocation + void $ liftIO $ inDir dir $ + addremote hostname hostlocation + whenM (addremote name dir) $ + void $ remoteListRefresh + {- Adds a remote only if there is not already one with + - the location. -} + addremote name location = inRepo $ \r -> + if (null $ filter samelocation $ Git.remotes r) + then do + let name' = uniqueremotename r name (0 :: Int) + Git.Command.runBool "remote" + [Param "add", Param name', Param location] r + else return False + where + samelocation x = Git.repoLocation x == location + {- Generate an unused name for a remote, adding a number if + - necessary. -} + uniqueremotename r basename n + | null namecollision = name + | otherwise = uniqueremotename r basename (succ n) + where + namecollision = filter samename (Git.remotes r) + samename x = Git.remoteName x == Just name + name + | n == 0 = basename + | otherwise = basename ++ show n + +{- List of removable drives. -} +driveList :: IO [RemovableDrive] +driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts + where + gen dir = RemovableDrive + <$> getDiskFree dir + <*> pure (T.pack dir) + -- filter out some things that are surely not removable drives + sane Mntent { mnt_dir = dir, mnt_fsname = dev } + {- We want real disks like /dev/foo, not + - dummy mount points like proc or tmpfs or + - gvfs-fuse-daemon. -} + | not ('/' `elem` dev) = False + {- Just in case: These mount points are surely not + - removable disks. -} + | dir == "/" = False + | dir == "/tmp" = False + | dir == "/run/shm" = False + | dir == "/run/lock" = False + | otherwise = True + +{- Bootstraps from first run mode to a fully running assistant in a + - repository, by running the postFirstRun callback, which returns the + - url to the new webapp. -} +startFullAssistant :: FilePath -> Handler () +startFullAssistant path = do + webapp <- getYesod + url <- liftIO $ do + makeRepo path False + initRepo path Nothing + addAutoStart path + changeWorkingDirectory path + fromJust $ postFirstRun webapp + redirect $ T.pack url + +{- Makes a new git-annex repository. -} +makeRepo :: FilePath -> Bool -> IO () +makeRepo path bare = do + unlessM (boolSystem "git" params) $ + error "git init failed!" + where + baseparams = [Param "init", Param "--quiet"] + params + | bare = baseparams ++ [Param "--bare", File path] + | otherwise = baseparams ++ [File path] + +{- Runs an action in the git-annex repository in the specified directory. -} +inDir :: FilePath -> Annex a -> IO a +inDir dir a = do + state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir + Annex.eval state a + +{- Initializes a git-annex repository in a directory with a description. -} +initRepo :: FilePath -> Maybe String -> IO () +initRepo dir desc = inDir dir $ + unlessM isInitialized $ + initialize desc + +{- Adds a directory to the autostart file. -} +addAutoStart :: FilePath -> IO () +addAutoStart path = do + autostart <- autoStartFile + createDirectoryIfMissing True (parentDir autostart) + appendFile autostart $ path ++ "\n" + +{- Checks if the user can write to a directory. + - + - The directory may be in the process of being created; if so + - the parent directory is checked instead. -} +canWrite :: FilePath -> IO Bool +canWrite dir = do + tocheck <- ifM (doesDirectoryExist dir) + (return dir, return $ parentDir dir) + catchBoolIO $ fileAccess tocheck False True False + +{- Checks if a directory is on a filesystem that supports symlinks. -} +canMakeSymlink :: FilePath -> IO Bool +canMakeSymlink dir = ifM (doesDirectoryExist dir) + ( catchBoolIO $ test dir + , canMakeSymlink (parentDir dir) + ) + where + test d = do + let link = d "delete.me" + createSymbolicLink link link + removeLink link + return True diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs new file mode 100644 index 000000000..912bc7866 --- /dev/null +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -0,0 +1,44 @@ +{- git-annex assistant webapp configurator for ssh-based remotes + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} + +module Assistant.WebApp.Configurators.Ssh where + +import Assistant.Common +import Assistant.WebApp +import Assistant.WebApp.SideBar +import Assistant.DaemonStatus +import Assistant.Threads.MountWatcher (handleMount) +import Utility.Yesod +import qualified Remote +import qualified Types.Remote as Remote +import Remote.List +import Annex.UUID (getUUID) +import Init +import qualified Git +import qualified Git.Construct +import qualified Git.Config +import qualified Git.Command +import qualified Annex +import Locations.UserConfig +import Utility.FreeDesktop +import Utility.Mounts +import Utility.DiskFree +import Utility.DataUnits +import Utility.Network + +import Yesod +import Data.Text (Text) +import qualified Data.Text as T +import Data.Char +import System.Posix.Directory +import qualified Control.Exception as E + +getAddRemoteServerR :: Handler RepHtml +getAddRemoteServerR = bootstrap (Just Config) $ do + error "TODO" diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index e3e7daf87..72b76c33d 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -6,6 +6,7 @@ /config ConfigR GET /config/repository RepositoriesR GET /config/repository/add/drive AddDriveR GET +/config/repository/add/remoteserver AddRemoteServerR GET /config/repository/first FirstRepositoryR GET /transfers/#NotificationId TransfersR GET -- cgit v1.2.3