diff --git a/apps/simplex-store-service/README.md b/apps/simplex-store-service/README.md index c70a62c33e..2d9a9400f5 100644 --- a/apps/simplex-store-service/README.md +++ b/apps/simplex-store-service/README.md @@ -394,7 +394,8 @@ The names site is on when, and only when, the ini has `[names]`. Its `[listener] beside `badges_port` (by default 8080), which serves the badges site. The two must differ. The service refuses to start with any of these keys but no `[names]`, and with `names_port` and -`serve_webapp = off`. +`serve_webapp = off`. It also refuses to start when a build it serves or exports is not a +directory, naming the setting, so a local run that keeps a default path stops there. With `serve_webapp = on` (all in one), the service listens on both ports, and each serves only its own site: every path outside `/api/` and `/webhooks/` is a file of that site, `/` and `/index.html` diff --git a/apps/simplex-store-service/src/StoreService/Service.hs b/apps/simplex-store-service/src/StoreService/Service.hs index 685554b3af..3188cfe4f4 100644 --- a/apps/simplex-store-service/src/StoreService/Service.hs +++ b/apps/simplex-store-service/src/StoreService/Service.hs @@ -53,7 +53,7 @@ import StoreService.StoreReceipts.Apple (readAppleRoot, verifyAppleTransaction) import StoreService.StoreReceipts.Google (playStoreVerifier) import StoreService.StoreReceipts.Mock (mockStoreVerifier) import StoreService.Waiters (Waiters, newWaiters) -import StoreService.Web.Server (exportWebapp, newWebEnv, runWebListeners) +import StoreService.Web.Server (checkSiteDirs, exportWebapp, newWebEnv, runWebListeners) import Control.Applicative (optional) import Control.Concurrent.STM import StoreService.Log (logError, logInfo, logWarn) @@ -213,6 +213,7 @@ configureStoreVerifier serviceCfg env@ServiceState {storeVerifier = v} = case se storeService :: StoreServiceOpts -> ChatConfig -> ServiceState -> IO () storeService opts@StoreServiceOpts {serviceConfigFile} baseCfg env = do serviceCfg <- traverse readConfigOrExit serviceConfigFile + forM_ serviceCfg $ \sc -> checkSiteDirs (listener sc) >>= orExit cfg <- requireDevKeys serviceCfg baseCfg key <- requireIssuerKey opts serviceCfg cfg waiters <- newWaiters diff --git a/apps/simplex-store-service/src/StoreService/Web/Server.hs b/apps/simplex-store-service/src/StoreService/Web/Server.hs index d88dfaab23..31c4f834ea 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Server.hs +++ b/apps/simplex-store-service/src/StoreService/Web/Server.hs @@ -12,6 +12,7 @@ module StoreService.Web.Server webListeners, webSettings, runWebListeners, + checkSiteDirs, ) where @@ -34,7 +35,7 @@ import StoreService.Web.Names.Registration (heldFor, registrationChangedResponse import Control.Concurrent.Async (race) import qualified Control.Exception as E import StoreService.Log (logError, logInfo, logWarn) -import Control.Monad (forM_, void, when) +import Control.Monad (filterM, forM_, void, when) import Data.Aeson ((.=)) import qualified Data.Aeson as J import qualified Data.Aeson.KeyMap as KM @@ -42,8 +43,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LB import Data.Char (toLower) +import Data.Functor ((<&>)) import Data.List (isPrefixOf) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T @@ -556,6 +558,17 @@ runWebListeners env = do where lc = listenerConfig env +-- | Each build that is served or exported must be a directory, or the service would serve nothing or fail its export. +checkSiteDirs :: ListenerConfig -> IO (Either String ()) +checkSiteDirs ListenerConfig {lServeWebapp, lBadgesStaticDir, lBadgesExportDir, lNamesStaticDir, lNamesExportDir, lNamesPort} = + filterM (fmap not . doesDirectoryExist . snd) used <&> \case + (site, dir) : _ -> Left ("listener." <> site <> "_static_dir = " <> dir <> " is not a directory; set it to the " <> site <> " build, since the default is the Docker image's path") + [] -> Right () + where + used = + [("badges", lBadgesStaticDir) | lServeWebapp || isJust lBadgesExportDir] + <> [("names", dir) | Just dir <- [lNamesStaticDir], isJust lNamesPort || isJust lNamesExportDir] + warnIfHeaderTrustIsExposed :: ListenerConfig -> IO () warnIfHeaderTrustIsExposed ListenerConfig {lHost, lTrustForwardedFor} = when (lTrustForwardedFor && not (isLoopbackHost lHost)) $ diff --git a/tests/Bots/StoreService/WebTests.hs b/tests/Bots/StoreService/WebTests.hs index a70975959c..e075370a99 100644 --- a/tests/Bots/StoreService/WebTests.hs +++ b/tests/Bots/StoreService/WebTests.hs @@ -248,6 +248,7 @@ badgeWebTests = do it "listens on the badges port alone without the names site" testOneListenerWithoutTheNamesSite it "serves a names asset with its type" testServesANamesAsset it "keeps every traversal spelling on the names port inside the names build" testNamesTraversalRefused + it "refuses a build folder that is not there, only where it is served or exported" testSiteDirsMustExist describe "store service settlement" $ do it "settles an open invoice: paid, a settled payment row, and the code" testSettlesAnOpenInvoice it "settles an expired invoice, because late settlement is routine" testLateSettlementIsLegal @@ -1199,6 +1200,25 @@ testNamesTraversalRefused = bounded "names traversal" $ withBothSites $ \_ names r <- webGet names target (target, statusOf r, responseBody r) `shouldBe` (target, 404, notFoundBody) +testSiteDirsMustExist :: IO () +testSiteDirsMustExist = do + createDirectoryIfMissing True "tests/tmp" + withTempDirectory "tests/tmp" "site-dirs" $ \root -> do + staticDir <- prepareStaticDir root + namesDir <- prepareNamesDir root + let absent = root "absent" + lc = listener (testServiceConfig staticDir False) + missing site dir = Left ("listener." <> site <> "_static_dir = " <> dir <> " is not a directory; set it to the " <> site <> " build, since the default is the Docker image's path") + checkSiteDirs lc `shouldReturn` Right () + checkSiteDirs lc {lNamesStaticDir = Just namesDir, lNamesPort = Just 8081} `shouldReturn` Right () + checkSiteDirs lc {lBadgesStaticDir = absent} `shouldReturn` missing "badges" absent + checkSiteDirs lc {lBadgesStaticDir = absent, lServeWebapp = False} `shouldReturn` Right () + checkSiteDirs lc {lBadgesStaticDir = absent, lServeWebapp = False, lBadgesExportDir = Just (root "out")} `shouldReturn` missing "badges" absent + checkSiteDirs lc {lNamesStaticDir = Just absent, lNamesPort = Just 8081} `shouldReturn` missing "names" absent + checkSiteDirs lc {lServeWebapp = False, lNamesStaticDir = Just absent} `shouldReturn` Right () + checkSiteDirs lc {lServeWebapp = False, lNamesStaticDir = Just absent, lNamesExportDir = Just (root "names-out")} `shouldReturn` missing "names" absent + checkSiteDirs lc {lBadgesStaticDir = root "secret.txt"} `shouldReturn` missing "badges" (root "secret.txt") + type WebClient = (Manager, String) withWebApp :: (WebEnv -> WebClient -> IO a) -> IO a