wtf

hbs2-peer/app/Browser/Root.hs

@@ -8,16 +8,21 @@ import HBS2.Prelude.Plated
 import HBS2.Base58
 import HBS2.Net.Proto.Types
 import HBS2.Peer.Proto.RefChan
+import HBS2.Peer.Proto.BrowserPlugin
+import HBS2.Net.Messaging.Pipe
 
 import Data.Config.Suckless.Syntax
 
+import Data.HashMap.Strict qualified as HM
 import Data.Maybe
-import Lucid (Html,HtmlT,toHtml)
+import Lucid (Html,HtmlT,toHtml,toHtmlRaw)
 import Lucid.Html5 hiding (for_)
 import Data.Text qualified as Text
 import Text.InterpolatedString.Perl6 (q)
 import System.FilePath
+import Control.Monad
 
+import UnliftIO
 
 rootPath :: [String] -> [String]
 rootPath = ("/browser":)
@@ -117,8 +122,17 @@ browserRootPage syn = rootPage do
             p_ (toHtml s)
 
 
-channelPage :: Monad m => RefChanId L4Proto -> HtmlT m ()
+channelPage :: MonadIO m
-channelPage chan = rootPage $ pure ()
+            => ServiceCaller BrowserPluginAPI PIPE
-
+            -> [(Text,Text)]
+            -> HtmlT m ()
+channelPage api env' = do
+  let env = HM.toList $ HM.fromList env' <> HM.fromList [("METHOD","list-entries"),("OUTPUT","html")]
+
+  r <- liftIO (callRpcWaitMay @RpcChannelQuery (TimeoutSec 1) api env)
+         <&> join
+         <&> fromMaybe mempty
+
+  rootPage $ toHtmlRaw r
 
 

hbs2-peer/app/HttpWorker.hs

@@ -314,13 +314,17 @@ httpWorker (PeerConfig syn) pmeta e = do
         get "/browser" do
           renderTextT (browserRootPage syn) >>= html
 
-        get "/browser/channel/:refchan" $ void $ flip runContT pure do
+        -- get "/browser/channel/:refchan" $ void $ flip runContT pure do
 
-          chan <- lift (param @String "refchan")
+        --   chan <- lift (param @String "refchan")
-                   <&> fromStringMay
+        --            <&> fromStringMay
-                   >>= orElse (status status404)
+        --            >>= orElse (status status404)
 
-          lift $ renderTextT (channelPage chan) >>= html
+        --   plugin <- readTVarIO handles <&> HM.lookup chan
+        --              >>= orElse (status status404)
+
+        --   let env = mempty
+        --   lift $ renderTextT (channelPage plugin env) >>= html
 
 
       put "/" do

hbs2-peer/lib/HBS2/Peer/Proto/BrowserPlugin.hs

@@ -1,5 +1,6 @@
 module HBS2.Peer.Proto.BrowserPlugin
   ( module HBS2.Peer.Proto.BrowserPlugin
+  , module HBS2.Net.Proto.Service
   , PIPE
   ) where