slack (empty) → 0.1.0.0

raw patch · 9 files changed

+538/−0 lines, 9 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, either, http-conduit, mtl, old-locale, text, time, transformers

Files

• LICENSE +20/−0
• Network/Slack.hs +34/−0
• Network/Slack/Channel.hs +55/−0
• Network/Slack/Message.hs +150/−0
• Network/Slack/Prelude.hs +30/−0
• Network/Slack/Types.hs +136/−0
• Network/Slack/User.hs +33/−0
• Setup.hs +2/−0
• slack.cabal +78/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 Diony Rosa++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.

@@ -0,0 +1,34 @@+module Network.Slack+       (+         Slack(..),+         runSlack,+         module Network.Slack.User,+         module Network.Slack.Channel,+         module Network.Slack.Message+       )+       where++import Network.Slack.Types+import Network.Slack.User+import Network.Slack.Channel+import Network.Slack.Message++import           Control.Monad.State (evalStateT, modify)+import           Control.Monad.Trans.Either (runEitherT)++-- |Given an API token and a Slack command, it executes the command in the IO monad+runSlack :: Token -> Slack a -> IO (Either SlackError a)+runSlack tok = flip evalStateT (slackAuth tok) . runEitherT . runSlackInternal . (slackInit >>)++-- |Constructs an initial internal state from the given API token+slackAuth :: Token -> SlackState+slackAuth tok = SlackState tok []++-- |Internal setup. Currently it just fetches the list of users so that it can associated user ids with names+slackInit :: Slack ()+slackInit = do+  currentUsers <- request' "users.list" :: Slack [User]+  let+    updateUsers state = state {_users = currentUsers}+  -- Update internal state+  modify updateUsers

