packages feed

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 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