diff --git a/Network/Linklater.hs b/Network/Linklater.hs --- a/Network/Linklater.hs +++ b/Network/Linklater.hs @@ -1,59 +1,44 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, GADTs #-} -- | -- Module: Network.Linklater -- Copyright: (c) The Linklaterteers --- -- License: BSD-style +-- Maintainer: me@haolian.org -- Stability: experimental -- Portability: GHC -- --- Features: --- --- * Uses @Text@ everywhere so you can send your slash commands crazy Unicode characters all day long. --- * Lovely documentation. --- * Battle-tested. --- -- 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 diplomatico@ in one of your channels, you'll get the --- image from @http://diplomatico.jpg.to@. How, you say? /Screen scraping/. --- --- @ --- urlParser :: Parser B.ByteString --- urlParser = p --- where --- p = garbage *> url --- garbage = string "src=\"" <|> (P.take 1 *> garbage) --- url = takeTill (== _quotedbl) +-- type @/jpgto baby corgi@ in one of your channels, you'll get the +-- image from @http://baby.corgi.jpg.to@. How, you say? /Screen scraping/. -- --- urlFor :: Text -> IO Text --- urlFor search = do --- r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search]) --- (return . handle . parse urlParser . strictly) (r ^. responseBody) --- where --- strictly = B.concat . L.toChunks --- handle (Fail i ctxs s) = error (show (i, ctxs, s)) --- handle (Partial f) = handle (f "") --- handle (Done _ r) = toText r +-- > -- Remaining imports left as an exercise to the reader. +-- > import Network.Linklater (say, slashSimple, Command(..), Config(..), Message(..), Icon(..), Format(..)) +-- > -- +-- > +-- > findUrl :: Text -> Maybe Text +-- > findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) +-- > +-- > jpgto :: Maybe Command -> IO Text +-- > jpgto (Just (Command user channel (Just text))) = do +-- > message <- (fmap messageOf . findUrl . decodeUtf8 . flip (^.) responseBody) <$> get ("http://" <> (unpack subdomain) <> ".jpg.to/") +-- > case (debug, message) of +-- > (True, _) -> putStrLn ("+ Pretending to post " <> (unpack . decodeUtf8 . encode) message) >> return "" +-- > (False, Just m) -> config' >>= say m >> return "" +-- > (False, Nothing) -> return "Something went wrong!" +-- > where config' = (Config "trello.slack.com" . filter (/= '\n') . pack) <$> readFile "token" +-- > subdomain = (intercalate "." . fmap (filter isLetter . filter isAscii) . words) text +-- > messageOf url = FormattedMessage (EmojiIcon "gift") "jpgtobot" channel [FormatAt user, FormatLink url (subdomain <> ".jpg.to>"), FormatString "no way!: &<>"] +-- > debug = True +-- > jpgto _ = return "Type more! (Did you know? jpgtobot is only 26 lines of Haskell. )" +-- > +-- > main :: IO () +-- > main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slashSimple jpgto) -- --- jpgto :: Maybe Command -> Application --- jpgto (Just (Command (User user) channel text)) req respond = do --- url <- urlFor (maybe "spolsky" id text) --- say (Message channel (response url) (EmojiIcon "gift")) config --- (respond . responseLBS status200 headers) "" --- where --- response url = F.format "@{} {}" (user, url) --- config = Config token "trello.slack.com" --- headers = [("Content-Type", "text/plain")] +-- One @/jpgto baby corgi@, et voila. -- --- main :: IO () --- main = do --- let port = 80 --- putStrLn (F.format "+ Listening on port {}" [port]) --- run port (slash jpgto) --- return () --- @ +-- <> -- -- For the full example (since this one is missing a ton of imports), -- see the @examples/@ directory on GitHub. @@ -64,29 +49,33 @@ ( say, slash, + slashSimple, Channel(..), User(..), Message(..), Config(..), Command(..), Icon(..), + Format(..) ) where import Control.Applicative ((<$>)) import Data.Aeson -import Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy as BSL import qualified Data.Map as M +import Data.Monoid import Data.Text.Lazy (Text) -import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE +import Network.HTTP.Types (status200) import qualified Network.Wai as W -import Network.Wreq hiding (params) +import Network.Wreq hiding (params, headers) --- | Where slash commands can come from, and where messages can go. +-- | 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?). + -- | A private conversation with your best friend -- or lover ;). | IMChannel Text deriving (Eq, Ord, Show) @@ -104,55 +93,94 @@ _commandText :: Maybe Text } deriving (Eq, Ord, Show) --- | For example, @":stars2:"@. Future versions should support actual --- images, I GUESS. -newtype Icon = EmojiIcon 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) --- | Here's how you talk. -data Message = Message { - -- | You need a channel. It can be a group channel or a private IM. - -- Alert: if it's a private IM, it'll look like it came from - -- slackbot (as of writing). - _messageChannel :: Channel, - -- | What you want to say. This will be parsed in full (parse=full). - -- In the future I'll support other forms of parsing, hopefully. - -- Poke me with a pull request if I forget. - _messageText :: Text, - -- | The icon you want your message to appear as. - _messageIcon :: Icon - } deriving (Eq, Ord, Show) +-- | A little DSL for . +data Format = + -- | @"\<\@user|user>"@ + FormatAt User + -- | @"\<\@user|user did this and that>"@ + | FormatUser User Text + -- | @"\"@ + | 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 (\(bad, good) -> TL.replace bad good) 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 where + SimpleMessage :: Icon -> Text -> Channel -> Text -> Message + FormattedMessage :: Icon -> Text -> Channel -> [Format] -> Message + instance ToJSON Message where - toJSON (Message channel text (EmojiIcon emoji)) = - object [ "channel" .= stringOfChannel channel - , "icon_emoji" .= TL.concat [":", emoji, ":"] - , "parse" .= String "full" - , "username" .= String "jpgtobot" - , "text" .= text - ] + toJSON m = case m of + (FormattedMessage emoji username channel formats) -> + toJSON_ emoji username channel (TL.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" .= stringOfChannel channel + , "icon_emoji" .= TL.concat [":", emoji, ":"] + , "parse" .= String (if toParse then "full" else "poop") + , "username" .= username + , "text" .= raw + , "unfurl_links" .= True + ] stringOfChannel (GroupChannel c) = TL.concat ["#", c] - stringOfChannel (IMChannel m) = TL.concat ["@", m] + stringOfChannel (IMChannel im) = TL.concat ["@", im] --- | Like a curiosity about the world, you'll need one of these to say something. +-- | Like a curiosity about the world, you'll need one of these to +-- 'say' something. data Config = Config { - -- | This is the incoming web hook token that Slack gave you. It's usually a long alphanumberic string of garbage. - _configIncomingHookToken :: Text, - -- | This is where your Slack account is hosted. For example, 'trello.slack.com'. - _configHostname :: Text + -- | This is where your Slack account is hosted. For example, + -- @"trello.slack.com"@. + _configHostname :: Text, + -- | This is the incoming web hook token that Slack gave you. It's + -- usually a long alphanumberic string of garbage. + _configIncomingHookToken :: Text } --- | The 'say' function posts a Message, with a capital M, to Slack. --- It'll, ahem, need your token first though. -say :: Message -> Config -> IO (Response ByteString) +-- | 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 (TL.unpack url) (encode message) where -- TODO: use a URL builder url = TL.concat ["https://", _configHostname config, "/services/hooks/incoming-webhook?token=", _configIncomingHookToken config] --- | A bot server! As if by magic. This acts like a WAI middleware in --- that you let us wrap around your application. +-- | 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)) + where + headers = [("Content-type", "text/plain")] + makeResponse = W.responseLBS status200 headers . TLE.encodeUtf8 + +-- | 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 = f command req respond where diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -8,6 +8,13 @@ Uh, do you want to be friends? Well let's talk about it later, because right now I have an example for you. +But you'll have to grab me first: + +* `cabal sandbox init` +* `cabal install linklater` + +If you don't have Haskell, it's quite easy: [Windows](http://www.haskell.org/platform/), [Mac](http://ghcformacosx.github.io/), and [Linux](https://gist.githubusercontent.com/hlian/b5a975252997cb3e0020/raw/e4ecab3042225d321a88ee74e804c38ead38ed52/gistfile1.txt). + ## Show me an example! Here's a `/jpgto` bot. If you run this program and then tell Slack @@ -16,42 +23,27 @@ image from [http://diplomatico.jpg.to](http://diplomatico.jpg.to). How, you say? _Screen scraping_. ```haskell -import Network.Linklater (say, slash, - Command(..), Config(..), Icon(..), Message(..), User(..)) - -urlParser :: Parser B.ByteString -urlParser = p - where - p = garbage *> url - garbage = string "src=\"" <|> (P.take 1 *> garbage) - url = takeTill (== _quotedbl) +-- Remaining imports left as an exercise to the reader. +import Network.Linklater (say, slashSimple, Command(..), Config(..), Message(..), Icon(..), Format(..)) -urlFor :: Text -> IO Text -urlFor search = do - r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search]) - (return . handle . parse urlParser . strictly) (r ^. responseBody) - where - strictly = B.concat . L.toChunks - handle (Fail i ctxs s) = error (show (i, ctxs, s)) - handle (Partial f) = handle (f "") - handle (Done _ r) = toText r +findUrl :: Text -> Maybe Text +findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) -jpgto :: Maybe Command -> Application -jpgto (Just (Command (User user) channel text)) req respond = do - url <- urlFor (maybe "spolsky" id text) - say (Message channel (response url) (EmojiIcon "gift")) config - (respond . responseLBS status200 headers) "" - where - response url = F.format "@{} {}" (user, url) - config = Config token "trello.slack.com" - headers = [("Content-Type", "text/plain")] +jpgto :: Maybe Command -> IO Text +jpgto (Just (Command user channel (Just text))) = do + message <- (fmap messageOf . findUrl . decodeUtf8 . flip (^.) responseBody) <$> get ("http://" <> (unpack subdomain) <> ".jpg.to/") + case (debug, message) of + (True, _) -> putStrLn ("+ Pretending to post " <> (unpack . decodeUtf8 . encode) message) >> return "" + (False, Just m) -> config' >>= say m >> return "" + (False, Nothing) -> return "Something went wrong!" + where config' = (Config "trello.slack.com" . filter (/= '\n') . pack) <$> readFile "token" + subdomain = (intercalate "." . fmap (filter isLetter . filter isAscii) . words) text + messageOf url = FormattedMessage (EmojiIcon "gift") "jpgtobot" channel [FormatAt user, FormatLink url (subdomain <> ".jpg.to>"), FormatString "no way!: &<>"] + debug = True +jpgto _ = return "Type more! (Did you know? jpgtobot is only 26 lines of Haskell. )" main :: IO () -main = do - let port = 80 - putStrLn (F.format "+ Listening on port {}" [port]) - run port (slash jpgto) - return () +main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slashSimple jpgto) ``` For the full example (since this one is missing a ton of imports), see diff --git a/corgi.jpg b/corgi.jpg new file mode 100644 Binary files /dev/null and b/corgi.jpg differ diff --git a/examples/JointPhotographicExpertsGroupTonga.hs b/examples/JointPhotographicExpertsGroupTonga.hs --- a/examples/JointPhotographicExpertsGroupTonga.hs +++ b/examples/JointPhotographicExpertsGroupTonga.hs @@ -1,63 +1,37 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-} +-- Full package here: https://github.com/hlian/jpgtobot/ module JointPhotographicExpertsGroupTonga where -import Control.Applicative -import Control.Lens hiding ((.=)) -import Control.Monad -import Data.Attoparsec.ByteString -import qualified Data.Attoparsec.ByteString as P -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import qualified Data.Text.Format as F -import Data.Text.Lazy (Text) -import qualified Data.Text.Lazy as T -import Data.Text.Lazy.Encoding (decodeUtf8) -import Data.Text.Lazy.IO -import Data.Word8 -import Network.HTTP.Types (status200) -import Network.Linklater -import Network.Wai -import Network.Wai.Handler.Warp (run) -import Network.Wreq hiding (params, headers) -import Prelude hiding (readFile, writeFile, putStrLn) - -toText :: B.ByteString -> Text -toText = decodeUtf8 . L.fromChunks . return - -token :: Text -token = undefined +import BasePrelude hiding (words, intercalate) +import Control.Lens ((^.)) +import Data.Attoparsec.Text.Lazy +import Data.Text.Lazy hiding (filter) +import Data.Text.Lazy.Encoding (decodeUtf8) +import Network.HTTP.Types (status200) +import Network.Linklater (say, slash, Channel(..), Command(..), User(..), Config(..), Message(..), Icon(..)) +import Network.Wai (Application, responseLBS) +import Network.Wai.Handler.Warp (run) +import Network.Wreq hiding (params) -urlParser :: Parser B.ByteString -urlParser = p - where - p = garbage *> url - garbage = string "src=\"" <|> (P.take 1 *> garbage) - url = takeTill (== _quotedbl) +findUrl :: Text -> Maybe Text +findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) -urlFor :: Text -> IO Text -urlFor search = do - r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search]) - (return . handle . parse urlParser . strictly) (r ^. responseBody) - where - strictly = B.concat . L.toChunks - handle (Fail i ctxs s) = error (show (i, ctxs, s)) - handle (Partial f) = handle (f "") - handle (Done _ r) = toText r +messageOf :: User -> Channel -> Text -> Text -> Message +messageOf (User u) c search = Message (EmojiIcon "gift") c . mappend (mconcat ["@", u, " Hello, wanderer. I found you this for \"", search, "\": "]) jpgto :: Maybe Command -> Application -jpgto (Just (Command (User user) channel text)) req respond = do - url <- urlFor (maybe "spolsky" id text) - say (Message channel (response url) (EmojiIcon "gift")) config - (respond . responseLBS status200 headers) "" - where - response url = F.format "@{} {}" (user, url) - config = Config token "trello.slack.com" - headers = [("Content-Type", "text/plain")] +jpgto (Just (Command user channel (Just text))) _ respond = do + message <- get url >>= (return . fmap (messageOf user channel text) . findUrl . decodeUtf8 . flip (^.) responseBody) + case (debug, message) of + (True, _) -> putStrLn ("+ Pretending to post " <> show message) >> respondWith "" + (False, Just m) -> config' >>= say m >> respondWith "" + (False, Nothing) -> respondWith "Something went wrong!" + where ourHeaders = [("Content-Type", "text/plain")] + respondWith = respond . responseLBS status200 ourHeaders + config' = (Config "trello.slack.com" . pack . filter (/= '\n')) <$> readFile "token" + url = "http://" <> (unpack . intercalate "." . words $ text) <> ".jpg.to/" + debug = True main :: IO () -main = do - let port = 80 - putStrLn (F.format "+ Listening on port {}" [port]) - run port (slash jpgto) - return () +main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slash jpgto) diff --git a/linklater.cabal b/linklater.cabal --- a/linklater.cabal +++ b/linklater.cabal @@ -2,12 +2,13 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: linklater -version: 1.0.0.3 -synopsis: Write bots for your Slack account, and then go to sleep (because it's so easy and late at night) +version: 2.0.0.0 +synopsis: The fast and fun way to write Slack.com bots homepage: https://github.com/hlian/linklater +bug-reports: https://github.com/hlian/linklater/issues license: BSD3 license-file: LICENSE -author: Hao Lian +author: Hao Lian maintainer: me@haolian.org category: Network build-type: Simple @@ -15,15 +16,32 @@ description: . - A library for writing Slack chat bots. + __A library for writing Slack chat bots.__ . - A mistake? + Tutorial: + . + Features you could take advantage of /right now, should you choose/: + . + * Uses 'Text' for state-of-the-art Unicode support; + * Lovely documentation with no misspelllllings to be found; + * A warm, receptive maintainer with beautiful brown eyes; + * Fully Haddock'd methods and module; + * Open source (BSD3). + . + For example, maybe you want this little guy to show up in your channel: + . + <> + . + Find out how by clicking on "Network.Linklater"! extra-source-files: examples/*.hs README.md changelog +extra-doc-files: + corgi.jpg + flag developer default: False manual: True @@ -45,4 +63,9 @@ bytestring >=0.10.4.0 && <0.11, text >=1.1.1.3 && <1.2, containers >=0.5 && <0.6, - wai >=3.0.0.2 && <3.1 + wai >=3.0.0.2 && <3.1, + http-types >=0.8.5 && <0.9 + +source-repository head + type: git + location: https://github.com/hlian/linklater