streamline deletion process and improve UI

This commit is contained in:
Joey Hess 2013-04-03 20:54:53 -04:00
parent eb2b9f9f3a
commit 37d7da4de8
8 changed files with 49 additions and 62 deletions

View file

@ -154,7 +154,6 @@ import Assistant.Threads.XMPPClient
#warning Building without the webapp. You probably need to install Yesod.. #warning Building without the webapp. You probably need to install Yesod..
#endif #endif
import Assistant.Environment import Assistant.Environment
import Assistant.Types.UrlRenderer
import qualified Utility.Daemon import qualified Utility.Daemon
import Utility.LogFile import Utility.LogFile
import Utility.ThreadScheduler import Utility.ThreadScheduler

View file

@ -19,7 +19,6 @@ import Logs.Transfer
import Logs.Location import Logs.Location
import Assistant.Alert import Assistant.Alert
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.Types.UrlRenderer
import qualified Remote import qualified Remote
import Remote.List import Remote.List
import qualified Git.Command import qualified Git.Command
@ -30,8 +29,8 @@ import qualified Data.Text as T
{- Removes a remote (but leave the repository as-is), and returns the old {- Removes a remote (but leave the repository as-is), and returns the old
- Remote data. -} - Remote data. -}
removeRemote :: UUID -> Assistant Remote disableRemote :: UUID -> Assistant Remote
removeRemote uuid = do disableRemote uuid = do
remote <- fromMaybe (error "unknown remote") remote <- fromMaybe (error "unknown remote")
<$> liftAnnex (Remote.remoteFromUUID uuid) <$> liftAnnex (Remote.remoteFromUUID uuid)
liftAnnex $ do liftAnnex $ do
@ -44,6 +43,12 @@ removeRemote uuid = do
updateSyncRemotes updateSyncRemotes
return remote return remote
{- Removes a remote, marking it dead .-}
removeRemote :: UUID -> Assistant Remote
removeRemote uuid = do
liftAnnex $ trustSet uuid DeadTrusted
disableRemote uuid
{- Called when a Remote is probably empty, to remove it. {- Called when a Remote is probably empty, to remove it.
- -
- This does one last check for any objects remaining in the Remote, - This does one last check for any objects remaining in the Remote,
@ -71,18 +76,22 @@ removableRemote urlrenderer uuid = do
a <- liftAnnex $ Annex.withCurrentState $ loggedKeysFor uuid a <- liftAnnex $ Annex.withCurrentState $ loggedKeysFor uuid
liftIO a liftIO a
{- With the webapp, this asks the user to click on a button to finish
- removing the remote.
-
- Without the webapp, just do the removal now.
-}
finishRemovingRemote :: UrlRenderer -> UUID -> Assistant () finishRemovingRemote :: UrlRenderer -> UUID -> Assistant ()
finishRemovingRemote urlrenderer uuid = do finishRemovingRemote urlrenderer uuid = do
void $ removeRemote uuid
liftAnnex $ trustSet uuid DeadTrusted
#ifdef WITH_WEBAPP #ifdef WITH_WEBAPP
desc <- liftAnnex $ Remote.prettyUUID uuid desc <- liftAnnex $ Remote.prettyUUID uuid
url <- liftIO $ renderUrl urlrenderer (FinishedDeletingRepositoryContentsR uuid) [] url <- liftIO $ renderUrl urlrenderer (FinishDeleteRepositoryR uuid) []
close <- asIO1 removeAlert close <- asIO1 removeAlert
void $ addAlert $ remoteRemovalAlert desc $ AlertButton void $ addAlert $ remoteRemovalAlert desc $ AlertButton
{ buttonLabel = T.pack "Finish removal" { buttonLabel = T.pack "Finish deletion process"
, buttonUrl = url , buttonUrl = url
, buttonAction = Just close , buttonAction = Just close
} }
#else
#endif #endif

View file

@ -27,33 +27,33 @@ import System.IO.HVFS (SystemFS(..))
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map as M import qualified Data.Map as M
getDisableRepositoryR :: UUID -> Handler RepHtml
getDisableRepositoryR uuid = do
void $ liftAssistant $ disableRemote uuid
redirect DashboardR
getDeleteRepositoryR :: UUID -> Handler RepHtml getDeleteRepositoryR :: UUID -> Handler RepHtml
getDeleteRepositoryR uuid = go =<< liftAnnex (Remote.remoteFromUUID uuid) getDeleteRepositoryR uuid = go =<< liftAnnex (Remote.remoteFromUUID uuid)
where where
go Nothing = redirect DeleteCurrentRepositoryR go Nothing = redirect DeleteCurrentRepositoryR
go (Just r) = deletionPage $ do go (Just r) = deletionPage $ do
reponame <- liftAnnex $ Remote.prettyUUID uuid reponame <- liftAnnex $ Remote.prettyUUID uuid
$(widgetFile "configurators/delete/choose") $(widgetFile "configurators/delete/start")
getDeleteRepositoryFromListR :: UUID -> Handler RepHtml getStartDeleteRepositoryR :: UUID -> Handler RepHtml
getDeleteRepositoryFromListR uuid = do getStartDeleteRepositoryR uuid = do
void $ liftAssistant $ removeRemote uuid
redirect DashboardR
getStartDeleteRepositoryContentsR :: UUID -> Handler RepHtml
getStartDeleteRepositoryContentsR uuid = deletionPage $ do
remote <- fromMaybe (error "unknown remote") remote <- fromMaybe (error "unknown remote")
<$> liftAnnex (Remote.remoteFromUUID uuid) <$> liftAnnex (Remote.remoteFromUUID uuid)
liftAnnex $ do liftAnnex $ do
trustSet uuid UnTrusted trustSet uuid UnTrusted
setStandardGroup uuid UnwantedGroup setStandardGroup uuid UnwantedGroup
liftAssistant $ addScanRemotes True [remote] liftAssistant $ addScanRemotes True [remote]
redirect DashboardR
reponame <- liftAnnex $ Remote.prettyUUID uuid getFinishDeleteRepositoryR :: UUID -> Handler RepHtml
$(widgetFile "configurators/delete/started") getFinishDeleteRepositoryR uuid = deletionPage $ do
void $ liftAssistant $ removeRemote uuid
getFinishedDeletingRepositoryContentsR :: UUID -> Handler RepHtml
getFinishedDeletingRepositoryContentsR uuid = deletionPage $ do
reponame <- liftAnnex $ Remote.prettyUUID uuid reponame <- liftAnnex $ Remote.prettyUUID uuid
{- If it's not listed in the remote log, it must be a git repo. -} {- If it's not listed in the remote log, it must be a git repo. -}
gitrepo <- liftAnnex $ M.notMember uuid <$> readRemoteLog gitrepo <- liftAnnex $ M.notMember uuid <$> readRemoteLog

View file

@ -43,12 +43,6 @@
/config/repository/add/cloud/glacier AddGlacierR GET POST /config/repository/add/cloud/glacier AddGlacierR GET POST
/config/repository/add/cloud/box.com AddBoxComR GET POST /config/repository/add/cloud/box.com AddBoxComR GET POST
/config/repository/delete/choose/#UUID DeleteRepositoryR GET
/config/repository/delete/fromlist/#UUID DeleteRepositoryFromListR GET
/config/repository/delete/contents/start/#UUID StartDeleteRepositoryContentsR GET
/config/repository/delete/contents/finish/#UUID FinishedDeletingRepositoryContentsR GET
/config/repository/delete/here DeleteCurrentRepositoryR GET POST
/config/repository/pair/local/start StartLocalPairR GET POST /config/repository/pair/local/start StartLocalPairR GET POST
/config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET /config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
/config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET POST /config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET POST
@ -69,6 +63,13 @@
/config/repository/reorder RepositoriesReorderR GET /config/repository/reorder RepositoriesReorderR GET
/config/repository/disable/#UUID DisableRepositoryR GET
/config/repository/delete/confirm/#UUID DeleteRepositoryR GET
/config/repository/delete/start/#UUID StartDeleteRepositoryR GET
/config/repository/delete/finish/#UUID FinishDeleteRepositoryR GET
/config/repository/delete/here DeleteCurrentRepositoryR GET POST
/transfers/#NotificationId TransfersR GET /transfers/#NotificationId TransfersR GET
/notifier/transfers NotifierTransfersR GET /notifier/transfers NotifierTransfersR GET

View file

@ -1,23 +0,0 @@
<div .span9 .hero-unit>
<h2>
Delete repository #
<small>
#{reponame}
<p>
There are two ways you can choose to delete the repository:
<p>
The repository can be removed from the list of repositories, #
but its contents left as-is. This prevents further syncing #
to the repository. You can add the repository back at any time.
<br>
<a .btn .btn-primary href="@{DeleteRepositoryFromListR uuid}">
<i .icon-minus></i> Remove repository from list
<p style="text-align: center">
-or-
<p>
All data in the repository can be moved off it, to other repositories. #
Once all the data has been transferred, the repository can be safely #
deleted.
<br>
<a .btn .btn-primary href="@{StartDeleteRepositoryContentsR uuid}">
<i .icon-minus></i> Start deletion process

View file

@ -1,6 +1,6 @@
<div .span9 .hero-unit> <div .span9 .hero-unit>
<h2> <h2>
Repository removed Repository deleted
<p> <p>
As much data as possible has been removed from the repository As much data as possible has been removed from the repository
"#{reponame}", and it has been removed from the list of repositories. "#{reponame}", and it has been removed from the list of repositories.
@ -11,4 +11,4 @@
some data. To completely remove it, you should go delete that git some data. To completely remove it, you should go delete that git
repository. repository.
$else $else
Now you can go go delete the underlying storage of the repository. Now you can safely go delete the underlying storage of the repository.

View file

@ -0,0 +1,11 @@
<div .span9 .hero-unit>
<h2>
Delete repository #
<small>
#{reponame}
<p>
Before this repository can be deleted, all data must be moved #
off it, to other repositories.
<p>
<a .btn .btn-primary href="@{StartDeleteRepositoryR uuid}">
<i .icon-minus></i> Start deletion process

View file

@ -1,10 +0,0 @@
<div .span9 .hero-unit>
<h2>
Deletion process started
<p>
All files located on the repository "#{reponame}" are being #
removed from it. Any files that were only located there will #
be moved to other repositories.
<p>
This could take a while. You can continue using git-annex as usual #
while this process is under way.