wip

hbs2-peer/app/Browser.hs

@@ -0,0 +1,9 @@
+module Browser
+  ( module Browser.Root
+  , module Lucid
+  ) where
+
+import Browser.Root
+import Lucid (Html,renderTextT)
+
+

hbs2-peer/app/Browser/Root.hs

@@ -0,0 +1,48 @@
+module Browser.Root
+  ( module Lucid
+  , browserRootPage
+  ) where
+
+import HBS2.Prelude.Plated
+
+import Lucid (Html,HtmlT)
+import Lucid.Html5
+import Text.InterpolatedString.Perl6 (qc,qq,q)
+import Control.Monad
+import Control.Monad.Identity
+
+browserRootPage :: Monad m => HtmlT m ()
+browserRootPage = do
+  head_ $ do
+    meta_ [charset_ "utf-8"]
+    meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"]
+    title_ "hbs2-peer browser"
+    link_ [rel_ "stylesheet", href_ "/css/pico.min.css"]
+    link_ [rel_ "stylesheet", href_ "/css/custom.css"]
+
+    style_ [type_ "text/css"]  [q|
+      .flex-container { display: flex; justify-content: space-around; }
+      .flex-item { margin: 10px; padding: 20px; border: 1px solid #ccc; }
+      .resource-box { box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1); margin: 20px; padding: 20px; border-radius: 8px; }
+      h2 { font-size: 1.00rem; };
+      .container header h2 { font-color: red; }
+      |]
+
+  body_ $ do
+    div_ [class_ "container"] $ do
+
+      header_ $ do
+        h1_ "hbs2-peer browser"
+
+      main_ $ do
+
+        replicateM_ 6 do
+
+          div_ [class_ "resource-box"] $ do
+            h2_ "Metadata channel"
+            div_ do
+              a_ [href_ "/wtf"] "5GnroAC8FXNRL8rcgJj6RTu9mt1AbuNd5MZVnDBcCKzb"
+              p_ "some-shitty-wtf"
+
+      footer_ "Это подвал страницы."
+

hbs2-peer/app/HttpWorker.hs

@@ -22,6 +22,7 @@ import HBS2.Misc.PrettyStuff
 import PeerTypes
 import PeerConfig
 import RefLog ( doRefLogBroadCast )
+import Browser
 
 import Data.Config.Suckless
 
@@ -29,7 +30,7 @@ import Data.ByteString.Lazy qualified as LBS
 import Network.HTTP.Types.Status
 import Network.Wai.Middleware.RequestLogger
 import Network.Wai.Middleware.StaticEmbedded
-import Text.InterpolatedString.Perl6 (qc)
+import Text.InterpolatedString.Perl6 (qc,qq,q)
 import Web.Scotty
 
 import Data.Text.Lazy.IO qualified as TIO
@@ -51,6 +52,9 @@ import System.FilePath
 import Control.Monad.Except
 import Control.Monad.Trans.Cont
 
+-- import Lucid (renderTextT)
+-- import Lucid.Html5 hiding (for_)
+
 import UnliftIO (async)
 
 {- HLINT ignore "Functor law" -}
@@ -222,11 +226,8 @@ httpWorker (PeerConfig syn) pmeta e = do
 
       when bro do
 
-        get "/browser" $ flip runContT pure do
-          template <- orElse (status status500) (HM.lookup "browser.html" templates)
-          lift do
-            html $ renderMustache template "JOPAKITA"
-            status status200
+        get "/browser" do
+          renderTextT browserRootPage >>= html
 
       put "/" do
         -- FIXME: optional-header-based-authorization

hbs2-peer/hbs2-peer.cabal

@@ -72,6 +72,7 @@ common common-deps
         , wai
         , wai-extra
         , wai-middleware-static-embedded
+        , lucid
         , unliftio
         , unliftio-core
         , unix
@@ -270,6 +271,8 @@ executable hbs2-peer
                     , LWWRef
                     , CheckMetrics
                     , HttpWorker
+                    , Browser
+                    , Browser.Root
                     , Brains
                     , DispatchProxy
                     , CLI.Common