Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[#64] Add possibility to run tzbot as a server #73

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 11 additions & 0 deletions config/config.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
6 changes: 6 additions & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ library:
- case-insensitive
- clock
- containers
- cryptonite
- directory
- fmt
- deriving-aeson
Expand All @@ -37,6 +38,7 @@ library:
- formatting
- guid
- glider-nlp
- http-api-data
- http-client
- http-client-tls
- http-types
Expand All @@ -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
Expand All @@ -69,6 +73,8 @@ library:
- validation
- yaml
- utf8-string
- wai
- warp

executables:
tzbot-exe:
Expand Down
73 changes: 8 additions & 65 deletions src/TzBot/BotMain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand All @@ -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
Expand All @@ -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)
57 changes: 57 additions & 0 deletions src/TzBot/BotMain/Common.hs
Original file line number Diff line number Diff line change
@@ -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)
Loading