{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Ema.Server where

import Control.Concurrent.Async (race)
import Control.Exception (try)
import Control.Monad.Logger
import Data.FileEmbed
import Data.LVar (LVar)
import Data.LVar qualified as LVar
import Data.Text qualified as T
import Ema.Asset (
  Asset (AssetGenerated, AssetStatic),
  Format (Html, Other),
 )
import Ema.CLI (Host (unHost))
import Ema.Route.Class (IsRoute (RouteModel, routePrism))
import Ema.Route.Prism (
  checkRoutePrismGivenFilePath,
  fromPrism_,
 )
import Ema.Route.Url (urlToFilePath)
import Ema.Site (EmaSite (siteOutput), EmaStaticSite)
import NeatInterpolation (text)
import Network.HTTP.Types qualified as H
import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp (Port)
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Handler.WebSockets qualified as WaiWs
import Network.Wai.Middleware.Static qualified as Static
import Network.WebSockets (ConnectionException)
import Network.WebSockets qualified as WS
import Optics.Core (review)
import Text.Printf (printf)
import UnliftIO (MonadUnliftIO)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception (catch)

runServerWithWebSocketHotReload ::
  forall r m.
  ( Show r
  , MonadIO m
  , MonadUnliftIO m
  , MonadLoggerIO m
  , Eq r
  , IsRoute r
  , EmaStaticSite r
  ) =>
  Host ->
  Maybe Port ->
  LVar (RouteModel r) ->
  m ()
runServerWithWebSocketHotReload :: Host -> Maybe Port -> LVar (RouteModel r) -> m ()
runServerWithWebSocketHotReload Host
host Maybe Port
mport LVar (RouteModel r)
model = do
  Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger <- m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: Type -> Type).
MonadLoggerIO m =>
m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO
  let runM :: LoggingT IO () -> IO ()
