linklater-3.2.0.0: Network/Linklater.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module: Network.Linklater
-- Copyright: (c) The Linklaterteers
-- License: BSD-style
-- Maintainer: hi@haolian.org
-- Stability: experimental
-- Portability: GHC
--
-- Here's a @/jpgto@ bot! If you run this program and then tell Slack
-- about your server (incoming hook and custom slash command) and then
-- type @/jpgto baby corgi@ in one of your channels, you'll get the
-- image from @http://baby.corgi.jpg.to@.
--
-- <https://github.com/hlian/linklater/blob/master/examples/JointPhotographicExpertsGroupTonga.hs>
--
-- One @/jpgto baby corgi@, et voila.
--
-- <<https://raw.githubusercontent.com/hlian/linklater/6232b950a333cfa6d5fffea997ec9ab8c2ce31ba/corgi.jpg>>
module Network.Linklater
(
say,
slash,
slashSimple,
Channel(..),
User(..),
Message(..),
Config(..),
Command(..),
Icon(..),
Format(..)
) where
import BasePrelude
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Network.HTTP.Types (status200, parseSimpleQuery)
import qualified Network.Wai as W
import Network.Wreq hiding (params, headers)
-- | Where 'slash' commands come from, and where 'Message's go.
data Channel =
-- | A public or private group.
GroupChannel Text
-- | A private conversation with your best friend -- or lover ;).
| IMChannel Text
deriving (Eq, Ord, Show)
-- | A username: no at-signs, just text!
newtype User = User Text deriving (Eq, Ord, Show)
-- | Incoming HTTP requests to the slash function get parsed into one
-- of these babies.
data Command = Command {
-- | The command name.
_commandName :: Text,
-- | Who ran your slash command.
_commandUser :: User,
-- | Where the person ran your slash command.
_commandChannel :: Channel,
-- | Text for the slash command, if any.
_commandText :: Maybe Text
} deriving (Eq, Ord, Show)
-- | The icon next to the messages you `say`. (Images unsupported
-- right now, sorry.)
newtype Icon =
-- | For example, ":stars2:".
EmojiIcon Text deriving (Eq, Ord, Show)
-- | A little DSL for <https://api.slack.com/docs/formatting Slack formatting>.
data Format =
-- | @"\<\@user|user>"@
FormatAt User
-- | @"\<\@user|user did this and that>"@
| FormatUser User Text
-- | @"\<http://example.com|user did this and that>"@
| FormatLink Text Text
-- | @"user did this & that"@
| FormatString Text
unformat :: Format -> Text
unformat (FormatAt user@(User u)) = unformat (FormatUser user u)
unformat (FormatUser (User u) t) = "<@" <> u <> "|" <> t <> ">"
unformat (FormatLink url t) = "<" <> url <> "|" <> t <> ">"
unformat (FormatString t) = foldr (uncurry T.replace) t [("<", "<"), (">", ">"), ("&", "&")]
-- | Here's how you talk: you make one of these and pass it to 'say'.
-- Before the day is done, Linklater will convert this to a JSON blob
-- using 'Data.Aeson'.
--
-- * Simple messages are parsed by Slack with parse=full (i.e. as if you had typed it into the input box).
--
-- * Complex messages are parsed according to Slack formatting. See 'Format'.
--
data Message =
SimpleMessage Icon Text Channel Text
| FormattedMessage Icon Text Channel [Format]
instance ToJSON Channel where
toJSON (GroupChannel c) =
String ("#" <> c)
toJSON (IMChannel im) =
String ("@" <> im)
instance ToJSON Message where
toJSON m = case m of
(FormattedMessage emoji username channel formats) ->
toJSON_ emoji username channel (T.intercalate " " (fmap unformat formats)) False
(SimpleMessage emoji username channel text) ->
toJSON_ emoji username channel text True
where
toJSON_ (EmojiIcon emoji) username channel raw toParse =
object [ "channel" .= channel
, "icon_emoji" .= (":" <> emoji <> ":")
, "parse" .= String (if toParse then "full" else "poop")
, "username" .= username
, "text" .= raw
, "unfurl_links" .= True
]
-- | Like a curiosity about the world, you'll need one of these to
-- 'say' something.
data Config = Config {
-- | This is the incoming web hook URL that Slack gave you. It's
-- usually @https://hooks.slack.com/services/...@.
_configHookURL :: Text
}
-- | The 'say' function posts a 'Message', with a capital M, to Slack.
-- It'll, however, need a 'Config' (a.k.a. incoming token) first.
say :: Message -> Config -> IO (Response BSL.ByteString)
say message Config{..} =
post (T.unpack _configHookURL) (encode message)
-- | A bot server for people who are in a hurry. Make a function that
-- takes a 'Command' and returns some 'Text' in 'IO' world, and we'll
-- convert it into a 'Network.WAI' application. If you want more
-- control over the request and respond, see 'slash'.
slashSimple :: (Maybe Command -> IO Text) -> W.Application
slashSimple f =
slash (\command _ respond -> f command >>= (respond . makeResponse . TL.fromStrict))
where
headers =
[("Content-type", "text/plain")]
makeResponse =
W.responseLBS status200 headers . TLE.encodeUtf8
channelOf :: User -> Text -> Maybe Channel
channelOf (User u) "directmessage" =
Just (IMChannel u)
channelOf _ "privategroup" =
Nothing
channelOf _ c =
Just (GroupChannel c)
paramsIO :: W.Request -> IO (M.Map Text Text)
paramsIO req = do
body <- W.strictRequestBody req
return (M.fromList ((second TE.decodeUtf8 . first TE.decodeUtf8) <$> parseSimpleQuery (BSL.toStrict body)))
-- | A bot server! As if by magic. This acts like a 'Network.WAI'
-- middleware: Linklater wraps around your application. (Really, it
-- just gives you a 'Command' to work with instead of a raw HTTP
-- request.)
slash :: (Maybe Command -> W.Application) -> W.Application
slash f req respond = do
params <- paramsIO req
f (command (`M.lookup` params)) req respond
where
command paramOf = do
user <- userOf <$> paramOf "user_name"
Command <$> (nameOf <$> paramOf "command")
<*> return user
<*> (paramOf "channel_name" >>= channelOf user)
<*> return (paramOf "text")
userOf = User . T.filter (/= '@')
nameOf = T.filter (/= '/')