From e05f7a7d5ff78e07f4f518d8a2997a812e3930d5 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Fri, 29 Mar 2024 10:57:57 +0300
Subject: [PATCH] wtf

---
 hbs2-peer/app/Browser/Root.hs                 | 22 +++++++++++++++----
 hbs2-peer/app/HttpWorker.hs                   | 14 +++++++-----
 .../lib/HBS2/Peer/Proto/BrowserPlugin.hs      |  1 +
 3 files changed, 28 insertions(+), 9 deletions(-)

diff --git a/hbs2-peer/app/Browser/Root.hs b/hbs2-peer/app/Browser/Root.hs
index bf2927c3..dfb974fc 100644
--- a/hbs2-peer/app/Browser/Root.hs
+++ b/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 chan = rootPage $ pure ()
-
+channelPage :: MonadIO m
+            => 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
 
 
diff --git a/hbs2-peer/app/HttpWorker.hs b/hbs2-peer/app/HttpWorker.hs
index 37c9c5b8..ad9467e4 100644
--- a/hbs2-peer/app/HttpWorker.hs
+++ b/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")
-                   <&> fromStringMay
-                   >>= orElse (status status404)
+        --   chan <- lift (param @String "refchan")
+        --            <&> fromStringMay
+        --            >>= 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
diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/BrowserPlugin.hs b/hbs2-peer/lib/HBS2/Peer/Proto/BrowserPlugin.hs
index da7cc2aa..11a58ebd 100644
--- a/hbs2-peer/lib/HBS2/Peer/Proto/BrowserPlugin.hs
+++ b/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