haskbot-core 0.0.1.1 → 0.1
raw patch · 15 files changed
+389/−298 lines, 15 filesdep +containersdep +waidep +warpdep −scottydep −timePVP ok
version bump matches the API change (PVP)
Dependencies added: containers, wai, warp
Dependencies removed: scotty, time
API changes (from Hackage documentation)
- Network.Haskbot: type Haskbot = ReaderT Environment IO
- Network.Haskbot.Internal.Environment: getAppEnv :: IO Environment
- Network.Haskbot.Internal.Environment: getSlackEndpoint :: IO String
- Network.Haskbot.Internal.Environment: networkConn :: Environment -> Manager
- Network.Haskbot.Internal.Environment: type ActionH = ActionT Text Haskbot
- Network.Haskbot.Internal.Environment: type Haskbot = ReaderT Environment IO
- Network.Haskbot.Internal.Environment: type ScottyH = ScottyT Text Haskbot
- Network.Haskbot.Internal.Incoming: Incoming :: !Channel -> {-# UNPACK #-} !Text -> Incoming
- Network.Haskbot.Internal.Incoming: addToSendQueue :: Incoming -> Haskbot ()
- Network.Haskbot.Internal.Incoming: data Incoming
- Network.Haskbot.Internal.Incoming: incChan :: Incoming -> !Channel
- Network.Haskbot.Internal.Incoming: incText :: Incoming -> {-# UNPACK #-} !Text
- Network.Haskbot.Internal.Incoming: instance ToJSON Incoming
- Network.Haskbot.Internal.Incoming: sendFromQueue :: Haskbot ()
- Network.Haskbot.Internal.Plugin: Plugin :: {-# UNPACK #-} !Command -> {-# UNPACK #-} !Text -> !HandlerFn -> {-# UNPACK #-} !Token -> Plugin
- Network.Haskbot.Internal.Plugin: data Plugin
- Network.Haskbot.Internal.Plugin: isAuthorized :: Plugin -> SlashCom -> Bool
- Network.Haskbot.Internal.Plugin: plCommand :: Plugin -> {-# UNPACK #-} !Command
- Network.Haskbot.Internal.Plugin: plHandler :: Plugin -> !HandlerFn
- Network.Haskbot.Internal.Plugin: plHelpText :: Plugin -> {-# UNPACK #-} !Text
- Network.Haskbot.Internal.Plugin: plToken :: Plugin -> {-# UNPACK #-} !Token
- Network.Haskbot.Internal.Plugin: runPlugin :: Plugin -> SlashCom -> Haskbot ()
- Network.Haskbot.Internal.Plugin: selectFrom :: [Plugin] -> Command -> Maybe Plugin
- Network.Haskbot.Internal.SlashCommand: SlashCom :: {-# UNPACK #-} !Token -> {-# UNPACK #-} !TeamID -> {-# UNPACK #-} !ChannelID -> {-# UNPACK #-} !ChannelName -> {-# UNPACK #-} !UserID -> {-# UNPACK #-} !UserName -> {-# UNPACK #-} !Command -> {-# UNPACK #-} !Text -> SlashCom
- Network.Haskbot.Internal.SlashCommand: channelID :: SlashCom -> {-# UNPACK #-} !ChannelID
- Network.Haskbot.Internal.SlashCommand: channelName :: SlashCom -> {-# UNPACK #-} !ChannelName
- Network.Haskbot.Internal.SlashCommand: command :: SlashCom -> {-# UNPACK #-} !Command
- Network.Haskbot.Internal.SlashCommand: data SlashCom
- Network.Haskbot.Internal.SlashCommand: fromParams :: ActionH SlashCom
- Network.Haskbot.Internal.SlashCommand: teamID :: SlashCom -> {-# UNPACK #-} !TeamID
- Network.Haskbot.Internal.SlashCommand: text :: SlashCom -> {-# UNPACK #-} !Text
- Network.Haskbot.Internal.SlashCommand: token :: SlashCom -> {-# UNPACK #-} !Token
- Network.Haskbot.Internal.SlashCommand: userID :: SlashCom -> {-# UNPACK #-} !UserID
- Network.Haskbot.Internal.SlashCommand: userName :: SlashCom -> {-# UNPACK #-} !UserName
- Network.Haskbot.Plugin: newPlugin :: NameStr -> HelpStr -> HandlerFn -> TokenStr -> Plugin
- Network.Haskbot.Plugin: type HelpStr = Text
- Network.Haskbot.Plugin: type NameStr = Text
- Network.Haskbot.Plugin: type TokenStr = Text
- Network.Haskbot.SlashCommand: text :: SlashCom -> {-# UNPACK #-} !Text
+ Network.Haskbot.Config: Config :: Int -> String -> String -> Config
+ Network.Haskbot.Config: data Config
+ Network.Haskbot.Config: incEndpoint :: Config -> String
+ Network.Haskbot.Config: incToken :: Config -> String
+ Network.Haskbot.Config: incUrl :: Config -> String
+ Network.Haskbot.Config: listenOn :: Config -> Int
+ Network.Haskbot.Incoming: addToSendQueue :: MonadIO m => Incoming -> EnvironT m ()
+ Network.Haskbot.Incoming: instance ToJSON Incoming
+ Network.Haskbot.Incoming: sendFromQueue :: MonadIO m => EnvironT m ()
+ Network.Haskbot.Internal.Environment: bootstrap :: Config -> IO Environment
+ Network.Haskbot.Internal.Environment: config :: Environment -> Config
+ Network.Haskbot.Internal.Environment: instance Error Status
+ Network.Haskbot.Internal.Environment: netConn :: Environment -> Manager
+ Network.Haskbot.Internal.Environment: type EnvironT m = ReaderT Environment m
+ Network.Haskbot.Internal.Environment: type HaskbotM = EnvironT (ErrorT Status IO)
+ Network.Haskbot.Internal.Request: getParamsMap :: Request -> IO Params
+ Network.Haskbot.Internal.Request: getPostParams :: Request -> HaskbotM Params
+ Network.Haskbot.Internal.Request: headOnly :: Status -> Response
+ Network.Haskbot.Internal.Request: jsonContentType :: Header
+ Network.Haskbot.Internal.Request: optParam :: Params -> Text -> HaskbotM (Maybe Text)
+ Network.Haskbot.Internal.Request: reqParam :: Params -> Text -> HaskbotM Text
+ Network.Haskbot.Internal.Request: textContentType :: Header
+ Network.Haskbot.Internal.Request: type Params = Map Text Text
+ Network.Haskbot.Plugin: isAuthorized :: Plugin -> SlashCom -> Bool
+ Network.Haskbot.Plugin: runPlugin :: Plugin -> SlashCom -> HaskbotM ()
+ Network.Haskbot.Plugin: selectFrom :: [Plugin] -> Command -> Maybe Plugin
+ Network.Haskbot.SlashCommand: fromParams :: Params -> HaskbotM SlashCom
+ Network.Haskbot.SlashCommand: optText :: SlashCom -> Maybe Text
- Network.Haskbot: haskbot :: [Plugin] -> Int -> IO ()
+ Network.Haskbot: haskbot :: Config -> [Plugin] -> IO ()
- Network.Haskbot.Internal.Environment: Environment :: Manager -> TVar [ByteString] -> Environment
+ Network.Haskbot.Internal.Environment: Environment :: TVar [ByteString] -> Manager -> Config -> Environment
- Network.Haskbot.Internal.Server: webServer :: [Plugin] -> Int -> IO ()
+ Network.Haskbot.Internal.Server: webServer :: Config -> [Plugin] -> IO ()
- Network.Haskbot.Plugin: type HandlerFn = SlashCom -> Haskbot (Maybe Incoming)
+ Network.Haskbot.Plugin: type HandlerFn = SlashCom -> HaskbotM (Maybe Incoming)
- Network.Haskbot.Plugin.Help: register :: [Plugin] -> TokenStr -> Plugin
+ Network.Haskbot.Plugin.Help: register :: [Plugin] -> Text -> Plugin
- Network.Haskbot.SlashCommand: SlashCom :: {-# UNPACK #-} !Token -> {-# UNPACK #-} !TeamID -> {-# UNPACK #-} !ChannelID -> {-# UNPACK #-} !ChannelName -> {-# UNPACK #-} !UserID -> {-# UNPACK #-} !UserName -> {-# UNPACK #-} !Command -> {-# UNPACK #-} !Text -> SlashCom
+ Network.Haskbot.SlashCommand: SlashCom :: {-# UNPACK #-} !Token -> {-# UNPACK #-} !TeamID -> {-# UNPACK #-} !ChannelID -> {-# UNPACK #-} !ChannelName -> {-# UNPACK #-} !UserID -> {-# UNPACK #-} !UserName -> {-# UNPACK #-} !Command -> Maybe Text -> SlashCom
Files
- README.md +7/−5
- haskbot-core.cabal +10/−9
- src/Network/Haskbot.hs +18/−12
- src/Network/Haskbot/Config.hs +23/−0
- src/Network/Haskbot/Incoming.hs +99/−7
- src/Network/Haskbot/Internal/Environment.hs +24/−27
- src/Network/Haskbot/Internal/Incoming.hs +0/−88
- src/Network/Haskbot/Internal/Plugin.hs +0/−23
- src/Network/Haskbot/Internal/Request.hs +59/−0
- src/Network/Haskbot/Internal/Server.hs +46/−34
- src/Network/Haskbot/Internal/SlashCommand.hs +0/−39
- src/Network/Haskbot/Plugin.hs +46/−39
- src/Network/Haskbot/Plugin/Help.hs +12/−12
- src/Network/Haskbot/SlashCommand.hs +41/−3
- src/Network/Haskbot/Types.hs +4/−0
README.md view
@@ -1,6 +1,6 @@ # Haskbot -### A easily-extensible, Haskell-based Slack chatbot+### An easily-extensible, Haskell-based Slack chatbot The purpose of this little bot is to provide: @@ -9,7 +9,8 @@ - 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.+creating Haskbot plugins. Further documentation can be found on+[Hackage](http://hackage.haskell.org/package/haskbot-core). ### New to Haskell? @@ -34,7 +35,7 @@ sudo apt-get update sudo apt-get install haskell-platform ```- - On OSX+ - On OSX (via [Homebrew](http://brew.sh/)) ```sh brew update@@ -60,10 +61,11 @@ cabal install haskbot-core ``` -### Create Plugins+### Creating 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.+on to [Hackage](http://hackage.haskell.org/package/haskbot-core) for a full+Haskbot API description and examples. ### Thanks
haskbot-core.cabal view
@@ -1,5 +1,5 @@ name: haskbot-core-version: 0.0.1.1+version: 0.1 maintainer: Jonathan Childress <jon@childr.es> homepage: https://github.com/jonplussed/haskbot-core @@ -17,7 +17,7 @@ write nice, clean Haskell than clunky Javascript any day of the week. stability: volatile-category: web+category: Network build-type: Simple extra-source-files: README.md cabal-version: >= 1.10@@ -29,12 +29,11 @@ library hs-source-dirs: src exposed-modules: Network.Haskbot+ Network.Haskbot.Config Network.Haskbot.Incoming Network.Haskbot.Internal.Environment- Network.Haskbot.Internal.Incoming- Network.Haskbot.Internal.Plugin+ Network.Haskbot.Internal.Request Network.Haskbot.Internal.Server- Network.Haskbot.Internal.SlashCommand Network.Haskbot.Plugin Network.Haskbot.Plugin.Help Network.Haskbot.SlashCommand@@ -46,13 +45,14 @@ base == 4.6.*, bytestring == 0.10.*, connection == 0.2.*,+ containers == 0.5.*, http-conduit == 2.1.*, http-types == 0.8.*, monads-tf == 0.1.*,- scotty == 0.8.*, stm == 2.4.*, text == 0.11.*,- time == 1.4.*+ wai == 3.0.*,+ warp == 3.0.* test-suite spec hs-source-dirs: src, test@@ -65,11 +65,12 @@ base == 4.6.*, bytestring == 0.10.*, connection == 0.2.*,+ containers == 0.5.*, 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.*+ wai == 3.0.*,+ warp == 3.0.*
src/Network/Haskbot.hs view
@@ -3,36 +3,42 @@ -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Network.Haskbot+-- > import Network.Haskbot.Config -- > import Network.Haskbot.Plugin -- > import qualified Network.Haskbot.Plugin.Help as Help -- > -- > main :: IO ()--- > main = haskbot registry 3000+-- > main = haskbot config registry -- >+-- > config :: Config+-- > config = Config { listenOn = 3000+-- > , incEndpoint = "https://my-company.slack.com/services/hooks/incoming-webhook"+-- > , incToken = "my-incoming-token"+-- > }+-- > -- > registry :: [Plugin]--- > registry = [ Help.register registry "my_secret_token" ]+-- > registry = [ Help.register registry "my-slash-token" ] -- -- This will run Haskbot on port 3000 with the included--- "Network.Haskbot.Plugin.Help" plugin installed, where @\"my_secret_token\"@+-- "Network.Haskbot.Plugin.Help" plugin installed, where @\"my-slash-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.+-- and set the 'incEndpoint' and 'incToken' to their corresponding values, so+-- that Slack can receive replies from Haskbot. module Network.Haskbot ( -- * Run a Haskbot server- Haskbot, haskbot+ haskbot ) where -import Network.Haskbot.Internal.Environment (Haskbot) import Network.Haskbot.Internal.Server (webServer)-import Network.Haskbot.Internal.Plugin (Plugin)+import Network.Haskbot.Config (Config)+import Network.Haskbot.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+-- | Run the listed plugins on a Haskbot server with the given config+haskbot :: Config -- ^ Your custom-created config+ -> [Plugin] -- ^ List of all Haskbot plugins to include -> IO () haskbot = webServer
+ src/Network/Haskbot/Config.hs view
@@ -0,0 +1,23 @@+-- | The configuration type required to bootstrap "Slack.Haskbot"+module Network.Haskbot.Config+(+-- * The Config type+ Config (..)+-- internal use only+, incUrl+) where++data Config =+ Config { listenOn :: Int+ -- ^ the port on which Haskbot listens+ , incEndpoint :: String+ -- ^ the Slack endpoint of your /incoming/ integration, usually in the+ -- form of @https://[your company name].slack.com/services/hooks/incoming-webhook@+ , incToken :: String+ -- ^ the secret token of your /incoming/ integration+ }++-- internal functions++incUrl :: Config -> String+incUrl conf = incEndpoint conf ++ "?token=" ++ incToken conf
src/Network/Haskbot/Incoming.hs view
@@ -1,14 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | 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.+-- 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 (..)+(+-- * The Incoming type+ Incoming (..)+-- internal use only+, 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 (MonadIO, asks, liftIO)+import Data.Aeson (ToJSON, (.=), encode, object, toJSON)+import Data.ByteString.Lazy (ByteString) import Data.Text (Text)-import Network.Haskbot.Types (Channel)+import Network.Haskbot.Config (incUrl)+import Network.Haskbot.Internal.Environment+ (EnvironT, config, incQueue, netConn)+import Network.Haskbot.Internal.Request (jsonContentType)+import Network.Haskbot.Types (Channel, getAddress)+import Network.HTTP.Conduit -- basically everything+import Network.HTTP.Types (methodPost, status200) -data Incoming = Incoming { incChan :: !Channel -- ^ the channel to send the reply- , incText :: {-# UNPACK #-} !Text -- ^ the text of the reply- } deriving (Eq, Show)+data Incoming =+ Incoming { incChan :: !Channel+ -- ^ the channel to send the reply+ , incText :: {-# UNPACK #-} !Text+ -- ^ the text of the reply+ } deriving (Eq, Show)++instance ToJSON Incoming where+ toJSON inc = object [ "channel" .= getAddress (incChan inc)+ , "text" .= incText inc+ ]++-- constants++timeBetweenSends :: Int+timeBetweenSends = 1000000 -- Slack rate limit++-- internal functions++addToSendQueue :: (MonadIO m) => Incoming -> EnvironT m ()+addToSendQueue inc = enqueueMsg . encode $ toJSON inc++sendFromQueue :: (MonadIO m) => EnvironT m ()+sendFromQueue = forever $ dequeueMsg >>= sendMsg >> wait++-- private functions++incRequest :: (MonadIO m) => EnvironT m Request+incRequest = do+ url <- asks $ incUrl . config+ initRequest <- liftIO $ parseUrl url+ return $ initRequest+ { method = methodPost+ , rawBody = True+ , requestHeaders = [jsonContentType]+ }++-- TODO:+-- 1. If the message queue extends beyond a certain count, Slack is+-- probably down and we should halt adding to the queue until it returns.+-- 2. Log any failed responses++enqueueMsg :: (MonadIO m) => ByteString -> EnvironT m ()+enqueueMsg msg = do+ queue <- asks incQueue+ liftIO . atomically $ modifyTVar' queue $ \q -> q ++ [msg]++dequeueMsg :: (MonadIO m) => EnvironT m (Maybe ByteString)+dequeueMsg = do+ queue <- asks incQueue+ liftIO . atomically $ do+ msgs <- readTVar queue+ case msgs of+ (m:ms) -> do+ modifyTVar' queue $ \q -> tail q+ return $ Just m+ _ -> return Nothing++sendMsg :: (MonadIO m) => Maybe ByteString -> EnvironT m ()+sendMsg (Just msg) = do+ conn <- asks netConn+ template <- incRequest+ let newRequest = template { requestBody = RequestBodyLBS msg }+ liftIO (httpLbs newRequest conn) >>= handleResp msg+sendMsg _ = return ()++handleResp :: (MonadIO m) => ByteString -> Response a -> EnvironT m ()+handleResp msg resp+ | allGood = return ()+ | otherwise = enqueueMsg msg+ where+ allGood = responseStatus resp == status200++wait :: (MonadIO m) => EnvironT m ()+wait = liftIO $ threadDelay timeBetweenSends
src/Network/Haskbot/Internal/Environment.hs view
@@ -1,49 +1,46 @@ {-# LANGUAGE RecordWildCards #-} module Network.Haskbot.Internal.Environment-( Haskbot-, ActionH-, ScottyH-, Environment (..)-, getAppEnv-, getSlackEndpoint+( Environment (..)+, bootstrap+, HaskbotM+, EnvironT ) where import Control.Concurrent.STM.TVar (TVar, newTVarIO)+import Control.Monad.Error (Error, ErrorT)+import Control.Monad.Error.Class (noMsg, strMsg) import Control.Monad.Reader (ReaderT)+import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL-import qualified Data.Text.Lazy as TL import qualified Network.Connection as N+import Network.Haskbot.Config (Config) 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+import Network.HTTP.Types (Status, internalServerError500, mkStatus) -data Environment = Environment { networkConn :: N.Manager- , incQueue :: TVar [BL.ByteString]+data Environment = Environment { incQueue :: TVar [BL.ByteString]+ , netConn :: N.Manager+ , config :: Config } --- constants--tokenVar :: String-tokenVar = "HASKBOT_ENDPOINT"+type EnvironT m = ReaderT Environment m+type HaskbotM = EnvironT (ErrorT Status IO) --- public functions+instance Error Status where+ noMsg = internalServerError500+ strMsg = mkStatus 500 . B8.pack -getSlackEndpoint :: IO String-getSlackEndpoint = getEnv tokenVar+-- internal functions -getAppEnv :: IO Environment-getAppEnv = do- networkConn <- getNetworkInfo >>= N.newManager+bootstrap :: Config -> IO Environment+bootstrap configuration = do incQueue <- newTVarIO []+ netConn <- defNetConn >>= N.newManager+ config <- return configuration return $ Environment {..} -- private functions -getNetworkInfo :: IO N.ManagerSettings-getNetworkInfo = return $ N.mkManagerSettings tlsInfo Nothing+defNetConn :: IO N.ManagerSettings+defNetConn = return $ N.mkManagerSettings tlsInfo Nothing where tlsInfo = N.TLSSettingsSimple False False False
− src/Network/Haskbot/Internal/Incoming.hs
@@ -1,88 +0,0 @@-{-# 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
− src/Network/Haskbot/Internal/Plugin.hs
@@ -1,23 +0,0 @@-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
+ src/Network/Haskbot/Internal/Request.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Haskbot.Internal.Request+( Params+, jsonContentType+, textContentType+, getPostParams+, headOnly+, getParamsMap+, optParam+, reqParam+) where++import Control.Monad.Error (liftIO, throwError)+import Data.ByteString.Lazy (fromStrict)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import qualified Data.Map as M+import qualified Network.HTTP.Types as N+import qualified Network.Wai as W+import Network.Haskbot.Internal.Environment (HaskbotM)++type Params = M.Map Text Text++-- constants++jsonContentType :: N.Header+jsonContentType = (N.hContentType, "application/json")++textContentType :: N.Header+textContentType = (N.hContentType, "text/plain")++-- internal functions++headOnly :: N.Status -> W.Response+headOnly status = W.responseLBS status [] . fromStrict $ N.statusMessage status++getParamsMap :: W.Request -> IO Params+getParamsMap req = do+ body <- W.requestBody req+ return . M.fromList . map decode $ N.parseSimpleQuery body+ where+ decode (k,v) = (decodeUtf8 k, decodeUtf8 v)++getPostParams :: W.Request -> HaskbotM Params+getPostParams req+ | isPost = liftIO $ getParamsMap req+ | otherwise = throwError N.status403+ where+ isPost = W.requestMethod req == N.methodPost++optParam :: Params -> Text -> HaskbotM (Maybe Text)+optParam pMap key = return $ M.lookup key pMap++reqParam :: Params -> Text -> HaskbotM Text+reqParam pMap key =+ case M.lookup key pMap of+ Just p -> return p+ _ -> throwError N.badRequest400
src/Network/Haskbot/Internal/Server.hs view
@@ -1,45 +1,57 @@ {-# LANGUAGE OverloadedStrings #-} -module Network.Haskbot.Internal.Server (webServer) where+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)+import Control.Monad.Error (runErrorT, throwError)+import Control.Monad.Reader (runReaderT)+import Network.Haskbot.Config (Config, listenOn)+import Network.Haskbot.Internal.Environment+ (Environment, HaskbotM, bootstrap, config)+import Network.Haskbot.Internal.Request (getPostParams, headOnly)+import Network.Haskbot.Incoming (sendFromQueue)+import Network.Haskbot.Plugin (Plugin, isAuthorized, runPlugin, selectFrom)+import Network.Haskbot.SlashCommand (SlashCom, command, fromParams)+import Network.HTTP.Types (ok200, badRequest400, unauthorized401)+import Network.Wai (Request, Response)+import Network.Wai.Handler.Warp (run) --- public functions+-- internal 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+webServer :: Config -> [Plugin] -> IO ()+webServer config plugins = do+ env <- bootstrap config+ forkIO $ sendResponsesToSlack env+ processSlackRequests env 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"+sendResponsesToSlack :: Environment -> IO ()+sendResponsesToSlack = runReaderT sendFromQueue -routes :: [Plugin] -> ScottyH ()-routes plugins = do- post "/slack" $ fromParams >>= findAndRun plugins- get "/ping" $ timestamp+processSlackRequests :: Environment -> [Plugin] -> IO ()+processSlackRequests env plugins = run port app+ where+ port = listenOn $ config env+ app req resp = runner env plugins req >>= resp -timestamp :: ActionH ()-timestamp = do- now <- liftIO getPOSIXTime- let stamp = show . truncate $ now * 1000000- text $ TL.pack stamp+runner :: Environment -> [Plugin] -> Request -> IO Response+runner env plugins req = do+ ranOrFailed <- runErrorT $ runReaderT (pipeline plugins req) env+ case ranOrFailed of+ Right _ -> return $ headOnly ok200+ Left errorStatus -> return $ headOnly errorStatus++pipeline :: [Plugin] -> Request -> HaskbotM ()+pipeline plugins req = getPostParams req >>= fromParams >>= findAndRun plugins++findAndRun :: [Plugin] -> SlashCom -> HaskbotM ()+findAndRun plugins slashCom =+ case selectFrom plugins (command slashCom) of+ Just plugin ->+ if isAuthorized plugin slashCom+ then runPlugin plugin slashCom+ else throwError unauthorized401+ _ -> throwError badRequest400
− src/Network/Haskbot/Internal/SlashCommand.hs
@@ -1,39 +0,0 @@-{-# 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)
src/Network/Haskbot/Plugin.hs view
@@ -1,10 +1,6 @@--- | 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+-- | 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, can be+-- 'Plugin'. The remaining argument, the Slack secret token, 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.@@ -15,19 +11,21 @@ -- > -- > module MyPlugins.HelloWorld (register) where -- >+-- > import Data.Text -- > import Network.Haskbot.Plugin+-- > import Network.Haskbot.Types -- >--- > name :: NameStr--- > name = "hello_world"+-- > name :: Command+-- > name = setCommand "hello_world" -- >--- > helpText :: HelpStr+-- > helpText :: Text -- > 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+-- > register :: Text -> Plugin+-- > register = Plugin name helpText handler . setToken -- -- To run the plugin, create a new Slack /slash command/ integration -- corresponding to the command @\/hello_world@ that points to your Haskbot@@ -40,55 +38,64 @@ ( -- * The Plugin type Plugin (..)--- * Creating Plugins--- ** Helpful Type aliases-, NameStr, HelpStr, HandlerFn, TokenStr--- ** Creating a new Plugin-, newPlugin+, HandlerFn -- * Common Slack replies , replySameChan, replyAsDM+-- internal use only+, runPlugin+, isAuthorized+, selectFrom ) where +import Control.Monad.Reader (lift)+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.Internal.SlashCommand (SlashCom (..))+import Network.Haskbot.Incoming (Incoming (Incoming), addToSendQueue)+import Network.Haskbot.Internal.Environment (HaskbotM)+import Network.Haskbot.SlashCommand (SlashCom (..), token) import Network.Haskbot.Types ++-- | The type of function run by a plugin. It receives the full+-- "Network.Haskbot.SlashCommand" invoked and can optionally return a+-- "Network.Haskbot.Incoming" reply+type HandlerFn = SlashCom -> HaskbotM (Maybe Incoming)+ data Plugin = Plugin { plCommand :: {-# UNPACK #-} !Command -- ^ The command that invokes this plugin , plHelpText :: {-# UNPACK #-} !Text -- ^ Help text displayed for this plugin via- -- "Network.Haskbot.Plugin.Help"+ -- "Network.Haskbot.Plugin.Help" , plHandler :: !HandlerFn- -- ^ The function that receives a "Network.Haskbot.SlashCommand"- -- and maybe returns a "Network.Haskbot.Incoming"+ -- ^ The function run when a 'Plugin' is invoked , plToken :: {-# UNPACK #-} !Token -- ^ The secret token corresponding with this plugin's /slash command/- -- Slack integration+ -- Slack integration } -type NameStr = Text-type HelpStr = Text-type HandlerFn = SlashCom -> Haskbot (Maybe Incoming)-type TokenStr = Text--newPlugin :: NameStr -- ^ The text name of the plugin command- -> HelpStr -- ^ (see 'plHelpText')- -> HandlerFn -- ^ (see 'plHandler')- -> TokenStr -- ^ The text value of the /slash command/ secret token- -> Plugin -- ^ Creates a plugin to be run by Haskbot-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--- <https://api.slack.com/docs/formatting Slack>+-- command/ was invoked, formatted according to+-- <https://api.slack.com/docs/formatting Slack> 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 <https://api.slack.com/docs/formatting Slack>+-- formatted according to <https://api.slack.com/docs/formatting Slack> replyAsDM :: SlashCom -> Text -> Maybe Incoming replyAsDM sc = Just . Incoming (DirectMsg $ userName sc)++-- internal functions++runPlugin :: Plugin -> SlashCom -> HaskbotM ()+runPlugin p slashCom = do+ reply <- plHandler p slashCom+ case reply of+ Just r -> addToSendQueue r+ _ -> return ()++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
src/Network/Haskbot/Plugin/Help.hs view
@@ -2,39 +2,39 @@ module Network.Haskbot.Plugin.Help (register) where +import Control.Applicative ((<$>)) 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)+import Network.Haskbot.SlashCommand+import Network.Haskbot.Types -- constants -name :: NameStr-name = "haskbot"+name :: Command+name = setCommand "haskbot" -helpText :: HelpStr+helpText :: T.Text 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+register :: [Plugin] -> T.Text -> Plugin+register plugins = Plugin name helpText (handler plugins) . setToken -- private functions -getHelp :: [Plugin] -> [T.Text] -> T.Text-getHelp plugins [] = listAllText plugins-getHelp plugins (comName:_) =+getHelp :: [Plugin] -> Maybe [T.Text] -> T.Text+getHelp plugins (Just [comName]) = maybe (listAllText plugins) plHelpText (selectFrom plugins $ setCommand comName)+getHelp plugins _ = listAllText plugins handler :: [Plugin] -> HandlerFn handler plugins slashCom = return $ replyAsDM slashCom reply- where reply = getHelp plugins . T.words $ text slashCom+ where reply = getHelp plugins $ T.words <$> optText slashCom listAllText :: [Plugin] -> T.Text listAllText plugins =
src/Network/Haskbot/SlashCommand.hs view
@@ -1,15 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | This provides a representation of the request data from a Slack /slash -- command/ integration. A "Network.Haskbot.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+-- * The Slash Command type SlashCom (..)+-- internal use only+, fromParams ) where -import Data.Text+import Control.Applicative ((<$>), (<*>))+import Data.Text (Text)+import Network.Haskbot.Internal.Environment (HaskbotM)+import Network.Haskbot.Internal.Request (Params, reqParam, optParam) import Network.Haskbot.Types+import Network.Wai (Request) -- | Encapsulates all data provided by a request from a Slack /slash command/ -- integration@@ -29,6 +37,36 @@ -- ^ the username of the command invoker , command :: {-# UNPACK #-} !Command -- ^ the name of the command invoked- , text :: {-# UNPACK #-} !Text+ , optText :: Maybe Text -- ^ any text following the invoked slash command } deriving (Eq, Show)++-- internal functions++fromParams :: Params -> HaskbotM SlashCom+fromParams params =+ newSlashCom <$> reqParam' "token"+ <*> reqParam' "team_id"+ <*> reqParam' "channel_id"+ <*> reqParam' "channel_name"+ <*> reqParam' "user_id"+ <*> reqParam' "user_name"+ <*> reqParam' "command"+ <*> optParam' "text"+ where+ reqParam' = reqParam params+ optParam' = optParam params++-- private functions++newSlashCom :: Text -> Text -> Text -> Text+ -> Text -> Text -> Text -> Maybe 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)
src/Network/Haskbot/Types.hs view
@@ -26,10 +26,14 @@ import qualified Data.Text as T +-- constants+ prefixChan, prefixCom, prefixUser :: Char prefixChan = '#' prefixCom = '/' prefixUser = '@'++-- public functions newtype Token = Token { getToken :: T.Text -- ^ get the text of a token