Skip to content

Commit bbcf0b3

Browse files
[#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.
1 parent 635077e commit bbcf0b3

File tree

17 files changed

+650
-143
lines changed

17 files changed

+650
-143
lines changed

config/config.yaml

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -60,3 +60,14 @@ inverseHelpUsageChance: 15
6060
# Envvar: SLACK_TZ_LOG_LEVEL
6161
#
6262
logLevel: Info
63+
64+
65+
# Port on which to run (server mode only).
66+
# Envvar: SLACK_TZ_PORT
67+
#
68+
port: 8912
69+
70+
# Signing key used to verify Slack signatures (server mode only).
71+
# Envvar: SLACK_TZ_SIGNING_SECRET
72+
#
73+
# signingKey: 12345qwerty

package.yaml

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ library:
2929
- case-insensitive
3030
- clock
3131
- containers
32+
- cryptonite
3233
- directory
3334
- fmt
3435
- deriving-aeson
@@ -37,6 +38,7 @@ library:
3738
- formatting
3839
- guid
3940
- glider-nlp
41+
- http-api-data
4042
- http-client
4143
- http-client-tls
4244
- http-types
@@ -45,10 +47,12 @@ library:
4547
- lens-aeson
4648
- managed
4749
- megaparsec
50+
- memory
4851
- nyan-interpolation
4952
- o-clock
5053
- random
5154
- optparse-applicative
55+
- servant
5256
- servant-auth
5357
- servant-auth-client
5458
- servant-client
@@ -69,6 +73,8 @@ library:
6973
- validation
7074
- yaml
7175
- utf8-string
76+
- wai
77+
- warp
7278

7379
executables:
7480
tzbot-exe:

src/TzBot/BotMain.hs

Lines changed: 8 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -6,29 +6,16 @@ module TzBot.BotMain where
66

77
import Universum
88

9-
import Control.Monad.Managed (managed, runManaged)
109
import Data.ByteString qualified as BS
11-
import Network.HTTP.Client (newManager)
12-
import Network.HTTP.Client.TLS (tlsManagerSettings)
1310
import Options.Applicative (execParser)
14-
import Slacker
15-
(defaultSlackConfig, handleThreadExceptionSensibly, runSocketMode, setApiToken, setAppToken,
16-
setGracefulShutdownHandler, setOnException)
1711
import System.Directory (doesFileExist)
1812
import Text.Interpolation.Nyan (int, rmode')
19-
import Time (hour)
2013

21-
import TzBot.Cache
22-
(TzCacheSettings(tcsExpiryRandomAmplitudeFraction), defaultTzCacheSettings, withTzCache,
23-
withTzCacheDefault)
24-
import TzBot.Config
14+
import TzBot.BotMain.Server (runServer)
15+
import TzBot.BotMain.Server.Verification (runVerificationServer)
16+
import TzBot.BotMain.SocketMode (runSocketMode)
2517
import TzBot.Config.Default (defaultConfigText)
26-
import TzBot.Config.Types (BotConfig)
27-
import TzBot.Logger
2818
import TzBot.Options
29-
import TzBot.ProcessEvents (handler)
30-
import TzBot.RunMonad
31-
import TzBot.Util (withMaybe)
3219

3320
{- |
3421
Usage:
@@ -43,7 +30,11 @@ main = do
4330
cliOptions <- execParser totalParser
4431
case cliOptions of
4532
DumpConfig dumpOpts -> dumpConfig dumpOpts
46-
DefaultCommand op -> run op
33+
RunSocketMode opts -> runSocketMode opts
34+
RunServer opts ->
35+
if rsoVerification opts
36+
then runVerificationServer opts
37+
else runServer opts
4738

4839
dumpConfig :: DumpOptions -> IO ()
4940
dumpConfig = \case
@@ -57,51 +48,3 @@ dumpConfig = \case
5748
(hPutStrLn @Text stderr [int||File #{path} already exists, \
5849
use --force to overwrite|] >> exitFailure)
5950
writeAction
60-
61-
run :: Options -> IO ()
62-
run opts = do
63-
let mbConfigFilePath = oConfigFile opts
64-
bsConfig@Config {..} <- readConfig mbConfigFilePath
65-
runManaged $ do
66-
67-
let fifteenPercentAmplitudeSettings = defaultTzCacheSettings
68-
{ tcsExpiryRandomAmplitudeFraction = Just 0.15
69-
}
70-
71-
gracefulShutdownContainer <- liftIO $ newIORef $ (pure () :: IO ())
72-
let extractShutdownFunction :: IO () -> IO ()
73-
extractShutdownFunction = writeIORef gracefulShutdownContainer
74-
let sCfg = defaultSlackConfig
75-
& setApiToken (unBotToken cBotToken)
76-
& setAppToken (unAppLevelToken cAppToken)
77-
& setOnException handleThreadExceptionSensibly -- auto-handle disconnects
78-
& setGracefulShutdownHandler extractShutdownFunction
79-
80-
bsManager <- liftIO $ newManager tlsManagerSettings
81-
bsFeedbackConfig <-
82-
managed $ withFeedbackConfig bsConfig
83-
bsUserInfoCache <-
84-
managed $ withTzCache fifteenPercentAmplitudeSettings cCacheUsersInfo
85-
bsConversationMembersCache <-
86-
managed $ withTzCache fifteenPercentAmplitudeSettings cCacheConversationMembers
87-
let defaultMessageInfoCachingTime = hour 1
88-
bsMessageCache <-
89-
managed $ withTzCacheDefault defaultMessageInfoCachingTime
90-
bsMessageLinkCache <-
91-
managed $ withTzCacheDefault defaultMessageInfoCachingTime
92-
bsReportEntries <-
93-
managed $ withTzCacheDefault cCacheReportDialog
94-
-- auto-acknowledge received messages
95-
(bsLogNamespace, bsLogContext, bsLogEnv) <- managed $ withLogger cLogLevel
96-
liftIO $ runSocketMode sCfg $ handler gracefulShutdownContainer BotState {..}
97-
98-
withFeedbackConfig :: BotConfig -> (FeedbackConfig -> IO a) -> IO a
99-
withFeedbackConfig Config {..} action = do
100-
let fcFeedbackChannel = cFeedbackChannel
101-
withFeedbackFile cFeedbackFile $ \fcFeedbackFile ->
102-
action FeedbackConfig {..}
103-
where
104-
withFeedbackFile :: Maybe FilePath -> (Maybe Handle -> IO a) -> IO a
105-
withFeedbackFile mbPath action =
106-
withMaybe mbPath (action Nothing) $ \path ->
107-
withFile path AppendMode (action . Just)

src/TzBot/BotMain/Common.hs

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
2+
--
3+
-- SPDX-License-Identifier: MPL-2.0
4+
5+
module TzBot.BotMain.Common where
6+
7+
8+
import Universum
9+
10+
import Control.Monad.Managed (Managed, managed)
11+
import Network.HTTP.Client (newManager)
12+
import Network.HTTP.Client.TLS (tlsManagerSettings)
13+
import Time (hour)
14+
15+
import TzBot.Cache
16+
(TzCacheSettings(tcsExpiryRandomAmplitudeFraction), defaultTzCacheSettings, withTzCache,
17+
withTzCacheDefault)
18+
import TzBot.Config
19+
import TzBot.Config.Types (BotConfig)
20+
import TzBot.Logger
21+
import TzBot.RunMonad
22+
import TzBot.Util
23+
24+
withBotState :: BotConfig -> Managed BotState
25+
withBotState bsConfig@Config {..} = do
26+
let fifteenPercentAmplitudeSettings = defaultTzCacheSettings
27+
{ tcsExpiryRandomAmplitudeFraction = Just 0.15
28+
}
29+
30+
bsManager <- liftIO $ newManager tlsManagerSettings
31+
bsFeedbackConfig <-
32+
managed $ withFeedbackConfig bsConfig
33+
bsUserInfoCache <-
34+
managed $ withTzCache fifteenPercentAmplitudeSettings cCacheUsersInfo
35+
36+
bsConversationMembersCache <-
37+
managed $ withTzCache fifteenPercentAmplitudeSettings cCacheConversationMembers
38+
let defaultMessageInfoCachingTime = hour 1
39+
bsMessageCache <-
40+
managed $ withTzCacheDefault defaultMessageInfoCachingTime
41+
bsMessageLinkCache <-
42+
managed $ withTzCacheDefault defaultMessageInfoCachingTime
43+
bsReportEntries <-
44+
managed $ withTzCacheDefault cCacheReportDialog
45+
-- auto-acknowledge received messages
46+
(bsLogNamespace, bsLogContext, bsLogEnv) <- managed $ withLogger cLogLevel
47+
pure BotState {..}
48+
49+
withFeedbackConfig :: BotConfig -> (FeedbackConfig -> IO a) -> IO a
50+
withFeedbackConfig Config {..} action = do
51+
let fcFeedbackChannel = cFeedbackChannel
52+
withFeedbackFile cFeedbackFile $ \fcFeedbackFile ->
53+
action FeedbackConfig {..}
54+
where
55+
withFeedbackFile :: Maybe FilePath -> (Maybe Handle -> IO a) -> IO a
56+
withFeedbackFile mbPath action =
57+
withMaybe mbPath (action Nothing) $ \path ->
58+
withFile path AppendMode (action . Just)

0 commit comments

Comments
 (0)