mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
git-annex/Assistant/Threads/WebApp.hs

121 lines
3.4 KiB
Haskell
Raw Normal View History

webapp now starts up when run not in a git repo
2012-07-31 16:17:31 +00:00
{- git-annex assistant webapp thread
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
import S3 only when enabled
2012-10-18 13:28:20 +00:00
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, CPP #-}
add NotificationID to StatusR, and use it to block
2012-07-29 01:21:22 +00:00
{-# OPTIONS_GHC -fno-warn-orphans #-}
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
module Assistant.Threads.WebApp where
import Assistant.Common
split up webapp files
2012-07-31 05:11:32 +00:00
import Assistant.WebApp
add ssh confirmation page also broke out webapp types into a separate module
2012-09-02 04:27:48 +00:00
import Assistant.WebApp.Types
split up webapp files
2012-07-31 05:11:32 +00:00
import Assistant.WebApp.DashBoard
import Assistant.WebApp.SideBar
import Assistant.WebApp.Notifications
import Assistant.WebApp.Configurators
add "configure" link to each repository in the webapp's repo list
2012-10-09 18:43:53 +00:00
import Assistant.WebApp.Configurators.Edit
split out local repo configurators
2012-08-31 19:17:12 +00:00
import Assistant.WebApp.Configurators.Local
import Assistant.WebApp.Configurators.Ssh
yesod skelton and routes for pairing yet more changes to pairing message data types
2012-09-08 04:26:47 +00:00
import Assistant.WebApp.Configurators.Pairing
import S3 only when enabled
2012-10-18 13:28:20 +00:00
#ifdef WITH_S3
add a configurator for S3
2012-09-26 18:44:07 +00:00
import Assistant.WebApp.Configurators.S3
import S3 only when enabled
2012-10-18 13:28:20 +00:00
#endif
XMPP configuration form Currently relies on SRV being set, or the JID's hostname being the server hostname and the port being default. Future work: Allow manual configuration of user name, hostname, and port.
2012-10-26 18:17:09 +00:00
import Assistant.WebApp.Configurators.XMPP
made navbar work also added an About page and a stub Config page.
2012-07-31 06:30:26 +00:00
import Assistant.WebApp.Documentation
make other repositories list list all autostarted repos And add a form to add another, unrelated repository
2012-09-18 21:50:07 +00:00
import Assistant.WebApp.OtherRepos
git annex webapp now opens a browser to the webapp Also, starts the assistant if it wasn't already running.
2012-07-26 03:13:01 +00:00
import Assistant.ThreadedMonad
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
import Utility.WebApp
generate random token and launch webapp using it
2012-07-26 07:38:20 +00:00
import Utility.FileMode
import Utility.TempFile
added a custom defaultLayout, static site, and favicon Broke hamlet out into standalone files. I don't like the favicon display; it should be served from /favicon.ico, but I could only get the static site to serve /static/favicon.ico, so I had to use a <link rel=icon> to pull it in. I looked at Yesod.Default.Handlers.getFaviconR, but it doesn't seem to embed the favicon into the binary?
2012-07-26 06:45:01 +00:00
import Git
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
import Yesod
added a custom defaultLayout, static site, and favicon Broke hamlet out into standalone files. I don't like the favicon display; it should be served from /favicon.ico, but I could only get the static site to serve /static/favicon.ico, so I had to use a <link rel=icon> to pull it in. I looked at Yesod.Default.Handlers.getFaviconR, but it doesn't seem to embed the favicon into the binary?
2012-07-26 06:45:01 +00:00
import Yesod.Static
git annex webapp now opens a browser to the webapp Also, starts the assistant if it wasn't already running.
2012-07-26 03:13:01 +00:00
import Network.Socket (PortNumber)
split up webapp files
2012-07-31 05:11:32 +00:00
import Data.Text (pack, unpack)
use the secret token for authentication, and add to all dynamic urls
2012-07-26 08:50:09 +00:00
thisThread :: String
thisThread = "WebApp"
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
split up webapp files
2012-07-31 05:11:32 +00:00
mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
implemented firstrun repository creation and redirection to full webapp Some of the trickiest code I've possibly ever written.
2012-08-01 20:10:26 +00:00
type Url = String
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
webAppThread
:: AssistantData
first pass at alert buttons They work fine. But I had to go to a lot of trouble to get Yesod to render routes in a pure function. It may instead make more sense to have each alert have an assocated IO action, and a single route that runs the IO action of a given alert id. I just wish I'd realized that before the past several hours of struggling with something Yesod really doesn't want to allow.
2012-09-08 23:57:15 +00:00
-> UrlRenderer
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
-> Bool
implemented firstrun repository creation and redirection to full webapp Some of the trickiest code I've possibly ever written.
2012-08-01 20:10:26 +00:00
-> Maybe (IO String)
-> Maybe (Url -> FilePath -> IO ())
display errors when any named thread crashes
2012-09-06 18:56:04 +00:00
-> NamedThread
Assistant monad, stage 2.5 Converted several threads to run in the monad. Added a lot of useful combinators for working with the monad. Now the monad includes the name of the thread. Some debugging messages are disabled pending converting other threads.
2012-10-29 06:21:04 +00:00
webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $ liftIO $ do
webapp now starts up when run not in a git repo
2012-07-31 16:17:31 +00:00
webapp <- WebApp
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
<$> pure assistantdata
webapp now starts up when run not in a git repo
2012-07-31 16:17:31 +00:00
<*> (pack <$> genRandomToken)
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
<*> getreldir
webapp now starts up when run not in a git repo
2012-07-31 16:17:31 +00:00
<*> pure $(embed "static")
<*> newWebAppState
implemented firstrun repository creation and redirection to full webapp Some of the trickiest code I've possibly ever written.
2012-08-01 20:10:26 +00:00
<*> pure postfirstrun
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
<*> pure noannex
first pass at alert buttons They work fine. But I had to go to a lot of trouble to get Yesod to render routes in a pure function. It may instead make more sense to have each alert have an assocated IO action, and a single route that runs the IO action of a given alert id. I just wish I'd realized that before the past several hours of struggling with something Yesod really doesn't want to allow.
2012-09-08 23:57:15 +00:00
setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
added jquery to static site Had to switch to toWaiAppPlain to avoid a seeming bug in toWaiApp; chromium only received a partial copy of jquery. Always the same length each time, which makes me think it's a bug in the compression, although a bug in the autohead middleware is also a possibility. Anyway, there's little need for compression for a local webapp. Not wasting time compressing things is probably a net gain. Similarly, I've not worried about minifying this yet. Although that would avoid bloating the git-annex binary quite so much.
2012-07-27 03:55:51 +00:00
app <- toWaiAppPlain webapp
run yesod, and launch webapp on startup
2012-07-26 01:26:13 +00:00
app' <- ifM debugEnabled
( return $ httpDebugLogger app
, return app
)
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
runWebApp app' $ \port -> if noannex
then withTempFile "webapp.html" $ \tmpfile _ ->
make other repositories list list all autostarted repos And add a form to add another, unrelated repository
2012-09-18 21:50:07 +00:00
go port webapp tmpfile Nothing
Assistant monad, stage 1 This adds the Assistant monad, and an AssistantData structure. So far, none of the assistant's threads run in the monad yet.
2012-10-29 04:15:43 +00:00
else do
let st = threadState assistantdata
make other repositories list list all autostarted repos And add a form to add another, unrelated repository
2012-09-18 21:50:07 +00:00
htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim
urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile
go port webapp htmlshim (Just urlfile)
tweak
2012-10-29 18:30:10 +00:00
where
thread = NamedThread thisThread
getreldir
| noannex = return Nothing
| otherwise = Just <$>
(relHome =<< absPath
=<< runThreadState (threadState assistantdata) (fromRepo repoPath))
go port webapp htmlshim urlfile = do
let url = myUrl webapp port
maybe noop (`writeFile` url) urlfile
writeHtmlShim url htmlshim
maybe noop (\a -> a url htmlshim) onstartup
git annex webapp now opens a browser to the webapp Also, starts the assistant if it wasn't already running.
2012-07-26 03:13:01 +00:00
use the secret token for authentication, and add to all dynamic urls
2012-07-26 08:50:09 +00:00
{- Creates a html shim file that's used to redirect into the webapp,
- to avoid exposing the secretToken when launching the web browser. -}
make other repositories list list all autostarted repos And add a form to add another, unrelated repository
2012-09-18 21:50:07 +00:00
writeHtmlShim :: String -> FilePath -> IO ()
writeHtmlShim url file = viaTmp go file $ genHtmlShim url
tweak
2012-10-29 18:30:10 +00:00
where
go tmpfile content = do
h <- openFile tmpfile WriteMode
modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
hPutStr h content
hClose h
git annex webapp now opens a browser to the webapp Also, starts the assistant if it wasn't already running.
2012-07-26 03:13:01 +00:00
{- TODO: generate this static file using Yesod. -}
make other repositories list list all autostarted repos And add a form to add another, unrelated repository
2012-09-18 21:50:07 +00:00
genHtmlShim :: String -> String
genHtmlShim url = unlines
don't use hamlet for htmlshim This allows me to not build-depend on blaze-markup, which was causing me some trouble when tring to build with cabal on debian. Seems debian ships Text.Blaze.Renderer.String in two packages.
2012-08-02 01:26:36 +00:00
[ "<html>"
, "<head>"
, "<title>Starting webapp...</title>"
, "<meta http-equiv=\"refresh\" content=\"0; URL="++url++"\">"
, "<body>"
, "<p>"
, "<a href=\"" ++ url ++ "\">Starting webapp...</a>"
, "</p>"
, "</body>"
, "</html>"
]
implemented firstrun repository creation and redirection to full webapp Some of the trickiest code I've possibly ever written.
2012-08-01 20:10:26 +00:00
make other repositories list list all autostarted repos And add a form to add another, unrelated repository
2012-09-18 21:50:07 +00:00
myUrl :: WebApp -> PortNumber -> Url
myUrl webapp port = unpack $ yesodRender webapp urlbase HomeR []
tweak
2012-10-29 18:30:10 +00:00
where
urlbase = pack $ "http://localhost:" ++ show port
Reference in a new issue Copy permalink