diff --git a/.gitignore b/.gitignore index 0b7582c4..40c67cf4 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,4 @@ cabal.project.local .backup/ .hbs2-git/state.db +bin/ diff --git a/hbs2-browser/css/fontawesomeall.css b/hbs2-browser/assets/css/fontawesomeall.css similarity index 100% rename from hbs2-browser/css/fontawesomeall.css rename to hbs2-browser/assets/css/fontawesomeall.css diff --git a/hbs2-browser/css/pico.min.css b/hbs2-browser/assets/css/pico.min.css similarity index 100% rename from hbs2-browser/css/pico.min.css rename to hbs2-browser/assets/css/pico.min.css diff --git a/hbs2-browser/hbs2-browser.cabal b/hbs2-browser/hbs2-browser.cabal index fb669b32..3e75be7e 100644 --- a/hbs2-browser/hbs2-browser.cabal +++ b/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 diff --git a/hbs2-browser/lib/HBS2/Peer/Browser/Assets.hs b/hbs2-browser/lib/HBS2/Peer/Browser/Assets.hs index 09b2c67e..edefa833 100644 --- a/hbs2-browser/lib/HBS2/Peer/Browser/Assets.hs +++ b/hbs2-browser/lib/HBS2/Peer/Browser/Assets.hs @@ -1 +1,11 @@ -module HBS2.Peer.Browser.Assets where \ No newline at end of file +{-# Language TemplateHaskell #-} +module HBS2.Peer.Browser.Assets where + +import Data.FileEmbed + +import Data.ByteString + +cssDir :: [(FilePath, ByteString)] +cssDir = $(embedDir "assets") + + diff --git a/hbs2-peer/app/HttpWorker.hs b/hbs2-peer/app/HttpWorker.hs index 0cef0224..ec4089db 100644 --- a/hbs2-peer/app/HttpWorker.hs +++ b/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? diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs index be90ff3a..90cdeb52 100644 --- a/hbs2-peer/app/PeerConfig.hs +++ b/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 diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal index 128e7251..dd965d59 100644 --- a/hbs2-peer/hbs2-peer.cabal +++ b/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