implemented firstrun repository creation and redirection to full webapp

Some of the trickiest code I've possibly ever written.

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)