[#64] Add possibility to run tzbot as server

Problem: only server-like Slack apps can be published in the Slack App Directory. Solution: Allow to choose how to run the server, using common handler functions.
serokell · Feb 18, 2023 · 7c3ff2b · 7c3ff2b
1 parent 635077e
commit 7c3ff2b
Show file tree

Hide file tree

Showing 17 changed files with 647 additions and 143 deletions.
diff --git a/config/config.yaml b/config/config.yaml
@@ -60,3 +60,14 @@ inverseHelpUsageChance: 15
 # Envvar: SLACK_TZ_LOG_LEVEL
 #
 logLevel: Info
+
+
+# Port on which to run (server mode only).
+# Envvar: SLACK_TZ_PORT
+#
+port: 8912
+
+# Signing key used to verify Slack signatures (server mode only).
+# Envvar: SLACK_TZ_SIGNING_SECRET
+#
+# signingKey: 12345qwerty
diff --git a/package.yaml b/package.yaml
@@ -29,6 +29,7 @@ library:
   - case-insensitive
   - clock
   - containers
+  - cryptonite
   - directory
   - fmt
   - deriving-aeson
@@ -37,6 +38,7 @@ library:
   - formatting
   - guid
   - glider-nlp
+  - http-api-data
   - http-client
   - http-client-tls
   - http-types
@@ -45,10 +47,12 @@ library:
   - lens-aeson
   - managed
   - megaparsec
+  - memory
   - nyan-interpolation
   - o-clock
   - random
   - optparse-applicative
+  - servant
   - servant-auth
   - servant-auth-client
   - servant-client
@@ -69,6 +73,8 @@ library:
   - validation
   - yaml
   - utf8-string
+  - wai
+  - warp
 
 executables:
   tzbot-exe:

diff --git a/src/TzBot/BotMain.hs b/src/TzBot/BotMain.hs
@@ -6,29 +6,16 @@ module TzBot.BotMain where
 
 import Universum
 
-import Control.Monad.Managed (managed, runManaged)
 import Data.ByteString qualified as BS
-import Network.HTTP.Client (newManager)
-import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Options.Applicative (execParser)
-import Slacker
-  (defaultSlackConfig, handleThreadExceptionSensibly, runSocketMode, setApiToken, setAppToken,
-  setGracefulShutdownHandler, setOnException)
 import System.Directory (doesFileExist)
 import Text.Interpolation.Nyan (int, rmode')
-import Time (hour)
 
-import TzBot.Cache
-  (TzCacheSettings(tcsExpiryRandomAmplitudeFraction), defaultTzCacheSettings, withTzCache,
-  withTzCacheDefault)
-import TzBot.Config
+import TzBot.BotMain.Server (runServer)
+import TzBot.BotMain.Server.Verification (runVerificationServer)
+import TzBot.BotMain.SocketMode (runSocketMode)
 import TzBot.Config.Default (defaultConfigText)
-import TzBot.Config.Types (BotConfig)
-import TzBot.Logger
 import TzBot.Options
-import TzBot.ProcessEvents (handler)
-import TzBot.RunMonad
-import TzBot.Util (withMaybe)
 
 {- |
 Usage:
@@ -43,7 +30,11 @@ main = do
   cliOptions <- execParser totalParser
   case cliOptions of
     DumpConfig dumpOpts -> dumpConfig dumpOpts
-    DefaultCommand op -> run op
+    RunSocketMode opts -> runSocketMode opts
+    RunServer opts ->
+      if rsoVerification opts
+      then runVerificationServer opts
+      else runServer opts
 
 dumpConfig :: DumpOptions -> IO ()
 dumpConfig = \case
@@ -57,51 +48,3 @@ dumpConfig = \case
       (hPutStrLn @Text stderr [int||File #{path} already exists, \
                                 use --force to overwrite|] >> exitFailure)
       writeAction
-
-run :: Options -> IO ()
-run opts = do
-  let mbConfigFilePath = oConfigFile opts
-  bsConfig@Config {..} <- readConfig mbConfigFilePath
-  runManaged $ do
-
-    let fifteenPercentAmplitudeSettings = defaultTzCacheSettings
-          { tcsExpiryRandomAmplitudeFraction = Just 0.15
-          }
-
-    gracefulShutdownContainer <- liftIO $ newIORef $ (pure () :: IO ())
-    let extractShutdownFunction :: IO () -> IO ()
-        extractShutdownFunction = writeIORef gracefulShutdownContainer
-    let sCfg = defaultSlackConfig
-              & setApiToken (unBotToken cBotToken)
-              & setAppToken (unAppLevelToken cAppToken)
-              & setOnException handleThreadExceptionSensibly -- auto-handle disconnects
-              & setGracefulShutdownHandler extractShutdownFunction
-
-    bsManager <- liftIO $ newManager tlsManagerSettings
-    bsFeedbackConfig <-
-      managed $ withFeedbackConfig bsConfig
-    bsUserInfoCache <-
-      managed $ withTzCache fifteenPercentAmplitudeSettings cCacheUsersInfo
-    bsConversationMembersCache <-
-      managed $ withTzCache fifteenPercentAmplitudeSettings cCacheConversationMembers
-    let defaultMessageInfoCachingTime = hour 1
-    bsMessageCache <-
-      managed $ withTzCacheDefault defaultMessageInfoCachingTime
-    bsMessageLinkCache <-
-      managed $ withTzCacheDefault defaultMessageInfoCachingTime
-    bsReportEntries <-
-      managed $ withTzCacheDefault cCacheReportDialog
-    -- auto-acknowledge received messages
-    (bsLogNamespace, bsLogContext, bsLogEnv) <- managed $ withLogger cLogLevel
-    liftIO $ runSocketMode sCfg $ handler gracefulShutdownContainer BotState {..}
-
-withFeedbackConfig :: BotConfig -> (FeedbackConfig -> IO a) -> IO a
-withFeedbackConfig Config {..} action = do
-  let fcFeedbackChannel = cFeedbackChannel
-  withFeedbackFile cFeedbackFile $ \fcFeedbackFile ->
-    action FeedbackConfig {..}
-  where
-    withFeedbackFile :: Maybe FilePath -> (Maybe Handle -> IO a) -> IO a
-    withFeedbackFile mbPath action =
-      withMaybe mbPath (action Nothing) $ \path ->
-        withFile path AppendMode (action . Just)
diff --git a/src/TzBot/BotMain/Common.hs b/src/TzBot/BotMain/Common.hs
@@ -0,0 +1,57 @@
+-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+module TzBot.BotMain.Common where
+
+import Universum
+
+import Control.Monad.Managed (Managed, managed)
+import Network.HTTP.Client (newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Time (hour)
+
+import TzBot.Cache
+  (TzCacheSettings(tcsExpiryRandomAmplitudeFraction), defaultTzCacheSettings, withTzCache,
+  withTzCacheDefault)
+import TzBot.Config
+import TzBot.Config.Types (BotConfig)
+import TzBot.Logger
+import TzBot.RunMonad
+import TzBot.Util
+
+withBotState :: BotConfig -> Managed BotState
+withBotState bsConfig@Config {..} = do
+  let fifteenPercentAmplitudeSettings = defaultTzCacheSettings
+        { tcsExpiryRandomAmplitudeFraction = Just 0.15
+        }
+
+  bsManager <- liftIO $ newManager tlsManagerSettings
+  bsFeedbackConfig <-
+    managed $ withFeedbackConfig bsConfig
+  bsUserInfoCache <-
+    managed $ withTzCache fifteenPercentAmplitudeSettings cCacheUsersInfo
+
+  bsConversationMembersCache <-
+    managed $ withTzCache fifteenPercentAmplitudeSettings cCacheConversationMembers
+  let defaultMessageInfoCachingTime = hour 1
+  bsMessageCache <-
+    managed $ withTzCacheDefault defaultMessageInfoCachingTime
+  bsMessageLinkCache <-
+    managed $ withTzCacheDefault defaultMessageInfoCachingTime
+  bsReportEntries <-
+    managed $ withTzCacheDefault cCacheReportDialog
+  -- auto-acknowledge received messages
+  (bsLogNamespace, bsLogContext, bsLogEnv) <- managed $ withLogger cLogLevel
+  pure BotState {..}
+
+withFeedbackConfig :: BotConfig -> (FeedbackConfig -> IO a) -> IO a
+withFeedbackConfig Config {..} action = do
+  let fcFeedbackChannel = cFeedbackChannel
+  withFeedbackFile cFeedbackFile $ \fcFeedbackFile ->
+    action FeedbackConfig {..}
+  where
+    withFeedbackFile :: Maybe FilePath -> (Maybe Handle -> IO a) -> IO a
+    withFeedbackFile mbPath action =
+      withMaybe mbPath (action Nothing) $ \path ->
+        withFile path AppendMode (action . Just)