runM = (LoggingT IO ()
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger
      settings :: Settings
settings =
        Settings
Warp.defaultSettings
          Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& HostPreference -> Settings -> Settings
Warp.setHost (String -> HostPreference
forall a. IsString a => String -> a
fromString (String -> HostPreference)
-> (Host -> String) -> Host -> HostPreference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> String
forall a. ToString a => a -> String
toString (LogSource -> String) -> (Host -> LogSource) -> Host -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> LogSource
unHost (Host -> HostPreference) -> Host -> HostPreference
forall a b. (a -> b) -> a -> b
$ Host
host)
      app :: Application
app =
        ConnectionOptions -> ServerApp -> Application -> Application
WaiWs.websocketsOr
          ConnectionOptions
WS.defaultConnectionOptions
          (LoggingT IO () -> IO ()
runM (LoggingT IO () -> IO ())
-> (PendingConnection -> LoggingT IO ()) -> ServerApp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingConnection -> LoggingT IO ()
wsApp)
          ((Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> Application
httpApp Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger)
      banner :: Port -> LoggingT IO ()
banner Port
port = do
        LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logInfoNS LogSource
"ema" LogSource
"==============================================="
        LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logInfoNS LogSource
"ema" (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Ema live server RUNNING: http://" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> Host -> LogSource
unHost Host
host LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
":" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> Port -> LogSource
forall b a. (Show a, IsString b) => a -> b
show Port
port
        LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logInfoNS LogSource
"ema" LogSource
"==============================================="
  IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Settings -> Maybe Port -> (Port -> IO ()) -> Application -> IO ()
forall a.
Settings -> Maybe Port -> (Port -> IO a) -> Application -> IO ()
warpRunSettings Settings
settings Maybe Port
mport (LoggingT IO () -> IO ()
runM (LoggingT IO () -> IO ())
-> (Port -> LoggingT IO ()) -> Port -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> LoggingT IO ()
banner) Application
app
  where
    enc :: RouteModel r -> Prism_ String r
enc = IsRoute r => RouteModel r -> Prism_ String r
forall r. IsRoute r => RouteModel r -> Prism_ String r
routePrism @r
    -- Like Warp.runSettings but takes *optional* port. When no port is set, a
    -- free (random) port is used.
    warpRunSettings :: Warp.Settings -> Maybe Port -> (Port -> IO a) -> Wai.Application -> IO ()
    warpRunSettings :: Settings -> Maybe Port -> (Port -> IO a) -> Application -> IO ()
warpRunSettings Settings
settings Maybe Port
mPort Port -> IO a
banner Application
app = do
      case Maybe Port
mPort of
        Maybe Port
Nothing ->
          Settings -> IO Application -> (Port -> IO ()) -> IO ()
forall a. Settings -> IO Application -> (Port -> IO a) -> IO a
Warp.withApplicationSettings Settings
settings (Application -> IO Application
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Application
app) ((Port -> IO ()) -> IO ()) -> (Port -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Port
port -> do
            IO a -> IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ Port -> IO a
banner Port
port
            Port -> IO ()
forall (m :: Type -> Type). MonadIO m => Port -> m ()
threadDelay Port
forall a. Bounded a => a
maxBound
        Just Port
port -> do
          IO a -> IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ Port -> IO a
banner Port
port
          Settings -> Application -> IO ()
Warp.runSettings (Settings
settings Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& Port -> Settings -> Settings
Warp.setPort Port
port) Application
app
    wsApp :: PendingConnection -> LoggingT IO ()
wsApp PendingConnection
pendingConn = do
      Connection
conn :: WS.Connection <- IO Connection -> LoggingT IO Connection
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Connection -> LoggingT IO Connection)
-> IO Connection -> LoggingT IO Connection
forall a b. (a -> b) -> a -> b
$ PendingConnection -> IO Connection
WS.acceptRequest PendingConnection
pendingConn
      Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger <- LoggingT IO (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: Type -> Type).
MonadLoggerIO m =>
m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO
      IO () -> LoggingT IO ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> Port -> IO () -> IO () -> IO ()
forall a. Connection -> Port -> IO () -> IO a -> IO a
WS.withPingThread Connection
conn Port
30 IO ()
forall (f :: Type -> Type). Applicative f => f ()
pass (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          (LoggingT IO ()
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Port
subId <- LVar (RouteModel r) -> LoggingT IO Port
forall (m :: Type -> Type) a. MonadIO m => LVar a -> m Port
LVar.addListener LVar (RouteModel r)
model
            let log :: LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
lvl (LogSource
s :: Text) =
                  LogSource -> LogLevel -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type) msg.
(MonadLogger m, ToLogStr msg) =>
LogSource -> LogLevel -> msg -> m ()
logWithoutLoc (ToText String => String -> LogSource
forall a. ToText a => a -> LogSource
toText @String (String -> LogSource) -> String -> LogSource
forall a b. (a -> b) -> a -> b
$ String -> Port -> String
forall r. PrintfType r => String -> r
printf String
"ema.ws.%.2d" Port
subId) LogLevel
lvl LogSource
s
            LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
LevelInfo LogSource
"Connected"
            let askClientForRoute :: LoggingT IO [LogSource]
askClientForRoute = do
                  LogSource
msg :: Text <- IO LogSource -> LoggingT IO LogSource
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO LogSource -> LoggingT IO LogSource)
-> IO LogSource -> LoggingT IO LogSource
forall a b. (a -> b) -> a -> b
$ Connection -> IO LogSource
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn
                  -- TODO: Let non-html routes pass through.
                  let pathInfo :: [LogSource]
pathInfo = LogSource -> [LogSource]
pathInfoFromWsMsg LogSource
msg
                  LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
LevelDebug (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"<~~ " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> [LogSource] -> LogSource
forall b a. (Show a, IsString b) => a -> b
show [LogSource]
pathInfo
                  [LogSource] -> LoggingT IO [LogSource]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [LogSource]
pathInfo
                decodeRouteWithCurrentModel :: [LogSource] -> LoggingT IO (Either (BadRouteEncoding r) (Maybe r))
decodeRouteWithCurrentModel [LogSource]
pathInfo = do
                  RouteModel r
val <- LVar (RouteModel r) -> LoggingT IO (RouteModel r)
forall (m :: Type -> Type) a. MonadIO m => LVar a -> m a
LVar.get LVar (RouteModel r)
model
                  Either (BadRouteEncoding r) (Maybe r)
-> LoggingT IO (Either (BadRouteEncoding r) (Maybe r))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (BadRouteEncoding r) (Maybe r)
 -> LoggingT IO (Either (BadRouteEncoding r) (Maybe r)))
-> Either (BadRouteEncoding r) (Maybe r)
-> LoggingT IO (Either (BadRouteEncoding r) (Maybe r))
forall a b. (a -> b) -> a -> b
$ RouteModel r
-> [LogSource] -> Either (BadRouteEncoding r) (Maybe r)
routeFromPathInfo RouteModel r
val [LogSource]
pathInfo
                sendRouteHtmlToClient :: [LogSource] -> RouteModel r -> LoggingT IO ()
sendRouteHtmlToClient [LogSource]
pathInfo RouteModel r
s = do
                  [LogSource] -> LoggingT IO (Either (BadRouteEncoding r) (Maybe r))
decodeRouteWithCurrentModel [LogSource]
pathInfo LoggingT IO (Either (BadRouteEncoding r) (Maybe r))
-> (Either (BadRouteEncoding r) (Maybe r) -> LoggingT IO ())
-> LoggingT IO ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Left BadRouteEncoding r
err -> do
                      LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
LevelError (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ BadRouteEncoding r -> LogSource
forall r. Show r => BadRouteEncoding r -> LogSource
badRouteEncodingMsg BadRouteEncoding r
err
                      IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ LogSource -> LByteString
emaErrorHtmlResponse (LogSource -> LByteString) -> LogSource -> LByteString
forall a b. (a -> b) -> a -> b
$ BadRouteEncoding r -> LogSource
forall r. Show r => BadRouteEncoding r -> LogSource
badRouteEncodingMsg BadRouteEncoding r
err
                    Right Maybe r
Nothing ->
                      IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ LogSource -> LByteString
emaErrorHtmlResponse LogSource
decodeRouteNothingMsg
                    Right (Just r
r) -> do
                      RouteModel r -> r -> LoggingT IO (Asset LByteString)
renderCatchingErrors RouteModel r
s r
r LoggingT IO (Asset LByteString)
-> (Asset LByteString -> LoggingT IO ()) -> LoggingT IO ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        AssetStatic String
staticPath ->
                          -- HACK: Websocket client should check for REDIRECT prefix.
                          -- Not bothering with JSON to avoid having to JSON parse every HTML dump.
                          IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LogSource -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn (LogSource -> IO ()) -> LogSource -> IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"REDIRECT " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a. ToText a => a -> LogSource
toText String
staticPath
                        AssetGenerated Format
Html LByteString
html ->
                          IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ LByteString
html LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy ByteString
wsClientHtml
                        AssetGenerated Format
Other LByteString
_s ->
                          -- HACK: Websocket client should check for REDIRECT prefix.
                          -- Not bothering with JSON to avoid having to JSON parse every HTML dump.
                          IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LogSource -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn (LogSource -> IO ()) -> LogSource -> IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"REDIRECT " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a. ToText a => a -> LogSource
toText (Optic' A_Prism NoIx String r -> r -> String
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review (Prism_ String r -> Optic' A_Prism NoIx String r
forall s a. Prism_ s a -> Prism' s a
fromPrism_ (Prism_ String r -> Optic' A_Prism NoIx String r)
-> Prism_ String r -> Optic' A_Prism NoIx String r
forall a b. (a -> b) -> a -> b
$ RouteModel r -> Prism_ String r
enc RouteModel r
s) r
r)
                      LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
LevelDebug (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
" ~~> " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> r -> LogSource
forall b a. (Show a, IsString b) => a -> b
show r
r
                loop :: IO ()
loop = (LoggingT IO ()
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                  -- Notice that we @askClientForRoute@ in succession twice here.
                  -- The first route will be the route the client intends to observe
                  -- for changes on. The second route, *if* it is sent, indicates
                  -- that the client wants to *switch* to that route. This proecess
                  -- repeats ad infinitum: i.e., the third route is for observing
                  -- changes, the fourth route is for switching to, and so on.
                  [LogSource]
mWatchingRoute <- LoggingT IO [LogSource]
askClientForRoute
                  -- Listen *until* either we get a new value, or the client requests
                  -- to switch to a new route.
                  IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ do
                    IO (RouteModel r)
-> IO [LogSource] -> IO (Either (RouteModel r) [LogSource])
forall a b. IO a -> IO b -> IO (Either a b)
race (LVar (RouteModel r) -> Port -> IO (RouteModel r)
forall (m :: Type -> Type) a. MonadIO m => LVar a -> Port -> m a
LVar.listenNext LVar (RouteModel r)
model Port
subId) (LoggingT IO [LogSource]
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> IO [LogSource]
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT IO [LogSource]
askClientForRoute Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger) IO (Either (RouteModel r) [LogSource])
-> (Either (RouteModel r) [LogSource] -> IO ()) -> IO ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either (RouteModel r) [LogSource]
res -> (LoggingT IO ()
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ case Either (RouteModel r) [LogSource]
res of
                      Left RouteModel r
newModel -> do
                        -- The page the user is currently viewing has changed. Send
                        -- the new HTML to them.
                        [LogSource] -> RouteModel r -> LoggingT IO ()
sendRouteHtmlToClient [LogSource]
mWatchingRoute RouteModel r
newModel
                        IO () -> LoggingT IO ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
loop
                      Right [LogSource]
mNextRoute -> do
                        -- The user clicked on a route link; send them the HTML for
                        -- that route this time, ignoring what we are watching
                        -- currently (we expect the user to initiate a watch route
                        -- request immediately following this).
                        [LogSource] -> RouteModel r -> LoggingT IO ()
sendRouteHtmlToClient [LogSource]
mNextRoute (RouteModel r -> LoggingT IO ())
-> LoggingT IO (RouteModel r) -> LoggingT IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< LVar (RouteModel r) -> LoggingT IO (RouteModel r)
forall (m :: Type -> Type) a. MonadIO m => LVar a -> m a
LVar.get LVar (RouteModel r)
model
                        IO () -> LoggingT IO ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
loop
            IO (Either ConnectionException ())
-> LoggingT IO (Either ConnectionException ())
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO (Either ConnectionException ())
forall e a. Exception e => IO a -> IO (Either e a)
try IO ()
loop) LoggingT IO (Either ConnectionException ())
-> (Either ConnectionException () -> LoggingT IO ())
-> LoggingT IO ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Right () -> LoggingT IO ()
forall (f :: Type -> Type). Applicative f => f ()
pass
              Left (ConnectionException
connExc :: ConnectionException) -> do
                case ConnectionException
connExc of
                  WS.CloseRequest Word16
_ (LByteString -> LogSource
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 -> LogSource
reason) ->
                    LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
LevelInfo (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Closing websocket connection (reason: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
reason LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
")"
                  ConnectionException
_ ->
                    LogLevel -> LogSource -> LoggingT IO ()
log LogLevel
LevelError (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Websocket error: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> ConnectionException -> LogSource
forall b a. (Show a, IsString b) => a -> b
show ConnectionException
connExc
                LVar (RouteModel r) -> Port -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => LVar a -> Port -> m ()
LVar.removeListener LVar (RouteModel r)
model Port
subId
    httpApp :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> Application
httpApp Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger Request
req Response -> IO ResponseReceived
f = do
      (LoggingT IO ResponseReceived
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
 -> IO ResponseReceived)
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ResponseReceived
-> IO ResponseReceived
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ResponseReceived
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> IO ResponseReceived
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger (LoggingT IO ResponseReceived -> IO ResponseReceived)
-> LoggingT IO ResponseReceived -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ do
        RouteModel r
val <- LVar (RouteModel r) -> LoggingT IO (RouteModel r)
forall (m :: Type -> Type) a. MonadIO m => LVar a -> m a
LVar.get LVar (RouteModel r)
model
        let path :: [LogSource]
path = Request -> [LogSource]
Wai.pathInfo Request
req
            mr :: Either (BadRouteEncoding r) (Maybe r)
mr = RouteModel r
-> [LogSource] -> Either (BadRouteEncoding r) (Maybe r)
routeFromPathInfo RouteModel r
val [LogSource]
path
        LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logInfoNS LogSource
"ema.http" (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"GET " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> (LogSource
"/" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource -> [LogSource] -> LogSource
T.intercalate LogSource
"/" [LogSource]
path) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" as " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> Either (BadRouteEncoding r) (Maybe r) -> LogSource
forall b a. (Show a, IsString b) => a -> b
show Either (BadRouteEncoding r) (Maybe r)
mr
        case Either (BadRouteEncoding r) (Maybe r)
mr of
          Left BadRouteEncoding r
err -> do
            LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logErrorNS LogSource
"App" (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ BadRouteEncoding r -> LogSource
forall r. Show r => BadRouteEncoding r -> LogSource
badRouteEncodingMsg BadRouteEncoding r
err
            let s :: LByteString
s = LogSource -> LByteString
emaErrorHtmlResponse (BadRouteEncoding r -> LogSource
forall r. Show r => BadRouteEncoding r -> LogSource
badRouteEncodingMsg BadRouteEncoding r
err) LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> LByteString
wsClientJS
            IO ResponseReceived -> LoggingT IO ResponseReceived
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> LoggingT IO ResponseReceived)
-> IO ResponseReceived -> LoggingT IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
f (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> LByteString -> Response
Wai.responseLBS Status
H.status500 [(HeaderName
H.hContentType, ByteString
"text/html")] LByteString
s
          Right Maybe r
Nothing -> do
            let s :: LByteString
s = LogSource -> LByteString
emaErrorHtmlResponse LogSource
decodeRouteNothingMsg LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> LByteString
wsClientJS
            IO ResponseReceived -> LoggingT IO ResponseReceived
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> LoggingT IO ResponseReceived)
-> IO ResponseReceived -> LoggingT IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
f (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> LByteString -> Response
Wai.responseLBS Status
H.status404 [(HeaderName
H.hContentType, ByteString
"text/html")] LByteString
s
          Right (Just r
r) -> do
            RouteModel r -> r -> LoggingT IO (Asset LByteString)
renderCatchingErrors RouteModel r
val r
r LoggingT IO (Asset LByteString)
-> (Asset LByteString -> LoggingT IO ResponseReceived)
-> LoggingT IO ResponseReceived
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              AssetStatic String
staticPath -> do
                let mimeType :: ByteString
mimeType = String -> ByteString
Static.getMimeType String
staticPath
                IO ResponseReceived -> LoggingT IO ResponseReceived
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> LoggingT IO ResponseReceived)
-> IO ResponseReceived -> LoggingT IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
f (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
Wai.responseFile Status
H.status200 [(HeaderName
H.hContentType, ByteString
mimeType)] String
staticPath Maybe FilePart
forall a. Maybe a
Nothing
              AssetGenerated Format
Html LByteString
html -> do
                let s :: LByteString
s = LByteString
html LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy ByteString
wsClientHtml LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> LByteString
wsClientJS
                IO ResponseReceived -> LoggingT IO ResponseReceived
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> LoggingT IO ResponseReceived)
-> IO ResponseReceived -> LoggingT IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
f (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> LByteString -> Response
Wai.responseLBS Status
H.status200 [(HeaderName
H.hContentType, ByteString
"text/html")] LByteString
s
              AssetGenerated Format
Other LByteString
s -> do
                let mimeType :: ByteString
mimeType = String -> ByteString
Static.getMimeType (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Prism NoIx String r -> r -> String
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review (Prism_ String r -> Optic' A_Prism NoIx String r
forall s a. Prism_ s a -> Prism' s a
fromPrism_ (Prism_ String r -> Optic' A_Prism NoIx String r)
-> Prism_ String r -> Optic' A_Prism NoIx String r
forall a b. (a -> b) -> a -> b
$ RouteModel r -> Prism_ String r
enc RouteModel r
val) r
r
                IO ResponseReceived -> LoggingT IO ResponseReceived
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> LoggingT IO ResponseReceived)
-> IO ResponseReceived -> LoggingT IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
f (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> LByteString -> Response
Wai.responseLBS Status
H.status200 [(HeaderName
H.hContentType, ByteString
mimeType)] LByteString
s
    renderCatchingErrors :: RouteModel r -> r -> LoggingT IO (Asset LByteString)
renderCatchingErrors RouteModel r
m r
r =
      LoggingT IO (Asset LByteString)
-> (SomeException -> LoggingT IO (Asset LByteString))
-> LoggingT IO (Asset LByteString)
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (Optic' A_Prism NoIx String r
-> RouteModel r -> r -> LoggingT IO (SiteOutput r)
forall r (m :: Type -> Type).
(EmaSite r, MonadIO m, MonadLoggerIO m) =>
Prism' String r -> RouteModel r -> r -> m (SiteOutput r)
siteOutput (Prism_ String r -> Optic' A_Prism NoIx String r
forall s a. Prism_ s a -> Prism' s a
fromPrism_ (Prism_ String r -> Optic' A_Prism NoIx String r)
-> Prism_ String r -> Optic' A_Prism NoIx String r
forall a b. (a -> b) -> a -> b
$ RouteModel r -> Prism_ String r
enc RouteModel r
m) RouteModel r
m r
r) ((SomeException -> LoggingT IO (Asset LByteString))
 -> LoggingT IO (Asset LByteString))
-> (SomeException -> LoggingT IO (Asset LByteString))
-> LoggingT IO (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ \(SomeException
err :: SomeException) -> do
        -- Log the error first.
        LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logErrorNS LogSource
"App" (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> LogSource
forall b a. (Show a, IsString b) => a -> b
show @Text SomeException
err
        Asset LByteString -> LoggingT IO (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> LoggingT IO (Asset LByteString))
-> Asset LByteString -> LoggingT IO (Asset LByteString)
forall a b. (a -> b) -> a -> b
$
          Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
AssetGenerated Format
Html (LByteString -> Asset LByteString)
-> (LogSource -> LByteString) -> LogSource -> Asset LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> LByteString
mkHtmlErrorMsg (LogSource -> Asset LByteString) -> LogSource -> Asset LByteString
forall a b. (a -> b) -> a -> b
$
            SomeException -> LogSource
forall b a. (Show a, IsString b) => a -> b
show @Text SomeException
err
    routeFromPathInfo :: RouteModel r
-> [LogSource] -> Either (BadRouteEncoding r) (Maybe r)
routeFromPathInfo RouteModel r
m =
      RouteModel r -> LogSource -> Either (BadRouteEncoding r) (Maybe r)
decodeUrlRoute RouteModel r
m (LogSource -> Either (BadRouteEncoding r) (Maybe r))
-> ([LogSource] -> LogSource)
-> [LogSource]
-> Either (BadRouteEncoding r) (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> [LogSource] -> LogSource
T.intercalate LogSource
"/"
    -- Decode an URL path into a route
    --
    -- This function is used only in live server. If the route is not
    -- isomoprhic, this returns a Left, with the mismatched encoding.
    decodeUrlRoute :: RouteModel r -> Text -> Either (BadRouteEncoding r) (Maybe r)
    decodeUrlRoute :: RouteModel r -> LogSource -> Either (BadRouteEncoding r) (Maybe r)
decodeUrlRoute RouteModel r
m (LogSource -> String
urlToFilePath -> String
s) = do
      case (RouteModel r -> Prism_ String r)
-> RouteModel r
-> String
-> Either (r, [(String, LogSource)]) (Maybe r)
forall r a.
(HasCallStack, Eq r, Show r) =>
(a -> Prism_ String r)
-> a -> String -> Either (r, [(String, LogSource)]) (Maybe r)
checkRoutePrismGivenFilePath RouteModel r -> Prism_ String r
enc RouteModel r
m String
s of
        Left (r
r, [(String, LogSource)]
log) -> BadRouteEncoding r -> Either (BadRouteEncoding r) (Maybe r)
forall a b. a -> Either a b
Left (BadRouteEncoding r -> Either (BadRouteEncoding r) (Maybe r))
-> BadRouteEncoding r -> Either (BadRouteEncoding r) (Maybe r)
forall a b. (a -> b) -> a -> b
$ String -> r -> [(String, LogSource)] -> BadRouteEncoding r
forall r.
String -> r -> [(String, LogSource)] -> BadRouteEncoding r
BadRouteEncoding String
s r
r [(String, LogSource)]
log
        Right Maybe r
mr -> Maybe r -> Either (BadRouteEncoding r) (Maybe r)
forall a b. b -> Either a b
Right Maybe r
mr

-- | A basic error response for displaying in the browser
emaErrorHtmlResponse :: Text -> LByteString
emaErrorHtmlResponse :: LogSource -> LByteString
emaErrorHtmlResponse LogSource
err =
  LogSource -> LByteString
mkHtmlErrorMsg LogSource
err LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy ByteString
wsClientHtml

mkHtmlErrorMsg :: Text -> LByteString
mkHtmlErrorMsg :: LogSource -> LByteString
mkHtmlErrorMsg LogSource
s =
  LogSource -> LByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (LogSource -> LByteString)
-> (ByteString -> LogSource) -> ByteString -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> LogSource -> LogSource -> LogSource
T.replace LogSource
"MESSAGE" LogSource
s (LogSource -> LogSource)
-> (ByteString -> LogSource) -> ByteString -> LogSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LogSource
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> LByteString) -> ByteString -> LByteString
forall a b. (a -> b) -> a -> b
$ $(embedFile "www/ema-error.html")

{- | Return the equivalent of WAI's @pathInfo@, from the raw path string
 (`document.location.pathname`) the browser sends us.
-}
pathInfoFromWsMsg :: Text -> [Text]
pathInfoFromWsMsg :: LogSource -> [LogSource]
pathInfoFromWsMsg =
  (LogSource -> Bool) -> [LogSource] -> [LogSource]
forall a. (a -> Bool) -> [a] -> [a]
filter (LogSource -> LogSource -> Bool
forall a. Eq a => a -> a -> Bool
/= LogSource
"") ([LogSource] -> [LogSource])
-> (LogSource -> [LogSource]) -> LogSource -> [LogSource]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> LogSource -> [LogSource]
T.splitOn LogSource
"/" (LogSource -> [LogSource])
-> (LogSource -> LogSource) -> LogSource -> [LogSource]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> LogSource -> LogSource
T.drop Port
1

decodeRouteNothingMsg :: Text
decodeRouteNothingMsg :: LogSource
decodeRouteNothingMsg = LogSource
"Ema: 404 (route decoding returned Nothing)"

data BadRouteEncoding r = BadRouteEncoding
  { BadRouteEncoding r -> String
_bre_urlFilePath :: FilePath
  , BadRouteEncoding r -> r
_bre_decodedRoute :: r
  , BadRouteEncoding r -> [(String, LogSource)]
_bre_checkLog :: [(FilePath, Text)]
  }
  deriving stock (Port -> BadRouteEncoding r -> ShowS
[BadRouteEncoding r] -> ShowS
BadRouteEncoding r -> String
(Port -> BadRouteEncoding r -> ShowS)
-> (BadRouteEncoding r -> String)
-> ([BadRouteEncoding r] -> ShowS)
-> Show (BadRouteEncoding r)
forall r. Show r => Port -> BadRouteEncoding r -> ShowS
forall r. Show r => [BadRouteEncoding r] -> ShowS
forall r. Show r => BadRouteEncoding r -> String
forall a.
(Port -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BadRouteEncoding r] -> ShowS
$cshowList :: forall r. Show r => [BadRouteEncoding r] -> ShowS
show :: BadRouteEncoding r -> String
$cshow :: forall r. Show r => BadRouteEncoding r -> String
showsPrec :: Port -> BadRouteEncoding r -> ShowS
$cshowsPrec :: forall r. Show r => Port -> BadRouteEncoding r -> ShowS
Show)

badRouteEncodingMsg :: Show r => BadRouteEncoding r -> Text
badRouteEncodingMsg :: BadRouteEncoding r -> LogSource
badRouteEncodingMsg BadRouteEncoding {r
String
[(String, LogSource)]
_bre_checkLog :: [(String, LogSource)]
_bre_decodedRoute :: r
_bre_urlFilePath :: String
_bre_checkLog :: forall r. BadRouteEncoding r -> [(String, LogSource)]
_bre_decodedRoute :: forall r. BadRouteEncoding r -> r
_bre_urlFilePath :: forall r. BadRouteEncoding r -> String
..} =
  LogSource -> LogSource
forall a. ToText a => a -> LogSource
toText (LogSource -> LogSource) -> LogSource -> LogSource
forall a b. (a -> b) -> a -> b
$
    LogSource
"A route Prism' is unlawful.\n\nThe URL '" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a. ToText a => a -> LogSource
toText String
_bre_urlFilePath
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
"' decodes to route '"
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> r -> LogSource
forall b a. (Show a, IsString b) => a -> b
show r
_bre_decodedRoute
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
"', but it is not isomporphic on any of the allowed candidates: \n\n"
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource -> [LogSource] -> LogSource
T.intercalate
        LogSource
"\n\n"
        ( [(String, LogSource)]
_bre_checkLog [(String, LogSource)]
-> ((String, LogSource) -> LogSource) -> [LogSource]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \(String
candidate, LogSource
log) ->
            LogSource
"## Candidate '" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a. ToText a => a -> LogSource
toText String
candidate LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
"':\n" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
log
        )
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" \n\nYou should make the relevant routePrism lawful to fix this issue."

wsClientHtml :: ByteString
wsClientHtml :: ByteString
wsClientHtml = $(embedFile "www/ema-indicator.html")

wsClientJSShim :: Text
wsClientJSShim :: LogSource
wsClientJSShim = ByteString -> LogSource
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 $(embedFile "www/ema-shim.js")

-- Browser-side JavaScript code for interacting with the Haskell server
wsClientJS :: LByteString
wsClientJS :: LByteString
wsClientJS =
  LogSource -> LByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
    [text|
        <script type="module" src="https://cdn.jsdelivr.net/npm/morphdom@2.6.1/dist/morphdom-umd.min.js"></script>

        <script type="module">
        ${wsClientJSShim}
        
        window.onpageshow = function () { init(false) };
        </script>
    |]