wip, webroot

hbs2-peer/app/HttpWorker.hs

@@ -14,6 +14,7 @@ import HBS2.Net.Auth.Schema
 import HBS2.Data.Types.SignedBox
 import HBS2.Events
 import HBS2.Storage.Operations.ByteString
+import HBS2.Misc.PrettyStuff
 
 import PeerTypes
 import PeerConfig
@@ -206,7 +207,11 @@ httpWorker (PeerConfig syn) pmeta = do
 
 
 getTreeHash :: AnyStorage -> HashRef -> ActionM ()
-getTreeHash sto what' = void $ flip runContT pure do
+getTreeHash sto what'' = void $ flip runContT pure do
+
+  flip fix (what'', 0) $ \again (what',i) -> do
+
+    let what = fromHashRef what'
 
     meta <- extractMetadataHash sto what'
               >>= orElse (status status404)
@@ -221,6 +226,18 @@ getTreeHash sto what' = void $ flip runContT pure do
              | ListVal [SymbolVal "file-name:", LitStrVal w] <- meta
              ]
 
+    let webroot = headMay [ w
+                          | i < 2, ListVal [SymbolVal "webroot", HashLike w] <- meta
+                          ]
+
+    case webroot of
+      Just x | i < 2 -> again (x, succ i)
+
+      _ -> do
+
+        for_ webroot $ \w -> do
+          warn $ green "HTTP:WEBROOT" <+> pretty w
+
         -- liftIO $ print $ pretty meta
 
         case fn of
@@ -241,7 +258,5 @@ getTreeHash sto what' = void $ flip runContT pure do
               for_ (LBS.toChunks lbs) $ \chunk -> do
                 write $ byteString chunk
               flush
-  where
-    what = fromHashRef what'