webapp: New --listen= option allows running the webapp on one computer and connecting to it from another.
Does not yet use HTTPS. I'd need to generate a certificate, and I'm not sure what's the best way to do that.
This commit is contained in:
parent
c80968c3dd
commit
5e2e4347a3
10 changed files with 92 additions and 45 deletions
|
@ -38,7 +38,7 @@ import Git
|
|||
|
||||
import Yesod
|
||||
import Yesod.Static
|
||||
import Network.Socket (SockAddr)
|
||||
import Network.Socket (SockAddr, HostName)
|
||||
import Data.Text (pack, unpack)
|
||||
|
||||
mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
|
||||
|
@ -49,10 +49,11 @@ webAppThread
|
|||
:: AssistantData
|
||||
-> UrlRenderer
|
||||
-> Bool
|
||||
-> Maybe HostName
|
||||
-> Maybe (IO String)
|
||||
-> Maybe (Url -> FilePath -> IO ())
|
||||
-> NamedThread
|
||||
webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $ liftIO $ do
|
||||
webAppThread assistantdata urlrenderer noannex listenhost postfirstrun onstartup = thread $ liftIO $ do
|
||||
webapp <- WebApp
|
||||
<$> pure assistantdata
|
||||
<*> (pack <$> genRandomToken)
|
||||
|
@ -60,13 +61,14 @@ webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $
|
|||
<*> pure $(embed "static")
|
||||
<*> pure postfirstrun
|
||||
<*> pure noannex
|
||||
<*> pure listenhost
|
||||
setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
|
||||
app <- toWaiAppPlain webapp
|
||||
app' <- ifM debugEnabled
|
||||
( return $ httpDebugLogger app
|
||||
, return app
|
||||
)
|
||||
runWebApp app' $ \addr -> if noannex
|
||||
runWebApp listenhost app' $ \addr -> if noannex
|
||||
then withTempFile "webapp.html" $ \tmpfile _ ->
|
||||
go addr webapp tmpfile Nothing
|
||||
else do
|
||||
|
|
|
@ -26,6 +26,7 @@ import Yesod
|
|||
import Yesod.Static
|
||||
import Text.Hamlet
|
||||
import Data.Text (Text, pack, unpack)
|
||||
import Network.Socket (HostName)
|
||||
|
||||
publicFiles "static"
|
||||
|
||||
|
@ -38,6 +39,7 @@ data WebApp = WebApp
|
|||
, getStatic :: Static
|
||||
, postFirstRun :: Maybe (IO String)
|
||||
, noAnnex :: Bool
|
||||
, listenHost ::Maybe HostName
|
||||
}
|
||||
|
||||
instance Yesod WebApp where
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue