tightrope (empty) → 0.1.0.0

raw patch · 4 files changed

+187/−0 lines, 4 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, http-types, lens, mtl, text, wai, wai-extra, wreq

Files

• LICENSE +20/−0
• Network/Tightrope.hs +129/−0
• Setup.hs +2/−0
• tightrope.cabal +36/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 Ian Henry++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,129 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}++module Network.Tightrope (+  Slack,+  Command,+  User(..), Channel(..), Icon(..), Room(..),+  say, bot, message, defaultMessage,+  Account(..),+  source, user, name, text,+  iconEmoji, destination, username,+  liftIO+) where+import qualified Network.Wai as Wai+import qualified Network.Wreq as Wreq+import           Control.Lens hiding ((.=))+import qualified Data.Aeson as Aeson+import           Data.Aeson ((.=))+import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Text.Lazy (fromStrict)+import qualified Data.Text.Lazy.Encoding as LazyEncoding+import qualified Data.Text.Encoding as StrictEncoding+import           Data.ByteString.Lazy (ByteString)+import           Network.HTTP.Types.Status (status200)+import           Network.Wai.Parse as WaiParse+import           Data.Map ((!))+import qualified Data.Map as Map+import           Control.Monad.Reader (MonadReader, MonadIO, ReaderT, liftIO, ask, runReaderT)+import           Control.Applicative (Applicative)+import           Data.Monoid (mconcat)++newtype User = User Text deriving (Show, Eq, Ord)+newtype Channel = Channel Text deriving (Show, Eq, Ord)+newtype Icon = Icon Text deriving (Show, Eq, Ord)++data Room = Public Channel | Private User deriving (Show, Eq, Ord)++data Command = Command { _commandSource :: Room+                       , _commandUser :: User+                       , _commandName :: Text+                       , _commandText :: Text+                       }+$(makeFields ''Command)++data Message = Message { _messageIconEmoji :: Icon+                       , _messageDestination :: Room+                       , _messageUsername :: Text+                       , _messageText :: Text+                       }+$(makeFields ''Message)++defaultMessage :: Message+defaultMessage = message+                 (Icon "ghost")+                 "Tightrope Bot"+                 "I love Tightrope"+                 (Public $ Channel "general")+                 +message :: Icon -> Text -> Text -> Room -> Message+message icon username text room =+  Message { _messageIconEmoji = icon+          , _messageDestination = room+          , _messageUsername = username+          , _messageText = text+          }++type Token = String+type Url = String+data Account = Account Token Url++instance Aeson.ToJSON Room where+  toJSON (Private u) = Aeson.toJSON u+  toJSON (Public c) = Aeson.toJSON c++instance Aeson.ToJSON User where+  toJSON (User u) = Aeson.String (Text.append "@" u)++instance Aeson.ToJSON Channel where+  toJSON (Channel c) = Aeson.String (Text.append "#" c)++instance Aeson.ToJSON Icon where+  toJSON (Icon i) = Aeson.String (mconcat [":", i, ":"])++instance Aeson.ToJSON Message where+  toJSON m = Aeson.object [ "channel" .= (m ^. destination)+                          , "icon_emoji" .= (m ^. iconEmoji)+                          , "username" .= (m ^. username)+                          , "text" .= (m ^. text)+                          ]++newtype Slack m = Slack (ReaderT Account IO m)+  deriving (Functor, Applicative, Monad, MonadIO, MonadReader Account)++say :: Message -> Slack (Wreq.Response ByteString)+say msg = do+  Account token path <- ask+  let opts = Wreq.defaults & Wreq.param "token" .~ [Text.pack token]+  liftIO $ Wreq.postWith opts path (Aeson.toJSON msg)++roomFromText :: User -> Text -> Room+roomFromText u "directmessage" = Private u+roomFromText _ channelName = Public (Channel channelName)++parseCommand :: Wai.Request -> IO Command+parseCommand req = do+  (paramList, _) <- WaiParse.parseRequestBody WaiParse.lbsBackEnd req+  let params = Map.fromList paramList+      decode = StrictEncoding.decodeUtf8 . (params !)+      requestor = User (decode "user_name")++  return Command { _commandSource = roomFromText requestor (decode "channel_name")+                 , _commandUser = requestor+                 , _commandName = decode "command"+                 , _commandText = decode "text"+                 }++bot :: Account -> (Command -> Slack Text) -> Wai.Application+bot acc handler req res = do+  command <- parseCommand req+  let (Slack m) = handler command+  responseText <- liftIO $ runReaderT m acc+  let responseBytes = LazyEncoding.encodeUtf8 (fromStrict responseText)+  res $ Wai.responseLBS status200 [contentType] responseBytes+  where contentType = ("Content-Type", "text/plain; charset=utf-8")

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

@@ -0,0 +1,36 @@+name:                tightrope+version:             0.1.0.0+synopsis:            Nice API for a Slackbot+description:         Making bots for Slack is hard! But wait: now it's easy.+license:             MIT+license-file:        LICENSE+author:              Ian Henry+maintainer:          ianthehenry@gmail.com+-- copyright:+category:            Web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/ianthehenry/tightrope++library+  exposed-modules: Network.Tightrope+  -- other-modules:+  -- other-extensions:+  build-depends:       wai-extra == 3.*,+                       base == 4.*,+                       wai,+                       wreq,+                       aeson,+                       bytestring,+                       lens,+                       mtl,+                       text,+                       containers,+                       http-types++  -- hs-source-dirs:+  default-language:    Haskell2010