68 lines
2.5 KiB
Haskell
68 lines
2.5 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Web.Announcements
|
|
(sendAnnouncement,
|
|
formatLink,
|
|
AnnouncementHook(..),
|
|
AnnouncementPiece(..),
|
|
AnnouncementMessage,
|
|
renderAnnouncementMessage,
|
|
toAnnouncementHook)
|
|
where
|
|
|
|
import Data.Text
|
|
import qualified Data.Text.Encoding as DTE
|
|
import Data.Maybe
|
|
import Network.HTTP.Req as R
|
|
import Prelude
|
|
import Data.Aeson
|
|
import Data.Default
|
|
|
|
data AnnouncementHook = SlackWebHook Text | DiscordWebHook Text
|
|
|
|
data AnnouncementPiece = AnnouncementText Text | AnnouncementLink Text Text
|
|
|
|
type AnnouncementMessage = [AnnouncementPiece]
|
|
|
|
renderAnnouncementMessage :: Maybe AnnouncementHook -> AnnouncementMessage -> Text
|
|
renderAnnouncementMessage hook pieces = Data.Text.concat $ Prelude.map (renderAnnouncementPiece hook) pieces
|
|
|
|
renderAnnouncementPiece :: Maybe AnnouncementHook -> AnnouncementPiece -> Text
|
|
renderAnnouncementPiece _ (AnnouncementText t) = t
|
|
renderAnnouncementPiece mHook (AnnouncementLink url title) = formatLink mHook url title
|
|
|
|
toAnnouncementHook :: Text -> AnnouncementHook
|
|
toAnnouncementHook url
|
|
| ".slack." `isInfixOf` url = SlackWebHook url
|
|
| "discord.com" `isInfixOf` url = DiscordWebHook url
|
|
| otherwise = error $ unpack $ "unknown hook type '" <> url <> "'"
|
|
|
|
sendAnnouncement :: AnnouncementHook -> AnnouncementMessage -> IO ()
|
|
sendAnnouncement hook message = sendAnnouncement' hook $ renderAnnouncementMessage (Just hook) message
|
|
|
|
sendAnnouncement' :: AnnouncementHook -> Text -> IO ()
|
|
sendAnnouncement' (SlackWebHook hook) message = sendAnnouncementViaJson hook "text" message
|
|
sendAnnouncement' (DiscordWebHook hook) message = sendAnnouncementViaJson hook "content" message
|
|
|
|
sendAnnouncementViaJson :: Text -> Text -> Text -> IO ()
|
|
sendAnnouncementViaJson hook fieldName message = do
|
|
let (Just (hookUrl, _)) = parseUrlHttps $ DTE.encodeUtf8 hook
|
|
|
|
R.runReq def $ do
|
|
let payload = object [ fieldName .= message ]
|
|
(_ :: IgnoreResponse) <- R.req R.POST
|
|
hookUrl
|
|
(R.ReqBodyJson payload)
|
|
R.ignoreResponse
|
|
mempty
|
|
return ()
|
|
|
|
formatLink :: Maybe AnnouncementHook -> Text -> Text -> Text
|
|
formatLink (Just (SlackWebHook _)) url title = "<" <> url <> "|" <> title <> ">"
|
|
formatLink (Just (DiscordWebHook _)) url title = formatLinkWithAngleBrackets url title
|
|
formatLink Nothing url title = formatLinkWithAngleBrackets url title
|
|
|
|
formatLinkWithAngleBrackets :: Text -> Text -> Text
|
|
formatLinkWithAngleBrackets url title = title <> " <" <> url <> ">"
|