hbs2-browser assets

.gitignore

@@ -11,3 +11,4 @@ cabal.project.local
 
 .backup/
 .hbs2-git/state.db
+bin/

hbs2-browser/hbs2-browser.cabal

@@ -24,7 +24,10 @@ library
 
     -- other-modules:
     -- other-extensions:
-    build-depends:    base, file-embed
+    build-depends:
+        base
+      , bytestring
+      , file-embed
 
     hs-source-dirs:   lib
     default-language: GHC2021

hbs2-browser/lib/HBS2/Peer/Browser/Assets.hs

@@ -1 +1,11 @@
+{-# Language TemplateHaskell #-}
 module HBS2.Peer.Browser.Assets where
+
+import Data.FileEmbed
+
+import Data.ByteString
+
+cssDir :: [(FilePath, ByteString)]
+cssDir = $(embedDir "assets")
+
+

hbs2-peer/app/HttpWorker.hs

@@ -10,11 +10,14 @@ import HBS2.Data.Types.Refs
 import HBS2.Merkle
 import HBS2.Peer.Proto
 import HBS2.Peer.Proto.LWWRef
+import HBS2.Peer.Browser.Assets
 import HBS2.Net.Auth.Schema
 import HBS2.Data.Types.SignedBox
 import HBS2.Events
 import HBS2.Storage.Operations.ByteString
 
+
+
 import PeerTypes
 import PeerConfig
 import RefLog ( doRefLogBroadCast )
@@ -24,6 +27,7 @@ import Data.Config.Suckless
 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 Web.Scotty
 
@@ -69,6 +73,7 @@ httpWorker (PeerConfig syn) pmeta e = do
 
   sto <- getStorage
   let port' = runReader (cfgValue @PeerHttpPortKey) syn  <&>  fromIntegral
+  let bro   = runReader (cfgValue @PeerBrowser) syn == FeatureOn
   penv <- ask
 
   maybe1 port' none $ \port -> liftIO do
@@ -194,6 +199,13 @@ httpWorker (PeerConfig syn) pmeta e = do
       get "/metadata" do
           raw $ serialise $ pmeta
 
+      when bro do
+        middleware (static cssDir)
+
+        get "/browser" do
+          text "BRO"
+          status status200
+
       put "/" do
         -- FIXME: optional-header-based-authorization
         --   signed nonce + peer key?

hbs2-peer/app/PeerConfig.hs

@@ -38,6 +38,7 @@ data PeerHttpPortKey
 data PeerTcpProbeWaitKey
 data PeerUseHttpDownload
 data PeerBrainsDBPath
+data PeerBrowser
 
 instance Monad m => HasConf (ReaderT PeerConfig m) where
   getConf = asks (\(PeerConfig syn) -> syn)
@@ -65,6 +66,8 @@ data PeerKnownPeersFile
 instance Monad m => HasCfgKey PeerKnownPeersFile (Set String) m where
   key = "known-peers-file"
 
+instance Monad m => HasCfgKey PeerBrowser a m where
+  key = "browser"
 
 instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a b m) => HasCfgValue a FeatureSwitch m where
   cfgValue = lastDef FeatureOff . val <$> getConf

hbs2-peer/hbs2-peer.cabal

@@ -71,6 +71,7 @@ common common-deps
         , http-types
         , wai
         , wai-extra
+        , wai-middleware-static-embedded
         , unliftio
         , unliftio-core
         , unix