{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Network.Pusher
-- Description : Haskell interface to the Pusher Channels HTTP API
-- Copyright   : (c) Will Sewell, 2016
-- Licence     : MIT
-- Maintainer  : me@willsewell.com
-- Stability   : stable
--
-- Exposes the functions necessary for interacting with the Pusher Channels HTTP
-- API, as well as functions for generating auth signatures for private and
-- presence channels.
--
-- First create a 'Settings'. The easiest way of doing this is by using
-- 'defaultSettings'. From that you can use 'newPusher' to create a 'Pusher'
-- instance and then call the functions defined in this module to make the HTTP
-- requests.
--
-- If any of the requests fail, the return values of the functions will result in
-- a 'Left' 'PusherError' when run.
--
-- An example of how you would use these functions:
--
-- @
--   let
--     settings =
--       'defaultSettings'
--         { 'pusherAddress' = 'Cluster' "mt1",
--           'pusherAppID' = 123,
--           'pusherToken' = 'Token' "wrd12344rcd234" "124df34d545v"
--         }
--   pusher <- 'newPusher' settings
--
--   result <-
--     'trigger' pusher ["my-channel"] "my-event" "my-data" Nothing
--
--   case result of
--     Left e -> putStrLn $ displayException e
--     Right resp -> print resp
--
-- @
--
-- There are simple working examples in the example/ directory.
--
-- See https://pusher.com/docs/channels/server_api/http-api for more detail on the
-- HTTP requests.
module Network.Pusher
  ( -- * Data types

    -- ** Settings
    Settings (..),
    defaultSettings,
    Token (..),
    Address (..),

    -- ** Main Pusher type
    Pusher,
    newPusher,
    newPusherWithConnManager,

    -- * HTTP Requests

    -- ** Trigger events
    trigger,
    triggerBatch,

    -- *** Event type for 'triggerBatch'
    Event (..),

    -- ** Channel queries
    channels,
    channel,
    users,

    -- * Authentication
    authenticatePresence,
    authenticatePrivate,

    -- * Errors
    PusherError (..),

    -- * Webhooks
    parseWebhookPayload,
    WebhookEv (..),
    WebhookPayload (..),
    Webhooks (..),
    parseAppKeyHdr,
    parseAuthSignatureHdr,
    parseWebhooksBody,
    verifyWebhooksBody,
    parseWebhookPayloadWith,
  )
where

import Control.Monad.IO.Class
  ( MonadIO,
    liftIO,
  )
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.Text as T
import Network.Pusher.Data
  ( Address (..),
    Event (..),
    Pusher (..),
    Settings (..),
    Token (..),
    defaultSettings,
    newPusher,
    newPusherWithConnManager,
  )
import Network.Pusher.Error (PusherError (..))
import qualified Network.Pusher.Internal as Pusher
import qualified Network.Pusher.Internal.Auth as Auth
import qualified Network.Pusher.Internal.HTTP as HTTP
import Network.Pusher.Internal.Util (getSystemTimeSeconds)
import Network.Pusher.Protocol
  ( ChannelInfoQuery,
    ChannelsInfo,
    ChannelsInfoQuery,
    FullChannelInfo,
    Users,
  )
import Network.Pusher.Webhook
  ( WebhookEv (..),
    WebhookPayload (..),
    Webhooks (..),
    parseAppKeyHdr,
    parseAuthSignatureHdr,
    parseWebhookPayloadWith,
    parseWebhooksBody,
    verifyWebhooksBody,
  )

-- | Trigger an event to one or more channels.
trigger ::
  MonadIO m =>
  Pusher ->
  -- | The list of channels to trigger to.
  [T.Text] ->
  -- | Event name.
  T.Text ->
  -- | Event data. Often encoded JSON.
  T.Text ->
  -- | An optional socket ID of a connection you wish to exclude.
  Maybe T.Text ->
  m (Either PusherError ())
trigger :: forall (m :: * -> *).
MonadIO m =>
Pusher
-> [Text]
-> Text
-> Text
-> Maybe Text
-> m (Either PusherError ())
trigger Pusher
pusher [Text]
chans Text
event Text
dat Maybe Text
socketId = do
  (RequestParams
requestParams, Value
requestBody) <-
    Pusher
-> [Text]
-> Text
-> Text
-> Maybe Text
-> Word64
-> (RequestParams, Value)
Pusher.mkTriggerRequest Pusher
pusher [Text]
chans Text
event Text
dat Maybe Text
socketId
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m Word64
getSystemTimeSeconds
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
ToJSON a =>
Manager -> RequestParams -> a -> IO (Either PusherError ())
HTTP.post (Pusher -> Manager
pConnectionManager Pusher
pusher) RequestParams
requestParams Value
requestBody

-- | Trigger multiple events.
triggerBatch ::
  MonadIO m =>
  Pusher ->
  -- | The list of events to trigger.
  [Event] ->
  m (Either PusherError ())
triggerBatch :: forall (m :: * -> *).
MonadIO m =>
Pusher -> [Event] -> m (Either PusherError ())
triggerBatch Pusher
pusher [Event]
events = do
  (RequestParams
requestParams, Value
requestBody) <-
    Pusher -> [Event] -> Word64 -> (RequestParams, Value)
Pusher.mkTriggerBatchRequest Pusher
pusher [Event]
events forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m Word64
getSystemTimeSeconds
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
ToJSON a =>
Manager -> RequestParams -> a -> IO (Either PusherError ())
HTTP.post (Pusher -> Manager
pConnectionManager Pusher
pusher) RequestParams
requestParams Value
requestBody

-- | Query a list of channels for information.
channels ::
  MonadIO m =>
  Pusher ->
  -- | A channel prefix you wish to filter on.
  T.Text ->
  -- | Data you wish to query for, currently just the user count.
  ChannelsInfoQuery ->
  -- | The returned data.
  m (Either PusherError ChannelsInfo)
channels :: forall (m :: * -> *).
MonadIO m =>
Pusher
-> Text -> ChannelsInfoQuery -> m (Either PusherError ChannelsInfo)
channels Pusher
pusher Text
prefixFilter ChannelsInfoQuery
attributes = do
  RequestParams
requestParams <-
    Pusher -> Text -> ChannelsInfoQuery -> Word64 -> RequestParams
Pusher.mkChannelsRequest Pusher
pusher Text
prefixFilter ChannelsInfoQuery
attributes
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m Word64
getSystemTimeSeconds
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON a =>
Manager -> RequestParams -> IO (Either PusherError a)
HTTP.get (Pusher -> Manager
pConnectionManager Pusher
pusher) RequestParams
requestParams

-- | Query for information on a single channel.
channel ::
  MonadIO m =>
  Pusher ->
  B.ByteString ->
  -- | Can query user count and also subscription count (if enabled).
  ChannelInfoQuery ->
  m (Either PusherError FullChannelInfo)
channel :: forall (m :: * -> *).
MonadIO m =>
Pusher
-> ByteString
-> ChannelInfoQuery
-> m (Either PusherError FullChannelInfo)
channel Pusher
pusher ByteString
chan ChannelInfoQuery
attributes = do
  RequestParams
requestParams <-
    Pusher -> ByteString -> ChannelInfoQuery -> Word64 -> RequestParams
Pusher.mkChannelRequest Pusher
pusher ByteString
chan ChannelInfoQuery
attributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m Word64
getSystemTimeSeconds
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON a =>
Manager -> RequestParams -> IO (Either PusherError a)
HTTP.get (Pusher -> Manager
pConnectionManager Pusher
pusher) RequestParams
requestParams

-- | Get a list of users in a presence channel.
users :: MonadIO m => Pusher -> B.ByteString -> m (Either PusherError Users)
users :: forall (m :: * -> *).
MonadIO m =>
Pusher -> ByteString -> m (Either PusherError Users)
users Pusher
pusher ByteString
chan = do
  RequestParams
requestParams <- Pusher -> ByteString -> Word64 -> RequestParams
Pusher.mkUsersRequest Pusher
pusher ByteString
chan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m Word64
getSystemTimeSeconds
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON a =>
Manager -> RequestParams -> IO (Either PusherError a)
HTTP.get (Pusher -> Manager
pConnectionManager Pusher
pusher) RequestParams
requestParams

-- | Generate an auth signature of the form "app_key:auth_sig" for a user of a
--  private channel.
authenticatePrivate :: Pusher -> T.Text -> T.Text -> B.ByteString
authenticatePrivate :: Pusher -> Text -> Text -> ByteString
authenticatePrivate Pusher
pusher = Token -> Text -> Text -> ByteString
Auth.authenticatePrivate (Pusher -> Token
pToken Pusher
pusher)

-- | Generate an auth signature of the form "app_key:auth_sig" for a user of a
--  presence channel.
authenticatePresence ::
  A.ToJSON a => Pusher -> T.Text -> T.Text -> a -> B.ByteString
authenticatePresence :: forall a. ToJSON a => Pusher -> Text -> Text -> a -> ByteString
authenticatePresence Pusher
pusher = forall a. ToJSON a => Token -> Text -> Text -> a -> ByteString
Auth.authenticatePresence (Pusher -> Token
pToken Pusher
pusher)

-- | Parse webhooks from a list of HTTP headers and a HTTP body given their
--  app key matches the one in our Pusher Channels credentials and the webhook
--  is correctly encrypted by the corresponding app secret.
parseWebhookPayload ::
  Pusher ->
  [(B.ByteString, B.ByteString)] ->
  B.ByteString ->
  Maybe WebhookPayload
parseWebhookPayload :: Pusher
-> [(ByteString, ByteString)] -> ByteString -> Maybe WebhookPayload
parseWebhookPayload Pusher
pusher =
  let token :: Token
token = Pusher -> Token
pToken Pusher
pusher
      ourAppKey :: ByteString
ourAppKey = Token -> ByteString
tokenKey Token
token
      ourAppSecret :: ByteString
ourAppSecret = Token -> ByteString
tokenSecret Token
token
      lookupKeysSecret :: ByteString -> Maybe ByteString
lookupKeysSecret ByteString
whAppKey =
        if ByteString
whAppKey forall a. Eq a => a -> a -> Bool
== ByteString
ourAppKey then forall a. a -> Maybe a
Just ByteString
ourAppSecret else forall a. Maybe a
Nothing
   in (ByteString -> Maybe ByteString)
-> [(ByteString, ByteString)] -> ByteString -> Maybe WebhookPayload
parseWebhookPayloadWith ByteString -> Maybe ByteString
lookupKeysSecret