module HZulip ( Event(..)
, Message(..)
, Queue(..)
, User(..)
, ZulipClient(..)
, EventCallback
, defaultBaseUrl
, getEvents
, newZulip
, onNewEvent
, registerQueue
, sendMessage
)
where
import Control.Lens ((.~), (&), (^.))
import Control.Monad (forever)
import qualified Data.ByteString.Char8 as BS (pack)
import qualified Data.Text as T (pack)
import Network.Wreq
import qualified Network.Wreq.Types as WT (params)
import HZulip.Types as ZT
newZulip :: String -> String -> ZulipClient
newZulip e k = ZulipClient e k defaultBaseUrl
defaultBaseUrl :: String
defaultBaseUrl = "https://api.zulip.com/v1"
sendMessage :: ZulipClient -> String -> [String] -> String -> String -> IO String
sendMessage z mtype mrecipients msubject mcontent = do
let form = [ "type" := mtype
, "content" := mcontent
, "to" := show mrecipients
, "subject" := msubject
]
r <- postWith (reqOptions z) (messagesUrl z) form >>= asJSON
let body = r ^. responseBody
if wasSuccessful body
then let Just mid = responseMessageId body in return mid
else fail $ responseMsg body
registerQueue :: ZulipClient -> [String] -> Bool -> IO Queue
registerQueue z evTps mdn = do
let form = [ "event_types" := show evTps
, "apply_markdown" := (if mdn then "true" else "false" :: String)
]
r <- postWith (reqOptions z) (registerUrl z) form >>= asJSON
let body = r ^. responseBody
if wasSuccessful body
then let Just qid = responseQueueId body
Just lid = responseLastEventId body in
return $ Queue qid lid
else fail $ responseMsg body
getEvents :: ZulipClient -> Queue -> Bool -> IO [Event]
getEvents z q b = do
let opts = (reqOptions z) { WT.params = [ ("queue_id", T.pack $ queueId q)
, ("last_event_id", T.pack $ show $
lastEventId q)
, ("dont_block", if b then "true"
else "false")
]
}
r <- getWith opts (eventsUrl z) >>= asJSON
let body = r ^. responseBody
if wasSuccessful body
then let Just evs = responseEvents body in return evs
else fail $ responseMsg body
onNewEvent :: ZulipClient -> Bool -> EventCallback -> IO ()
onNewEvent z b f = do
q <- registerQueue z [] b
forever $ getEvents z q b >>= mapM_ f
wasSuccessful :: ZT.Response -> Bool
wasSuccessful = (== ResponseSuccess) . responseResult
messagesUrl :: ZulipClient -> String
messagesUrl = (++ "/messages") . clientBaseUrl
registerUrl :: ZulipClient -> String
registerUrl = (++ "/register") . clientBaseUrl
eventsUrl :: ZulipClient -> String
eventsUrl = (++ "/events") . clientBaseUrl
reqOptions :: ZulipClient -> Options
reqOptions (ZulipClient e k _) = defaults & auth .~ basicAuth (BS.pack e) (BS.pack k)