slack-api 0.2 → 0.2.1
raw patch · 6 files changed
+59/−13 lines, 6 files
Files
- slack-api.cabal +6/−1
- src/Web/Slack.hs +15/−9
- src/Web/Slack/Config.hs +7/−2
- src/Web/Slack/Message.hs +27/−1
- src/Web/Slack/State.hs +2/−0
- src/Web/Slack/Types/Event.hs +2/−0
slack-api.cabal view
@@ -1,5 +1,5 @@ Name: slack-api-Version: 0.2+Version: 0.2.1 Synopsis: Bindings to the Slack RTM API. Description: This library provides bindings to the <https://api.slack.com/rtm Slack Real Time Messaging API>. Users should find it easy to program their own Slack bots using the functionality found in `Web.Slack`.@@ -12,6 +12,8 @@ Please note that the interface provided by this package is not yet stable. There are a number of unresolved internal inconsistencies which have yet to be resolved by Slack HQ. License: MIT+Bug-reports: https://github.com/mpickering/slack-api/issues+ License-File: LICENSE Author: Matthew Pickering Maintainer: matthewtpickering@gmail.com@@ -19,6 +21,9 @@ Category: Web Build-type: Simple Cabal-version: >=1.6+source-repository head+ type: git+ location: https://github.com/mpickering/slack-api.git Library
src/Web/Slack.hs view
@@ -70,8 +70,8 @@ -- -- Be warned that this function will throw an `IOError` if the connection -- to the Slack API fails.-runBot :: SlackConfig -> SlackBot s -> s -> IO ()-runBot SlackConfig{..} bot start = do+runBot :: forall s . SlackConfig -> SlackBot s -> s -> IO ()+runBot conf bot start = do r <- get rtmStartUrl let Just (BoolPrim ok) = r ^? responseBody . key "ok" . _Primitive unless ok (do@@ -82,6 +82,8 @@ case eitherDecode (r ^. responseBody) of Left e -> (print (r ^. responseBody)) >> (ioError . userError $ e) Right res -> return res+ let partialState :: Metainfo -> SlackState s+ partialState metainfo = SlackState metainfo sessionInfo start conf putStrLn "rtm.start call successful" let (host, path) = splitAt 19 (drop 6 $ T.unpack url) SSL.withOpenSSL $ do@@ -95,24 +97,28 @@ SSL.connect ssl (i,o) <- Streams.sslToStreams ssl (stream :: WS.Stream) <- WS.makeStream (StreamsIO.read i) (\b -> StreamsIO.write (B.toStrict <$> b) o )- WS.runClientWithStream stream host path WS.defaultConnectionOptions [] (mkBot sessionInfo start bot)+ WS.runClientWithStream stream host path WS.defaultConnectionOptions []+ (mkBot partialState bot) where port = 443 :: Int rtmStartUrl :: String- rtmStartUrl = "https://slack.com/api/rtm.start?token=" ++ slackApiToken+ rtmStartUrl = "https://slack.com/api/rtm.start?token="+ ++ (conf ^. slackApiToken) -mkBot :: SlackSession -> s -> SlackBot s -> WS.ClientApp ()-mkBot slackSession start f conn = do++mkBot :: (Metainfo -> SlackState s) -> SlackBot s -> WS.ClientApp ()+mkBot partialState bot conn = do let initMeta = Meta conn 0- botLoop conn (SlackState initMeta slackSession start) f+ botLoop (partialState initMeta) bot -botLoop :: forall s . WS.Connection -> SlackState s -> SlackBot s -> IO ()-botLoop conn st f =+botLoop :: forall s . SlackState s -> SlackBot s -> IO ()+botLoop st f = () <$ (flip S.runStateT st . runSlack $ forever loop) where loop :: Slack s () loop = do+ conn <- use connection raw <- liftIO $ WS.receiveData conn let (msg :: Either String Event) = eitherDecode raw case msg of
src/Web/Slack/Config.hs view
@@ -1,6 +1,11 @@-module Web.Slack.Config (SlackConfig(..)) where+{-# LANGUAGE TemplateHaskell #-}+module Web.Slack.Config (SlackConfig(..), slackApiToken) where +import Control.Lens.TH+ -- | Configuration options needed to connect to the Slack API data SlackConfig = SlackConfig- { slackApiToken :: String -- ^ API Token for Bot+ { _slackApiToken :: String -- ^ API Token for Bot } deriving (Show)++makeLenses ''SlackConfig
src/Web/Slack/Message.hs view
@@ -1,8 +1,9 @@ {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-module Web.Slack.Message (sendMessage) where+module Web.Slack.Message (sendMessage, makePingPacket, ping) where +import Control.Applicative import Control.Lens import Control.Monad.State import Data.Aeson (encode)@@ -12,6 +13,7 @@ import qualified Network.WebSockets as WS import Web.Slack.State import Web.Slack.Types+import Data.Time.Clock.POSIX data MessagePayload = MessagePayload { messageId :: Int@@ -32,4 +34,28 @@ let payload = MessagePayload uid "message" cid message slackLog payload liftIO $ WS.sendTextData conn (encode payload)++data PingPayload = PingPayload+ { pingId :: Int+ , pingType :: T.Text+ , pingTimestamp :: Int+ } deriving Show++$(deriveToJSON defaultOptions {fieldLabelModifier = map toLower . drop 4} ''PingPayload)++makePingPacket :: Slack s (IO ())+makePingPacket = do+ conn <- use connection+ uid <- counter+ now <- round <$> liftIO getPOSIXTime+ let payload = PingPayload uid "ping" now+ return (ping conn payload)+++-- | Send a ping packet to the server+-- The server will respond with a @pong@ `Event`.+ping :: WS.Connection -> PingPayload -> IO ()+ping conn payload =+ WS.sendTextData conn (encode payload)+
src/Web/Slack/State.hs view
@@ -15,6 +15,7 @@ import qualified Control.Monad.State as S import qualified Network.WebSockets as WS import Web.Slack.Types+import Web.Slack.Config newtype Slack s a = Slack {runSlack :: S.StateT (SlackState s) IO a} deriving (Monad, Functor, Applicative, S.MonadState (SlackState s), MonadIO)@@ -34,6 +35,7 @@ , _session :: SlackSession -- ^ Information about the session at the -- start of the connection , _userState :: s -- ^ User defined state+ , _config :: SlackConfig -- ^ A copy of the initial configuration } deriving Show
src/Web/Slack/Types/Event.hs view
@@ -84,6 +84,7 @@ UserTyping :: ChannelId -> UserId -> Event MessageResponse :: Int -> SlackTimeStamp -> Text -> Event MessageError :: Int -> SlackError -> Event+ Pong :: Time -> Event NoEvent :: Event deriving (Show) @@ -169,6 +170,7 @@ "bot_added" -> BotAdded <$> v .: "bot" "bot_changed" -> BotChanged <$> v .: "bot" "accounts_changed" -> pure AccountsChanged+ "pong" -> Pong <$> v .: "timestamp" _ -> fail $ "Unrecognised type: " <> T.unpack typ parseType _ _ = error "Expecting object"