diff --git a/slack-api.cabal b/slack-api.cabal --- a/slack-api.cabal +++ b/slack-api.cabal @@ -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 . 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 diff --git a/src/Web/Slack.hs b/src/Web/Slack.hs --- a/src/Web/Slack.hs +++ b/src/Web/Slack.hs @@ -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 diff --git a/src/Web/Slack/Config.hs b/src/Web/Slack/Config.hs --- a/src/Web/Slack/Config.hs +++ b/src/Web/Slack/Config.hs @@ -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 diff --git a/src/Web/Slack/Message.hs b/src/Web/Slack/Message.hs --- a/src/Web/Slack/Message.hs +++ b/src/Web/Slack/Message.hs @@ -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) + diff --git a/src/Web/Slack/State.hs b/src/Web/Slack/State.hs --- a/src/Web/Slack/State.hs +++ b/src/Web/Slack/State.hs @@ -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 diff --git a/src/Web/Slack/Types/Event.hs b/src/Web/Slack/Types/Event.hs --- a/src/Web/Slack/Types/Event.hs +++ b/src/Web/Slack/Types/Event.hs @@ -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"