...
 
Commits (2)
{-# LANGUAGE OverloadedStrings #-}
module Main where -- TODO: Refactor this horrible module
import Data.Text (Text)
import ClassyPrelude
import Data.Text as T (splitOn, breakOn, head, tail)
import Data.Maybe
import System.Environment
import Control.Applicative
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import Data.Char
import qualified Telegram.Bot.API as Telegram
import Telegram.Bot.Simple
import Telegram.Bot.Simple.Debug
......@@ -21,9 +17,13 @@ import Crypto.Hash
import System.IO.Unsafe
-- | Bot conversation state model.
data Model = Model deriving (Show)
-- | Run bot reading token from token file.
main :: IO ()
main = do
lookupEnv "MOCK_BOT_TOKEN" >>= \case
Nothing -> putStrLn "Please supply bot token in environment variable $MOCK_BOT_TOKEN."
Just token -> Telegram.defaultTelegramClientEnv (Telegram.Token $ pack token)
>>= startBot_ (traceBotDefault bot)
-- | Actions bot can perform.
data Action
......@@ -34,12 +34,13 @@ data Action
deriving (Show)
-- | Bot application.
bot :: BotApp Model Action
bot = BotApp {
botInitialModel = Model,
botAction = flip handleUpdate,
botHandler = handleAction,
botJobs = []}
bot :: BotApp () Action
bot = BotApp
{ botInitialModel = ()
, botAction = \update () -> handleUpdate update
, botHandler = handleAction
, botJobs = []
}
-- | Whether the message was sent in a private chat.
isPrivate :: Telegram.Message -> Bool
......@@ -52,13 +53,13 @@ directMock = UpdateParser f where
f :: Telegram.Update -> Maybe Text
f update = do
message <- Telegram.updateMessage update
(command':body') <- T.words <$> Telegram.messageText message
let styleNames = T.splitOn "|" . T.toLower $ fst $ T.breakOn "@" $ if T.head command' == '/' then T.tail command' else command'
let body = T.unwords body'
(command':body') <- words <$> Telegram.messageText message
let styleNames = splitOn "|" . toLower $ fst $ breakOn "@" $ if T.head command' == '/' then T.tail command' else command'
let body = unwords body'
if length styleNames > 5 then
return "Only concatenations of up to 5 styles are allowed."
else case concatMaybeFunctions . map (`lookup` styles) $ styleNames of
Just f -> if T.null body
Just f -> if body == ""
then do
replyToMessage <- Telegram.messageReplyToMessage message
replyToText <- Telegram.messageText replyToMessage
......@@ -73,15 +74,14 @@ replyToInline = UpdateParser f where
inlineQuery <- Telegram.updateInlineQuery update
let txt = Telegram.inlineQueryQuery inlineQuery
--let id = Telegram.inlineQueryId inlineQuery
if T.empty == txt
if txt == ""
then return []
else return $ map (\(name, f) -> (
name,
f txt,
T.pack $ show (hash $ T.encodeUtf8 (name <> txt) :: Digest SHA256)
pack $ show (Crypto.Hash.hash $ encodeUtf8 (name <> txt) :: Digest SHA256)
)) styles
-- |Concatenates a list of Maybe functions. Execution goes from left to right.
-- Returns Nothing if any of the elements of the list is Nothing.
concatMaybeFunctions :: [Maybe (a -> a)] -> Maybe (a -> a)
......@@ -93,9 +93,9 @@ concatMaybeFunctions (mf:mfs) = do
-- | How to process incoming 'Telegram.Update's
-- and turn them into 'Action's.
handleUpdate :: Model -> Telegram.Update -> Maybe Action
handleUpdate _ = parseUpdate $
SendHelp <$ command "help"
handleUpdate :: Telegram.Update -> Maybe Action
handleUpdate = parseUpdate
$ SendHelp <$ command "help"
<|> SendHelp <$ command "start"
<|> Reply <$> directMock
<|> InlineReply <$> replyToInline
......@@ -103,35 +103,26 @@ handleUpdate _ = parseUpdate $
-- <|> SendHelp <$ text
-- | How to handle 'Action's.
handleAction :: Action -> Model -> Eff Action Model
handleAction NoAction model = pure model
handleAction (Reply message) model = model <# do
replyText message
pure NoAction
handleAction (InlineReply msgs) model = model <# do
let results = map (\(title, message, id) -> Telegram.InlineQueryResultArticle "article" id title (Telegram.InputTextMessageContent message Nothing Nothing) message) msgs
answerInlineQuery results
pure NoAction
handleAction SendHelp model = model <# do
reply $ (toReplyMessage help) {replyMessageParseMode = Just Telegram.Markdown, replyMessageDisableWebPagePreview = Just True}
pure NoAction
-- | Run bot with a given 'Telegram.Token'.
run :: Text -> IO ()
run token = do
env <- Telegram.defaultTelegramClientEnv (Telegram.Token token)
startBot_ (traceBotDefault bot) env
-- | Run bot reading token from token file.
main :: IO ()
main = T.readFile "config/token" >>= run . T.dropWhileEnd isSpace
-- | Help string.
help :: T.Text
help = T.unlines [
handleAction :: Action -> () -> Eff Action ()
handleAction action model = case action of
NoAction -> pure model
(Reply message) -> model <# do
replyText message
pure NoAction
(InlineReply msgs) -> model <# do
let results = map (\(title, message, id) -> Telegram.InlineQueryResultArticle "article" id title (Telegram.InputTextMessageContent message Nothing Nothing) message) msgs
answerInlineQuery results
pure NoAction
SendHelp -> model <# do
reply $ (toReplyMessage help) {replyMessageParseMode = Just Telegram.Markdown, replyMessageDisableWebPagePreview = Just True}
pure NoAction
-- | Help text.
help :: Text
help = unlines [
"*Mock " <> version <> "*",
"A Great BoT tO TRANsFoRM TEXt, wRiTten iN HaSKeLL.",
"By Nicolas Lenz. [Free and open source under the WTFPL.](https://git.eisfunke.com/software/mock-telegram-bot)",
"By Nicolas Lenz. [Free and open source under the WTFPL.](https://git.eisfunke.com/software/mock-bot-telegram)",
"",
"*Inline usage:* Just type `@truemockbot` and the text you want to stylize in any chat. Telegram will show you a selection of the styles available.",
"",
......@@ -142,7 +133,7 @@ help = T.unlines [
"*Example:* `random|double Cool Text`",
"",
"*Available Styles:*",
T.intercalate "\n" styleHelps] where
intercalate "\n" styleHelps] where
styleHelps = map
(\(name, _) -> T.concat [" *", name, "*: ", styleHelp name])
(\(name, _) -> concat [" *", name, "*: ", styleHelp name])
styles
FROM debian:latest
COPY mock-bot-telegram .
RUN apt update && apt install -y ca-certificates
RUN mkdir config
CMD echo $TOKEN > config/token && ./mock-bot-telegram
CMD ./mock-bot-telegram
......@@ -4,10 +4,10 @@ cabal-version: 2.2
--
-- see: https://github.com/sol/hpack
--
-- hash: 1da995315ec22a8c25b2b31d360b4d7233d32bc9686ce78e4848346d15bb0c29
-- hash: 35c5ed765db9fd192a99f0f1e1052b4c5a09f2da54d8839ec86e60f0ee1930cc
name: mock-bot-telegram
version: 0.3.1
version: 0.3.2
synopsis: tELegrAm bOT iNteGratiOn fOR mOCK
description: Please see the README at <https://git.eisfunke.com/software/mock-bot-telegram#readme>
category: Web
......@@ -30,9 +30,11 @@ executable mock-bot-telegram
Paths_mock_bot_telegram
hs-source-dirs:
app
default-extensions: LambdaCase OverloadedStrings NoImplicitPrelude
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
base
, classy-prelude
, cryptonite
, memory
, mock
......
name: mock-bot-telegram
version: 0.3.1
version: 0.3.2
license: WTFPL
git: "https://git.eisfunke.com/software/mock-bot-telegram"
author: "Nicolas Lenz"
......@@ -21,6 +21,12 @@ dependencies:
- mtl
- cryptonite
- memory
- classy-prelude
default-extensions:
- LambdaCase
- OverloadedStrings
- NoImplicitPrelude
executables:
mock-bot-telegram:
......