mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-12 04:46:04 +00:00
EvgenyandEvgeny @ SimpleX Chat
1876357c7f
* xftp server: support storage time and BBS proofs of badge credential to extend it * update * types * implementation * update * remove permanent and FTTL * refactor * refactor * refactor * simplify * simplify * simpler * remove comments * add file expiration time to agent event * add test of upload with entitlement * update schema * fix header and test * fix store log encoding, add xftp store log tests * send entitlement proof in handshake * type, query * more fixes * test entitlement keys * update * fixes * fix * comment * remove log * simpler * ignore entitlement proofs in browser requests * remove condition --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
68 lines
3.0 KiB
Haskell
68 lines
3.0 KiB
Haskell
{-# 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)
|
|
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
|
|
import Simplex.Messaging.Encoding.String (strEncode)
|
|
import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
|
|
import Simplex.Messaging.Server.Information (ServerPublicInfo)
|
|
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 s -> Maybe ServerPublicInfo -> Maybe TransportHost -> FilePath -> IO ()
|
|
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 s -> Maybe ServerPublicInfo -> Maybe TransportHost -> ByteString
|
|
xftpServerInformation cfg info onionHost = render (Web.indexHtml embeddedContent) (xftpSubsts cfg info onionHost)
|
|
|
|
xftpSubsts :: XFTPServerConfig s -> 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
|
|
substConfig =
|
|
[ ("fileExpiration", Just . fromString . timedTTLText . ttl $ fileExpiration),
|
|
("statsEnabled", Just . yesNo $ isJust logStatsInterval),
|
|
("newUploadsAllowed", Just . yesNo $ allowNewFiles),
|
|
("basicAuthEnabled", Just . yesNo $ isJust newFileBasicAuth)
|
|
]
|
|
yesNo True = "Yes"
|
|
yesNo False = "No"
|