slack-api 0.9 → 0.10

raw patch · 17 files changed

+446/−176 lines, 17 filesdep +hashabledep +tlsdep +wussdep −HsOpenSSLdep −openssl-streamsdep ~basedep ~lensdep ~mtlnew-component:exe:example_counterbotnew-component:exe:example_echobotPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, tls, wuss

Dependencies removed: HsOpenSSL, openssl-streams

Dependency ranges changed: base, lens, mtl, text

API changes (from Hackage documentation)

Files

• example/CounterBot.hs +41/−0
• example/EchoBot.hs +29/−0
• slack-api.cabal +76/−61
• src/Web/Slack.hs +12/−40
• src/Web/Slack/Config.hs +0/−11
• src/Web/Slack/Message.hs +0/−18
• src/Web/Slack/State.hs +1/−1
• src/Web/Slack/Types.hs +37/−35
• src/Web/Slack/Types/Event.hs +5/−6
• src/Web/Slack/Types/Event/Subtype.hs +3/−1
• src/Web/Slack/Types/IM.hs +7/−0
• src/Web/Slack/Types/Id.hs +6/−2
• src/Web/Slack/Types/Item.hs +15/−0
• src/Web/Slack/Types/Message.hs +120/−0
• src/Web/Slack/Types/Preferences.hs +0/−1
• src/Web/Slack/WebAPI.hs +93/−0
• tests/tests-main.hs +1/−0

@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell, CPP #-}+module Main where++import qualified Data.Text as T (pack)++import Web.Slack+import Web.Slack.Message++import System.Environment (lookupEnv)+import Data.Maybe (fromMaybe)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif++import Control.Lens++myConfig :: String -> SlackConfig+myConfig apiToken = SlackConfig+         { _slackApiToken = apiToken+         }++data CounterState = CounterState+                  { _messageCount :: Int+                  }++makeLenses ''CounterState++-- Count how many messages the bot recieves+counterBot :: SlackBot CounterState+counterBot (Message cid _ _ _ _ _) = do+  num <- userState . messageCount <%= (+1)+  sendMessage cid (T.pack . show $ num)+counterBot _ = return ()++main :: IO ()+main = do+  apiToken <- fromMaybe (error "SLACK_API_TOKEN not set")+               <$> lookupEnv "SLACK_API_TOKEN"+  runBot (myConfig apiToken) counterBot startState+  where+    startState = CounterState 0

@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}++module Main where++import Web.Slack+import Web.Slack.Message+import System.Environment (lookupEnv)+import Data.Maybe (fromMaybe)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif++myConfig :: String -> SlackConfig+myConfig apiToken = SlackConfig+         { _slackApiToken = apiToken -- Specify your API token here+         }++echoBot :: SlackBot ()+echoBot (Message cid _ msg _ _ _) = sendMessage cid msg+echoBot _ = return ()++main :: IO ()+main = do+  apiToken <- fromMaybe (error "SLACK_API_TOKEN not set")+               <$> lookupEnv "SLACK_API_TOKEN"+  runBot (myConfig apiToken) echoBot ()+++

