diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014, Hao Lian +Copyright (c) 2014-2016, Hao Lian All rights reserved. diff --git a/Network/Linklater.hs b/Network/Linklater.hs deleted file mode 100644 --- a/Network/Linklater.hs +++ /dev/null @@ -1,189 +0,0 @@ -{-# 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@. --- --- --- --- One @/jpgto baby corgi@, et voila. --- --- <> - -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 . -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 (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 (/= '/') diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,45 +0,0 @@ -## Who let you in here? - -Relax! I'm here to make your life easier. Has your company ever -switched to using [Slack](https://slack.com), and then you wanted to -write silly Slack bots in Haskell as a way to learn Haskell? - -Really?WowThat was a pretty specific question. - -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! - -* [jpgtobot](https://github.com/hlian/jpgtobot/blob/master/Main.hs) is a slackbot that pastes the image at `foo.jpg.to` into chat. It even supports jpgto's flags: so `-- r+gif` will give you a GIF, randomly selected from all known images named `foo`. Thanks to the magic of -screen scraping-. - - ![jpgtobot in action](https://raw.githubusercontent.com/hlian/linklater/38536bebf00c60fb1214b2c3a741ce00485e87af/corgi.jpg) - -* [hi5bot](https://github.com/hlian/hi5bot/blob/master/Main.hs) lets you high-five people. There are other amazing things it can do too. - -## Features - - * Uses `Text` for state-of-the-art Unicode support; - * Lovely documentation with no misspelllllings to be found; - * Supports [Slack's formatting syntax](https://api.slack.com/docs/formatting Slack's formatting syntax) - * Comes with a fast mode (`slashSimple`) and a power mode (`slash`) - * A warm, receptive maintainer with beautiful brown eyes; - * Fully Haddock'd methods and module; - * Open source (BSD3). - -## Contributors - -* [Hao Lian](https://hao.codes), author; -* [Ulysses Popple](http://upopple.com/); and -* [Ian Henry](https://ianthehenry.com/), who showed me the `flip (+) foo` -> `(+ foo)` trick; -* *Shields* (the Grizzly Bear album), which I listened all the way through for the first time while I was writing this ★★★★. - -## See also - -* [tightrope](https://github.com/ianthehenry/tightrope), a library Ian should really document diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,33 +0,0 @@ --*- markdown -*- - -## 2015-07-21 3.2.0 - -* Slack.com seems to have broken GET incoming hooks, so we're switching to POST -* Support for Stack -* Unconstrained dependencies - -## 2015-04-01 3.1.0 - -* Removed: silly usage of GADTs -* Simpler: incoming hook tokens are now incoming hook URLs -* Corgi picture: made bigger -* Added: Command now carries the name of the command - * Patch by Ulysses Popple -* Text: stricter! - * I decided to make the library take strict texts only, - as they are simpler to reason about and lead to fewer - conversions: really only WAI vends lazy text - * Sorry for the churn! - -## 2014-07-27 2.0.0 - -* Documentation improved with links -* jpgtobot code shortened due to market forces -* slashSimple -* FormattedMessage - -## 2014-07-23 1.0.0 - -* Initial release -* slash and run -* Command, Channel, User, Message, Icon diff --git a/corgi.jpg b/corgi.jpg deleted file mode 100644 Binary files a/corgi.jpg and /dev/null differ diff --git a/examples/JointPhotographicExpertsGroupTonga.hs b/examples/JointPhotographicExpertsGroupTonga.hs deleted file mode 100644 --- a/examples/JointPhotographicExpertsGroupTonga.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoImplicitPrelude #-} - --- If writing Slack bots intrigues you, check out: https://github.com/hlian/linklater - -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -import Control.Lens ((^.)) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) -import Data.Aeson (encode) -import Data.ByteString.Lazy (ByteString) -import Data.Char (isAlphaNum, isAscii) -import Data.Text (Text) -import Data.Text.Lazy.Encoding (decodeUtf8) -import Network.HTTP.Base (urlEncode) -import Network.Wai.Handler.Warp (run) - --- Naked imports. -import BasePrelude hiding (words, intercalate) -import Data.Attoparsec.Text.Lazy -import Network.Linklater -import Network.Wreq hiding (params) - -findURL :: ByteString -> Maybe Text -findURL = - encode . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) . decode - where - encode = - maybeResult - decode = - decodeUtf8 - -configIO :: IO Config -configIO = - Config <$> (T.filter (/= '\n') . T.pack <$> readFile "hook") - -urlOf :: Text -> Text -> String -urlOf query path = - "http://" <> urlEncode (T.unpack query) <> ".jpg.to/" <> T.unpack path - -parseText :: Text -> Maybe (Text, Text) -parseText text = - f (filter (/= "") (T.strip <$> T.splitOn "--" text)) - where - f [] = mzero - f [raw] = return (parseRaw raw, "") - f [raw, options] = return (parseRaw raw, "/" <> options) - f _ = mzero - parseRaw = T.intercalate "." . T.words - -liftMaybe :: Maybe a -> MaybeT IO a -liftMaybe = maybe mzero return - -messageOfCommand :: Command -> MaybeT IO Message -messageOfCommand (Command "jpeg" _ _ (Nothing)) = - mzero -messageOfCommand (Command "jpeg" user channel (Just text)) = do - (query, path) <- liftMaybe (parseText text) - response <- liftIO (get (urlOf query path)) - url <- liftMaybe (findURL $ response ^. responseBody) - return (messageOf [FormatAt user, FormatLink url (query <> ".jpg.to" <> path)]) - where - messageOf = - FormattedMessage (EmojiIcon "gift") "jpgtobot" channel - -jpgto :: Maybe Command -> IO Text -jpgto Nothing = do - return "Unrecognized Slack request!" - -jpgto (Just command) = do - putStrLn ("+ Incoming command: " <> show command) - config <- configIO - message <- (runMaybeT . messageOfCommand) command - putStrLn ("+ Outgoing messsage: " <> show (encode <$> message)) - case (debug, message) of - (False, Just m) -> do - say m config - return "" - (False, Nothing) -> - return "*FRIZZLE* ERROR PROCESSING INPUT; BEGIN SELF-DETONATION; PLEASE FILE ISSUE AT " - _ -> - return "" - where - debug = False - -main :: IO () -main = do - putStrLn ("+ Listening on port " <> show port) - run port (slashSimple jpgto) - where - port = 3333 diff --git a/lib/Network/Linklater.hs b/lib/Network/Linklater.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Linklater.hs @@ -0,0 +1,134 @@ +{-# 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@. +-- +-- +-- +-- One @/jpgto baby corgi@, et voila. +-- +-- <> + +module Network.Linklater + ( + -- * Types + Channel(..), + User(..), + Message(..), + Config(..), + Command(..), + Icon(..), + Format(..), + -- * API calls + say, + startRTM, + startRTMWithOptions, + -- * HTTP bot servers + slash, + slashSimple, + ) where + +import qualified Data.Aeson as Aeson +import Network.HTTP.Types (status200, status400, parseSimpleQuery, ResponseHeaders) +import Network.Wai (responseLBS, strictRequestBody, Application, Request) +import qualified Network.Wai as Wai +import qualified URI.ByteString as URI + +import Control.Lens +import Control.Monad.Except +import Data.Aeson.Lens +import Data.Text.Strict.Lens +import Network.Linklater.Batteries +import Network.Linklater.Types +import Network.Wreq hiding (Response, params, headers) + + +headers :: ResponseHeaders +headers = + [("Content-type", "text/plain")] + +responseOf :: Status -> Text -> Wai.Response +responseOf status message = + responseLBS status headers (message ^. (re utf8 . lazy)) + +-- | 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 :: (Command -> IO Text) -> Application +slashSimple f = + slash (\command _ respond -> f command >>= (respond . responseOf status200)) + +-- | 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 :: (Command -> Application) -> Application +slash inner req respond = do + params <- _paramsIO req + case commandOfParams params of + Right command -> + inner command req respond + Left msg -> + respond (responseOf status400 ("linklater: unable to parse request: " <> msg ^. packed)) + +---------------------------------------- +-- ~ API calls ~ + +-- | I POST a 'Message' to Slack and return the HTTP response. +-- However, I need a 'Config' (containing an incoming hook configured +-- through Slack administration) first. +-- +-- Guaranted to not throw an unchecked exception. +say :: (MonadError RequestError m, MonadIO m) => Message -> Config -> m () +say message Config{..} = do + _ <- tryRequest (postWith _reasonableOptions (_configHookURL ^. unpacked) (Aeson.encode message)) + pure () + +-- | I GET a WebSocket 'URI' from Slack's real-time messaging +-- endpoint. However, I need an 'APIToken' (configured through Slack +-- administration) first. +-- +-- Guaranted to not throw an unchecked exception. +startRTM :: (MonadError RequestError m, MonadIO m) => APIToken -> m URI.URI +startRTM token = + startRTMWithOptions (_reasonableOptions & authenticate) + where + authenticate = + (param "token" .~ [view coerced token]) . (param "simple_latest" .~ ["1"]) . (param "no_unreads" .~ ["1"]) + +startRTMWithOptions :: (MonadError RequestError m, MonadIO m) => Options -> m URI.URI +startRTMWithOptions opts = do + response <- tryRequest (getWith opts (_u "/api/rtm.start")) + (value :: Aeson.Value) <- Aeson.eitherDecode (response ^. responseBody) & promoteEither response id + rawURI <- value ^? key "url" . _String . re utf8 & promoteMaybe response (show value) + URI.parseURI URI.strictURIParserOptions rawURI & promoteEither response show + +---------------------------------------- +-- ~ Helpers ~ + +-- | Disables Wreq's default behavior of throwing exceptions, which +-- seems reckless +_reasonableOptions :: Options +_reasonableOptions = + defaults & checkResponse .~ Nothing + +_paramsIO :: Request -> IO (Map Text Text) +_paramsIO req = do + lazyBytes <- strictRequestBody req + let query = lazyBytes ^.. (strict . to parseSimpleQuery . traverse . to (both %~ view utf8)) + return (fromList query) + +_u :: String -> String +_u = ("https://slack.com" ++) diff --git a/lib/Network/Linklater/Batteries.hs b/lib/Network/Linklater/Batteries.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Linklater/Batteries.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Network.Linklater.Batteries (module X) where + +import BasePrelude as X hiding ((&), lazy) +import Control.Monad.Catch as X + (MonadThrow(..)) +import Control.Monad.Reader as X + (MonadIO(..)) +import Data.Map as X (Map) +import Data.Text as X (Text) +import GHC.Exts as X (fromList) diff --git a/lib/Network/Linklater/Types.hs b/lib/Network/Linklater/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Linklater/Types.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Network.Linklater.Types where + +import qualified Control.Exception.Safe as Ex +import qualified Data.ByteString.Lazy as LazyBytes +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Network.Wreq as Wreq + +import BasePrelude +import Control.Lens hiding ((.=)) +import Control.Monad.Except +import Data.Aeson + +-- | The unique 'C' Slack assigns to each channel. Used to +-- 'say' things. +type ChannelID = Text + +-- | Where 'slash' commands come from and where 'Message's go. +data Channel = Channel !ChannelID !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 . +data Format = + -- | @"\<\@user|user>"@ + FormatAt !User + -- | @"\<\@user|user did this and that>"@ + | FormatUser !User !Text + -- | @"\"@ + | FormatLink !Text !Text + -- | @"user did this & that"@ + | FormatString !Text + +-- | 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] + +-- | 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 + } + +-- | An API token, either a tester token or one obtained through +-- OAuth. +-- +-- See: +-- +-- * @https://api.slack.com/docs/oauth-test-tokens@ +-- +-- * @https://api.slack.com/docs/oauth@ +newtype APIToken = + APIToken Text + deriving (Show, Eq, Ord) + +type Response = Wreq.Response LazyBytes.ByteString + +-- | Rather than throwing unchecked exceptions from our HTTP requests, +-- we catch all unchecked exceptions and convert them to checked +-- 'RequestError' values. +data RequestError = + RequestError { _requestErrorException :: !(Maybe SomeException) + -- ^ An unchecked exception, typically 'IOException', occurred + , _requestErrorResponse :: !(Maybe Response) + -- ^ Something awry with the response, typically a non-2xx response + , _requestErrorDecoding :: !(Maybe String) + -- ^ Something awry with the JSON decoding + } deriving Show + +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 Text.replace) t (asList [("<", "<"), (">", ">"), ("&", "&")]) + +commandOfParams :: Map.Map Text Text -> Either String Command +commandOfParams params = do + user <- userOf <$> paramOf "user_name" + channel <- Channel <$> paramOf "channel_id" <*> paramOf "channel_name" + Command <$> (nameOf <$> paramOf "command") + <*> pure user + <*> pure channel + <*> pure (either (const Nothing) Just (paramOf "text")) + where + userOf = User . Text.filter (/= '@') + nameOf = Text.filter (/= '/') + paramOf key = case params ^. at key of + Just value -> Right value + Nothing -> Left ("paramOf: no key: " <> show key) + +tryRequest :: (MonadIO m, MonadError RequestError m) => IO Response -> m Response +tryRequest io = do + either_ <- liftIO $ Ex.try io + case either_ of + Left e -> + throwError (RequestError (Just e) Nothing Nothing) + Right response -> do + let code = response ^. Wreq.responseStatus . Wreq.statusCode + if code >= 200 && code < 300 then + pure response + else + throwError (RequestError Nothing (Just response) Nothing) + +promoteEither :: MonadError RequestError m => Response -> (l -> String) -> Either l r -> m r +promoteEither response l2s = + \case Left l -> throwError $ RequestError Nothing (Just response) (Just $ l2s l) + Right r -> pure r + +promoteMaybe :: MonadError RequestError m => Response -> String -> Maybe r -> m r +promoteMaybe response s = + \case Nothing -> throwError $ RequestError Nothing (Just response) (Just s) + Just r -> pure r + +asList :: [a] -> [a] +asList = id + +instance ToJSON Channel where + toJSON (Channel cid _) = toJSON cid + +instance ToJSON Message where + toJSON m = case m of + (FormattedMessage emoji username channel formats) -> + toJSON_ emoji username channel (Text.unwords (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 + ] diff --git a/linklater.cabal b/linklater.cabal --- a/linklater.cabal +++ b/linklater.cabal @@ -1,72 +1,71 @@ --- Initial linklater.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - -name: linklater -version: 3.2.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 -maintainer: me@haolian.org -category: Network -build-type: Simple -cabal-version: >=1.10 - -description: - . - A library for writing Slack chat bots. - . - 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; - . - * Supports - . - * Comes with a fast mode (@slashSimple@) and a power mode (@slash@) - . - * A warm, receptive maintainer with beautiful brown eyes; - . - * Fully Haddock'd methods and module; - . - * Open source (BSD3). - . - Shamelessly cute example: - . - <> - -extra-source-files: - examples/*.hs - README.md - changelog +-- This file has been generated from package.yaml by hpack version 0.17.0. +-- +-- see: https://github.com/sol/hpack -extra-doc-files: - corgi.jpg +name: linklater +version: 4.0.0.0 +synopsis: A Haskell library for the Slack API +description: +category: Network +homepage: https://github.com/hlian/linklater +bug-reports: https://github.com/hlian/linklater/issues +author: Hao Lian +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 library - default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs - + hs-source-dirs: + lib/ + default-extensions: FlexibleContexts LambdaCase OverloadedLists OverloadedStrings ScopedTypeVariables + build-depends: + aeson + , base >= 4.9.1.0 && < 5 + , base-prelude + , bytestring + , containers + , exceptions + , http-types + , lens + , lens-aeson + , mtl + , safe-exceptions + , tasty + , tasty-hunit + , text + , uri-bytestring + , wai + , wreq exposed-modules: - Network.Linklater + Network.Linklater + Network.Linklater.Batteries + Network.Linklater.Types + default-language: Haskell2010 +test-suite linklater-tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + test/ + default-extensions: FlexibleContexts LambdaCase OverloadedLists OverloadedStrings ScopedTypeVariables build-depends: - -- cabal told me to upper-constrain base - base < 4.9 + aeson + , base >= 4.9.1.0 && < 5 , base-prelude - , wreq - , aeson , bytestring - , text , containers - , wai + , exceptions , http-types - -source-repository head - type: git - location: https://github.com/hlian/linklater + , lens + , lens-aeson + , mtl + , safe-exceptions + , tasty + , tasty-hunit + , text + , uri-bytestring + , wai + , wreq + , linklater + default-language: Haskell2010 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified Data.Map as Map + +import Network.Linklater.Types + +import Test.Tasty +import Test.Tasty.HUnit + +commandOfParamsTest :: Assertion +commandOfParamsTest = + commandOfParams incoming @?= fixture + where + fixture = + Right (Command "prove" (User "Knuth") (Channel "C2147483705" "test") (Just "text")) + incoming = Map.fromList [ + ("token", "XXXXXXXXXXXXXXXXXX") + , ("team_id", "T0001") + , ("team_domain", "example") + , ("channel_id", "C2147483705") + , ("channel_name", "test") + , ("timestamp", "1355517523.000005") + , ("user_id", "U2147483697") + , ("user_name", "Knuth") + , ("text", "text") + , ("command", "/prove") + ] + +unitTests :: TestTree +unitTests = + testGroup "unit" [testCase "commandOfParams" commandOfParamsTest] + +main :: IO () +main = + defaultMain unitTests