Merge pull request #53 from diogob/disable-static-server

Use a dummy app in case no path is passed for static server

Author: diogob

app/Config.hs

@@ -24,12 +24,12 @@ import Env
 import           Data.Text                   (intercalate)
 import           Data.Version                (versionBranch)
 import           Paths_postgres_websockets   (version)
-import           Protolude hiding            (intercalate, (<>))
+import           Protolude hiding            (intercalate, (<>), optional)
 
 -- | Config file settings for the server
 data AppConfig = AppConfig {
     configDatabase          :: Text
-  , configPath              :: Text
+  , configPath              :: Maybe Text
   , configHost              :: Text
   , configPort              :: Int
   , configListenChannel     :: Text
@@ -47,7 +47,7 @@ readOptions :: IO AppConfig
 readOptions =
     Env.parse (header "You need to configure some environment variables to start the service.") $
       AppConfig <$> var (str <=< nonempty) "PGWS_DB_URI"  (help "String to connect to PostgreSQL")
-                <*> var str "PGWS_ROOT_PATH" (def "./" <> helpDef show <> help "Root path to serve static files")
+                <*> optional (var str "PGWS_ROOT_PATH" (help "Root path to serve static files, unset to disable."))
                 <*> var str "PGWS_HOST" (def "*4" <> helpDef show <> help "Address the server will listen for websocket connections")
                 <*> var auto "PGWS_PORT" (def 3000 <> helpDef show <> help "Port the server will listen for websocket connections")
                 <*> var str "PGWS_LISTEN_CHANNEL" (def "postgres-websockets-listener" <> helpDef show <> help "Master channel used in the database to send or read messages in any notification channel")

app/Main.hs

@@ -18,8 +18,10 @@ import qualified Hasql.Session                        as H
 import qualified Hasql.Decoders                       as HD
 import qualified Hasql.Encoders                       as HE
 import qualified Hasql.Pool                           as P
-import Network.Wai.Application.Static
+import           Network.Wai.Application.Static
 
+import           Network.Wai (Application, responseLBS)
+import           Network.HTTP.Types (status200)
 import           Network.Wai.Handler.Warp
 import           Network.Wai.Middleware.RequestLogger (logStdout)
 import           System.IO                            (BufferMode (..),
@@ -32,7 +34,7 @@ isServerVersionSupported = do
  where
   pgVersion =
     H.Statement "SELECT current_setting('server_version_num')::integer"
-      HE.noParams (HD.singleRow $ HD.column $ HD.nonNullable $ HD.int4) False
+      HE.noParams (HD.singleRow $ HD.column $ HD.nonNullable HD.int4) False
 
 main :: IO ()
 main = do
@@ -62,7 +64,13 @@ main = do
 
   runSettings appSettings $
     postgresWsMiddleware listenChannel (configJwtSecret conf) pool multi $
-    logStdout $ staticApp $ defaultFileServerSettings $ toS $ configPath conf
+    logStdout $ maybe dummyApp staticApp' (configPath conf)
+  where
+    staticApp' :: Text -> Application
+    staticApp' = staticApp . defaultFileServerSettings . toS
+    dummyApp :: Application
+    dummyApp _ respond =
+        respond $ responseLBS status200 [("Content-Type", "text/plain")] "Hello, Web!"
 
 loadSecretFile :: AppConfig -> IO AppConfig
 loadSecretFile conf = extractAndTransform secret

postgres-websockets.cabal

@@ -67,6 +67,7 @@ executable postgres-websockets
                      , wai
                      , wai-extra
                      , wai-app-static
+                     , http-types
                      , envparse
   default-language:    Haskell2010
   default-extensions: OverloadedStrings, NoImplicitPrelude, QuasiQuotes

src/PostgresWebsockets.hs

@@ -55,7 +55,7 @@ wsApp dbChannel secret pool multi pendingConn =
     hasRead m = m == ("r" :: ByteString) || m == ("rw" :: ByteString)
     hasWrite m = m == ("w" :: ByteString) || m == ("rw" :: ByteString)
     rejectRequest = WS.rejectRequest pendingConn . encodeUtf8
-    -- the URI has one of the two formats - /:jwt or /:channel/:jwt 
+    -- the URI has one of the two formats - /:jwt or /:channel/:jwt
     pathElements = BS.split '/' $ BS.drop 1 $ WS.requestPath $ WS.pendingRequest pendingConn
     jwtToken
       | length pathElements > 1 = headDef "" $ tailSafe pathElements
@@ -74,7 +74,7 @@ wsApp dbChannel secret pool multi pendingConn =
             onMessage multi ch $ WS.sendTextData conn . B.payload
 
           when (hasWrite mode) $
-            let sendNotifications = void . (H.notifyPool pool dbChannel) . toS
+            let sendNotifications = void . H.notifyPool pool dbChannel . toS
             in notifySession validClaims (toS ch) conn sendNotifications
 
           waitForever <- newEmptyMVar