@@ -1,5 +1,5 @@ Name:                slack-api-Version:             0.9+Version:             0.10 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`.@@ -20,73 +20,88 @@ Stability:           Experimental Category:            Web Build-type:          Simple-Cabal-version:       >=1.8+Cabal-version:       >=1.10 source-repository head     type: git     location: https://github.com/mpickering/slack-api.git --Library+library+  default-language:    Haskell2010   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.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-+  exposed-modules:+      Web.Slack+    , Web.Slack.Message+    , Web.Slack.State+    , Web.Slack.Types+    , Web.Slack.Types.Base+    , Web.Slack.Types.Bot+    , Web.Slack.Types.Channel+    , Web.Slack.Types.ChannelOpt+    , Web.Slack.Types.Comment+    , Web.Slack.Types.Error+    , Web.Slack.Types.Event+    , Web.Slack.Types.Event.Subtype+    , Web.Slack.Types.File+    , Web.Slack.Types.IM+    , Web.Slack.Types.Id+    , Web.Slack.Types.Item+    , Web.Slack.Types.Message+    , Web.Slack.Types.Preferences+    , Web.Slack.Types.Presence+    , Web.Slack.Types.Self+    , Web.Slack.Types.Session+    , Web.Slack.Types.Team+    , Web.Slack.Types.TeamPreferences+    , Web.Slack.Types.Time+    , Web.Slack.Types.Topic+    , Web.Slack.Types.User+    , Web.Slack.WebAPI   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,+  build-depends:+      -- corePackages (see [cabal2nix/src/Cabal2Nix/CorePackages.hs])+      base >= 4.4 && < 5+    , bytestring >= 0.9.1 && < 0.11+    , containers >= 0.4+      -- Normal Packages+    , aeson >= 0.8+    , errors >= 1.4 && < 3.0+    , hashable >= 1.2+    , io-streams >= 1.2+    , lens >= 4.8+    , lens-aeson >= 1.0+    , monad-loops >= 0.4+    , mtl >= 2.1+    , network >= 2.6+    , network-uri >= 2.6+    , text >= 1.2+    , time >= 1.4+    , time-locale-compat >= 0.1 && < 0.2+    , tls >= 1.3+    , transformers >= 0.3+    , websockets > 0.9+    , wreq >= 0.2+    , wuss >= 1.0 +test-suite tests+    default-language:    Haskell2010+    type: exitcode-stdio-1.0+    main-is: tests-main.hs+    ghc-options: -threaded  -Wall+    hs-source-dirs: tests .+    build-depends: slack-api, base+    other-modules: Tests.ConnectionTest -    -- Normal Packages-    websockets > 0.9,-    wreq                      >= 0.2,-    text >= 1.2,-    lens >= 4.8,-    lens-aeson >= 1.0 ,-    network >= 2.6,-    network-uri >= 2.6,-    openssl-streams >= 1.2,-    HsOpenSSL >= 0.11 ,-    io-streams >= 1.2,-    mtl >= 2.1,-    aeson >= 0.8 ,-    time-locale-compat >= 0.1 && < 0.2,-    errors >= 1.4 && < 3.0,-    monad-loops >= 0.4,-    transformers >= 0.3,-    time >= 1.4+executable example_echobot+    default-language:    Haskell2010+    ghc-options:         -Wall+    hs-source-dirs:      example+    main-is:             EchoBot.hs+    build-depends:       base, slack-api -Test-Suite tests-    Type: exitcode-stdio-1.0-    Main-Is: tests-main.hs-    ghc-options: -threaded  -Wall-    HS-Source-Dirs: tests .-    Build-Depends: slack-api, base-    Other-Modules: Tests.ConnectionTest+executable example_counterbot+    default-language:    Haskell2010+    ghc-options:         -Wall+    hs-source-dirs:      example+    main-is:             CounterBot.hs+    build-depends:       base, slack-api, text, mtl, lens

@@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE CPP                        #-} ------------------------------------------ -- | -- This module exposes functionality to write bots which responds@@ -38,33 +39,26 @@                  , userState                  , session                  , module Web.Slack.Types-                 , module Web.Slack.Config+                 , SlackConfig(..)                  ) where +#if !MIN_VERSION_base(4,8,0) import           Control.Applicative+#endif import           Control.Lens-import Control.Monad (forever, unless)+import           Control.Monad.Except 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.URI                as URI 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+import           Web.Slack.WebAPI+import           Wuss  -- | Run a `SlackBot`. The supplied bot will respond to all events sent by -- the Slack RTM API.@@ -73,45 +67,23 @@ -- to the Slack API fails. 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-    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 -> print (r ^. responseBody) >> (ioError . userError $ e)-      Right res -> return res+  (url, sessionInfo) <- crashOnError $ rtm_start conf   let partialState :: Metainfo -> SlackState s       partialState metainfo = SlackState metainfo sessionInfo start conf   putStrLn "rtm.start call successful"   case parseWebSocketUrl (T.unpack url) of     Just (host, path) ->-      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 partialState bot)+      runSecureClient host port path (mkBot partialState bot)     Nothing -> error $ "Couldn't parse WebSockets URL: " ++ T.unpack url   where-    port = 443 :: Int-    rtmStartUrl :: String-    rtmStartUrl = "https://slack.com/api/rtm.start?token="-                    ++ (conf ^. slackApiToken)+    port = 443     parseWebSocketUrl :: String -> Maybe (String, String)     parseWebSocketUrl url = do       uri  <- URI.parseURI url       name <- URI.uriRegName <$> URI.uriAuthority uri       return (name, URI.uriPath uri)+    crashOnError :: ExceptT T.Text IO a -> IO a+    crashOnError = either (ioError . userError . T.unpack) return <=< runExceptT  mkBot :: (Metainfo -> SlackState s) -> SlackBot s -> WS.ClientApp () mkBot partialState bot conn = do

@@ -1,11 +0,0 @@-{-# 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-                 } deriving (Show)--makeLenses ''SlackConfig

@@ -7,8 +7,6 @@ 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@@ -17,14 +15,6 @@  import Prelude -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@@ -36,14 +26,6 @@   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

@@ -15,7 +15,7 @@ import qualified Control.Monad.State       as S import qualified Network.WebSockets        as WS import           Web.Slack.Types-import           Web.Slack.Config+import           Web.Slack.WebAPI (SlackConfig) import Prelude  newtype Slack s a = Slack {runSlack :: S.StateT (SlackState s) IO a}

@@ -1,45 +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.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+module Web.Slack.Types+    ( module Web.Slack.Types.Base+    , module Web.Slack.Types.Bot+    , module Web.Slack.Types.Channel+    , module Web.Slack.Types.ChannelOpt+    , module Web.Slack.Types.Comment+    , module Web.Slack.Types.Error+    , module Web.Slack.Types.Event+    , module Web.Slack.Types.Event.Subtype+    , module Web.Slack.Types.File+    , module Web.Slack.Types.IM+    , module Web.Slack.Types.Id+    , module Web.Slack.Types.Item+    , module Web.Slack.Types.Message+    , module Web.Slack.Types.Preferences+    , module Web.Slack.Types.Presence+    , module Web.Slack.Types.Self+    , module Web.Slack.Types.Session+    , module Web.Slack.Types.Team+    , module Web.Slack.Types.TeamPreferences+    , module Web.Slack.Types.Time+    , module Web.Slack.Types.Topic+    , module Web.Slack.Types.User+    ) 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.Item-import Web.Slack.Types.User import Web.Slack.Types.ChannelOpt+import Web.Slack.Types.Comment+import Web.Slack.Types.Error import Web.Slack.Types.Event+import Web.Slack.Types.Event.Subtype+import Web.Slack.Types.File+import Web.Slack.Types.IM import Web.Slack.Types.Id-import Web.Slack.Types.Time-import Web.Slack.Types.Error+import Web.Slack.Types.Item+import Web.Slack.Types.Message import Web.Slack.Types.Preferences-import Web.Slack.Types.TeamPreferences-import Web.Slack.Types.Team+import Web.Slack.Types.Presence import Web.Slack.Types.Self import Web.Slack.Types.Session-import Web.Slack.Types.Presence+import Web.Slack.Types.Team+import Web.Slack.Types.TeamPreferences+import Web.Slack.Types.Time+import Web.Slack.Types.Topic+import Web.Slack.Types.User

@@ -21,9 +21,8 @@  import Control.Lens.TH import Control.Applicative+import Control.Monad import Data.Text (Text)-import qualified Data.Text as T-import Data.Monoid import Prelude  type Domain = Text@@ -70,8 +69,8 @@   PrefChange :: Pref -> Event   UserChange :: User -> Event   TeamJoin :: User -> Event-  ReactionAdded :: UserId -> Maybe Text -> Item -> SlackTimeStamp -> Event-  ReactionRemoved :: UserId -> Maybe Text -> Item -> SlackTimeStamp -> Event+  ReactionAdded :: UserId -> Text -> UserId {- item author -} -> EmbeddedItem -> SlackTimeStamp -> Event+  ReactionRemoved :: UserId -> Maybe Text -> EmbeddedItem -> SlackTimeStamp -> Event   StarAdded :: UserId -> Item -> SlackTimeStamp -> Event   StarRemoved :: UserId -> Item -> SlackTimeStamp -> Event   EmojiChanged :: SlackTimeStamp -> Event@@ -125,7 +124,7 @@         submitter <- case subt of                       Just (SBotMessage bid _ _) -> return $ BotComment bid                       _ -> maybe System UserComment <$> v .:? "user"-        (v .: "channel") :: Parser ChannelId+        void $ (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"@@ -169,7 +168,7 @@       "pref_change" -> curry PrefChange <$> v .: "name" <*> v .: "value"       "user_change" -> UserChange <$> v .: "user"       "team_join"   -> TeamJoin <$> v .: "user"-      "reaction_added" -> ReactionAdded <$> v .: "user" <*> v .:? "name" <*> v .: "item" <*> v .: "event_ts"+      "reaction_added" -> ReactionAdded <$> v .: "user" <*> v .: "reaction" <*> v .: "item_user" <*> v .: "item" <*> v .: "event_ts"       "reaction_removed" -> ReactionRemoved <$> v .: "user" <*> v .:? "name" <*> v .: "item" <*> v .: "event_ts"       "star_added" ->  StarAdded <$> v .: "user" <*> v .: "item" <*> v .: "event_ts"       "star_removed" -> StarRemoved <$> v .: "user" <*> v .: "item" <*> v .: "event_ts"

@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase, GADTs, OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE LambdaCase, GADTs, OverloadedStrings, TemplateHaskell, CPP #-} module Web.Slack.Types.Event.Subtype (Subtype(..), subtype) where  import Data.Aeson@@ -9,7 +9,9 @@ import Web.Slack.Types.Comment import Web.Slack.Types.Bot import Web.Slack.Types.Item+#if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif import Data.Text (Text) import Control.Lens.TH 

@@ -3,6 +3,7 @@  import Data.Aeson import Data.Aeson.Types+import Data.Coerce import Control.Applicative import Control.Lens.TH @@ -30,3 +31,9 @@                 <*> o .: "is_open"                 <*> o .: "is_im"                 <*> (pure $ parseMaybe parseJSON (Object o) :: Parser (Maybe ChannelOpt)))++imToChannel :: IMId -> ChannelId+imToChannel = coerce++channelToIM :: ChannelId -> IMId+channelToIM = coerce

@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, KindSignatures, TemplateHaskell #-}+{-# LANGUAGE DataKinds, KindSignatures, TemplateHaskell, DeriveGeneric #-} module Web.Slack.Types.Id   ( UserId,     BotId,@@ -14,10 +14,12 @@ import Data.Aeson import Data.Text (Text) import Control.Lens.TH+import Data.Hashable+import GHC.Generics  data FieldType = TUser | TBot | TChannel | TFile | TComment | TIM | TTeam deriving (Eq, Show) -newtype Id (a :: FieldType) = Id { _getId :: Text } deriving (Show, Eq)+newtype Id (a :: FieldType) = Id { _getId :: Text } deriving (Show, Eq, Ord, Generic)   instance ToJSON (Id a) where@@ -25,6 +27,8 @@  instance FromJSON (Id a) where   parseJSON = withText "Id" (return . Id)++instance Hashable (Id a)  type UserId    = Id 'TUser type BotId     = Id 'TBot

@@ -20,6 +20,12 @@           | IMItem ChannelId           | GroupItem ChannelId deriving Show +data EmbeddedItem+          = EmbeddedMessageItem ChannelId SlackTimeStamp+          | EmbeddedFileItem FileId+          | EmbeddedFileCommentItem FileId CommentId+          deriving Show+ instance  FromJSON Item where   parseJSON = withObject "item" (\o -> do                 (typ :: String) <- o .: "type"@@ -31,6 +37,15 @@                   "im"      -> IMItem <$> o .: "channel"                   "group"   -> GroupItem <$> o .: "group"                   _         -> fail $ "Unrecognised item type: " ++ typ)++instance FromJSON EmbeddedItem where+  parseJSON = withObject "item" $ \o -> do+                (typ :: String) <- o .: "type"+                case typ of+                  "message"      -> EmbeddedMessageItem <$> o .: "channel" <*> o .: "ts"+                  "file"         -> EmbeddedFileItem <$> o .: "file"+                  "file_comment" -> EmbeddedFileCommentItem <$> o .: "file" <*> o .: "file_comment"+                  _              -> fail $ "Unrecognised item type: " ++ typ  data MessageUpdate = MessageUpdate                    { _messageUpdateUser   :: UserId

@@ -0,0 +1,120 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}++module Web.Slack.Types.Message where++import Data.Aeson+import Data.Aeson.TH+import qualified Data.Text as T+import Data.Time.Clock.POSIX+import GHC.Generics+import Web.Slack.Types.Base+import Web.Slack.Types.Id+import Web.Slack.Utils++data MessagePayload = MessagePayload+    { messageId      :: Int+    , messageType    :: T.Text+    , messageChannel :: ChannelId+    , messageText    :: T.Text+    } deriving (Show)++data PingPayload = PingPayload+    { pingId        :: Int+    , pingType      :: T.Text+    , pingTimestamp :: Int+    } deriving (Show)++data Attachment = Attachment+    { attachmentFallback :: T.Text+        -- ^ A plain-text summary of the attachment.+    , attachmentColor :: AttachmentColor+        -- ^ Used to color the border along the left side of the message+        -- attachment.+    , attachmentPretext :: Maybe T.Text+        -- ^ Optional text that appears above the message attachment block.+    , attachmentAuthorName :: Maybe T.Text+        -- ^ Small text used to display the author's name.+    , attachmentAuthorLink :: Maybe URL+        -- ^ A valid URL that will hyperlink the author_name text mentioned+        -- above.+    , attachmentAuthorIcon :: Maybe URL+        -- ^ A valid URL that displays a small 16x16px image to the left of+        -- the author_name text.+    , attachmentTitle :: Maybe T.Text+        -- ^ The title is displayed as larger, bold text near the top of+        -- a message attachment.+    , attachmentTitleLink :: Maybe URL+        -- ^ By passing a valid URL, the title text will be hyperlinked.+    , attachmentText :: Maybe T.Text+        -- ^ This is the main text in a message attachment, and can contain+        -- standard message markup.+    , attachmentFields :: [Field]+    , attachmentImageUrl :: Maybe URL+        -- ^ An image file that will be displayed inside a message+        -- attachment. GIF, JPEG, PNG, or BMP; scaled down to 400x500px.+    , attachmentThumbUrl :: Maybe URL+        -- ^ Displayed as a thumbnail on the right side of a message+        -- attachment. GIF, JPEG, PNG, or BMP; scaled down to 75x75px.+    , attachmentFooter :: Maybe T.Text+        -- ^ Add some brief text to help contextualize and identify an+        -- attachment.+    , attachmentFooterIcon :: Maybe URL+        -- ^ Render a small icon beside your footer text. Scaled to 16x16px.+    , attachmentTs :: Maybe POSIXTime+        -- ^ Display an additional timestamp value as part of the+        -- attachment's footer.+    }++data Field = Field+    { fieldTitle :: Maybe T.Text+        -- ^ Shown as a bold heading above the value text. It cannot+        -- contain markup and will be escaped for you.+    , fieldValue :: T.Text+        -- ^ The text value of the field. It may contain standard message+        -- markup and must be escaped as normal. May be multi-line.+    , fieldShort :: Bool+        -- ^ Whether the value is short enough to be displayed side-by-side+        -- with other values.+    }++data AttachmentColor+    = DefaultColor       -- grey+    | GoodColor          -- green+    | WarningColor       -- yellow+    | DangerColor        -- red+    | CustomColor T.Text -- hexadecimal RGB colour, eg. CustomColor "#439FE0"+    deriving (Generic)++defaultAttachment :: Attachment+defaultAttachment = Attachment+        { attachmentFallback = ""+        , attachmentColor = DefaultColor+        , attachmentPretext = Nothing+        , attachmentAuthorName = Nothing+        , attachmentAuthorLink = Nothing+        , attachmentAuthorIcon = Nothing+        , attachmentTitle = Nothing+        , attachmentTitleLink = Nothing+        , attachmentText = Nothing+        , attachmentFields = []+        , attachmentImageUrl = Nothing+        , attachmentThumbUrl = Nothing+        , attachmentFooter = Nothing+        , attachmentFooterIcon = Nothing+        , attachmentTs = Nothing+        }++instance ToJSON AttachmentColor where+    toEncoding x = toEncoding $ case x of+        DefaultColor  -> Nothing+        GoodColor     -> Just "good"+        WarningColor  -> Just "warning"+        DangerColor   -> Just "danger"+        CustomColor c -> Just c++$(deriveToJSON defaultOptions {fieldLabelModifier = toSnake . drop 7}  ''MessagePayload)+$(deriveToJSON defaultOptions {fieldLabelModifier = toSnake . drop 4}  ''PingPayload)+$(deriveToJSON defaultOptions {fieldLabelModifier = toSnake . drop 10} ''Attachment)+$(deriveToJSON defaultOptions {fieldLabelModifier = toSnake . drop 5}  ''Field)

@@ -29,7 +29,6 @@                  , _prefLoudChannels                    :: Text                  , _prefNeverChannels                   :: Text                  , _prefLoudChannelsSet                 :: Text-                 , _prefShowMemberPresence              :: Bool                  , _prefSearchSort                      :: Text                  , _prefExpandInlineImgs                :: Bool                  , _prefExpandSnippets                  :: Bool

@@ -0,0 +1,93 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.Slack.WebAPI+    ( SlackConfig(..)+    , makeSlackCall++      -- * Methods+    , rtm_start+    , chat_postMessage+    ) where++import Control.Lens hiding ((??))+import Control.Monad.Except+import Data.Aeson+import Data.Aeson.Lens+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.Wreq as W+import Web.Slack.Types++-- | Configuration options needed to connect to the Slack API+data SlackConfig = SlackConfig+   { _slackApiToken :: String -- ^ API Token for Bot+   } deriving (Show)++makeLenses ''SlackConfig++makeSlackCall+    :: (MonadError T.Text m, MonadIO m)+    => SlackConfig+    -> String+    -> (W.Options -> W.Options)+    -> m Value+makeSlackCall conf method setArgs = do+    let url = "https://slack.com/api/" ++ method+    let setToken = W.param "token" .~ [T.pack (conf ^. slackApiToken)]+    let opts = W.defaults & setToken & setArgs+    rawResp <- liftIO $ W.getWith opts url+    resp <- rawResp ^? W.responseBody . _Value ?? "Couldn't parse response"+    case resp ^? key "ok"  . _Bool of+        Just True  -> return resp+        Just False -> throwError $ resp ^. key "error" . _String+        Nothing    -> throwError "Couldn't parse key 'ok' from response"++-------------------------------------------------------------------------------+-- Methods++-- See https://api.slack.com/methods for the docs.++rtm_start+    :: (MonadError T.Text m, MonadIO m)+    => SlackConfig+    -> m (T.Text, SlackSession)+rtm_start conf = do+    resp <- makeSlackCall conf "rtm.start" id+    url <- resp ^? key "url" . _String ?? "rtm_start: No url!"+    sessionInfo <- fromJSON' resp+    return (url, sessionInfo)++chat_postMessage+    :: (MonadError T.Text m, MonadIO m)+    => SlackConfig+    -> ChannelId+    -> T.Text+    -> [Attachment]+    -> m ()+chat_postMessage conf (Id cid) msg as =+    void $ makeSlackCall conf "chat.postMessage" $+        (W.param "channel"     .~ [cid]) .+        (W.param "text"        .~ [msg]) .+        (W.param "attachments" .~ [encode' as]) .+        (W.param "as_user"     .~ ["true"])++-------------------------------------------------------------------------------+-- Helpers++encode' :: ToJSON a => a -> T.Text+encode' = T.decodeUtf8 . BL.toStrict . encode++fromJSON' :: (FromJSON a, MonadError T.Text m) => Value -> m a+fromJSON' x = case fromJSON x of+    Error e -> throwError (T.pack e)+    Success r -> return r++-- | Like '(??)' from Control.Error, but a bit more general and with the+-- right precedence.+infixl 7 ??+(??) :: MonadError e m => Maybe a -> e -> m a+x ?? e = maybe (throwError e) return x+

@@ -2,4 +2,5 @@  import qualified Tests.ConnectionTest as C +main :: IO () main = C.main