@@ -0,0 +1,55 @@+module Network.Slack.Channel+       (+        Channel(..),+        channels,+        channelFromName+       )+       where++import Network.Slack.Prelude++import Network.Slack.Types (SlackResponseName(..), parseStrippedPrefix, Slack(..), request')++import Network.Slack.User (User(..), userFromId)++import Data.List (find)++-- | Represents a response from the "channels.list" command. This+-- contains a list of user IDs instead of user objects. This should be+-- converted to a Channel object+data ChannelRaw = ChannelRaw {+  _channelId :: String,+  _channelName :: String,+  _channelMembers :: [String] -- This is a list of user IDs+  } deriving (Show, Generic)++instance FromJSON ChannelRaw where+  parseJSON = parseStrippedPrefix "_channel"++instance SlackResponseName [ChannelRaw] where+  slackResponseName _ = "channels"++-- | A more useable version of ChannelRaw+data Channel = Channel {+  channelId :: String,+  channelName :: String,+  channelMembers :: [User]+} deriving (Show)++-- | List of all channels associated with the team+channels :: Slack [Channel]+channels = mapM convertRawChannel =<< request' "channels.list"+  where+    -- Converts a ChannelRaw to a Channel by doing user id lookups+    convertRawChannel :: ChannelRaw -> Slack Channel+    convertRawChannel (ChannelRaw cid cname cuids) = do+      channelUsers <- mapM userFromId cuids+      return (Channel cid cname channelUsers)++-- | Retrieves the Channel with the corresponding name+channelFromName :: String -> Slack Channel+channelFromName cname = do+  maybeChannel <- find (\c -> channelName c == cname) <$> channels+  case maybeChannel of+   Nothing   -> Slack . hoistEither . Left . printf "Could not find channel with name: %s" $ cname+   Just channel -> Slack . hoistEither $ Right channel

@@ -0,0 +1,150 @@+module Network.Slack.Message+       (+         Message(..),+         MessageRaw(..),+         convertRawMessage,+         TimeStamp(..),+         timeStampToString,+         channelHistory,+         channelHistoryBefore,+         channelHistoryAll,+         channelHistoryRecent,+         messagesByUser,+         postMessage+       )+       where++import Network.Slack.Prelude++import Network.Slack.Types (SlackResponseName(..), parseStrippedPrefix, Slack(..), request)++import Network.Slack.User (User(..), userFromId)+import Network.Slack.Channel (Channel(..))++import Data.Time.Clock (UTCTime, getCurrentTime, addUTCTime)+import Data.Time.Format (parseTime, formatTime)+import System.Locale (defaultTimeLocale)++import qualified Data.Traversable as T+import qualified Data.Map as M++-- | Fixed point number with 12 decimal places of precision+newtype TimeStamp = TimeStamp {+  utcTime :: UTCTime+  } deriving (Show, Eq, Ord)++-- | Converts a TimeStamp to the timestamp format the Slack API expects+timeStampToString :: TimeStamp -> String+timeStampToString = formatTime defaultTimeLocale "%s%Q" . utcTime++instance FromJSON TimeStamp where+  parseJSON (String s) = do+    let maybeTime = parseTime defaultTimeLocale "%s%Q" (unpack s):: Maybe UTCTime+    case maybeTime of+     Nothing     -> fail "Incorrect timestamp format."+     Just (time) -> return (TimeStamp time)++  parseJSON _ = fail "Expected a timestamp string"++instance SlackResponseName TimeStamp where+  slackResponseName _ = "ts"++-- | A message sent on a channel. Message can also mean things like user joined or a message was edited+-- TODO: Make this into a sum type of different message types, instead of using Maybe+data MessageRaw = MessageRaw {+  _messageType :: String,+  _messageUser :: Maybe String, -- user ID+  _messageText :: String,+  _messageTs :: TimeStamp+} deriving (Show, Generic)++instance FromJSON MessageRaw where+  parseJSON = parseStrippedPrefix "_message"++instance SlackResponseName [MessageRaw] where +  slackResponseName _ = "messages"++-- | A nicer version of MessageRaw, with the user id converted to a User+data Message = Message {+  messageType :: String,+  messageUser :: Maybe User,+  messageText :: String,+  messageTimeStamp :: TimeStamp+  } deriving (Show, Eq) ++-- | Converts a MessageRaw into a Message+convertRawMessage :: MessageRaw -> Slack Message+convertRawMessage (MessageRaw mtype muid mtext mts) = do+  -- This converts a Maybe (Slack User) to a Slack (Maybe User)+  user <- T.sequence (userFromId <$> muid)+  return (Message mtype user mtext mts)+   +-- | List of the past n messages in the given channel+-- n must be no greater than 1000+channelHistory :: Int -> Channel -> Slack [Message]+channelHistory n chan = mapM convertRawMessage =<< request "channels.history" args+  where+    args = M.fromList [+      ("channel", channelId chan),+      ("count", show n)+      ]++-- | Gets the n messages occuring before the given time+channelHistoryBefore :: Int -> TimeStamp -> Channel -> Slack [Message]+channelHistoryBefore n ts chan = mapM convertRawMessage =<< request "channels.history" args+  where+    args = M.fromList [+      ("channel", channelId chan),+      ("count", show n),+      ("latest", timeStampToString ts)+      ]+-- | Retrieves the entire channel history+channelHistoryAll :: Channel -> Slack [Message]+channelHistoryAll chan = do+  latest <- channelHistory 1000 chan+  let+    older = go . messageTimeStamp . last $ latest+    -- Recursively fetch older and older messages, until Slack returns an empty list+    go :: TimeStamp -> Slack [Message]+    go ts = do+      messages <- channelHistoryBefore 1000 ts chan+      case messages of+       -- No more messages!+       [] -> return []+       -- Return the retreived messages ++ the messages older than the oldest retrieved message+       _  -> (messages ++) <$> (go . messageTimeStamp . last $ messages)+  (latest ++) <$> older++-- | Retrieves a list of the most recent messages within the last n seconds+channelHistoryRecent :: Int -> Channel -> Slack [Message]+channelHistoryRecent n chan = do+  now <- liftIO getCurrentTime+  let+    args = M.fromList [+      ("channel", channelId chan),+      ("count", "1000"),+      ("oldest", timeStampToString . TimeStamp $ addUTCTime nSecsAgo now)+      ]+    -- Convert to NominalDiffTime+    nSecsAgo = fromInteger (- (toInteger n))+  mapM convertRawMessage =<< request "channels.history" args+    +                              +-- | Retrieves the messages by the given user+messagesByUser :: User -> [Message] -> [Message]+messagesByUser user = filter (byUser . messageUser)+  where+    -- Messages with no users are excluded+    byUser Nothing = False+    byUser (Just u) = u == user++-- | Posts a message as the given user to the given channel.+-- Returns the timestamp of the message, if successful+postMessage :: String -> String -> Channel -> Slack TimeStamp+postMessage uname text chan = request "chat.postMessage" args+  where+    args = M.fromList [+      ("channel", channelId chan),+      ("username", uname),+      ("text", text)+      ]

@@ -0,0 +1,30 @@+module Network.Slack.Prelude+       (+         (<$>),+         (<*>),+         FromJSON(..),+         Value(..),+         (.:),+         eitherDecode,+         Generic,+         Text,+         unpack,+         printf,+         liftIO,+         get,+         hoistEither+         )+       where++import Control.Applicative((<$>), (<*>))++import Data.Aeson (FromJSON(..), Value(..), (.:), eitherDecode)+  +import GHC.Generics (Generic)+import Data.Text (Text, unpack)++import Text.Printf (printf)++import Control.Monad.IO.Class (liftIO)+import Control.Monad.State (get)+import Control.Monad.Trans.Either (hoistEither)

@@ -0,0 +1,136 @@+module Network.Slack.Types+       (+         SlackError,+         parseStrippedPrefix,+         Token,+         Slack(..),+         SlackState(..),+         SlackResponse(..),+         SlackResponseName(..),+         ArgName,+         ArgValue,+         CommandName,+         CommandArgs,+         request,+         request',+         User(..),+         users+       )+       where++import Network.Slack.Prelude++import Data.Char (toLower)+import Data.List (stripPrefix)+import qualified Data.Map as M++import Data.Aeson (genericParseJSON)+import Data.Aeson.Types(Options(..), defaultOptions)++import           Network.HTTP.Conduit (simpleHttp)++import           Control.Monad.IO.Class (MonadIO)+import           Control.Monad.State (MonadState, StateT)+import           Control.Monad.Trans.Either (EitherT)+import Control.Applicative(Applicative(..))++type SlackError = String++-- |A Slack Web API token+type Token = String++-- | A Slack User+data User = User {+  userId :: String,+  userName :: String+  } deriving (Show, Eq, Generic)++instance FromJSON User where+  parseJSON = parseStrippedPrefix "user"++instance SlackResponseName [User] where+  slackResponseName _ = "members"++-- |Gets the list of users associated with the Slack team+users :: Slack [User]+users = _users <$> get++-- |Internal state for slack commands+data SlackState = SlackState+                  {+                    _token :: Token,  -- ^ Slack API token+                    _users :: [User]  -- ^ The users in this team. This is maintained as state to be able to reference user IDs to users+                  }+                  deriving (Show)++-- |The Slack monad. It executes commands with the context of possible failure (malformed requests, Slack is down, etc...), and some internal state+newtype Slack a = Slack {runSlackInternal :: EitherT SlackError (StateT SlackState IO) a}+                  deriving (Functor, Applicative, Monad, MonadIO, MonadState SlackState)++-- |Parses a record from a JSON object by stripping the given prefix off of each field+parseStrippedPrefix prefix = genericParseJSON (defaultOptions {fieldLabelModifier = uncamel})+  where+    --  Removes a prefix from a string, and lowercases the first letter of the resulting string+    -- This is to turn things like userId into id+    uncamel :: String -> String+    uncamel str = lowercaseFirst . maybe str id . stripPrefix prefix $ str+    lowercaseFirst [] = []+    lowercaseFirst (x:xs) = toLower x : xs++type ArgName = String+type ArgValue = String+type CommandName = String+type CommandArgs = M.Map ArgName ArgValue++-- | Represents the response the Slack API returns+data SlackResponse a = SlackResponse { response :: Either SlackError a }+                       deriving (Show)++-- | Maps response types to the name of the key in the Slack API+-- For example, the "users.list" command returns the list of users in a key labeled "members"+class SlackResponseName a where+  slackResponseName :: a -> Text++instance (FromJSON a, SlackResponseName a) => FromJSON (SlackResponse a) where+  parseJSON (Object v) = do+    ok <- v .: "ok"+    if ok+      -- If success, get the name of the key to parse, and return the parsed object+      then SlackResponse . Right <$> v .: slackResponseName (undefined :: a)+      -- Else get the error message+      else SlackResponse . Left <$> v .: "error"++  parseJSON _ = fail "Expected an Object."++type URL = String++-- |Constructs an API request URL given the API token, command names, and command args+buildURL :: CommandName -> CommandArgs -> Slack URL+buildURL command args = do+  -- Retrieve the token from the internal state+  tokenArg <- _token <$> get+  let+    -- Insert the token into the args+    queryArgs = M.insert "token" tokenArg args+    -- Build the GET query string+    queryString :: String+    queryString = M.foldMapWithKey (printf "%s=%s&") queryArgs++    url = printf "https://slack.com/api/%s?%s" command queryString+  return url++-- |Takes a API command name and the args and executes the request+request :: (SlackResponseName a, FromJSON a) => CommandName -> CommandArgs -> Slack a+request command args = do+  -- Construct the proper API url+  url <- buildURL command args+  -- Retrieve the raw JSON Data+  raw <- liftIO (simpleHttp url) +  -- Parse it into a SlackResponse object+  resp <- Slack . hoistEither . eitherDecode $ raw+  -- Merge the Either inside the SlackResponse with the EitherT in the Slack monad stack+  Slack . hoistEither . response $ resp++-- |Same as request with no command arguments+request' :: (SlackResponseName a, FromJSON a) => CommandName -> Slack a+request' command = request command M.empty

@@ -0,0 +1,33 @@+module Network.Slack.User+       (+         User(..),+         users,+         userFromId,+         userFromName+       )+       where++import Network.Slack.Types (User(..), Slack(..), users)++import Data.List (find)+import Text.Printf (printf)++import Control.Applicative ((<$>))+import Control.Monad.Trans.Either (hoistEither)++-- |Converts a user ID to a user object, signaling an error if there's no such user ID+userFromId :: String -> Slack User+userFromId uid = do+  maybeUser <- find (\u -> userId u == uid) <$> users :: Slack (Maybe User)+  case maybeUser of+   Nothing   -> Slack . hoistEither . Left . printf "Could not find user with id: %s" $ uid+   Just user -> Slack . hoistEither $ Right user++-- | Converts a user name to a user object, signaling an error if there's no such user name+userFromName :: String -> Slack User+userFromName uname = do+  maybeUser <- find (\u -> userName u == uname) <$> users :: Slack (Maybe User)+  case maybeUser of+   Nothing   -> Slack . hoistEither . Left . printf "Could not find user with name: %s" $ uname+   Just user -> Slack . hoistEither $ Right user+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+-- Initial slack.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                slack++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Haskell API for interacting with Slack++-- A longer description of the package.+description:         Visit https://api.slack.com/web in order to get your API token++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Diony Rosa++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          dhrosa@gmail.com++-- A copyright notice.+-- copyright:           ++category:            Network++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10+++library+  -- Modules exported by the library.+  exposed-modules:     Network.Slack, Network.Slack.User, Network.Slack.Channel, Network.Slack.Message+  +  -- Modules included in this library but not exported.+  other-modules:   Network.Slack.Types, Network.Slack.Prelude+  +  -- LANGUAGE extensions used by modules in this package.+  default-extensions:    DeriveFunctor, DeriveGeneric, GeneralizedNewtypeDeriving, DisambiguateRecordFields, FlexibleInstances, OverloadedStrings, ScopedTypeVariables+  +  -- Other library packages from which modules are imported.+  build-depends:       aeson >=0.8 && <0.9+                     , base >=4.7 && <4.8+                     , containers >=0.5 && <0.6+                     , either >=4.3 && <4.4+                     , http-conduit >=2.1 && <2.2+                     , mtl >=2.2 && <2.3+                     , old-locale+                     , text+                     , time+                     , transformers >= 0.4.1.0+  +  -- Directories containing source files.+  -- hs-source-dirs:      +  +  -- Base language which the package is written in.+  default-language:    Haskell2010++  ghc-options: -Wall+