diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-01 16:10:26 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-01 16:10:26 -0400 |
commit | ecc168aba30a0477381bcd2037c8d301368f3449 (patch) | |
tree | 13efe09744264cea284f87a0179a6b6023f987d6 /Assistant/Threads | |
parent | 1efe4f3332680be5ad9d5d496939d6757fbd2b0a (diff) |
implemented firstrun repository creation and redirection to full webapp
Some of the trickiest code I've possibly ever written.
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/WebApp.hs | 22 |
1 files changed, 17 insertions, 5 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index ad2bff892..a5484b5be 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -38,8 +38,16 @@ thisThread = "WebApp" mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") -webAppThread :: (Maybe ThreadState) -> DaemonStatusHandle -> TransferQueue -> Maybe (FilePath -> IO ()) -> IO () -webAppThread mst dstatus transferqueue onstartup = do +type Url = String + +webAppThread + :: (Maybe ThreadState) + -> DaemonStatusHandle + -> TransferQueue + -> Maybe (IO String) + -> Maybe (Url -> FilePath -> IO ()) + -> IO () +webAppThread mst dstatus transferqueue postfirstrun onstartup = do webapp <- WebApp <$> pure mst <*> pure dstatus @@ -48,6 +56,7 @@ webAppThread mst dstatus transferqueue onstartup = do <*> getreldir mst <*> pure $(embed "static") <*> newWebAppState + <*> pure postfirstrun app <- toWaiAppPlain webapp app' <- ifM debugEnabled ( return $ httpDebugLogger app @@ -66,7 +75,7 @@ webAppThread mst dstatus transferqueue onstartup = do else dir go port webapp htmlshim = do writeHtmlShim webapp port htmlshim - maybe noop (\a -> a htmlshim) onstartup + maybe noop (\a -> a (myUrl webapp port) htmlshim) onstartup {- Creates a html shim file that's used to redirect into the webapp, - to avoid exposing the secretToken when launching the web browser. -} @@ -85,5 +94,8 @@ writeHtmlShim webapp port file = do genHtmlShim :: WebApp -> PortNumber -> String genHtmlShim webapp port = renderHtml $(shamletFile $ hamletTemplate "htmlshim") where - url = "http://localhost:" ++ show port ++ - "/?auth=" ++ unpack (secretToken webapp) + url = myUrl webapp port + +myUrl :: WebApp -> PortNumber -> Url +myUrl webapp port = "http://localhost:" ++ show port ++ + "/?auth=" ++ unpack (secretToken webapp) |