Types.hs

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