xftp-server: embed file download widget in XFTP server web page

apps/common/Web/static/index.html

@@ -105,6 +105,13 @@
                     class="text-[16px] leading-[26px] tracking-[0.01em] nav-link-text text-black dark:text-white before:bg-black dark:before:bg-white">Server
                     information</span></a>
               </li>
+              <x-xftpConfig>
+              <li class="nav-link relative"><a href="/file"
+                  class="flex items-center justify-between gap-2 lg:py-5 whitespace-nowrap"><span
+                    class="text-[16px] leading-[26px] tracking-[0.01em] nav-link-text text-black dark:text-white before:bg-black dark:before:bg-white">File
+                    transfer</span></a>
+              </li>
+              </x-xftpConfig>
             </ul><a target="_blank" href="https://github.com/simplex-chat/simplex-chat#help-us-with-donations"
               class="whitespace-nowrap flex items-center gap-1 self-center text-white dark:text-black text-[16px] font-medium tracking-[0.02em] rounded-[34px] bg-primary-light dark:bg-primary-dark py-3 lg:py-2 px-20 lg:px-5 mb-16 lg:mb-0">Donate</a>
           </div>

apps/xftp-server/XFTPWeb.hs

@@ -1,12 +1,16 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module XFTPWeb
   ( xftpGenerateSite,
     xftpServerInformation,
   ) where
 
+import Control.Monad (forM_)
+import qualified Data.ByteString.Char8 as B
 import Data.ByteString (ByteString)
+import Data.FileEmbed (embedDir, embedFile)
 import Data.Maybe (isJust)
 import Data.String (fromString)
 import Web.Embedded (embeddedContent)
@@ -18,15 +22,41 @@ import Simplex.Messaging.Server.Main (simplexmqSource)
 import qualified Simplex.Messaging.Server.Web as Web
 import Simplex.Messaging.Server.Web (render, serverInfoSubsts, timedTTLText)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath ((</>))
+
+xftpWebContent :: [(FilePath, ByteString)]
+xftpWebContent = $(embedDir "apps/xftp-server/static/xftp-web-bundle/")
+
+xftpMediaContent :: [(FilePath, ByteString)]
+xftpMediaContent = $(embedDir "apps/xftp-server/static/media/")
+
+xftpFilePageHtml :: ByteString
+xftpFilePageHtml = $(embedFile "apps/xftp-server/static/file.html")
 
 xftpGenerateSite :: XFTPServerConfig -> Maybe ServerPublicInfo -> Maybe TransportHost -> FilePath -> IO ()
-xftpGenerateSite cfg info onionHost path =
-  Web.generateSite embeddedContent (xftpServerInformation cfg info onionHost) [] path
+xftpGenerateSite cfg info onionHost path = do
+  let substs = xftpSubsts cfg info onionHost
+  Web.generateSite embeddedContent (render (Web.indexHtml embeddedContent) substs) [] path
+  let xftpDir = path </> "xftp-web-bundle"
+      mediaDir = path </> "media"
+      fileDir = path </> "file"
+  filePage xftpDir xftpWebContent
+  filePage mediaDir xftpMediaContent
+  createDirectoryIfMissing True fileDir
+  B.writeFile (fileDir </> "index.html") $ render xftpFilePageHtml substs
+  where
+    filePage dir content_ = do
+      createDirectoryIfMissing True dir
+      forM_ content_ $ \(fp, content) -> B.writeFile (dir </> fp) content
 
 xftpServerInformation :: XFTPServerConfig -> Maybe ServerPublicInfo -> Maybe TransportHost -> ByteString
-xftpServerInformation XFTPServerConfig {fileExpiration, logStatsInterval, allowNewFiles, newFileBasicAuth} information onionHost = render (Web.indexHtml embeddedContent) substs
+xftpServerInformation cfg info onionHost = render (Web.indexHtml embeddedContent) (xftpSubsts cfg info onionHost)
+
+xftpSubsts :: XFTPServerConfig -> Maybe ServerPublicInfo -> Maybe TransportHost -> [(ByteString, Maybe ByteString)]
+xftpSubsts XFTPServerConfig {fileExpiration, logStatsInterval, allowNewFiles, newFileBasicAuth} information onionHost =
+  [("smpConfig", Nothing), ("xftpConfig", Just "y")] <> substConfig <> serverInfoSubsts simplexmqSource information <> [("onionHost", strEncode <$> onionHost), ("iniFileName", Just "file-server.ini")]
   where
-    substs = [("smpConfig", Nothing), ("xftpConfig", Just "y")] <> substConfig <> serverInfoSubsts simplexmqSource information <> [("onionHost", strEncode <$> onionHost), ("iniFileName", Just "file-server.ini")]
     substConfig =
       [ ("fileExpiration", Just $ maybe "Never" (fromString . timedTTLText . ttl) fileExpiration),
         ("statsEnabled", Just . yesNo $ isJust logStatsInterval),