diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2014 Jonathan Childress + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,76 @@ +# Haskbot + +### A easily-extensible, Haskell-based Slack chatbot + +The purpose of this little bot is to provide: + +- a slew of mini-services for [Bendyworks](http://bendyworks.com/) +- a simple platform for Bendyworkers to learn Haskell +- a playground for exciting Haskell web modules, such as WAI, Warp, and Aeson + +This `README` only demonstrates how to setup a Haskell dev environment for +creating Haskbot plugins. Further documentation can be found on Hackage. + +### New to Haskell? + +I find enjoyment of Haskell is greatly increased by a thorough reading of the +first few chapters of [Learn You a Haskell...](http://learnyouahaskell.com). Of +course, I highly recommend the entire book when you've time. + +If you're an in-house Bendyworker, I'm also available before/after hours or +during growth time to help or answer any questions. + +### Installing the Haskell Platform and Haskbot + +To run Haskbot locally, all you require is the latest Haskell platform. If your +distro of choice isn't +[Debian](http://www.extellisys.com/articles/haskell-on-debian-wheezy), +this means your package manager probably provides it for you. + +1. Run the following to install the platform: + - On Ubuntu + + ```sh + sudo apt-get update + sudo apt-get install haskell-platform + ``` + - On OSX + + ```sh + brew update + brew install haskell-platform + ``` + +2. Add Cabal's (the Haskell package manager) `bin` folder to your shell's + `$PATH`. This is usually done by adding the following lines to + `~/.profile` or `~/.bash_profile` (whichever you have/prefer). + ```sh + PATH="$HOME/.cabal/bin:$PATH" + export PATH + ``` + Make sure to re-source whatever file contains the new `$PATH`, like so: + ```sh + source ~/.profile + ``` +3. Update the Haskell packages via: + + ```sh + cabal update + cabal install cabal-install + cabal install haskbot-core + ``` + +### Create Plugins + +You're now ready to begin creating plugins for your very own Haskbot! Continue +on to Hackage for a full Haskbot API description and examples. + +### Thanks + +I wouldn't have had time to write this without the growth time supplied by +[Bendyworks](http://bendyworks.com/). Hey, employers! This is what developers +need to survive. + +### License + +See `LICENSE.txt` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/haskbot-core.cabal b/haskbot-core.cabal new file mode 100644 --- /dev/null +++ b/haskbot-core.cabal @@ -0,0 +1,75 @@ +name: haskbot-core +version: 0.0.1.0 +maintainer: Jonathan Childress +homepage: https://github.com/jonplussed/haskbot-core + +license: MIT +license-file: LICENSE.txt +copyright: (c) 2014 Jonathan Childress + +synopsis: Easily-extensible chatbot for Slack messaging service +description: Haskbot melds together the Slack /slash command/ and /incoming/ API + integrations to create an easily-extensible platform for adding your own + custom /slash commands/ with arbitrary responses to your team's Slack + service. + . + Sure, Hubot exists, but when I desire custom chatbot functionality, I'd rather + write nice, clean Haskell than clunky Javascript any day of the week. + +stability: volatile +category: web +build-type: Simple +extra-source-files: README.md +cabal-version: >= 1.10 + +source-repository head + type: git + location: https://github.com/jonplussed/haskbot-core + +library + hs-source-dirs: src + exposed-modules: Network.Haskbot + Network.Haskbot.Incoming + Network.Haskbot.Internal.Environment + Network.Haskbot.Internal.Incoming + Network.Haskbot.Internal.Plugin + Network.Haskbot.Internal.Server + Network.Haskbot.Internal.SlashCommand + Network.Haskbot.Plugin + Network.Haskbot.Plugin.Help + Network.Haskbot.SlashCommand + Network.Haskbot.Types + default-language: Haskell2010 + other-extensions: OverloadedStrings, + RecordWildCards + build-depends: aeson == 0.6.*, + base == 4.6.*, + bytestring == 0.10.*, + connection == 0.2.*, + http-conduit == 2.1.*, + http-types == 0.8.*, + monads-tf == 0.1.*, + scotty == 0.8.*, + stm == 2.4.*, + text == 0.11.*, + time == 1.4.* + +test-suite spec + hs-source-dirs: src, test + main-is: Spec.hs + default-language: Haskell2010 + other-extensions: OverloadedStrings, + RecordWildCards + type: exitcode-stdio-1.0 + build-depends: aeson == 0.6.*, + base == 4.6.*, + bytestring == 0.10.*, + connection == 0.2.*, + hspec == 1.8.*, + http-conduit == 2.1.*, + http-types == 0.8.*, + monads-tf == 0.1.*, + scotty == 0.8.*, + stm == 2.4.*, + text == 0.11.*, + time == 1.4.* diff --git a/src/Network/Haskbot.hs b/src/Network/Haskbot.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot.hs @@ -0,0 +1,46 @@ +-- | Module : Network.Haskbot +-- Description : An easily-extensible Slack chatbot server +-- Copyright : (c) Jonathan Childress 2014 +-- License : MIT +-- Maintainer : jon@childr.es +-- Stability : experimental +-- Portability : POSIX +-- +-- A minimal Haskbot server can be run via: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Network.Haskbot +-- > import Network.Haskbot.Plugin +-- > import qualified Slack.Haskbot.Plugin.Help as Help +-- > +-- > main :: IO () +-- > main = haskbot registry 3000 +-- > +-- > registry :: [Plugin] +-- > registry = [ Help.register registry "my_secret_token" ] +-- +-- This will run Haskbot on port 3000 with the included +-- "Help" plugin installed, where @\"my_secret_token\"@ is the secret token +-- of a Slack slash command integration corresponding to the @/haskbot@ +-- command and pointing to the Haskbot server. +-- +-- Be sure to create a Slack incoming integration (usually named /Haskbot/) +-- with the local @HASKBOT_ENDPOINT@ environment variable set to the +-- integration's endpoint URL (including the secret key query string), so that +-- Slack can process replies from Haskbot. +module Network.Haskbot +( +-- * Run a Haskbot server + Haskbot, haskbot +) where + +import Network.Haskbot.Internal.Environment (Haskbot) +import Network.Haskbot.Internal.Server (webServer) +import Network.Haskbot.Internal.Plugin (Plugin) + +-- | Run a Haskbot server with the listed plugins on the specified port. +haskbot :: [Plugin] -- ^ List of all Haskbot plugins to include + -> Int -- ^ Port on which to run Haskbot server + -> IO () +haskbot = webServer diff --git a/src/Network/Haskbot/Incoming.hs b/src/Network/Haskbot/Incoming.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Incoming.hs @@ -0,0 +1,22 @@ +-- | Module : Network.Haskbot.Incoming +-- Description : Wrapper for the Slack API /incoming/ integration +-- Copyright : (c) Jonathan Childress 2014 +-- License : MIT +-- Maintainer : jon@childr.es +-- Stability : experimental +-- Portability : POSIX +-- +-- This provides a simple representation of the request data for a Slack +-- /incoming/ integration- the means via which Haskbot replies to Slack. +-- Currently only simple text replies are supported, but this will be expanded +-- to support fully-slack-formatted messages in the future. +module Network.Haskbot.Incoming +( Incoming (..) +) where + +import Data.Text (Text) +import Network.Haskbot.Types (Channel) + +data Incoming = Incoming { incChan :: !Channel -- ^ the channel to send the reply + , incText :: {-# UNPACK #-} !Text -- ^ the text of the reply + } deriving (Eq, Show) diff --git a/src/Network/Haskbot/Internal/Environment.hs b/src/Network/Haskbot/Internal/Environment.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Internal/Environment.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE RecordWildCards #-} + +module Network.Haskbot.Internal.Environment +( Haskbot +, ActionH +, ScottyH +, Environment (..) +, getAppEnv +, getSlackEndpoint +) where + +import Control.Concurrent.STM.TVar (TVar, newTVarIO) +import Control.Monad.Reader (ReaderT) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Lazy as TL +import qualified Network.Connection as N +import qualified Network.HTTP.Conduit as N +import System.Environment (getEnv) +import Web.Scotty.Trans (ActionT, ScottyT) + +type Haskbot = ReaderT Environment IO +type ScottyH = ScottyT TL.Text Haskbot +type ActionH = ActionT TL.Text Haskbot + +data Environment = Environment { networkConn :: N.Manager + , incQueue :: TVar [BL.ByteString] + } + +-- constants + +tokenVar :: String +tokenVar = "HASKBOT_ENDPOINT" + +-- public functions + +getSlackEndpoint :: IO String +getSlackEndpoint = getEnv tokenVar + +getAppEnv :: IO Environment +getAppEnv = do + networkConn <- getNetworkInfo >>= N.newManager + incQueue <- newTVarIO [] + return $ Environment {..} + +-- private functions + +getNetworkInfo :: IO N.ManagerSettings +getNetworkInfo = return $ N.mkManagerSettings tlsInfo Nothing + where tlsInfo = N.TLSSettingsSimple False False False diff --git a/src/Network/Haskbot/Internal/Incoming.hs b/src/Network/Haskbot/Internal/Incoming.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Internal/Incoming.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.Haskbot.Internal.Incoming +( Incoming (..) +, addToSendQueue +, sendFromQueue +) where + +import Control.Concurrent (threadDelay) +import Control.Concurrent.STM (atomically) +import Control.Concurrent.STM.TVar (modifyTVar', readTVar) +import Control.Monad (forever) +import Control.Monad.Reader (ask, liftIO) +import Data.Aeson (ToJSON, (.=), encode, object, toJSON) +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy as BL +import Data.Text (Text) +import Network.HTTP.Conduit -- basically everything +import Network.HTTP.Types (Header, methodPost, status200) +import Network.Haskbot.Incoming +import Network.Haskbot.Internal.Environment (Haskbot, getSlackEndpoint, incQueue, + networkConn) +import Network.Haskbot.Types (getAddress) + +instance ToJSON Incoming where + toJSON inc = object [ "channel" .= getAddress (incChan inc) + , "text" .= incText inc + ] + +-- constants + +jsonContentType :: Header +jsonContentType = ("Content-Type", "application/json") + +timeBetweenSends :: Int +timeBetweenSends = 1000000 -- Slack rate limit + +-- public functions + +addToSendQueue :: Incoming -> Haskbot () +addToSendQueue inc = enqueueMsg . encode $ toJSON inc + +sendFromQueue :: Haskbot () +sendFromQueue = forever $ dequeueMsg >>= sendMsg >> wait + +-- private functions + +incRequest :: Haskbot Request +incRequest = do + endpoint <- liftIO getSlackEndpoint + initRequest <- parseUrl endpoint + return $ initRequest + { method = methodPost + , rawBody = True + , requestHeaders = [jsonContentType] + } + +handleResp :: BL.ByteString -> Response a -> Haskbot () +handleResp msg resp + | responseStatus resp == status200 = return () + | otherwise = enqueueMsg msg -- should also log failure + +sendMsg :: Maybe BL.ByteString -> Haskbot () +sendMsg (Just msg) = do + env <- ask + template <- incRequest + let newRequest = template { requestBody = RequestBodyLBS msg } + httpLbs newRequest (networkConn env) >>= handleResp msg +sendMsg _ = return () + +wait :: Haskbot () +wait = liftIO $ threadDelay timeBetweenSends + +enqueueMsg :: BL.ByteString -> Haskbot () +enqueueMsg msg = do + env <- ask + liftIO . atomically $ modifyTVar' (incQueue env) (\q -> q ++ [msg]) + +dequeueMsg :: Haskbot (Maybe BL.ByteString) +dequeueMsg = do + env <- ask + liftIO . atomically $ do + msgs <- readTVar $ incQueue env + case msgs of + (m:ms) -> do + modifyTVar' (incQueue env) (\q -> tail q) + return $ Just m + _ -> return Nothing diff --git a/src/Network/Haskbot/Internal/Plugin.hs b/src/Network/Haskbot/Internal/Plugin.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Internal/Plugin.hs @@ -0,0 +1,23 @@ +module Network.Haskbot.Internal.Plugin +( Plugin (..) +, isAuthorized +, runPlugin +, selectFrom +) where + +import Data.List (find) +import Data.Text (Text) +import Network.Haskbot.Internal.Environment (Haskbot) +import Network.Haskbot.Internal.Incoming (Incoming (Incoming), addToSendQueue) +import Network.Haskbot.Plugin (Plugin (..)) +import Network.Haskbot.SlashCommand (SlashCom, token) +import Network.Haskbot.Types + +runPlugin :: Plugin -> SlashCom -> Haskbot () +runPlugin p slashCom = plHandler p slashCom >>= maybe (return ()) addToSendQueue + +isAuthorized :: Plugin -> SlashCom -> Bool +isAuthorized plugin slashCom = plToken plugin == token slashCom + +selectFrom :: [Plugin] -> Command -> Maybe Plugin +selectFrom list com = find (\p -> plCommand p == com) list diff --git a/src/Network/Haskbot/Internal/Server.hs b/src/Network/Haskbot/Internal/Server.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Internal/Server.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.Haskbot.Internal.Server (webServer) where + +import Control.Concurrent (forkIO) +import Control.Monad.Reader (lift, liftIO, runReaderT) +import qualified Data.Text.Lazy as TL +import Data.Time.Clock.POSIX (getPOSIXTime) +import Network.Haskbot.Internal.Environment (ActionH, ScottyH, getAppEnv) +import Network.Haskbot.Internal.Incoming (sendFromQueue) +import Network.Haskbot.Internal.Plugin (Plugin, isAuthorized, runPlugin, selectFrom) +import Network.Haskbot.Internal.SlashCommand (SlashCom, command, fromParams) +import Network.HTTP.Types.Status (badRequest400, unauthorized401) +import Web.Scotty.Trans (get, post, scottyT, status, text) + +-- public functions + +webServer :: [Plugin] -> Int -> IO () +webServer plugins port = do + env <- getAppEnv + let haskbot r = runReaderT r env + forkIO $ haskbot sendFromQueue + scottyT port haskbot haskbot $ routes plugins + +-- private functions + +findAndRun :: [Plugin] -> SlashCom -> ActionH () +findAndRun plugins slashCom = + case selectFrom plugins (command slashCom) of + Just p -> + if isAuthorized p slashCom + then lift (runPlugin p slashCom) >> text "200 OK" + else status unauthorized401 >> text "401 Unauthorized" + _ -> status badRequest400 >> text "400 Bad Request" + +routes :: [Plugin] -> ScottyH () +routes plugins = do + post "/slack" $ fromParams >>= findAndRun plugins + get "/ping" $ timestamp + +timestamp :: ActionH () +timestamp = do + now <- liftIO getPOSIXTime + let stamp = show . truncate $ now * 1000000 + text $ TL.pack stamp diff --git a/src/Network/Haskbot/Internal/SlashCommand.hs b/src/Network/Haskbot/Internal/SlashCommand.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Internal/SlashCommand.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.Haskbot.Internal.SlashCommand +( SlashCom (..) +, fromParams +) where + +import Control.Applicative ((<$>), (<*>)) +import Data.Text (Text) +import Network.Haskbot.Internal.Environment (ActionH) +import Network.Haskbot.SlashCommand (SlashCom (..)) +import Network.Haskbot.Types +import Web.Scotty.Trans (param) + +-- public functions + +fromParams :: ActionH SlashCom +fromParams = newSlashCom <$> param "token" + <*> param "team_id" + <*> param "channel_id" + <*> param "channel_name" + <*> param "user_id" + <*> param "user_name" + <*> param "command" + <*> param "text" + +-- private functions + +newSlashCom :: Text -> Text -> Text -> Text + -> Text -> Text -> Text -> Text + -> SlashCom +newSlashCom a b c d e f g = + SlashCom (setToken a) + (setTeamID b) + (setChanID c) + (setChanName d) + (setUserID e) + (setUserName f) + (setCommand g) diff --git a/src/Network/Haskbot/Plugin.hs b/src/Network/Haskbot/Plugin.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Plugin.hs @@ -0,0 +1,100 @@ +-- | Module : Network.Haskbot.Plugin +-- Description : Everything needed to create a Haskbot plugin +-- Copyright : (c) Jonathan Childress 2014 +-- License : MIT +-- Maintainer : jon@childr.es +-- Stability : experimental +-- Portability : POSIX +-- +-- Haskbot plugins are functions returning a "Plugin" data type. The "Plugin" +-- type is not exported directly; you should create new plugins via +-- 'newPlugin'. +-- +-- The recommended process for exporting plugins is to create a new module +-- that exports a single function currying the first three arguments to +-- 'newPlugin'. The remaining argument, the Slack secret token of the +-- corresponding Slack /slash command/ service integration, can be supplied +-- in a separate file exporting the list of installed commands for "Haskbot". +-- This enables you to recreate a registry of installed tokens and +-- corresponding secret tokens in a separate file outside of version control. +-- +-- A basic /Hello World/ plugin can created via: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > module MyPlugins.HelloWorld (register) where +-- > +-- > import Network.Haskbot.Plugin +-- > +-- > name :: NameStr +-- > name = "hello_world" +-- > +-- > helpText :: HelpStr +-- > helpText = "Have Haskbot say _Hello, World!_ in your current channel." +-- > +-- > handler :: HandlerFn +-- > handler slashCom = return $ replySameChan slashCom "Hello, World!" +-- > +-- > register :: TokenStr -> Plugin +-- > register = newPlugin name helpText handler +-- +-- To run the plugin, create a new Slack /slash command/ integration +-- corresponding to the command @\/hello_world@ that points to your Haskbot +-- server. Add the plugin's @register@ function to your Haskbot server's +-- plugin registry like detailed in "Slack.Haskbot", giving it the Slack +-- integration's secret token as the remaining argument. Rebuild and run the +-- server. Typing @\/hello_word@ into any Slack channel should return a +-- Haskbot response of /Hellow, world!/ +module Network.Haskbot.Plugin +( +-- * Plugins + Plugin +-- ** PLugin components +, plCommand, plHelpText, plHandler, plToken +-- ** Type aliases +, NameStr, HelpStr, HandlerFn, TokenStr +-- ** Creating a new Plugin +, newPlugin +-- * Slack replies +, replySameChan, replyAsDM +) where + +import Data.Text (Text) +import Network.Haskbot.Internal.Environment (Haskbot) +import Network.Haskbot.Internal.Incoming (Incoming (Incoming), addToSendQueue) +import Network.Haskbot.Internal.SlashCommand (SlashCom (..)) +import Network.Haskbot.Types + +data Plugin = Plugin { plCommand :: {-# UNPACK #-} !Command + , plHelpText :: {-# UNPACK #-} !Text + , plHandler :: !HandlerFn + , plToken :: {-# UNPACK #-} !Token + } + +type NameStr = Text +type HelpStr = Text +type HandlerFn = SlashCom -> Haskbot (Maybe Incoming) +type TokenStr = Text + +-- | Create a new 'Plugin' from the components +newPlugin :: NameStr -- ^ The text name of the plugin command + -> HelpStr -- ^ Help text displayed in conjunction with the + -- "Slack.Haskbot.Plugin.Help" plugin + -> HandlerFn -- ^ A function that takes a "Slack.Haskbot.SlashCommand" + -- and potentially returns a 'Incoming' + -> TokenStr -- ^ The secret token of the Slack /slash command/ + -- integration associated with this plugin + -> Plugin +newPlugin com help handler token = + Plugin (setCommand com) help handler (setToken token) + +-- | Send a Slack reply to the same channel as where the corresponding /slash +-- command/ was invoked, formatted according to +-- +replySameChan :: SlashCom -> Text -> Maybe Incoming +replySameChan sc = Just . Incoming (Channel $ channelName sc) + +-- | Send a Slack reply as a DM to the user who invoked the /slash command/, +-- formatted according to +replyAsDM :: SlashCom -> Text -> Maybe Incoming +replyAsDM sc = Just . Incoming (DirectMsg $ userName sc) diff --git a/src/Network/Haskbot/Plugin/Help.hs b/src/Network/Haskbot/Plugin/Help.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Plugin/Help.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.Haskbot.Plugin.Help (register) where + +import Data.List (find) +import qualified Data.Text as T +import Network.Haskbot.Internal.Plugin (selectFrom) +import Network.Haskbot.Plugin +import Network.Haskbot.SlashCommand (text) +import Network.Haskbot.Types (getCommand, setCommand) + +-- constants + +name :: NameStr +name = "haskbot" + +helpText :: HelpStr +helpText = + "List all installed Plugins via `/haskbot`. To see the help text of a\ + \ particular Plugin, use `/haskbot [Plugin name]`." + +-- public functions + +register :: [Plugin] -> TokenStr -> Plugin +register = newPlugin name helpText . handler + +-- private functions + +getHelp :: [Plugin] -> [T.Text] -> T.Text +getHelp plugins [] = listAllText plugins +getHelp plugins (comName:_) = + maybe (listAllText plugins) plHelpText + (selectFrom plugins $ setCommand comName) + +handler :: [Plugin] -> HandlerFn +handler plugins slashCom = return $ replyAsDM slashCom reply + where reply = getHelp plugins . T.words $ text slashCom + +listAllText :: [Plugin] -> T.Text +listAllText plugins = + T.concat [ "Available commands: " + , T.intercalate ", " (map name plugins) + , ". To get help for a specific command, use `/haskbot [command]`." + ] + where name p = T.concat ["`/", getCommand (plCommand p), "`"] diff --git a/src/Network/Haskbot/SlashCommand.hs b/src/Network/Haskbot/SlashCommand.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/SlashCommand.hs @@ -0,0 +1,34 @@ +-- | Module : Network.Haskbot.SlashCommand +-- Description : Wrapper for the Slack API /slash command/ integration +-- Copyright : (c) Jonathan Childress 2014 +-- License : MIT +-- Maintainer : jon@childr.es +-- Stability : experimental +-- Portability : POSIX +-- +-- This provides a representation of the request data from a Slack /slash +-- command/ integration. A "Plugin" handler function is given +-- direct access to this data type when a /slash command/ is invoked via +-- Slack. +module Network.Haskbot.SlashCommand +( + -- * The SlashCom type + SlashCom (..) +) where + +import Data.Text +import Network.Haskbot.Types + +-- | Encapsulates all data provided by a request from a Slack /slash command/ +-- integration +data SlashCom + = SlashCom + { token :: {-# UNPACK #-} !Token -- ^ the secret token corresponding to the /slash command/ integration token + , teamID :: {-# UNPACK #-} !TeamID -- ^ the team ID of the invoker + , channelID :: {-# UNPACK #-} !ChannelID -- ^ the channel ID where the command was invoked + , channelName :: {-# UNPACK #-} !ChannelName -- ^ the channel name where the command was invoked + , userID :: {-# UNPACK #-} !UserID -- ^ the user ID of the invoker + , userName :: {-# UNPACK #-} !UserName -- ^ the username of the invoker + , command :: {-# UNPACK #-} !Command -- ^ the name of the command invoked + , text :: {-# UNPACK #-} !Text -- ^ any text following the invoked slash command + } deriving (Eq, Show) diff --git a/src/Network/Haskbot/Types.hs b/src/Network/Haskbot/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskbot/Types.hs @@ -0,0 +1,126 @@ +-- | Module : Network.Haskbot.Types +-- Description : Wrappers for Slack API data types +-- Copyright : (c) Jonathan Childress 2014 +-- License : MIT +-- Maintainer : jon@childr.es +-- Stability : experimental +-- Portability : POSIX +-- +-- This provides wrappers for the various types of data supplied by the Slack +-- API, so that any processing of the API data remains type-safe. No +-- constructors are directly exported to allow for flexibility with the +-- currently-beta Slack API. +module Network.Haskbot.Types +( +-- * Slack types +-- ** Token + Token, getToken, setToken +-- ** Team ID +, TeamID, getTeamID, setTeamID +-- ** Channel ID +, ChannelID, getChanID, setChanID +-- ** Channel name +, ChannelName, getChanName, getPoundChan, setChanName +-- ** User ID +, UserID, getUserID, setUserID +-- ** User name +, UserName, getUserName, getAtUserName, setUserName +-- ** Command +, Command, getCommand, getSlashCom, setCommand +-- * Native types +-- ** Channel +, Channel (..), getAddress +) where + +import qualified Data.Text as T + +prefixChan, prefixCom, prefixUser :: Char +prefixChan = '#' +prefixCom = '/' +prefixUser = '@' + +newtype Token + = Token { getToken :: T.Text -- ^ get the text of a token + } deriving (Eq, Show) + +-- | make a token of the given text +setToken :: T.Text -> Token +setToken = Token + +newtype TeamID + = TeamID { getTeamID :: T.Text -- ^ get the text value of a team ID + } deriving (Eq, Show) + +-- | make a team ID of the given text value +setTeamID :: T.Text -> TeamID +setTeamID = TeamID + +newtype ChannelID + = ChannelID { getChanID :: T.Text -- ^ get the text value of a channel ID + } deriving (Eq, Show) + +-- | make a channel ID of the given text value +setChanID :: T.Text -> ChannelID +setChanID = ChannelID + +newtype ChannelName + = ChannelName { getChanName :: T.Text -- ^ get the text value of a channel name + } deriving (Eq, Show) + +-- | get the text value of a channel name, prefixed with a @#@ +getPoundChan :: ChannelName -> T.Text +getPoundChan = T.append (T.singleton prefixChan) . getChanName + +-- | make a channel name of the given text value +setChanName :: T.Text -> ChannelName +setChanName = prefixedBy prefixChan ChannelName + +newtype UserID + = UserID { getUserID :: T.Text -- ^ get the text value of a user ID + } deriving (Eq, Show) + +-- | make a user ID of the given text value +setUserID :: T.Text -> UserID +setUserID = UserID + +newtype UserName + = UserName { getUserName :: T.Text -- ^ get the text value of a username + } deriving (Eq, Show) + +-- | get the text value of a username prefixed with a @\@@ +getAtUserName :: UserName -> T.Text +getAtUserName = T.append (T.singleton prefixUser) . getUserName + +-- | make a username of given text value +setUserName :: T.Text -> UserName +setUserName = prefixedBy prefixUser UserName + +newtype Command + = Command { getCommand :: T.Text -- ^ get the text name of a command + } deriving (Eq, Show) + +-- | get the text name of a command prefixed with a @\/@ +getSlashCom :: Command -> T.Text +getSlashCom = T.append (T.singleton prefixCom) . getCommand + +-- | make a command with the given name +setCommand :: T.Text -> Command +setCommand = prefixedBy prefixCom Command + +-- | Slack channels are either regular channels or direct messages to users +data Channel = DirectMsg {-# UNPACK #-} !UserName + | Channel {-# UNPACK #-} !ChannelName + deriving (Eq, Show) + +-- | Get the text representation of a channel, with the appropriate prefix +-- required by Slack +getAddress :: Channel -> T.Text +getAddress (DirectMsg un) = getAtUserName un +getAddress (Channel ch) = getPoundChan ch + +-- private functions + +prefixedBy :: Char -> (T.Text -> a) -> T.Text -> a +prefixedBy pre f text + | T.head text == pre = f $ T.tail text + | otherwise = f text diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}