├── Procfile ├── docker-compose.yml ├── stack-bootstrap ├── Setup.hs ├── bin ├── build ├── deploy ├── run └── setup ├── app.json ├── env ├── .gitignore ├── Dockerfile ├── .dockerignore ├── src ├── Main.hs └── FOMObot │ ├── Types │ ├── BotState.hs │ ├── AppState.hs │ ├── ChannelState.hs │ ├── HistoryItem.hs │ ├── Command.hs │ ├── BotConfig.hs │ └── Bot.hs │ ├── Helpers │ ├── DMChannel.hs │ ├── MessageProcessor.hs │ ├── CommandProcessor.hs │ ├── FOMOChannel.hs │ ├── Algorithm.hs │ └── Preferences.hs │ └── App.hs ├── stack.yaml ├── LICENSE ├── CONTRIBUTING.md ├── fomobot.cabal └── README.md /Procfile: -------------------------------------------------------------------------------- 1 | bot: ./fomobot 2 | -------------------------------------------------------------------------------- /docker-compose.yml: -------------------------------------------------------------------------------- 1 | web: 2 | build: . 3 | -------------------------------------------------------------------------------- /stack-bootstrap: -------------------------------------------------------------------------------- 1 | alex happy slack-api 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bin/build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | stack build 6 | -------------------------------------------------------------------------------- /app.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "FOMObot", 3 | "addons": [] 4 | } 5 | -------------------------------------------------------------------------------- /bin/deploy: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | heroku docker:release 6 | -------------------------------------------------------------------------------- /env: -------------------------------------------------------------------------------- 1 | SLACK_API_TOKEN= 2 | HISTORY_SIZE=10 3 | FOMO_DEBOUNCE=20 4 | FOMO_THRESHOLD=5 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | slug.tgz 3 | .cabal-sandbox/ 4 | cabal.sandbox.config 5 | .stack-work/ 6 | .env 7 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM thoughtbot/heroku-haskell-stack:lts-5.11 2 | MAINTAINER Tony DiPasquale 3 | -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | * 2 | 3 | !stack-bootstrap 4 | !stack.yaml 5 | !fomobot.cabal 6 | 7 | !Setup.hs 8 | !src 9 | !LICENSE 10 | -------------------------------------------------------------------------------- /bin/run: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | set -o allexport 6 | source .env 7 | set +o allexport 8 | 9 | stack exec fomobot 10 | -------------------------------------------------------------------------------- /bin/setup: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | # Create environment file if it doesn't exist 6 | [ -f .env ] || cp env .env 7 | 8 | stack setup 9 | stack build --dependencies-only 10 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | import System.IO (hSetBuffering, stdout, BufferMode(..)) 2 | 3 | import FOMObot.App (initApp) 4 | 5 | main :: IO () 6 | main = do 7 | hSetBuffering stdout LineBuffering 8 | initApp 9 | -------------------------------------------------------------------------------- /src/FOMObot/Types/BotState.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Types.BotState where 2 | 3 | import qualified Data.HashMap as HM 4 | 5 | import FOMObot.Types.ChannelState 6 | 7 | type BotState = HM.Map String ChannelState 8 | 9 | emptyState :: BotState 10 | emptyState = HM.empty 11 | -------------------------------------------------------------------------------- /src/FOMObot/Types/AppState.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Types.AppState where 2 | 3 | import Control.Lens 4 | 5 | import FOMObot.Types.BotConfig 6 | import FOMObot.Types.BotState 7 | 8 | data AppState = AppState 9 | { _botConfig :: BotConfig 10 | , _botState :: BotState 11 | } 12 | 13 | makeLenses ''AppState 14 | -------------------------------------------------------------------------------- /src/FOMObot/Types/ChannelState.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Types.ChannelState where 2 | 3 | import Control.Lens (makeLenses) 4 | import FOMObot.Types.HistoryItem 5 | 6 | data ChannelState = ChannelState 7 | { _stateHistory :: [HistoryItem] 8 | , _stateEventHistory :: [Bool] 9 | } deriving (Show) 10 | 11 | makeLenses ''ChannelState 12 | -------------------------------------------------------------------------------- /src/FOMObot/Types/HistoryItem.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Types.HistoryItem where 2 | 3 | import Control.Lens (makeLenses) 4 | import qualified Web.Slack as Slack 5 | 6 | data HistoryItem = HistoryItem 7 | { _historyTimeStamp :: Slack.SlackTimeStamp 8 | , _historyUserId :: Slack.UserId 9 | } deriving (Show) 10 | 11 | makeLenses ''HistoryItem 12 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: 2 | # https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 3 | 4 | # Specifies the GHC version and set of packages available 5 | resolver: lts-5.11 6 | 7 | packages: 8 | - '.' 9 | 10 | extra-deps: 11 | - slack-api-0.8 12 | - hedis-0.8.3 13 | - scanner-0.2 14 | 15 | # Extra directories used by stack for building 16 | extra-include-dirs: [/usr/local/opt/openssl/include] 17 | extra-lib-dirs: [/usr/local/opt/openssl/lib] 18 | -------------------------------------------------------------------------------- /src/FOMObot/Types/Command.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Types.Command where 2 | 3 | import Data.Either (rights) 4 | import Text.Parsec (parse, manyTill) 5 | import Text.Parsec.String (Parser) 6 | import Text.Parsec.Char (string, anyChar, char) 7 | 8 | data Command 9 | = Add [String] 10 | | Remove [String] 11 | | List 12 | | Stop 13 | | Help 14 | | Unknown 15 | deriving Show 16 | 17 | parseCommand :: String -> Command 18 | parseCommand s = 19 | case words s of 20 | "add":xs -> Add $ parseChannels xs 21 | "remove":xs -> Remove $ parseChannels xs 22 | "list":_ -> List 23 | "stop":_ -> Stop 24 | "help":_ -> Help 25 | _ -> Unknown 26 | where 27 | parseChannels xs = rights $ (parse parser "") <$> xs 28 | 29 | parser :: Parser String 30 | parser = (string "<#") *> (manyTill anyChar $ char '>') 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 thoughtbot 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | We love pull requests from everyone. Follow the thoughtbot [code of conduct] 2 | while contributing. 3 | 4 | [code of conduct]: https://thoughtbot.com/open-source-code-of-conduct 5 | 6 | ## Dependencies 7 | 8 | FOMObot uses [Stack] for dependency management. Running `bin/setup` will install 9 | the dependencies via `stack` if they aren't already installed. 10 | 11 | [Stack]: http://docs.haskellstack.org/en/stable/README/ 12 | 13 | ## Contributing 14 | 15 | 1. Fork the repo. 16 | 2. Make your changes. 17 | 3. Add clear documentation of your changes to your commit messages. 18 | 4. Push to your fork and submit a pull request. 19 | 20 | At this point you're waiting on us. We like to at least comment on, if not 21 | accept, pull requests before they are merged. We may suggest some changes or 22 | improvements or alternatives. 23 | 24 | Some things that will increase the chance that your pull request is accepted, 25 | 26 | * Include tests that fail without your code, and pass with it 27 | * Update the documentation, the surrounding one, examples elsewhere, guides, 28 | whatever is affected by your contribution 29 | * Follow the existing style of the project 30 | -------------------------------------------------------------------------------- /src/FOMObot/Helpers/DMChannel.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Helpers.DMChannel 2 | ( setDMChannel 3 | , isDMChannel 4 | , getDMChannel 5 | ) where 6 | 7 | import Control.Lens ((^.), views) 8 | import Control.Monad (void) 9 | import Data.ByteString (ByteString) 10 | import Data.ByteString.Char8 (pack, unpack) 11 | import Data.Monoid ((<>)) 12 | import Data.Text.Encoding (encodeUtf8) 13 | import qualified Database.Redis as R 14 | import qualified Web.Slack as Slack 15 | 16 | import FOMObot.Types.Bot 17 | 18 | setDMChannel :: Slack.UserId -> Slack.IMId -> Bot () 19 | setDMChannel uid cid = void $ R.liftRedis $ R.set (dmChannelKey uid) dmChannelValue 20 | where 21 | dmChannelValue = encodeUtf8 $ cid ^. Slack.getId 22 | 23 | isDMChannel :: Slack.UserId -> Slack.ChannelId -> Bot Bool 24 | isDMChannel uid cid = do 25 | channelId <- R.liftRedis $ R.get (dmChannelKey uid) 26 | return $ channelId == views Slack.getId (Right . Just . encodeUtf8) cid 27 | 28 | getDMChannel :: String -> Bot (Maybe String) 29 | getDMChannel uid = either (const Nothing) (maybe Nothing (Just . unpack)) 30 | <$> (R.liftRedis $ R.get (pack uid <> ":channel")) 31 | 32 | dmChannelKey :: Slack.UserId -> ByteString 33 | dmChannelKey uid = userKey uid <> ":channel" 34 | 35 | userKey :: Slack.UserId -> ByteString 36 | userKey uid = "users:" <> (encodeUtf8 $ uid ^. Slack.getId) 37 | -------------------------------------------------------------------------------- /src/FOMObot/Helpers/MessageProcessor.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Helpers.MessageProcessor 2 | ( processMessage 3 | ) where 4 | 5 | import Control.Lens (views, (^.)) 6 | import qualified Data.Text as T 7 | import qualified Web.Slack as Slack 8 | 9 | import FOMObot.Helpers.Algorithm 10 | import FOMObot.Types.Bot 11 | import FOMObot.Types.ChannelState 12 | import FOMObot.Types.HistoryItem 13 | 14 | processMessage :: Slack.Event -> Bot Bool 15 | processMessage (Slack.Message channelID (Slack.UserComment userID) _ messageTimestamp _ _) = do 16 | config <- getConfig 17 | let messageChannelID = T.unpack $ channelID ^. Slack.getId 18 | 19 | -- Add the message timestamp to the channel state 20 | let historyItem = HistoryItem messageTimestamp userID 21 | channelState <- shiftInHistory config historyItem 22 | <$> botChannelState messageChannelID 23 | 24 | -- Detect an event that surpasses the threshold 25 | eventOccurred <- detectFOMOEvent channelState 26 | 27 | -- Save the channel state after adding the event status 28 | botSaveState messageChannelID 29 | $ shiftInEvent config eventOccurred channelState 30 | 31 | -- Signal an event only if an event occured and no recent events 32 | let recentlyNotified = views stateEventHistory or channelState 33 | return $ eventOccurred && not recentlyNotified 34 | 35 | processMessage _ = return False 36 | -------------------------------------------------------------------------------- /src/FOMObot/Helpers/CommandProcessor.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Helpers.CommandProcessor 2 | ( processCommand 3 | ) where 4 | 5 | import Data.Monoid ((<>)) 6 | import qualified Data.Text as T 7 | import qualified Web.Slack as Slack 8 | import qualified Web.Slack.Message as Slack 9 | 10 | import FOMObot.Helpers.Preferences 11 | import FOMObot.Types.Bot 12 | import FOMObot.Types.Command 13 | 14 | processCommand :: Slack.Event -> Bot () 15 | processCommand (Slack.Message cid (Slack.UserComment uid) txt _ _ _) = 16 | case parseCommand $ T.unpack txt of 17 | (Add xs) -> addUserPrefs uid xs 18 | (Remove xs) -> removeUserPrefs uid xs 19 | List -> Slack.sendMessage cid =<< (joinChannels <$> getUserPrefs uid) 20 | Stop -> deleteUserPrefs uid 21 | Help -> Slack.sendMessage cid helpText 22 | Unknown -> return () 23 | where 24 | joinChannels [] = "No preferences set." 25 | joinChannels cids = "<#" <> T.intercalate "> <#" (map T.pack cids) <> ">" 26 | 27 | processCommand _ = return () 28 | 29 | helpText :: T.Text 30 | helpText = "Possible Commands:\ 31 | \\nadd [#channel ...] : Add channels that you would like to monitor for activity.\ 32 | \\nremove [#channel ...] : Remove channels that you would no longer like to monitor.\ 33 | \\nlist : List the channels you are monitoring for activity.\ 34 | \\nstop : Stop FOMObot from monitoring any channels for activity.\ 35 | \\nhelp : Print the help text." 36 | -------------------------------------------------------------------------------- /src/FOMObot/Types/BotConfig.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Types.BotConfig where 2 | 3 | import Data.ByteString.Char8 (pack, unpack) 4 | import Database.Redis (ConnectInfo(..), PortID(PortNumber), defaultConnectInfo) 5 | import System.Environment (getEnv) 6 | import URI.ByteString 7 | ( Authority(..) 8 | , Host(..) 9 | , Port(..) 10 | , URI(..) 11 | , UserInfo(..) 12 | , parseURI 13 | , strictURIParserOptions 14 | ) 15 | 16 | data BotConfig = BotConfig 17 | { configHistorySize :: Int 18 | , configDebounceSize :: Int 19 | , configThreshold :: Double 20 | , configRedisConnection :: ConnectInfo 21 | } 22 | 23 | buildConfig :: IO BotConfig 24 | buildConfig = BotConfig 25 | <$> (read <$> getEnv "HISTORY_SIZE") 26 | <*> (read <$> getEnv "FOMO_DEBOUNCE") 27 | <*> (read <$> getEnv "FOMO_THRESHOLD") 28 | <*> (parseRedisURL <$> getEnv "REDIS_URL") 29 | 30 | parseRedisURL :: String -> ConnectInfo 31 | parseRedisURL url = defaultConnectInfo 32 | { connectAuth = uiPassword <$> (authorityUserInfo =<< mauth) 33 | , connectHost = host 34 | , connectPort = port 35 | } 36 | where 37 | parseURI' = either (const Nothing) Just . parseURI strictURIParserOptions 38 | muri = parseURI' $ pack url 39 | mauth = uriAuthority =<< muri 40 | host = maybe (connectHost defaultConnectInfo) (unpack . hostBS) $ authorityHost <$> mauth 41 | port = maybe (connectPort defaultConnectInfo) (PortNumber . fromIntegral . portNumber) $ authorityPort =<< mauth 42 | -------------------------------------------------------------------------------- /src/FOMObot/Helpers/FOMOChannel.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Helpers.FOMOChannel 2 | ( isFOMOChannel 3 | , alertFOMOChannel 4 | , alertUsers 5 | ) where 6 | 7 | import Control.Lens (uses, views, view, (^.), review) 8 | import Data.List (find) 9 | import Data.Maybe (fromJust) 10 | import Data.Monoid ((<>)) 11 | import qualified Data.Text as T 12 | import qualified Web.Slack as Slack 13 | import qualified Web.Slack.Message as Slack 14 | 15 | import FOMObot.Helpers.DMChannel (getDMChannel) 16 | import FOMObot.Types.Bot 17 | 18 | isFOMOChannel :: Slack.ChannelId -> Bot Bool 19 | isFOMOChannel cid = views Slack.channelId (== cid) <$> getFOMOChannel 20 | 21 | getFOMOChannel :: Bot Slack.Channel 22 | getFOMOChannel = do 23 | channels <- uses Slack.session $ view Slack.slackChannels 24 | return $ fromJust $ channelFinder channels 25 | where 26 | channelFinder = find (views Slack.channelName (== "fomo")) 27 | 28 | alertFOMOChannel :: Slack.ChannelId -> Bot () 29 | alertFOMOChannel channelID = do 30 | fomoChannel <- view Slack.channelId <$> getFOMOChannel 31 | Slack.sendMessage fomoChannel message 32 | where 33 | message = "Check out <#" <> (channelID ^. Slack.getId) <> ">" 34 | 35 | alertUsers :: [String] -> Slack.ChannelId -> Bot () 36 | alertUsers uids cid = mapM_ (\uid -> do 37 | channel <- getDMChannel uid 38 | let channelId = (review Slack.getId) . T.pack <$> channel 39 | maybe (return ()) (`Slack.sendMessage` message) channelId) uids 40 | where 41 | message = "Check out <#" <> (cid ^. Slack.getId) <> ">" 42 | -------------------------------------------------------------------------------- /src/FOMObot/Types/Bot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE TypeSynonymInstances #-} 3 | {-# OPTIONS_GHC -fno-warn-orphans #-} 4 | 5 | module FOMObot.Types.Bot where 6 | 7 | import Control.Lens (view, uses, modifying, set) 8 | import Control.Monad.IO.Class (liftIO) 9 | import qualified Data.HashMap as HM 10 | import Database.Redis (MonadRedis(..), runRedis, connect) 11 | import qualified Web.Slack as Slack 12 | 13 | import FOMObot.Types.AppState 14 | import FOMObot.Types.BotConfig 15 | import FOMObot.Types.BotState 16 | import FOMObot.Types.ChannelState 17 | 18 | type Bot = Slack.Slack AppState 19 | 20 | instance MonadRedis Bot where 21 | liftRedis f = do 22 | BotConfig{configRedisConnection} <- getConfig 23 | connection <- liftIO $ connect configRedisConnection 24 | liftIO $ runRedis connection f 25 | 26 | getConfig :: Bot BotConfig 27 | getConfig = uses Slack.userState $ view botConfig 28 | 29 | getState :: Bot BotState 30 | getState = uses Slack.userState $ view botState 31 | 32 | modifyState :: (BotState -> BotState) -> Bot () 33 | modifyState f = do 34 | state <- getState 35 | modifying Slack.userState $ set botState $ f state 36 | 37 | botChannelState :: String -> Bot ChannelState 38 | botChannelState channelID = do 39 | mChannelState <- HM.lookup channelID <$> getState 40 | maybe (botInsert channelID) return mChannelState 41 | 42 | botInsert :: String -> Bot ChannelState 43 | botInsert channelID = do 44 | let newChannelState = ChannelState [] [] 45 | botSaveState channelID newChannelState 46 | return newChannelState 47 | 48 | botSaveState :: String -> ChannelState -> Bot () 49 | botSaveState channelID = modifyState . (HM.insert channelID) 50 | -------------------------------------------------------------------------------- /src/FOMObot/App.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.App 2 | ( initApp 3 | ) where 4 | 5 | import qualified Data.Text as T 6 | import System.Environment (getEnv) 7 | import Control.Lens (uses, views, (^.)) 8 | import Control.Monad (void, when) 9 | import qualified Web.Slack as Slack 10 | 11 | import FOMObot.Helpers.CommandProcessor 12 | import FOMObot.Helpers.DMChannel 13 | import FOMObot.Helpers.FOMOChannel 14 | import FOMObot.Helpers.MessageProcessor 15 | import FOMObot.Helpers.Preferences 16 | import FOMObot.Types.AppState 17 | import FOMObot.Types.Bot 18 | import FOMObot.Types.BotConfig 19 | import FOMObot.Types.BotState 20 | 21 | runApp :: Slack.Event -> Bot () 22 | runApp m@(Slack.Message cid (Slack.UserComment uid) _ _ _ _) = do 23 | ignoreFOMOChannel <- isFOMOChannel cid 24 | isDM <- isDMChannel uid cid 25 | 26 | case () of 27 | _ | ignoreFOMOChannel -> return () 28 | | isDM -> processCommand m 29 | | otherwise -> do 30 | eventOccured <- processMessage m 31 | when eventOccured $ do 32 | alertFOMOChannel cid 33 | users <- getUsersForChannel $ T.unpack $ cid ^. Slack.getId 34 | alertUsers users cid 35 | 36 | runApp (Slack.ImCreated uid (Slack.IM cid _ _ _ _ _)) = setDMChannel uid cid 37 | 38 | runApp Slack.Hello = do 39 | ims <- uses Slack.session (views Slack.slackIms $ map pullOutUserAndChannel) 40 | mapM_ (uncurry setDMChannel) ims 41 | where 42 | pullOutUserAndChannel im = (im ^. Slack.imUser, im ^. Slack.imId) 43 | 44 | runApp _ = return () 45 | 46 | initApp :: IO () 47 | initApp = do 48 | token <- getEnv "SLACK_API_TOKEN" 49 | config <- buildConfig 50 | void $ Slack.runBot (Slack.SlackConfig token) runApp $ AppState config emptyState 51 | -------------------------------------------------------------------------------- /fomobot.cabal: -------------------------------------------------------------------------------- 1 | -- Initial fomobot.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: fomobot 5 | version: 0.1.0.0 6 | synopsis: A FOMO bot 7 | -- description: 8 | homepage: thoughtbot.com 9 | license: MIT 10 | license-file: LICENSE 11 | author: thoughtbot 12 | maintainer: tony@thoughtbot.com 13 | -- copyright: 14 | category: Web 15 | build-type: Simple 16 | -- extra-source-files: 17 | cabal-version: >=1.10 18 | 19 | executable fomobot 20 | main-is: Main.hs 21 | other-modules: FOMObot.App 22 | FOMObot.Helpers.Algorithm 23 | FOMObot.Helpers.CommandProcessor 24 | FOMObot.Helpers.DMChannel 25 | FOMObot.Helpers.FOMOChannel 26 | FOMObot.Helpers.MessageProcessor 27 | FOMObot.Helpers.Preferences 28 | FOMObot.Types.AppState 29 | FOMObot.Types.Bot 30 | FOMObot.Types.BotConfig 31 | FOMObot.Types.BotState 32 | FOMObot.Types.ChannelState 33 | FOMObot.Types.Command 34 | FOMObot.Types.HistoryItem 35 | 36 | default-extensions: OverloadedStrings 37 | , NamedFieldPuns 38 | , TemplateHaskell 39 | 40 | build-depends: base >=4.8 && <4.9 41 | , lens 42 | , text 43 | , hashmap 44 | , slack-api 45 | , hedis 46 | , bytestring 47 | , transformers 48 | , parsec 49 | , uri-bytestring 50 | 51 | hs-source-dirs: src 52 | default-language: Haskell2010 53 | ghc-options: -Wall -threaded 54 | -------------------------------------------------------------------------------- /src/FOMObot/Helpers/Algorithm.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Helpers.Algorithm 2 | ( shiftInHistory 3 | , shiftInEvent 4 | , detectFOMOEvent 5 | ) where 6 | 7 | import Control.Lens ((^.), (^?), (^?!), (&), (.~), (%~), _head, _last, views) 8 | import Data.List (nub) 9 | import qualified Web.Slack as Slack 10 | 11 | import FOMObot.Types.Bot 12 | import FOMObot.Types.BotConfig 13 | import FOMObot.Types.ChannelState 14 | import FOMObot.Types.HistoryItem 15 | 16 | type Density = Double 17 | 18 | calcDensity :: ChannelState -> Bot Density 19 | calcDensity s = do 20 | BotConfig{configHistorySize} <- getConfig 21 | return $ if isArrayFull (s ^. stateHistory) configHistorySize 22 | then calc $ fromIntegral configHistorySize 23 | else 0 24 | where 25 | calc historySize = 60 * historySize / timeOverHistory 26 | timeOverHistory = realToFrac $ latestTimeStamp - earliestTimeStamp 27 | latestTimeStamp = s ^?! stateHistory . _head . historyTimeStamp . Slack.slackTime 28 | earliestTimeStamp = s ^?! stateHistory . _last . historyTimeStamp . Slack.slackTime 29 | 30 | detectFOMOEvent :: ChannelState -> Bot Bool 31 | detectFOMOEvent state = do 32 | densitySurpassesThreshold <- (>) <$> calcDensity state <*> (configThreshold <$> getConfig) 33 | return $ and 34 | [ densitySurpassesThreshold 35 | , atLeastThreeUniqueUsers 36 | ] 37 | where 38 | atLeastThreeUniqueUsers = views stateHistory ((>=3) . length . nub . (map (^. historyUserId))) state 39 | 40 | shiftInHistory :: BotConfig -> HistoryItem -> ChannelState -> ChannelState 41 | shiftInHistory BotConfig{configHistorySize} historyItem s = 42 | if isFromPreviousUser 43 | then 44 | s & stateHistory . _head .~ historyItem 45 | else 46 | s & stateHistory %~ shiftIn configHistorySize historyItem 47 | where 48 | isFromPreviousUser = (s ^? stateHistory . _head . historyUserId) == Just (historyItem ^. historyUserId) 49 | 50 | shiftInEvent :: BotConfig -> Bool -> ChannelState -> ChannelState 51 | shiftInEvent BotConfig{configDebounceSize} event s = 52 | s & stateEventHistory %~ shiftIn configDebounceSize event 53 | 54 | shiftIn :: Int -> a -> [a] -> [a] 55 | shiftIn size item xs 56 | | isArrayFull xs size = item:init xs 57 | | otherwise = item:xs 58 | 59 | isArrayFull :: [a] -> Int -> Bool 60 | isArrayFull xs size = length xs == size 61 | -------------------------------------------------------------------------------- /src/FOMObot/Helpers/Preferences.hs: -------------------------------------------------------------------------------- 1 | module FOMObot.Helpers.Preferences 2 | ( addUserPrefs 3 | , getUserPrefs 4 | , deleteUserPrefs 5 | , removeUserPrefs 6 | , getUsersForChannel 7 | ) where 8 | 9 | import Control.Lens (view) 10 | import Control.Monad (void) 11 | import Data.ByteString (ByteString) 12 | import Data.ByteString.Char8 (pack, unpack) 13 | import Data.Monoid ((<>)) 14 | import Data.Text.Encoding (encodeUtf8) 15 | import qualified Database.Redis as R 16 | import qualified Web.Slack as Slack 17 | 18 | import FOMObot.Types.Bot 19 | 20 | addUserPrefs :: Slack.UserId -> [String] -> Bot () 21 | addUserPrefs uid prefs = do 22 | -- add channel prefs to user 23 | void $ R.liftRedis $ R.sadd (userPrefsKey uid) $ pack <$> prefs 24 | -- add user to each channel 25 | mapM_ (addUserToChannel uid) prefs 26 | 27 | getUserPrefs :: Slack.UserId -> Bot [String] 28 | getUserPrefs uid = either (const []) (map unpack) 29 | <$> (R.liftRedis $ R.smembers $ userPrefsKey uid) 30 | 31 | deleteUserPrefs :: Slack.UserId -> Bot () 32 | deleteUserPrefs uid = do 33 | -- remove user from each channel 34 | mapM_ (removeUserFromChannel uid) =<< getUserPrefs uid 35 | -- delete user prefs 36 | void $ R.liftRedis $ R.del [userPrefsKey uid] 37 | 38 | removeUserPrefs :: Slack.UserId -> [String] -> Bot () 39 | removeUserPrefs uid prefs = do 40 | -- remove channel prefs from user 41 | void $ R.liftRedis $ R.srem (userPrefsKey uid) $ pack <$> prefs 42 | -- remove user from each channel 43 | mapM_ (removeUserFromChannel uid) prefs 44 | 45 | getUsersForChannel :: String -> Bot [String] 46 | getUsersForChannel cid = either (const []) (map unpack) 47 | <$> (R.liftRedis $ R.smembers $ channelKey cid) 48 | 49 | addUserToChannel :: Slack.UserId -> String -> Bot () 50 | addUserToChannel uid = void . R.liftRedis . (`R.sadd` [userIdByteString uid]) . channelKey 51 | 52 | removeUserFromChannel :: Slack.UserId -> String -> Bot () 53 | removeUserFromChannel uid = void . R.liftRedis . (`R.srem` [userIdByteString uid]) . channelKey 54 | 55 | userPrefsKey :: Slack.UserId -> ByteString 56 | userPrefsKey uid = userKey uid <> ":prefs" 57 | 58 | userIdByteString :: Slack.UserId -> ByteString 59 | userIdByteString = encodeUtf8 . (view Slack.getId) 60 | 61 | userKey :: Slack.UserId -> ByteString 62 | userKey uid = "users:" <> userIdByteString uid 63 | 64 | channelKey :: String -> ByteString 65 | channelKey cid = "channels:" <> (pack cid) <> ":users" 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # FOMObot 2 | 3 | A Slack bot that monitors channels for message activity spikes. When activity 4 | spikes within a channel, FOMObot posts a message to the `#fomo` channel to let 5 | anyone in that channel know that they could be missing out on an important 6 | conversation. 7 | 8 | ## Development Environment Setup 9 | 10 | This project uses [Stack] to build and run locally. You can install Stack via 11 | the [instructions on their site.](http://docs.haskellstack.org/en/stable/README/) 12 | 13 | [Stack]: http://docs.haskellstack.org/en/stable/README/ 14 | 15 | Then run: 16 | 17 | ``` 18 | bin/setup 19 | ``` 20 | 21 | FOMObot needs a Slack API token. You can create a new Slack bot and 22 | generate an API token [here](https://my.slack.com/services/new/bot). 23 | 24 | Insert the Slack API token into the `.env` file. 25 | 26 | ``` 27 | SLACK_API_TOKEN=your_token_goes_here 28 | ... 29 | ``` 30 | 31 | ## Running Locally 32 | 33 | Run this: 34 | 35 | ``` 36 | bin/run 37 | ``` 38 | 39 | ## Deployment Environment Setup 40 | 41 | This project uses [Docker] to build for deployment. You can install docker and 42 | docker-compose via the [instructions] on their website. 43 | 44 | [Docker]: https://docker.com 45 | [instructions]: https://docs.docker.com/engine/installation 46 | 47 | If you're using OS X, you will also need docker-machine. Make sure to [setup 48 | Docker Machine] properly if it's your first time using it. 49 | 50 | [setup Docker Machine]: https://docs.docker.com/machine/get-started 51 | 52 | FOMObot can be easily deployed to [Heroku]. If you would also like to deploy to 53 | Heroku then start by creating a Heroku account if you don't already have one. 54 | Next, install the [Heroku Toolbelt]. 55 | 56 | [Heroku]: https://www.heroku.com/ 57 | [Heroku Toolbelt]: https://toolbelt.heroku.com/ 58 | 59 | Log in to Heroku by running `heroku login`. 60 | 61 | Create a new app for this project by running `heroku apps:create YOUR_APP_NAME`. 62 | 63 | Set the same environment variables in your Heroku app as you have in `.env`. 64 | 65 | Finally, install the `heroku-docker` plugin. 66 | 67 | ``` 68 | heroku plugins:install heroku-docker 69 | ``` 70 | 71 | ## Deploying to Heroku 72 | 73 | Simply run `heroku docker:release`. 74 | 75 | ## Contributing 76 | 77 | See the [CONTRIBUTING] document. Thank you, [contributors]! 78 | 79 | [CONTRIBUTING]: CONTRIBUTING.md 80 | [contributors]: https://github.com/thoughtbot/FOMObot/graphs/contributors 81 | 82 | ## License 83 | 84 | FOMObot is Copyright (c) 2016 thoughtbot, inc. It is free software, and may be 85 | redistributed under the terms specified in the [LICENSE] file. 86 | 87 | [LICENSE]: /LICENSE 88 | 89 | ## About 90 | 91 | ![thoughtbot](https://thoughtbot.com/logo.png) 92 | 93 | FOMObot is maintained and funded by thoughtbot, inc. The names and logos for 94 | thoughtbot are trademarks of thoughtbot, inc. 95 | 96 | We love open source software! See [our other projects][community] or look at 97 | our product [case studies] and [hire us][hire] to help build your Haskell app. 98 | 99 | [community]: https://thoughtbot.com/community?utm_source=github 100 | [case studies]: https://thoughtbot.com/work?utm_source=github 101 | [hire]: https://thoughtbot.com/hire-us?utm_source=github 102 | --------------------------------------------------------------------------------