mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

special case edit page for web remote

Browse source 
The crash came from calling Git.repoLocation, but it made sense to fix this
higher up, because there is nothing to edit about the web, it just is what
it is.
This commit is contained in:
Joey Hess 2014-08-12 16:35:13 -04:00
parent 62f619c3eb
commit 2418bae471
3 changed files with 34 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
Assistant/WebApp/Configurators/Edit.hs
View file

@ -42,6 +42,7 @@ import Utility.Gpg
import Annex.UUID
import Assistant.Ssh
import Config
import Logs.Web (webUUID)
import qualified Data.Text as T
import qualified Data.Map as M
@ -191,26 +192,29 @@ postEditNewCloudRepositoryR :: UUID -> Handler Html
postEditNewCloudRepositoryR uuid = connectionNeeded >> editForm True (RepoUUID uuid)
editForm :: Bool -> RepoId -> Handler Html
editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
when (mremote == Nothing) $
whenM ((/=) uuid <$> liftAnnex getUUID) $
error "unknown remote"
curr <- liftAnnex $ getRepoConfig uuid mremote
liftAnnex $ checkAssociatedDirectory curr mremote
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr
case result of
FormSuccess input -> liftH $ do
setRepoConfig uuid mremote curr input
liftAnnex $ checkAssociatedDirectory input mremote
redirect DashboardR
_ -> do
let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
let repoInfo = getRepoInfo mremote config
let repoEncryption = getRepoEncryption mremote config
$(widgetFile "configurators/edit/repository")
editForm new (RepoUUID uuid)
| uuid == webUUID = page "The web" (Just Configuration) $ do
$(widgetFile "configurators/edit/webrepository")
| otherwise = page "Edit repository" (Just Configuration) $ do
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
when (mremote == Nothing) $
whenM ((/=) uuid <$> liftAnnex getUUID) $
error "unknown remote"
curr <- liftAnnex $ getRepoConfig uuid mremote
liftAnnex $ checkAssociatedDirectory curr mremote
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr
case result of
FormSuccess input -> liftH $ do
setRepoConfig uuid mremote curr input
liftAnnex $ checkAssociatedDirectory input mremote
redirect DashboardR
_ -> do
let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
let repoInfo = getRepoInfo mremote config
let repoEncryption = getRepoEncryption mremote config
$(widgetFile "configurators/edit/repository")
editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
mr <- liftAnnex (repoIdRemote r)
let repoInfo = getRepoInfo mr Nothing

2
doc/bugs/youtube_web_download_gives_Prelude.undefined_in_webapp.mdwn
View file

@ -23,3 +23,5 @@ Not much in the logs, I see this:
[2014-07-25 08:40:14 BST] TransferWatcher: transfer starting: Download UUID "00000000-0000-0000-0000-000000000001" Chase_Adam_at_Startup_School_NY_2014.mp4 Nothing
"""]]
> [[fixed|done]] --[[Joey]]

8
templates/configurators/edit/webrepository.hamlet Normal file
View file

@ -0,0 +1,8 @@
<div .col-sm-9>
<div .content-box>
<h2>
The world wide web
<p>
git-annex can download files from the web.
<p>
This is not a normal repository, and cannot be configured.