slack-web (empty) → 0.1.0
raw patch · 11 files changed
+880/−0 lines, 11 filesdep +aesondep +basedep +generics-sopsetup-changed
Dependencies added: aeson, base, generics-sop, http-api-data, http-client, http-client-tls, servant, servant-client, text, transformers
Files
- CHANGELOG.md +1/−0
- LICENSE.md +22/−0
- README.md +35/−0
- Setup.hs +0/−0
- slack-web.cabal +58/−0
- src/Web/Slack.hs +174/−0
- src/Web/Slack/Api.hs +94/−0
- src/Web/Slack/Auth.hs +93/−0
- src/Web/Slack/Channel.hs +171/−0
- src/Web/Slack/Chat.hs +148/−0
- src/Web/Slack/Util.hs +84/−0
+ CHANGELOG.md view
@@ -0,0 +1,1 @@+# 0.1.0
+ LICENSE.md view
@@ -0,0 +1,22 @@+MIT License++Copyright (c) 2017 Juan Pedro Villa Isaza++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.
+ README.md view
@@ -0,0 +1,35 @@+# Haskell bindings for the Slack web API++## Example++```+> import qualified Web.Slack as Slack+```++```+> import qualified Web.Slack.Api as Api+```++```+> manager <- Slack.mkManager+```++```+> :set -XRecordWildCards+> Slack.Cli{..} = Slack.mkCli+apiTest :: ...+authTest :: ...+channelsCreate :: ...+chatPostMessage :: ...+```++```+> Slack.run manager (apiTest Api.mkTestReq)+Right ...+```++```+> :set -XOverloadedStrings+> Slack.run manager (apiTest Api.mkTestReq { testReqFoo = Just "bar" })+Right ...+```
+ Setup.hs view
+ slack-web.cabal view
@@ -0,0 +1,58 @@+name: slack-web+version: 0.1.0++build-type: Simple+cabal-version: >= 1.21++license: MIT+license-file: LICENSE.md++copyright: 2017 Juan Pedro Villa Isaza+author: Juan Pedro Villa Isaza <jpvillaisaza@gmail.com>+maintainer: Juan Pedro Villa Isaza <jpvillaisaza@gmail.com>++homepage: https://github.com/jpvillaisaza/slack-web+bug-reports: https://github.com/jpvillaisaza/slack-web/issues++synopsis: Bindings for the Slack web API+description: Haskell bindings for the Slack web API.++category: Web++tested-with: GHC == 8.0.2++extra-source-files:+ CHANGELOG.md+ README.md+++library+ hs-source-dirs:+ src+ exposed-modules:+ Web.Slack+ Web.Slack.Api+ Web.Slack.Auth+ Web.Slack.Channel+ Web.Slack.Chat+ Web.Slack.Util+ build-depends:+ aeson >= 1.1 && < 1.2+ , base >= 4.9 && < 4.10+ , generics-sop >= 0.2 && < 0.3+ , http-api-data >= 0.3 && < 0.4+ , http-client >= 0.5 && < 0.6+ , http-client-tls >= 0.3 && < 0.4+ , servant >= 0.10 && < 0.11+ , servant-client >= 0.10 && < 0.11+ , text >= 1.2 && < 1.3+ , transformers+ default-language:+ Haskell2010+ ghc-options:+ -Wall+++source-repository head+ type: git+ location: https://github.com/jpvillaisaza/slack-web
+ src/Web/Slack.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack+ ( Cli(..)+ , mkCli+ , run+ , mkManager+ )+ where++-- base+import Data.Proxy (Proxy(..))+import GHC.Generics (Generic)++-- generics-sop+import qualified Generics.SOP (Generic)++-- http-client+import Network.HTTP.Client (Manager, newManager)++-- http-client-tls+import Network.HTTP.Client.TLS (tlsManagerSettings)++-- servant+import Servant.API++-- servant-client+import Servant.Client+import Servant.Client.Generic++-- slack-web+import qualified Web.Slack.Api as Api+import qualified Web.Slack.Auth as Auth+import qualified Web.Slack.Channel as Channel+import qualified Web.Slack.Chat as Chat++-- transformers+import Control.Monad.IO.Class+++-- |+--+--++type Api =+ "api.test"+ :> ReqBody '[FormUrlEncoded] Api.TestReq+ :> Post '[JSON] Api.TestRsp+ :<|>+ "auth.test"+ :> ReqBody '[FormUrlEncoded] Auth.TestReq+ :> Post '[JSON] Auth.TestRsp+ :<|>+ "channels.create"+ :> ReqBody '[FormUrlEncoded] Channel.CreateReq+ :> Post '[JSON] Channel.CreateRsp+ :<|>+ "chat.postMessage"+ :> ReqBody '[FormUrlEncoded] Chat.PostMsgReq+ :> Post '[JSON] Chat.PostMsgRsp+++-- |+--+--++data Cli =+ Cli+ { -- |+ --+ -- Check API calling code.+ --+ -- <https://api.slack.com/methods/api.test>++ apiTest+ :: Api.TestReq+ -> ClientM Api.TestRsp++ -- |+ --+ -- Check authentication and identity.+ --+ -- <https://api.slack.com/methods/auth.test>++ , authTest+ :: Auth.TestReq+ -> ClientM Auth.TestRsp++ -- |+ --+ -- Create a channel.+ --+ -- <https://api.slack.com/methods/channels.create>++ , channelsCreate+ :: Channel.CreateReq+ -> ClientM Channel.CreateRsp++ -- |+ --+ -- Send a message to a channel.+ --+ -- <https://api.slack.com/methods/chat.postMessage>++ , chatPostMessage+ :: Chat.PostMsgReq+ -> ClientM Chat.PostMsgRsp++ }+ deriving (Generic)+++-- |+--+--++instance Generics.SOP.Generic Cli+++-- |+--+--++instance (Client Api ~ cli) => ClientLike cli Cli+++-- |+--+--++mkCli :: Cli+mkCli =+ mkClient (client (Proxy :: Proxy Api))+++-- |+--+--++run+ :: MonadIO m+ => Manager+ -> ClientM a+ -> m (Either ServantError a)+run manager =+ let+ baseUrl =+ BaseUrl Https "slack.com" 443 "/api"++ in+ liftIO . flip runClientM (ClientEnv manager baseUrl)+++-- |+--+--++mkManager :: IO Manager+mkManager =+ newManager tlsManagerSettings
+ src/Web/Slack/Api.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Api+-- Description:+--+--+--+----------------------------------------------------------------------+++module Web.Slack.Api+ ( TestReq(..)+ , mkTestReq+ , TestRsp(..)+ )+ where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- http-api-data+import Web.FormUrlEncoded++-- slack-web+import Web.Slack.Util++-- text+import Data.Text (Text)+++-- |+--+--++data TestReq =+ TestReq+ { testReqError :: Maybe Text+ , testReqFoo :: Maybe Text+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "testReq") ''TestReq)+++-- |+--+--++instance ToForm TestReq where+ toForm =+ genericToForm (formOpts "testReq")+++-- |+--+--++mkTestReq :: TestReq+mkTestReq =+ TestReq+ { testReqError = Nothing+ , testReqFoo = Nothing+ }+++-- |+--+--++data TestRsp =+ TestRsp+ { testRspOk :: Bool+ , testRspArgs :: Maybe TestReq+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "testRsp") ''TestRsp)
+ src/Web/Slack/Auth.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Auth+-- Description:+--+--+--+----------------------------------------------------------------------+++module Web.Slack.Auth+ where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- http-api-data+import Web.FormUrlEncoded++-- slack-web+import Web.Slack.Util++-- text+import Data.Text (Text)+++-- |+--+--++newtype TestReq =+ TestReq+ { testReqToken :: Text+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "testReq") ''TestReq)+++-- |+--+--++instance ToForm TestReq where+ toForm =+ genericToForm (formOpts "testReq")+++-- |+--+--++mkTestReq+ :: Text+ -> TestReq+mkTestReq =+ TestReq+++-- |+--+--++data TestRsp =+ TestRsp+ { testRspOk :: Bool+ , testRspUrl :: Text+ , testRspTeam :: Text+ , testRspUser :: Text+ , testRspTeamId :: Text+ , testRspUserId :: Text+ , testRspEnterpriseId :: Maybe Text+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "testRsp") ''TestRsp)
+ src/Web/Slack/Channel.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Channel+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Channel+ ( Channel(..)+ , Purpose(..)+ , Topic(..)+ , CreateReq(..)+ , mkCreateReq+ , CreateRsp(..)+ )+ where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- http-api-data+import Web.FormUrlEncoded++-- slack-web+import Web.Slack.Util++-- text+import Data.Text (Text)+++-- |+--+--++data Channel =+ Channel+ { channelId :: Text+ , channelName :: Text+ , channelCreated :: Integer+ , channelCreator :: Text+ , channelIsArchived :: Bool+ , channelIsMember :: Bool+ , channelIsGeneral :: Bool+ , channelLastRead :: Text+ , channelLatest :: Maybe Text+ , channelUnreadCount :: Integer+ , channelUnreadCountDisplay :: Integer+ , channelMembers :: [Text]+ , channelTopic :: Topic+ , channelPurpose :: Purpose+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++data Purpose =+ Purpose+ { purposeValue :: Text+ , purposeCreator :: Text+ , purposeLastSet :: Integer+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++data Topic =+ Topic+ { topicValue :: Text+ , topicCreator :: Text+ , topicLastSet :: Integer+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "channel") ''Channel)+++-- |+--+--++$(deriveJSON (jsonOpts "purpose") ''Purpose)+++-- |+--+--++$(deriveJSON (jsonOpts "topic") ''Topic)+++-- |+--+--++data CreateReq =+ CreateReq+ { createReqToken :: Text+ , createReqName :: Text+ , createReqValidate :: Maybe Bool+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "createReq") ''CreateReq)+++-- |+--+--++instance ToForm CreateReq where+ toForm =+ genericToForm (formOpts "createReq")+++-- |+--+--++mkCreateReq+ :: Text+ -> Text+ -> CreateReq+mkCreateReq token name =+ CreateReq+ { createReqToken = token+ , createReqName = name+ , createReqValidate = Nothing+ }+++-- |+--+--++data CreateRsp =+ CreateRsp+ { createRspOk :: Bool+ , createRspChannel :: Channel+ }+ deriving (Eq, Generic, Show)+++-- |+--+--+$(deriveJSON (jsonOpts "createRsp") ''CreateRsp)
+ src/Web/Slack/Chat.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Chat+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Chat+ ( PostMsg(..)+ , PostMsgReq(..)+ , mkPostMsgReq+ , PostMsgRsp(..)+ )+ where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- http-api-data+import Web.FormUrlEncoded++-- slack-web+import Web.Slack.Util++-- text+import Data.Text (Text)+++data PostMsg =+ PostMsg+ { postMsgText :: Text+ , postMsgParse :: Maybe Text+ , postMsgLinkNames :: Maybe Bool+ , postMsgAttachments :: Maybe Text+ , postMsgUnfurlLinks :: Maybe Bool+ , postMsgUnfurlMedia :: Maybe Bool+ , postMsgUsername :: Maybe Text+ , postMsgAsUser :: Maybe Bool+ , postMsgIconUrl :: Maybe Text+ , postMsgIconEmoji :: Maybe Text+ , postMsgThreadTs :: Maybe Text+ , postMsgReplyBroadcast :: Maybe Bool+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "postMsg") ''PostMsg)+++-- |+--+--++data PostMsgReq =+ PostMsgReq+ { postMsgReqToken :: Text+ , postMsgReqChannel :: Text+ , postMsgReqText :: Text+ , postMsgReqParse :: Maybe Text+ , postMsgReqLinkNames :: Maybe Bool+ , postMsgReqAttachments :: Maybe Text+ , postMsgReqUnfurlLinks :: Maybe Bool+ , postMsgReqUnfurlMedia :: Maybe Bool+ , postMsgReqUsername :: Maybe Text+ , postMsgReqAsUser :: Maybe Bool+ , postMsgReqIconUrl :: Maybe Text+ , postMsgReqIconEmoji :: Maybe Text+ , postMsgReqThreadTs :: Maybe Text+ , postMsgReqReplyBroadcast :: Maybe Bool+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "postMsgReq") ''PostMsgReq)+++-- |+--+--++instance ToForm PostMsgReq where+ toForm =+ genericToForm (formOpts "postMsgReq")+++-- |+--+--++mkPostMsgReq+ :: Text+ -> Text+ -> Text+ -> PostMsgReq+mkPostMsgReq token channel text =+ PostMsgReq+ { postMsgReqToken = token+ , postMsgReqChannel = channel+ , postMsgReqText = text+ , postMsgReqParse = Nothing+ , postMsgReqLinkNames = Nothing+ , postMsgReqAttachments = Nothing+ , postMsgReqUnfurlLinks = Nothing+ , postMsgReqUnfurlMedia = Nothing+ , postMsgReqUsername = Nothing+ , postMsgReqAsUser = Nothing+ , postMsgReqIconUrl = Nothing+ , postMsgReqIconEmoji = Nothing+ , postMsgReqThreadTs = Nothing+ , postMsgReqReplyBroadcast = Nothing+ }+++-- |+--+--++data PostMsgRsp =+ PostMsgRsp+ { postMsgRspOk :: Bool+ , postMsgRspTs :: String+ , postMsgRspMessage :: PostMsg+ }+ deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "postMsgRsp") ''PostMsgRsp)
+ src/Web/Slack/Util.hs view
@@ -0,0 +1,84 @@+----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Util+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Util+ ( formOpts+ , jsonOpts+ )+ where++-- aeson+import Data.Aeson.TH++-- base+import Data.Char++-- http-api-data+import Web.FormUrlEncoded (FormOptions(FormOptions))++-- text+import Data.Text (Text)+import qualified Data.Text as Text+++-- |+--+--++formOpts+ :: Text+ -> FormOptions+formOpts prefix =+ FormOptions (modifyLabel prefix)+++-- |+--+--++jsonOpts+ :: Text+ -> Options+jsonOpts prefix =+ defaultOptions+ { fieldLabelModifier = modifyLabel prefix+ }+++-- |+--+--++modifyLabel+ :: Text+ -> String+ -> String+modifyLabel prefix =+ fmap toLower+ . addUnderscores+ . drop (Text.length prefix)+++-- |+--+--++addUnderscores+ :: String+ -> String+addUnderscores =+ let+ go res [] = res+ go [] (x:xs) = go [toLower x] xs+ go res (x:xs)+ | isUpper x = go (toLower x : '_' : res) xs+ | otherwise = go (x : res) xs++ in+ reverse . go []