{-# 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" ++)