packages feed

slack-api (empty) → 0.1

raw patch · 32 files changed

+1463/−0 lines, 32 filesdep +HsOpenSSLdep +aesondep +basesetup-changed

Dependencies added: HsOpenSSL, aeson, base, bytestring, containers, errors, io-streams, lens, lens-aeson, monad-loops, mtl, network, openssl-streams, text, time, transformers, websockets, wreq

Files

+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2014 Matthew Pickering++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.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ slack-api.cabal view
@@ -0,0 +1,79 @@+Name:                slack-api+Version:             0.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`.++                     The bindings are very nearly complete. Library authors+                     looking to build bindings to the <https://api.slack.com/web Slack Web API> may+                     find the `FromJSON` instances located in `Web.Slack.Types`+                     useful.++                     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+License-File:        LICENSE+Author:              Matthew Pickering+Maintainer:          matthewtpickering@gmail.com+Stability:           Experimental+Category:            Web+Build-type:          Simple+Cabal-version:       >=1.6+++Library+  hs-source-dirs: src+  ghc-options: -Wall -fno-warn-unused-do-bind+  Exposed-Modules: Web.Slack,+                   Web.Slack.Message,+                   Web.Slack.State,+                   Web.Slack.Types,+                   Web.Slack.Config+                   Web.Slack.Types.Bot,+                   Web.Slack.Types.Comment,+                   Web.Slack.Types.File,+                   Web.Slack.Types.IM,+                   Web.Slack.Types.Topic,+                   Web.Slack.Types.Channel,+                   Web.Slack.Types.Event,+                   Web.Slack.Types.Event.Subtype,+                   Web.Slack.Types.Group,+                   Web.Slack.Types.Item,+                   Web.Slack.Types.User,+                   Web.Slack.Types.ChannelOpt,+                   Web.Slack.Types.Id,+                   Web.Slack.Types.Time,+                   Web.Slack.Types.Error,+                   Web.Slack.Types.Preferences,+                   Web.Slack.Types.TeamPreferences,+                   Web.Slack.Types.Team,+                   Web.Slack.Types.Session,+                   Web.Slack.Types.Self,+                   Web.Slack.Types.Presence,+                   Web.Slack.Types.Base++  other-modules: Web.Slack.Utils+  Build-depends:+    -- corePackages (see [cabal2nix/src/Cabal2Nix/CorePackages.hs])+    base                      >= 4.4      && < 5,+    bytestring                >= 0.9.1   && < 0.11,+    containers                >= 0.4,+++    -- Normal Packages+    websockets > 0.9,+    wreq                      >= 0.2,+    text >= 1.2,+    lens >= 4.6,+    lens-aeson >= 1.0 ,+    network >= 2.6,+    openssl-streams >= 1.2,+    HsOpenSSL >= 0.11 ,+    io-streams >= 1.2,+    mtl >= 2.1,+    aeson >= 0.8 ,+    time >= 1.4.2,+    errors >= 1.4,+    monad-loops >= 0.4,+    transformers >= 0.3+
+ src/Web/Slack.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeSynonymInstances       #-}+------------------------------------------+-- |+-- This module exposes functionality to write bots which responds+-- to `Event`s sent by the RTM API. By using the user state parameter `s`+-- complicated interactions can be established.+--+-- This basic example echos every message the bot recieves.+-- Other examples can be found in the+-- @<http://google.com examples>@ directory.+--+-- > myConfig :: SlackConfig+-- > myConfig = SlackConfig+-- >         { slackApiToken = "..." -- Specify your API token here+-- >         }+-- >+-- > -- type SlackBot s = Event -> Slack s ()+-- > echoBot :: SlackBot ()+-- > echoBot (Message cid _ msg _ _ _) = sendMessage cid msg+-- > echoBot _ = return ()+-- >+-- > main :: IO ()+-- > main = runBot myConfig echoBot ()+--+module Web.Slack ( runBot+                 -- Re-exports+                 , Slack(..)+                 , SlackBot+                 , SlackState(..)+                 , userState+                 , session+                 , module Web.Slack.Types+                 , module Web.Slack.Config+                 ) where++import           Control.Applicative+import           Control.Lens+import Control.Monad (forever, unless)+import qualified Control.Monad.State        as S+import           Control.Monad.Trans+import           Data.Aeson.Lens+import qualified Data.ByteString.Lazy       as B+import qualified Data.ByteString.Lazy.Char8 as BC+import qualified Data.Text                  as T+import qualified Network.Socket             as S+import qualified Network.WebSockets         as WS+import qualified Network.WebSockets.Stream  as WS+import           Network.Wreq+import qualified OpenSSL                    as SSL+import qualified OpenSSL.Session            as SSL+import qualified System.IO.Streams.Internal as StreamsIO+import qualified System.IO.Streams.SSL      as Streams++import           Data.Aeson++import           Web.Slack.Config+import           Web.Slack.State+import           Web.Slack.Types++-- | Run a `SlackBot`. The supplied bot will respond to all events sent by+-- the Slack RTM API.+--+-- 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+  r <- get rtmStartUrl+  let Just (BoolPrim ok) = r ^? responseBody . key "ok"  . _Primitive+  unless ok (do+    putStrLn "Unable to connect"+    ioError . userError . T.unpack $ r ^. responseBody . key "error" . _String)+  let Just url = r ^? responseBody . key "url" . _String+  (sessionInfo :: SlackSession) <-+    case eitherDecode (r ^. responseBody) of+      Left e -> ioError . userError $ e+      Right res -> return res+  putStrLn "rtm.start call successful"+  let (host, path) = splitAt 19 (drop 6 $ T.unpack url)+  SSL.withOpenSSL $ do+    ctx <- SSL.context+    is  <- S.getAddrInfo Nothing (Just host) (Just $ show port)+    let a = S.addrAddress $ head is+        f = S.addrFamily $ head is+    s <- S.socket f S.Stream S.defaultProtocol+    S.connect s a+    ssl <- SSL.connection ctx s+    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)+  where+    port = 443 :: Int+    rtmStartUrl :: String+    rtmStartUrl = "https://slack.com/api/rtm.start?token=" ++ slackApiToken+++mkBot :: SlackSession -> s -> SlackBot s -> WS.ClientApp ()+mkBot slackSession start f conn = do+    let initMeta = Meta conn 0+    botLoop conn (SlackState initMeta slackSession start) f++botLoop :: forall s . WS.Connection -> SlackState s -> SlackBot s -> IO ()+botLoop conn st f =+  () <$ (flip S.runStateT st  . runSlack $ forever loop)+  where+    loop :: Slack s ()+    loop = do+      raw <- liftIO $ WS.receiveData conn+      let (msg :: Either String Event) = eitherDecode raw+      case msg of+        Left e -> do+                    liftIO $ BC.putStrLn raw+                    liftIO $ putStrLn e+                    liftIO . putStrLn $ "Please report this failure to the github issue tracker"+        Right event -> f event+
+ src/Web/Slack/Config.hs view
@@ -0,0 +1,6 @@+module Web.Slack.Config (SlackConfig(..)) where++-- | Configuration options needed to connect to the Slack API+data SlackConfig = SlackConfig+                 { slackApiToken :: String -- ^ API Token for Bot+                 } deriving (Show)
+ src/Web/Slack/Message.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TemplateHaskell            #-}+module Web.Slack.Message (sendMessage) where++import           Control.Lens+import           Control.Monad.State+import           Data.Aeson          (encode)+import           Data.Aeson.TH+import           Data.Char+import qualified Data.Text           as T+import qualified Network.WebSockets  as WS+import           Web.Slack.State+import           Web.Slack.Types++data MessagePayload = MessagePayload+                    { messageId      :: Int+                    , messageType    :: T.Text+                    , messageChannel :: ChannelId+                    , messageText    :: T.Text } deriving Show++$(deriveToJSON defaultOptions {fieldLabelModifier = map toLower . drop 7} ''MessagePayload)++-- | Send a message to the specified channel.+--+-- If the message is longer than 4000 bytes then the connection will be+-- closed.+sendMessage :: ChannelId -> T.Text -> Slack s ()+sendMessage cid message = do+  conn <- use connection+  uid  <- counter+  let payload = MessagePayload uid "message" cid message+  slackLog payload+  liftIO $ WS.sendTextData conn (encode payload)+
+ src/Web/Slack/State.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FunctionalDependencies     #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Web.Slack.State where++import           Control.Applicative+import           Control.Lens+import           Control.Monad.IO.Class+import qualified Control.Monad.State       as S+import qualified Network.WebSockets        as WS+import           Web.Slack.Types++newtype Slack s a = Slack {runSlack :: S.StateT (SlackState s) IO a}+  deriving (Monad, Functor, Applicative, S.MonadState (SlackState s), MonadIO)++type SlackBot s =  Event -> Slack s ()++data Metainfo = Meta+              { _metaConnection :: WS.Connection -- ^ Websockets connection+              , _msgCounter :: Int           -- ^ Unique message counter+              }++instance Show Metainfo where+  show (Meta _ b) = "Metainfo: " ++ "<connection> " ++  show b++data SlackState s = SlackState+                { _meta      :: Metainfo      -- ^ Information about the connection+                , _session   :: SlackSession  -- ^ Information about the session at the+                                                  -- start of the connection+                , _userState :: s             -- ^ User defined state+                } deriving Show+++makeLenses ''SlackState+makeLenses ''Metainfo++slackLog :: Show a => a -> MonadIO m => m ()+slackLog = liftIO . print++counter :: Slack s Int+counter = meta . msgCounter <<+= 1++connection :: Lens' (SlackState s) WS.Connection+connection = meta . metaConnection
+ src/Web/Slack/Types.hs view
@@ -0,0 +1,47 @@+module Web.Slack.Types (+ module Web.Slack.Types.Bot,+ module Web.Slack.Types.Comment,+ module Web.Slack.Types.File,+ module Web.Slack.Types.IM,+ module Web.Slack.Types.Topic,+ module Web.Slack.Types.Channel,+ module Web.Slack.Types.Event.Subtype,+ module Web.Slack.Types.Group,+ module Web.Slack.Types.Item,+ module Web.Slack.Types.User,+ module Web.Slack.Types.ChannelOpt,+ module Web.Slack.Types.Event,+ module Web.Slack.Types.Id,+ module Web.Slack.Types.Time,+ module Web.Slack.Types.Error,+ module Web.Slack.Types.Preferences,+ module Web.Slack.Types.TeamPreferences,+ module Web.Slack.Types.Team,+ module Web.Slack.Types.Self,+ module Web.Slack.Types.Session,+ module Web.Slack.Types.Presence,+ module Web.Slack.Types.Base+ ) where++import Web.Slack.Types.Base+import Web.Slack.Types.Bot+import Web.Slack.Types.Comment+import Web.Slack.Types.File+import Web.Slack.Types.IM+import Web.Slack.Types.Topic+import Web.Slack.Types.Channel+import Web.Slack.Types.Event.Subtype+import Web.Slack.Types.Group+import Web.Slack.Types.Item+import Web.Slack.Types.User+import Web.Slack.Types.ChannelOpt+import Web.Slack.Types.Event+import Web.Slack.Types.Id+import Web.Slack.Types.Time+import Web.Slack.Types.Error+import Web.Slack.Types.Preferences+import Web.Slack.Types.TeamPreferences+import Web.Slack.Types.Team+import Web.Slack.Types.Self+import Web.Slack.Types.Session+import Web.Slack.Types.Presence
+ src/Web/Slack/Types/Base.hs view
@@ -0,0 +1,5 @@+module Web.Slack.Types.Base where++import Data.Text (Text)++type URL = Text
+ src/Web/Slack/Types/Bot.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Web.Slack.Types.Bot where++import Data.Aeson+import Control.Lens.TH+import Control.Applicative+import Data.Text (Text)++import Web.Slack.Types.Id+import Web.Slack.Types.Base+++data Bot = Bot+         { _botId    :: BotId+         , _botName  :: Text+         , _botIcons :: BotIcons+         } deriving (Show)+++data BotIcons = BotIcons+            { _botIconImage48 :: URL+            } deriving (Show)++makeLenses ''Bot+makeLenses ''BotIcons+++instance FromJSON BotIcons where+  parseJSON = withObject "icons" (\v ->+                BotIcons <$> v .: "image_48")++instance FromJSON Bot where+  parseJSON = withObject "bot" (\v ->+                Bot <$> v .: "id" <*> v .: "name" <*> v .: "icons")
+ src/Web/Slack/Types/Channel.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.Channel where++import Data.Aeson+import Data.Aeson.Types+import Control.Applicative+import Data.Text (Text)+import Control.Lens.TH++import Web.Slack.Types.Id+import Web.Slack.Types.Time+import Web.Slack.Types.Topic+import {-# SOURCE #-} Web.Slack.Types.ChannelOpt (ChannelOpt)++data Channel = Channel { _channelId         :: ChannelId+                       , _channelName       :: Text+                       , _channelCreated    :: Time+                       , _channelCreator    :: UserId+                       , _channelIsArchived :: Bool+                       , _channelIsGeneral  :: Bool+                       , _channelMembers    :: Maybe [UserId]+                       , _channelTopic      :: Maybe Topic+                       , _channelPurpose    :: Maybe Purpose+                       , _channelIsMember   :: Bool+                       , _channelOpt        :: Maybe ChannelOpt+                       } deriving Show++makeLenses ''Channel++instance FromJSON Channel where+  parseJSON = withObject "Channel" (\o -> Channel <$> o .: "id" <*> o .: "name"+                                                  <*> o .: "created" <*> o .:"creator"+                                                  <*> o .: "is_archived" <*> o .: "is_general"+                                                  <*> o .:? "members" <*> o .:? "topic"+                                                  <*> o .:? "purpose" <*> o .: "is_member"+                                                  <*> (pure $ parseMaybe parseJSON (Object o) :: Parser (Maybe ChannelOpt)))
+ src/Web/Slack/Types/ChannelOpt.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.ChannelOpt where++import Data.Aeson+import Control.Lens.TH+import Control.Applicative+import Web.Slack.Types.Event+import Web.Slack.Types.Time+++data ChannelOpt = ChannelOpt+                { _channelOptLastRead    :: SlackTimeStamp+                , _channelOptUnreadCount :: Int+                , _channelOptLatest      :: Event+                } deriving (Show)++makeLenses ''ChannelOpt++instance FromJSON ChannelOpt where+  parseJSON = withObject "ChannelOpt"+                (\o -> ChannelOpt+                        <$> o .: "last_read"+                        <*> o .: "unread_count"+                        <*> o .: "latest")
+ src/Web/Slack/Types/ChannelOpt.hs-boot view
@@ -0,0 +1,9 @@+module Web.Slack.Types.ChannelOpt (ChannelOpt) where++import Data.Aeson++data ChannelOpt++instance FromJSON ChannelOpt++instance Show ChannelOpt
+ src/Web/Slack/Types/Comment.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.Comment where++import Data.Aeson+import Control.Applicative+import Control.Lens.TH+import Data.Text (Text)++import Web.Slack.Types.Id+import Web.Slack.Types.Time++data Comment = Comment+             { _commentId        :: CommentId+             , _commentTimestamp :: Time+             , _commentUser      :: UserId+             , _commentComment   :: Text+             } deriving (Show)++makeLenses ''Comment++instance FromJSON Comment where+  parseJSON = withObject "comment" (\o ->+                Comment <$> o .: "id" <*> o .: "timestamp" <*> o .: "user" <*> o .: "comment")
+ src/Web/Slack/Types/Error.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Web.Slack.Types.Error where++import Data.Aeson+import Control.Lens.TH++data SlackError = SlackError deriving Show++makeLenses ''SlackError++instance FromJSON SlackError where+  parseJSON = withObject "SlackError" (\_ -> return SlackError)
+ src/Web/Slack/Types/Event.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE GADTs, LambdaCase, OverloadedStrings, ScopedTypeVariables,+ TemplateHaskell #-}+module Web.Slack.Types.Event  where++import Web.Slack.Types.Channel+import Web.Slack.Types.Bot+import Web.Slack.Types.Base+import Web.Slack.Types.User+import Web.Slack.Types.File+import Web.Slack.Types.IM+import Web.Slack.Types.Id+import Web.Slack.Types.Item+import Web.Slack.Types.Comment+import Web.Slack.Types.Error+import Web.Slack.Types.Event.Subtype+import Web.Slack.Types.Group+import Web.Slack.Types.Time+import Web.Slack.Types.Presence++import Data.Aeson+import Data.Aeson.Types++import Control.Lens.TH+import Control.Applicative+import Data.Text (Text)+import qualified Data.Text as T+import Data.Monoid++type Domain = Text++data Event where+  Hello :: Event+  Message :: ChannelId -> Submitter -> Text -> SlackTimeStamp -> Maybe Subtype -> Maybe Edited -> Event+  HiddenMessage :: ChannelId -> Submitter -> SlackTimeStamp -> Maybe Subtype -> Event+  ChannelMarked :: ChannelId -> SlackTimeStamp -> Event+  ChannelCreated :: Channel -> Event+  ChannelJoined :: Channel -> Event+  ChannelLeft   :: Channel -> Event+  ChannelDeleted :: ChannelId -> Event+  ChannelRename :: ChannelRenameInfo -> Event+  ChannelArchive :: ChannelId -> UserId -> Event+  ChannelUnarchive :: ChannelId -> UserId -> Event+  ChannelHistoryChanged :: SlackTimeStamp -> SlackTimeStamp -> SlackTimeStamp -> Event+  ImCreated :: UserId -> IM -> Event+  ImOpen :: UserId -> IMId -> Event+  ImClose :: UserId -> IMId -> Event+  ImMarked :: IMId -> SlackTimeStamp -> Event+  ImHistoryChanged :: SlackTimeStamp -> SlackTimeStamp -> SlackTimeStamp -> Event+  GroupJoined :: Group -> Event+  GroupLeft :: Group -> Event+  GroupOpen :: UserId -> GroupId -> Event+  GroupClose :: UserId -> GroupId -> Event+  GroupArchive :: GroupId -> Event+  GroupUnarchive :: GroupId -> Event+  GroupRename :: ChannelRenameInfo -> Event+  GroupMarked :: GroupId -> SlackTimeStamp -> Event+  GroupHistoryChanged :: SlackTimeStamp -> SlackTimeStamp -> SlackTimeStamp -> Event+  FileCreated :: File -> Event+  FileShared :: File -> Event+  FileUnshared :: File -> Event+  FilePublic :: File -> Event+  FilePrivate :: FileId -> Event+  FileChange  :: File -> Event+  FileDeleted :: FileId -> SlackTimeStamp -> Event+  FileCommentAdded :: File -> Comment -> Event+  FileCommentEdited :: File -> Comment -> Event+  FileCommentDeleted :: File -> CommentId -> Event+  PresenceChange :: UserId -> Presence -> Event+  ManualPresenceChange :: Presence -> Event+  PrefChange :: Pref -> Event+  UserChange :: User -> Event+  TeamJoin :: User -> Event+  StarAdded :: UserId -> Item -> SlackTimeStamp -> Event+  StarRemoved :: UserId -> Item -> SlackTimeStamp -> Event+  EmojiChanged :: SlackTimeStamp -> Event+  CommandsChanged :: SlackTimeStamp -> Event+  TeamPrefChange :: Pref -> Event+  TeamRenameEvent :: Text -> Event+  TeamDomainChange :: URL -> Domain -> Event+  EmailDomainChange :: Domain -> SlackTimeStamp -> Event+  BotChanged :: Bot -> Event+  BotAdded :: Bot -> Event+  AccountsChanged :: Event+  UserTyping :: ChannelId -> UserId -> Event+  MessageResponse :: Int -> SlackTimeStamp -> Text -> Event+  MessageError :: Int -> SlackError -> Event+  NoEvent :: Event+  deriving (Show)++type Pref = (Text, Value)++instance FromJSON Event where+  parseJSON o@(Object v) = do+    (typ :: Maybe Text) <- v .:? "type"+    case typ of+      Just t -> parseType o t+      Nothing -> do+        (ok :: Bool) <- v .: "ok"+        if ok+          then MessageResponse <$> v .: "reply_to" <*> v .: "ts" <*> v .: "text"+          else MessageError <$> v .: "reply_to" <*> v .: "error"+  parseJSON Null = return NoEvent+  parseJSON _ = error "Expecting object: Event"++parseType :: Value -> Text -> Parser Event+parseType o@(Object v) typ =+    case typ of+      "hello" -> return Hello++      "message" -> do+        subt <- (\case+                  Nothing -> return Nothing+                  Just r  -> Just <$> subtype r o) =<< v .:? "subtype"+        submitter <- case subt of+                      Just (SBotMessage bid _ _) -> return $ BotComment bid+                      _ -> maybe System UserComment <$> v .:? "user"+        (v .: "channel") :: Parser ChannelId+        hidden <- (\case {Just True -> True; _ -> False}) <$> v .:? "hidden"+        if not hidden+          then Message <$>  v .: "channel" <*> pure submitter  <*> v .: "text" <*> v .: "ts" <*> pure subt <*> v .:? "edited"+          else HiddenMessage <$>  v .: "channel" <*> pure submitter  <*> v .: "ts" <*> pure subt+      "user_typing" -> UserTyping <$> v .: "channel" <*> v .: "user"+      "presence_change" -> PresenceChange <$> v .: "user" <*> v .: "presence"+      "channel_marked"  -> ChannelMarked <$> v .: "channel" <*> v .: "ts"+      "channel_created" -> ChannelCreated <$> v .: "channel"+      "channel_joined"  -> ChannelJoined <$> v .: "channel"+      "channel_left"    -> ChannelLeft <$> v .: "channel"+      "channel_deleted" -> ChannelDeleted <$> v .: "channel"+      "channel_rename"  -> ChannelRename <$> v .: "channel"+      "channel_archive" -> ChannelArchive <$> v .: "channel" <*> v .: "user"+      "channel_unarchive" -> ChannelUnarchive <$> v .: "channel" <*> v .: "user"+      "channel_history_changed" -> ChannelHistoryChanged <$> v .: "latest" <*> v .: "ts" <*> v .: "event_ts"+      "im_open"     -> ImOpen <$> v .: "user" <*> v .: "channel"+      "im_created" -> ImCreated <$> v .: "user" <*> v .: "channel"+      "im_close" -> ImClose <$> v .: "user" <*> v .: "channel"+      "im_marked" -> ImMarked <$> v .: "channel" <*> v .: "ts"+      "im_history_changed" -> ImHistoryChanged <$> v .: "latest" <*> v .: "ts" <*> v .: "event_ts"+      "group_joined" -> GroupJoined <$> v .: "channel"+      "group_left" ->  GroupLeft <$> v  .: "channel"+      "group_open" ->  GroupOpen <$> v .: "user" <*> v .: "channel"+      "group_close" -> GroupClose <$> v .: "user" <*> v .: "channel"+      "group_archive" -> GroupArchive <$> v .: "channel"+      "group_unarchive" -> GroupUnarchive <$> v .: "channel"+      "group_rename" -> GroupRename <$> v .: "channel"+      "group_marked" -> GroupMarked <$> v .: "channel" <*> v .: "ts"+      "group_history_changed" -> GroupHistoryChanged <$> v .: "latest" <*> v .: "ts" <*> v .: "event_ts"+      "file_created" -> FileCreated <$> v .: "file"+      "file_shared"  -> FileShared <$> v .: "file"+      "file_unshared" -> FileUnshared <$> v .: "file"+      "file_public"  -> FilePublic <$> v .: "file"+      "file_private" -> FilePrivate <$> v .: "file"+      "file_change"  -> FileChange <$> v .: "file"+      "file_deleted"  -> FileDeleted <$> v .: "file_id" <*> v .: "event_ts"+      "file_comment_added" -> FileCommentAdded <$> v .: "file" <*> v .: "comment"+      "file_comment_edited" -> FileCommentEdited <$> v .: "file" <*> v .: "comment"+      "file_comment_deleted" -> FileCommentDeleted <$> v .: "file" <*> v .: "comment"+      "manual_presence_change" -> ManualPresenceChange <$> v .: "presence"+      "pref_change" -> curry PrefChange <$> v .: "name" <*> v .: "value"+      "user_change" -> UserChange <$> v .: "user"+      "team_join"   -> TeamJoin <$> v .: "user"+      "star_added" ->  StarAdded <$> v .: "user" <*> v .: "item" <*> v .: "event_ts"+      "star_removed" -> StarRemoved <$> v .: "user" <*> v .: "item" <*> v .: "event_ts"+      "emoji_changed" -> EmojiChanged <$> v .: "event_ts"+      "commands_changed" -> CommandsChanged <$> v .: "event_ts"+      "team_pref_change" -> curry TeamPrefChange <$> v .: "name" <*> v .: "value"+      "team_rename" -> TeamRenameEvent <$> v .: "name"+      "team_domain_change" -> TeamDomainChange <$> v .: "url" <*> v .: "domain"+      "email_domain_changed" -> EmailDomainChange <$> v .: "email_domain" <*> v .: "event_ts"+      "bot_added" -> BotAdded <$> v .:  "bot"+      "bot_changed" -> BotChanged <$> v .: "bot"+      "accounts_changed" -> pure AccountsChanged+      _ -> fail $ "Unrecognised type: " <> T.unpack typ+parseType _ _ = error "Expecting object"+++data Submitter = UserComment UserId | BotComment BotId | System deriving (Show, Eq)++data ChannelRenameInfo = ChannelRenameInfo+                       { _channelRenameId      :: ChannelId+                       , _channelRenameName    :: Text+                       , _channelRenameCreated :: Time } deriving Show++makeLenses ''ChannelRenameInfo++instance FromJSON ChannelRenameInfo where+  parseJSON = withObject "ChannelRenameInfo" (\o -> ChannelRenameInfo <$> o .: "id" <*> o .: "name" <*> o .: "created")+
+ src/Web/Slack/Types/Event/Subtype.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE LambdaCase, GADTs, OverloadedStrings #-}+module Web.Slack.Types.Event.Subtype (Subtype(..), subtype) where++import Data.Aeson+import Data.Aeson.Types+import Web.Slack.Types.Time+import Web.Slack.Types.Id+import Web.Slack.Types.File hiding (URL)+import Web.Slack.Types.Comment+import Web.Slack.Types.Bot+import Web.Slack.Types.Item+import Control.Applicative+import Data.Text (Text)++type Username = Text++data Subtype where+  SBotMessage :: BotId -> Maybe Username -> Maybe BotIcons -> Subtype+  SMeMessage  :: Subtype+  SMessageChanged :: MessageUpdate -> Subtype+  SChannelJoin :: Maybe UserId -> Subtype+  SMessageDeleted :: SlackTimeStamp -> Subtype+  SChannelLeave :: Subtype+  SChannelTopic :: Text -> Subtype+  SChannelPurpose :: Text -> Subtype+  SChannelName :: Text -> Text -> Subtype+  SChannelArchive :: [UserId] -> Subtype+  SChannelUnarchive :: Subtype+  SGroupJoin :: Maybe UserId -> Subtype+  SGroupLeave :: Subtype+  SGroupTopic :: Text -> Subtype+  SGroupPurpose :: Text -> Subtype+  SGroupName :: Text -> Text -> Subtype+  SGroupArchive :: [UserId] -> Subtype+  SGroupUnarchive :: Subtype+  SFileShare :: File -> Bool -> Subtype+  SFileComment :: File -> Comment -> Subtype+  SFileMention :: File -> Subtype+  deriving Show++subtype :: String -> Value -> Parser Subtype+subtype s = withObject "subtype" (\v ->+  case s of+    "bot_message" -> SBotMessage <$> v .: "bot_id"  <*> v .:? "username" <*> v .:? "icons"+    "me_message"  -> return SMeMessage+    "message_changed" -> SMessageChanged <$> v .: "message"+    "message_deleted" -> SMessageDeleted <$> v .: "deleted_ts"+    "channel_join"  ->   SChannelJoin  <$> v .:? "inviter"+    "channel_leave"   -> return SChannelLeave+    "channel_topic"   -> SChannelTopic <$> v .: "topic"+    "channel_purpose" -> SChannelPurpose <$> v .: "purpose"+    "channel_name"    -> SChannelName <$> v .: "old_name" <*> v .: "name"+    "channel_archive" -> SChannelArchive <$> v .: "members"+    "channel_unarchive" ->  return SChannelUnarchive++    "group_join"    -> SGroupJoin  <$> v .:? "inviter"+    "group_leave"   -> return SGroupLeave+    "group_topic"   -> SGroupTopic <$> v .: "topic"+    "group_purpose" -> SGroupPurpose <$> v .: "purpose"+    "group_name"    -> SGroupName <$> v .: "old_name" <*> v .: "name"+    "group_archive" -> SGroupArchive <$> v .: "members"+    "group_unarchive" ->  return SGroupUnarchive+    "file_share"    -> SFileShare <$> v .: "file" <*> v .: "upload"+    "file_comment"  -> SFileComment <$> v .: "file" <*> v .: "comment"+    "file_mention"  -> SFileMention <$> v .: "file"+    _               -> fail $ "Unrecognised subtype: " ++ s)+
+ src/Web/Slack/Types/File.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings, LambdaCase, TemplateHaskell #-}+module Web.Slack.Types.File where++import Data.Aeson+import Data.Aeson.Types+import Control.Applicative+import Data.Text (Text)+import qualified Data.Text as T+import Data.Maybe+import Control.Lens.TH++import Web.Slack.Types.Id+import Web.Slack.Types.Comment+import Web.Slack.Types.Time+import Web.Slack.Types.Base++data File = File { _fileId             :: FileId+                 , _fileTimestamp      :: Time+                 , _fileName           :: Maybe Text+                 , _fileTitle          :: Text+                 , _fileMime           :: Text+                 , _filetype       :: Text+                 , _filePrettyType     :: Text+                 , _fileUser           :: UserId+                 , _fileMode           :: Mode+                 , _fileEditable       :: Bool+                 , _fileIsExternal     :: Bool+                 , _fileExternalType   :: Text+                 , _fileSize           :: Int+                 , _fileUrl            :: FileUrl+                 , _fileThumbs         :: Thumbnail+                 , _filePermalink      :: URL+                 , _fileEditLink       :: Maybe URL+                 , _filePreview        :: Maybe Preview+                 , _filePublic         :: Bool+                 , _filePublicShared   :: Bool+                 , _fileChannels       :: [ChannelId]+                 , _fileGroups         :: [ChannelId]+                 , _fileInitialComment :: Maybe Comment+                 , _fileStars          :: Int+                 , _fileComments       :: Int } deriving Show++data Mode = Hosted | External | Snippet | Post deriving Show++instance FromJSON File where+  parseJSON = withObject "File" (\o ->+              File <$> o .: "id" <*> o .: "timestamp" <*> o .: "name" <*> o .: "title"+                <*> o .: "mimetype" <*> o .: "filetype" <*> o .: "pretty_type" <*> o .: "user"+                <*> o .: "mode" <*> o .: "editable" <*> o .: "is_external" <*> o .: "external_type"+                <*> o .: "size" <*> (parseJSON (Object o) :: Parser FileUrl)+                <*> (parseJSON (Object o) :: Parser Thumbnail)  <*> o .: "permalink" <*> o .:? "edit_link"+                <*>  (pure $ parseMaybe parseJSON (Object o) :: Parser (Maybe Preview))+                <*> o .: "is_public" <*> o .: "public_url_shared"+                <*> o .: "channels" <*> o .: "groups" <*> o .:? "initial_comment"+                <*> fmap (fromMaybe 0) (o .:? "num_stars") <*> o .: "comments_count" )+instance FromJSON FileUrl where+  parseJSON = withObject "FileURL" (\o -> URL <$> o .: "url" <*> o .: "url_download" <*> o .: "url_private" <*> o .: "url_private_download")+instance FromJSON Thumbnail where+  parseJSON = withObject "Thumbnail" (\o -> Thumbnail <$> o .:? "thumb_64" <*> o .:? "thumb_80" <*>  o .:? "thumb_360" <*> o .:? "thumb_360_gif" <*> o .:? "thumb_360_w" <*> o .:? "thumb_360_h")+instance FromJSON Preview where+  parseJSON = withObject "preview" (\o ->  Preview <$> o .: "preview" <*> o .: "preview_highlight"+                                                   <*> o .: "lines"   <*> o .: "lines_more")++data Preview = Preview { _previewText :: Text, _previewHighlight :: Text, _lines :: Int, _linesMore :: Int } deriving Show+data FileUrl = URL { _access  :: Text,  _download :: Text, _private :: Text, _privateDownload :: Text } deriving Show+data Thumbnail = Thumbnail { _w64 :: Maybe URL, _w80 :: Maybe URL, _w360 :: Maybe URL, _w360gif :: Maybe URL, _width :: Maybe Int, _height :: Maybe Int} deriving Show++makeLenses ''File+makeLenses ''FileUrl+makeLenses ''Thumbnail+makeLenses ''Preview+++instance FromJSON Mode where+  parseJSON = withText "mode"+                (\case+                  "hosted"   -> pure Hosted+                  "external" -> pure External+                  "snippet"  -> pure Snippet+                  "post"     -> pure Post+                  s          -> fail $ "Unrecognised mode: " ++ T.unpack s)
+ src/Web/Slack/Types/Group.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.Group where++import Data.Aeson+import Data.Aeson.Types+import Control.Lens.TH+import Web.Slack.Types.Id+import Web.Slack.Types.Time+import Web.Slack.Types.Topic+import {-# SOURCE #-} Web.Slack.Types.ChannelOpt (ChannelOpt)++import Control.Applicative++import Data.Text (Text)++data Group = Group+           { _groupId         :: GroupId+           , _groupName       :: Text+           , _groupCreated    :: Time+           , _groupCreator    :: UserId+           , _groupIsArchived :: Bool+           , _groupIsOpen     :: Bool+           , _groupMembers    :: [UserId]+           , _groupTopic      :: Topic+           , _groupPurpose    :: Purpose+           , _groupOpt        :: Maybe ChannelOpt+           , _groupIsGroup    :: Bool+           } deriving (Show)++makeLenses ''Group++instance FromJSON Group where+  parseJSON = withObject "Group" (\o ->+               Group <$> o .: "id" <*> o .: "name"+                <*> o .: "created" <*> o .: "creator"+                <*> o .: "is_archived" <*> o .: "is_open"+                <*> o .: "members" <*> o .: "topic"+                <*> o .: "purpose"+                <*> (pure $ parseMaybe parseJSON (Object o) :: Parser (Maybe ChannelOpt))+                <*> o .: "is_group")
+ src/Web/Slack/Types/IM.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.IM where++import Data.Aeson+import Data.Aeson.Types+import Control.Applicative+import Control.Lens.TH++import Web.Slack.Types.Id+import Web.Slack.Types.Time+import {-# SOURCE #-} Web.Slack.Types.ChannelOpt (ChannelOpt)++data IM = IM+        { _imId      :: IMId+        , _imUser    :: UserId+        , _imCreated :: Time+        , _imIsOpen  :: Bool+        , _imIsIm    :: Bool+        , _imOpt     :: Maybe ChannelOpt+        } deriving (Show)++makeLenses ''IM++instance FromJSON IM where+  parseJSON = withObject "IM" (\o ->+               IM <$> o .: "id" <*> o .: "user"+                <*> o .: "created"+                <*> o .: "is_open"+                <*> o .: "is_im"+                <*> (pure $ parseMaybe parseJSON (Object o) :: Parser (Maybe ChannelOpt)))
+ src/Web/Slack/Types/Id.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DataKinds, KindSignatures, TemplateHaskell #-}+module Web.Slack.Types.Id+  ( UserId,+    BotId,+    ChannelId,+    FileId,+    CommentId,+    GroupId,+    IMId,+    TeamId,+    Id,+    getId+  ) where++import Data.Aeson+import Data.Text (Text)+import Control.Lens.TH++data FieldType = TUser | TBot | TChannel | TFile | TComment | TGroup | TIM | TTeam deriving (Eq, Show)++newtype Id (a :: FieldType) = Id { _getId :: Text } deriving (Show, Eq)+++instance ToJSON (Id a) where+  toJSON (Id uid) = String uid++instance FromJSON (Id a) where+  parseJSON = withText "Id" (return . Id)++type UserId    = Id TUser+type BotId     = Id TBot+type ChannelId = Id TChannel+type FileId    = Id TFile+type CommentId = Id TComment+type GroupId   = Id TGroup+type IMId      = Id TIM+type TeamId    = Id TTeam++makeLenses ''Id
+ src/Web/Slack/Types/Item.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}+module Web.Slack.Types.Item where++import Data.Aeson+import Web.Slack.Types.Id+import Web.Slack.Types.File+import Web.Slack.Types.Comment+import Web.Slack.Types.Time+import Control.Applicative+import Data.Text (Text)+import Web.Slack.Types.Base++import Control.Lens.TH++data Item = MessageItem ChannelId MessageUpdate+          | FileItem File+          | FileCommentItem File Comment+          | ChannelItem ChannelId+          | IMItem ChannelId+          | GroupItem GroupId deriving Show++instance  FromJSON Item where+  parseJSON = withObject "item" (\o -> do+                (typ :: String) <- o .: "type"+                case typ of+                  "message" -> MessageItem <$> o .: "channel" <*> o .: "message"+                  "file" -> FileItem <$> o .: "file"+                  "file_comment" -> FileCommentItem <$> o .: "file" <*> o .: "comment"+                  "channel" -> ChannelItem <$> o .: "channel"+                  "im"      -> IMItem <$> o .: "channel"+                  "group"   -> GroupItem <$> o .: "group"+                  _         -> fail $ "Unrecognised item type: " ++ typ)++data MessageUpdate = MessageUpdate+                   { _messageUpdateUser   :: UserId+                   , _messageUpdateText   :: Text+                   , _messageUpdateTime   :: SlackTimeStamp+                   , _messageUpdateEdited :: Maybe Edited+                   , _messagePermalink    :: Maybe URL+                   } deriving Show+++instance FromJSON MessageUpdate where+  parseJSON = withObject "MessageUpdate"+                (\o -> MessageUpdate <$> o .: "user"+                        <*> o .: "text" <*> o .: "ts"+                        <*> o .:? "edited" <*> o .:? "permalink" )++data Edited = Edited { _editedUser :: UserId, _editTimestap :: SlackTimeStamp } deriving Show++makeLenses ''MessageUpdate+makeLenses ''Edited++instance FromJSON Edited where+  parseJSON = withObject "Edited" (\o -> Edited <$> o .: "user" <*> o .: "ts")
+ src/Web/Slack/Types/Preferences.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE TemplateHaskell, LambdaCase #-}+module Web.Slack.Types.Preferences where++import           Data.Aeson.TH+import Data.Text (Text)+import           Web.Slack.Utils+--import Control.Lens.TH+++data Preferences = Preferences+                 { _prefHighlightWords                  :: Text+                 , _prefUserColors                      :: Text+                 , _prefColorNamesInList                :: Bool+                 , _prefGrowlsEnabled                   :: Bool+                 , _prefTimezone                        :: Maybe Text+                 , _prefPushDmAlert                     :: Bool+                 , _prefPushMentionAlert                :: Bool+                 , _prefPushEverything                  :: Bool+                 , _prefPushIdleWait                    :: Int+                 , _prefPushSound                       :: Text+                 , _prefPushLoudChannels                :: Text+                 , _prefPushLoudChannelsSet             :: Text+                 , _prefEmailAlerts                     :: Text+                 , _prefEmailAlertsSleepUntil           :: Int+                 , _prefEmailMisc                       :: Bool+                 , _prefEmailWeekly                     :: Bool+                 , _prefWelcomeMessageHidden            :: Bool+                 , _prefAllChannelsLoud                 :: Bool+                 , _prefLoudChannels                    :: Text+                 , _prefNeverChannels                   :: Text+                 , _prefLoudChannelsSet                 :: Text+                 , _prefShowMemberPresence              :: Bool+                 , _prefSearchSort                      :: Text+                 , _prefExpandInlineImgs                :: Bool+                 , _prefExpandSnippets                  :: Bool+                 , _prefPostsFormattingGuide            :: Bool+                 , _prefSeenWelcome2                    :: Bool+                 , _prefSeenSsbPrompt                   :: Bool+                 , _prefSearchOnlyMyChannels            :: Bool+                 , _prefEmojiMode                       :: Text+                 , _prefHasInvited                      :: Bool+                 , _prefHasUploaded                     :: Bool+                 , _prefHasCreatedChannel               :: Bool+                 , _prefSearchExcludeChannels           :: Text+                 , _prefMessagesTheme                   :: Text+                 , _prefWebappSpellcheck                :: Bool+                 , _prefNoJoinedOverlays                :: Bool+                 , _prefNoCreatedOverlays               :: Bool+                 , _prefDropboxEnabled                  :: Bool+                 , _prefSeenUserMenuTipCard             :: Bool+                 , _prefSeenTeamMenuTipCard             :: Bool+                 , _prefSeenChannelMenuTipCard          :: Bool+                 , _prefSeenMessageInputTipCard         :: Bool+                 , _prefSeenChannelsTipCard             :: Bool+                 , _prefSeenDomainInviteReminder        :: Bool+                 , _prefSeenMemberInviteReminder        :: Bool+                 , _prefSeenFlexpaneTipCard             :: Bool+                 , _prefMuteSounds                      :: Bool+                 , _prefArrowHistory                    :: Bool+                 , _prefTabUiReturnSelects              :: Bool+                 , _prefObeyInlineImgLimit              :: Bool+                 , _prefNewMsgSnd                       :: Text+                 , _prefCollapsible                     :: Bool+                 , _prefCollapsibleByClick              :: Bool+                 , _prefRequireAt                       :: Bool+                 , _prefMacSsbBullet                    :: Bool+                 , _prefWinSsbBullet                    :: Bool+                 , _prefExpandNonMediaAttachments       :: Bool+                 , _prefShowTyping                      :: Bool+                 , _prefPagekeysHandled                 :: Bool+                 , _prefLastSnippetType                 :: Text+                 , _prefDisplayRealNamesOverride        :: Int+                 , _prefTime24                          :: Bool+                 , _prefEnterIsSpecialInTbt             :: Bool+                 , _prefGraphicEmoticons                :: Bool+                 , _prefConvertEmoticons                :: Bool+                 , _prefAutoplayChatSounds              :: Bool+                 , _prefSsEmojis                        :: Bool+                 , _prefSidebarBehavior                 :: Text+                 , _prefMarkMsgsReadImmediately         :: Bool+                 , _prefStartScrollAtOldest             :: Bool+                 , _prefSnippetEditorWrapLongLines      :: Bool+                 , _prefLsDisabled                      :: Bool+                 , _prefSidebarTheme                    :: Text+                 , _prefSidebarThemeCustomValues        :: Text+                 , _prefFKeySearch                      :: Bool+                 , _prefKKeyOmnibox                     :: Bool+                 , _prefSpeakGrowls                     :: Bool+                 , _prefMacSpeakVoice                   :: Text+                 , _prefMacSpeakSpeed                   :: Int+                 , _prefPushAtChannelSuppressedChannels :: Text+                 , _prefPromptedForEmailDisabling       :: Bool+                 , _prefFullTextExtracts                :: Bool+                 , _prefNoTextInNotifications           :: Bool+                 , _prefMutedChannels                   :: Text+                 , _prefNoMacssb1Banner                 :: Bool+                 , _prefPrivacyPolicySeen               :: Bool+                 , _prefSearchExcludeBots               :: Bool+                 , _prefFuzzyMatching                   :: Bool+                 } deriving Show+++$(deriveJSON defaultOptions {fieldLabelModifier = \case+                                                    "prefTime24" -> "time24"+                                                    "prefNoMacssb1Banner" -> "no_macssb1_banner"+                                                    s -> toSnake . drop 4 $ s} ''Preferences)++-- Bad performance regression from lens 4.6 causes GHC to run out of memory+-- on compilation+--makeLenses ''Preferences+
+ src/Web/Slack/Types/Presence.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE LambdaCase, OverloadedStrings #-}+module Web.Slack.Types.Presence where++import Data.Aeson+import Control.Applicative+import qualified Data.Text as T++data Presence = Away | Active deriving Show++instance FromJSON Presence where+  parseJSON = withText "Presence"+                (\case+                  "active" -> pure Active+                  "away"   -> pure Away+                  s -> fail $ "Unrecognised presence type: " ++ T.unpack s)
+ src/Web/Slack/Types/Self.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.Self where++import Data.Text (Text)+import Web.Slack.Types.Preferences+import Web.Slack.Types.Id+import Web.Slack.Types.Time+import Web.Slack.Types.Presence++import Data.Aeson+import Control.Applicative+import Control.Lens.TH++data Self = Self+          { _selfUserId         :: UserId+          , _selfName           :: Text+          , _selfPreferences    :: Preferences+          , _selfCreated        :: Time+          , _selfManualPresence :: Presence+          } deriving Show++makeLenses ''Self++instance FromJSON Self where+  parseJSON = withObject "self"+                (\o -> Self <$> o .: "id" <*> o .: "name"+                        <*> o .: "prefs" <*> o .: "created"+                        <*> o .: "manual_presence")
+ src/Web/Slack/Types/Session.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, RankNTypes,+ FunctionalDependencies, MultiParamTypeClasses, FlexibleInstances #-}+module Web.Slack.Types.Session where++import Control.Applicative+import Data.Aeson+import Web.Slack.Types.User+import Web.Slack.Types.Time+import Web.Slack.Types.Self+import Web.Slack.Types.Team+import Web.Slack.Types.Channel+import Web.Slack.Types.Group+import Web.Slack.Types.IM+import Web.Slack.Types.Bot+import Data.Text (Text)+import Control.Lens.TH++data SlackSession = SlackSession+                { _slackSelf          :: Self+                , _slackTeam          :: Team+                , _slackUsers         :: [User]+                , _slackLatestEventTs :: SlackTimeStamp+                , _slackChannels      :: [Channel]+                , _slackGroups        :: [Group]+                , _slackIms           :: [IM]+                , _slackBots          :: [Bot]+                , _slackCacheVersion  :: Text+                } deriving Show++instance FromJSON SlackSession where+  parseJSON = withObject "SlackSession"+                (\o -> SlackSession <$>  o .: "self" <*> o .: "team"+                        <*> o .: "users"+                        <*> o .: "latest_event_ts" <*> o .: "channels"+                        <*> o .: "groups" <*> o .: "ims"+                        <*> o .: "bots" <*> o .: "cache_version")++makeLenses ''SlackSession
+ src/Web/Slack/Types/Team.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.Team where++import Data.Text (Text)+import Web.Slack.Types.Id+import Web.Slack.Types.TeamPreferences+import Web.Slack.Types.Base++import Control.Lens.TH+import Data.Aeson+import Control.Applicative++data Team = Team+          { _teamId                :: TeamId+          , _teamName              :: Text+          , _teamEmailDomain       :: Text+          , _teamDomain            :: Text+          , _teamPreferences       :: TeamPreferences+          , _teamIcons             :: TeamIcons+          , _teamOverStorageLimit  :: Bool+          } deriving Show++data TeamIcons = TeamIcons+               { _teamIcon34      :: URL+               , _teamIcon44      :: URL+               , _teamIcon68      :: URL+               , _teamIcon88      :: URL+               , _teamIcon102     :: URL+               , _teamIcon132     :: URL+               , _teamIconDefault :: Bool+               } deriving Show++makeLenses ''Team+makeLenses ''TeamIcons++instance FromJSON Team where+  parseJSON = withObject "team"+                (\o -> Team <$> o .: "id" <*> o .: "name"+                        <*> o .: "email_domain" <*> o .: "domain"+                        <*> o .: "prefs"+                        <*> o .: "icon" <*> o .: "over_storage_limit")++instance FromJSON TeamIcons where+ parseJSON = withObject "teamIcons"+              (\o -> TeamIcons+                      <$> o .: "image_34"+                      <*> o .: "image_44"+                      <*> o .: "image_68"+                      <*> o .: "image_88"+                      <*> o .: "image_102"+                      <*> o .: "image_132"+                      <*> o .: "image_default")
+ src/Web/Slack/Types/TeamPreferences.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FunctionalDependencies     #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeSynonymInstances       #-}+++module Web.Slack.Types.TeamPreferences where+import           Data.Aeson.TH+import Data.Text (Text)+import           Web.Slack.Utils+import Web.Slack.Types.Id+import Control.Lens.TH+++data TeamPreferences = TeamPreferences+                     { _teamDefaultChannels        :: [ChannelId]+                     , _teamMsgEditWindowMins      :: Int+                     , _teamAllowMessageDeletion   :: Bool+                     , _teamHideReferers           :: Bool+                     , _teamDisplayRealNames       :: Bool+                     , _teamWhoCanAtEveryone       :: Text+                     , _teamWhoCanAtChannel        :: Text+                     , _teamWhoCanCreateChannels   :: Text+                     , _teamWhoCanArchiveChannels  :: Text+                     , _teamWhoCanCreateGroups     :: Text+                     , _teamWhoCanPostGeneral      :: Text+                     , _teamWhoCanKickChannels     :: Text+                     , _teamWhoCanKickGroups       :: Text+                     , _teamRetentionType          :: Int+                     , _teamRetentionDuration      :: Int+                     , _teamGroupRetentionType     :: Int+                     , _teamGroupRetentionDuration :: Int+                     , _teamDmRetentionType        :: Int+                     , _teamDmRetentionDuration    :: Int+                     , _teamRequireAtForMention    :: Int+                     } deriving Show+++$(deriveJSON defaultOptions {fieldLabelModifier = toSnake . drop 4} ''TeamPreferences)++--makeLensesWith abbreviatedFields ''TeamPreferences+makeLenses ''TeamPreferences
+ src/Web/Slack/Types/Time.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE ViewPatterns, GeneralizedNewtypeDeriving, TemplateHaskell #-}+module Web.Slack.Types.Time where++import Data.Time.Clock.POSIX+import Data.Aeson+import Data.Aeson.Types+import qualified Data.Text as T+import Control.Applicative+import Control.Error+import Control.Lens.TH++default ()++newtype Time = Time { _getTime :: POSIXTime } deriving (Fractional, Num, Real, Eq, Ord, Show)++-- Might be better to keep this abstract..+data SlackTimeStamp = SlackTimeStamp { _slackTime :: Time, _timestampUid :: Int } deriving (Show, Ord, Eq)++makeLenses ''SlackTimeStamp+makeLenses ''Time++instance FromJSON SlackTimeStamp where+  parseJSON = withText "SlackTimeStamp"+                (\s -> let (ts, tail -> uid) = break (== '.') (T.unpack s) in+                  SlackTimeStamp+                    <$> fmap (Time . realToFrac) (readZ ts :: Parser Integer)+                    <*> readZ uid)++instance FromJSON Time where+  parseJSON = withScientific "Time" (return . Time . realToFrac)
+ src/Web/Slack/Types/Topic.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.Topic where++import Data.Aeson+import Data.Text (Text)+import Control.Applicative+import Control.Lens.TH++type Purpose = Topic++data Topic = Topic+           { _topicValue   :: Text+           , _topicCreator :: Text+           , _topicLastSet :: Int+           } deriving (Show)++makeLenses ''Topic++instance FromJSON Topic where+  parseJSON = withObject "topic" (\o ->+                Topic <$> o .: "value" <*> o .: "creator" <*> o .: "last_set")
+ src/Web/Slack/Types/User.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Web.Slack.Types.User where++import Control.Applicative+import Data.Aeson+import Data.Aeson.Types+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Control.Lens.TH++import Web.Slack.Types.Id+import Web.Slack.Types.Base+++data User = User+          { _userId         :: UserId+          , _userName       :: Text+          , _userDeleted    :: Bool+          , _userStatus     :: Maybe Text+          , _userColor      :: Text+          , _userProfile    :: Profile+          , _userPermission :: Permissions+          , _userHasFiles   :: Bool+          , _userTimezone   :: Timezone+          } deriving (Show)++instance FromJSON User where+  parseJSON = withObject "User" (\o -> User <$> o .: "id" <*> o .: "name" <*> o .: "deleted"+                                        <*> o .:? "status" <*> o .: "color"+                                        <*> o .: "profile" <*> (parseJSON (Object o) :: Parser Permissions)+                                        <*> fmap (fromMaybe False) (o .:? "has_files")+                                        <*> (parseJSON (Object o) :: Parser Timezone))++instance FromJSON Permissions where+  parseJSON = withObject "Permissions" (\o -> let v = (o .:) in+                                        Permissions <$> v "is_admin" <*> v "is_owner"+                                          <*> v "is_primary_owner" <*> v "is_restricted"+                                          <*> v "is_ultra_restricted" <*> v "is_bot")++data Timezone = Timezone+              { _timezoneDesc   :: Maybe Text+              , _timezoneLabel  :: Text+              , _timezoneOffset :: Int+              } deriving Show++instance FromJSON Timezone where+  parseJSON = withObject "timezone" (\o -> Timezone <$> o .: "tz" <*> o .: "tz_label" <*> o .: "tz_offset")++data Permissions = Permissions+                 { _isAdmin           :: Bool+                 , _isOwner           :: Bool+                 , _isPrimaryOwner    :: Bool+                 , _isRestricted      :: Bool+                 , _isUltraRestricted :: Bool+                 , _isBot             :: Bool+                 } deriving (Show)++data Profile = Profile+             { _profileFirstName          :: Maybe Text+             , _profileLastName           :: Maybe Text+             , _profileRealName           :: Maybe Text+             , _profileRealNameNormalized :: Maybe Text+             , _profileTitle              :: Maybe Text+             , _progileEmail              :: Maybe Text+             , _profileSkype              :: Maybe Text+             , _profilePhone              :: Maybe Text+             , _profileImage24            :: URL+             , _profileImage32            :: URL+             , _profileImage48            :: URL+             , _profileImage72            :: URL+             , _profileImage192           :: URL+             } deriving (Show)++makeLenses ''Profile+makeLenses ''Permissions+makeLenses ''Timezone++instance FromJSON Profile where+  parseJSON = withObject "Profile"+                (\o -> let v = (o .:)+                           vm = (o .:?) in+                  Profile <$> vm "first_name" <*> vm "last_name" <*> vm "real_name"+                          <*> vm "real_name_normalized" <*> vm "title" <*> vm "email"+                          <*> vm "skype" <*> vm "phone" <*> v "image_24" <*> v "image_32"+                          <*> v "image_48" <*> v "image_72" <*> v "image_192")++type Username = Text
+ src/Web/Slack/Utils.hs view
@@ -0,0 +1,16 @@+module Web.Slack.Utils where++import           Data.Char++toSnake :: String -> String+toSnake (a:b:c)+  | isAlpha a && (isUpper b || isDigit b) = toLower a : '_' : toSnake (toLower b : c)+  | otherwise = toLower a : toSnake (b:c)+toSnake [x] = [toLower x]+toSnake [] = []+++toCamel :: String -> String+toCamel ('_':x:xs) = toUpper x : toCamel xs+toCamel (x:xs) = x : toCamel xs+toCamel [] = []