linklater 3.1.0.0 → 3.2.0.0
raw patch · 4 files changed
+130/−57 lines, 4 filesdep ~aesondep ~basedep ~base-preludePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, base, base-prelude, bytestring, containers, http-types, text, wai, wreq
API changes (from Hackage documentation)
Files
- Network/Linklater.hs +16/−17
- changelog +19/−0
- examples/JointPhotographicExpertsGroupTonga.hs +85/−26
- linklater.cabal +10/−14
Network/Linklater.hs view
@@ -37,13 +37,15 @@ 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)+import Network.HTTP.Types (status200, parseSimpleQuery) import qualified Network.Wai as W import Network.Wreq hiding (params, headers) @@ -163,28 +165,25 @@ 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 = f command req respond+slash f req respond = do+ params <- paramsIO req+ f (command (`M.lookup` params)) req respond where- command = do- user <- userOf <$> wishFor "user_name"- Command <$> (nameOf <$> wishFor "command")+ command paramOf = do+ user <- userOf <$> paramOf "user_name"+ Command <$> (nameOf <$> paramOf "command") <*> return user- <*> (wishFor "channel_name" >>= channelOf user)- <*> return (wishFor "text")- wishFor key =- case M.lookup (key :: TL.Text) params of- Just (Just "") ->- Nothing- Just (Just value) ->- Just (TL.toStrict value)- _ ->- Nothing+ <*> (paramOf "channel_name" >>= channelOf user)+ <*> return (paramOf "text") userOf = User . T.filter (/= '@') nameOf = T.filter (/= '/')- params = M.fromList [(toText k, toText <$> v) | (k, v) <- W.queryString req]- toText = TLE.decodeUtf8 . BSL.fromChunks . return
changelog view
@@ -1,5 +1,24 @@ -*- 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
examples/JointPhotographicExpertsGroupTonga.hs view
@@ -1,34 +1,93 @@-{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-} --- Full package here: https://github.com/hlian/jpgtobot/-module JointPhotographicExpertsGroupTonga where+-- If writing Slack bots intrigues you, check out: https://github.com/hlian/linklater -import BasePrelude hiding (words, intercalate, filter)-import Control.Lens ((^.))-import Data.Aeson (encode)-import Data.Attoparsec.Text.Lazy-import Data.Char (isLetter, isAscii)-import Data.Text.Lazy-import Data.Text.Lazy.Encoding (decodeUtf8)-import Network.Linklater (say, slashSimple, Command(..), Config(..), Message(..), Icon(..), Format(..))-import Network.Wai.Handler.Warp (run)-import Network.Wreq hiding (params)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL -findUrl :: Text -> Maybe Text-findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"'))+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 (Just (Command commandText user channel (Just text))) = do- message <- (fmap messageOf . findUrl . decodeUtf8 . flip (^.) responseBody) <$> get ("http://" <> (unpack subdomain) <> ".jpg.to/")+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- (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>")]- debug = False-jpgto _ = return "Type more! (Did you know? jpgtobot is only 26 lines of Haskell. <https://github.com/hlian/jpgtobot/blob/master/Main.hs>)"+ (False, Just m) -> do+ say m config+ return ""+ (False, Nothing) ->+ return "*FRIZZLE* ERROR PROCESSING INPUT; BEGIN SELF-DETONATION; PLEASE FILE ISSUE AT <https://github.com/hlian/jpgtobot>"+ _ ->+ return ""+ where+ debug = False main :: IO ()-main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slashSimple jpgto)+main = do+ putStrLn ("+ Listening on port " <> show port)+ run port (slashSimple jpgto)+ where+ port = 3333
linklater.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: linklater-version: 3.1.0.0+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@@ -48,10 +48,6 @@ extra-doc-files: corgi.jpg -flag developer- default: False- manual: True- library default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs@@ -61,15 +57,15 @@ build-depends: -- cabal told me to upper-constrain base- base <= 4.7.0.1- , base-prelude >= 0.1.16- , wreq >=0.2- , aeson >=0.8- , bytestring >=0.10.4.0- , text >=1.1.1.3- , containers >=0.5- , wai >=3.0.0.2- , http-types >=0.8.5+ base < 4.9+ , base-prelude+ , wreq+ , aeson+ , bytestring+ , text+ , containers+ , wai+ , http-types source-repository head type: git