{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Network.Linklater
(
Channel(..),
User(..),
Message(..),
Config(..),
Command(..),
Icon(..),
Format(..),
say,
startRTM,
startRTMWithOptions,
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))
slashSimple :: (Command -> IO Text) -> Application
slashSimple f =
slash (\command _ respond -> f command >>= (respond . responseOf status200))
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))
say :: (MonadError RequestError m, MonadIO m) => Message -> Config -> m ()
say message Config{..} = do
_ <- tryRequest (postWith _reasonableOptions (_configHookURL ^. unpacked) (Aeson.encode message))
pure ()
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
_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" ++)