-- |
-- Module      : Network.Pusher.Data
-- Description : Data structures representing Channels concepts and settings
-- Copyright   : (c) Will Sewell, 2016
-- Licence     : MIT
-- Maintainer  : me@willsewell.com
-- Stability   : stable
module Network.Pusher.Data
  ( Settings (..),
    defaultSettings,
    Token (..),
    Address (..),
    Pusher (..),
    newPusher,
    newPusherWithConnManager,
    Event (..),
  )
where

import Control.Monad.IO.Class (MonadIO)
import Data.Aeson ((.:), (.:?))
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import Data.Maybe (maybeToList)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16, Word32)
import Network.HTTP.Client (Manager)
import Network.HTTP.Client.TLS (newTlsManager)
import Network.Pusher.Internal.Util (show')

-- | All the required configuration needed to interact with the API.
data Settings
  = Settings
      { Settings -> Address
pusherAddress :: Address,
        Settings -> Word32
pusherAppID :: Word32,
        Settings -> Token
pusherToken :: Token,
        Settings -> Bool
pusherUseTLS :: Bool
      }

instance A.FromJSON Settings where
  parseJSON :: Value -> Parser Settings
parseJSON =
    String -> (Object -> Parser Settings) -> Value -> Parser Settings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Settings" ((Object -> Parser Settings) -> Value -> Parser Settings)
-> (Object -> Parser Settings) -> Value -> Parser Settings
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ByteString
cluster <- (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Text -> Maybe ByteString)
-> Parser (Maybe Text) -> Parser (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cluster"
      Maybe ByteString
host <- (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Text -> Maybe ByteString)
-> Parser (Maybe Text) -> Parser (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"host"
      Maybe Word16
port <- Object
v Object -> Key -> Parser (Maybe Word16)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port"
      let address :: Maybe Address
address = case (Maybe ByteString
cluster, Maybe ByteString
host, Maybe Word16
port) of
            (Just ByteString
c, Maybe ByteString
Nothing, Maybe Word16
Nothing) -> Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address) -> Address -> Maybe Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
Cluster ByteString
c
            (Maybe ByteString
Nothing, Just ByteString
h, Just Word16
p) -> Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address) -> Address -> Maybe Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Word16 -> Address
HostPort ByteString
h Word16
p
            (Maybe ByteString
Nothing, Maybe ByteString
Nothing, Maybe Word16
Nothing) -> Maybe Address
forall a. Maybe a
Nothing
            (Maybe ByteString, Maybe ByteString, Maybe Word16)
_ -> String -> Maybe Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"`cluster` is mutually exclusive with `host` and `port`"
      Word32
appID <- Object
v Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"app_id"
      Token
token <- Object
v Object -> Key -> Parser Token
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
      Maybe Bool
useTLS <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"use_tls"
      let settings :: Settings
settings =
            Settings
defaultSettings
              { pusherAppID :: Word32
pusherAppID = Word32
appID,
                pusherToken :: Token
pusherToken = Token
token
              }
      Settings -> Parser Settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Settings -> Parser Settings) -> Settings -> Parser Settings
forall a b. (a -> b) -> a -> b
$ Maybe Address -> Maybe Bool -> Settings -> Settings
setOptionals Maybe Address
address Maybe Bool
useTLS Settings
settings
    where
      setOptionals :: Maybe Address -> Maybe Bool -> Settings -> Settings
setOptionals Maybe Address
maybeAddress Maybe Bool
maybeUseTLS =
        Maybe Address -> Settings -> Settings
setAddress Maybe Address
maybeAddress (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> Settings -> Settings
setUseTLS Maybe Bool
maybeUseTLS
      setAddress :: Maybe Address -> Settings -> Settings
setAddress (Just Address
address) Settings
settings = Settings
settings {pusherAddress :: Address
pusherAddress = Address
address}
      setAddress Maybe Address
Nothing Settings
settings = Settings
settings
      setUseTLS :: Maybe Bool -> Settings -> Settings
setUseTLS (Just Bool
useTLS) Settings
settings = Settings
settings {pusherUseTLS :: Bool
pusherUseTLS = Bool
useTLS}
      setUseTLS Maybe Bool
Nothing Settings
settings = Settings
settings

-- | A convenient way of creating an instance of 'Settings'. Another
-- benefit is it prevents breaking changes when fields are added to
-- 'Settings', see <https://www.yesodweb.com/book/settings-types>.You
-- must set 'pusherAppID' and 'pusherToken'. Currently 'pusherAddress'
-- defaults to the @mt1@ cluster.
--
-- Example:
--
-- @
-- defaultSettings
--   { 'pusherAppID' = 123,
--     'pusherToken' = 'Token' { 'tokenKey' = "key", 'tokenSecret' "secret" }
--   }
-- @
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
  Settings :: Address -> Word32 -> Token -> Bool -> Settings
Settings
    { pusherAddress :: Address
pusherAddress = ByteString -> Address
Cluster ByteString
"mt1",
      pusherAppID :: Word32
pusherAppID = Word32
1,
      pusherToken :: Token
pusherToken = ByteString -> ByteString -> Token
Token ByteString
"" ByteString
"",
      pusherUseTLS :: Bool
pusherUseTLS = Bool
True
    }

-- | A Channels key and secret pair for a particular app.
data Token
  = Token
      { Token -> ByteString
tokenKey :: B.ByteString,
        Token -> ByteString
tokenSecret :: B.ByteString
      }

instance A.FromJSON Token where
  parseJSON :: Value -> Parser Token
parseJSON =
    String -> (Object -> Parser Token) -> Value -> Parser Token
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Token" ((Object -> Parser Token) -> Value -> Parser Token)
-> (Object -> Parser Token) -> Value -> Parser Token
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      ByteString
key <- Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
      ByteString
secret <- Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"secret"
      Token -> Parser Token
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Token
Token ByteString
key ByteString
secret

-- | Typically you will want to connect directly to a standard Pusher Channels
-- 'Cluster'.
data Address
  = -- | The cluster the current app resides on. Common clusters include:
    -- @mt1@, @eu@, @ap1@, @ap2@.
    Cluster B.ByteString
  | -- | Used to connect to a raw address:port.
    HostPort B.ByteString Word16

-- | The core handle to the Pusher API.
data Pusher
  = Pusher
      { Pusher -> Bool
pUseTLS :: Bool,
        Pusher -> ByteString
pHost :: B.ByteString,
        Pusher -> Word16
pPort :: Word16,
        Pusher -> ByteString
pPath :: B.ByteString,
        Pusher -> Token
pToken :: Token,
        Pusher -> Manager
pConnectionManager :: Manager
      }

-- | Use this to get a Pusher instance.
newPusher :: MonadIO m => Settings -> m Pusher
newPusher :: Settings -> m Pusher
newPusher Settings
settings = do
  Manager
connManager <- m Manager
forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
  Pusher -> m Pusher
forall (m :: * -> *) a. Monad m => a -> m a
return (Pusher -> m Pusher) -> Pusher -> m Pusher
forall a b. (a -> b) -> a -> b
$ Manager -> Settings -> Pusher
newPusherWithConnManager Manager
connManager Settings
settings

-- | Get a Pusher instance with a given connection manager. This can be useful
--  if you want to share a connection with your application code.
newPusherWithConnManager :: Manager -> Settings -> Pusher
newPusherWithConnManager :: Manager -> Settings -> Pusher
newPusherWithConnManager Manager
connectionManager Settings
settings =
  let (ByteString
host, Word16
port) = case Settings -> Address
pusherAddress Settings
settings of
        HostPort ByteString
h Word16
p -> (ByteString
h, Word16
p)
        Cluster ByteString
c -> (ByteString
"api-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
c ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".pusher.com", if Settings -> Bool
pusherUseTLS Settings
settings then Word16
443 else Word16
80)
      path :: ByteString
path = ByteString
"/apps/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
forall a b. (Show a, IsString b) => a -> b
show' (Settings -> Word32
pusherAppID Settings
settings) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/"
   in Pusher :: Bool
-> ByteString -> Word16 -> ByteString -> Token -> Manager -> Pusher
Pusher
        { pUseTLS :: Bool
pUseTLS = Settings -> Bool
pusherUseTLS Settings
settings,
          pHost :: ByteString
pHost = ByteString
host,
          pPort :: Word16
pPort = Word16
port,
          pPath :: ByteString
pPath = ByteString
path,
          pToken :: Token
pToken = Settings -> Token
pusherToken Settings
settings,
          pConnectionManager :: Manager
pConnectionManager = Manager
connectionManager
        }

data Event
  = Event
      { -- | Channel to trigger on.
        Event -> Text
eventChannel :: T.Text,
        -- | Event name.
        Event -> Text
eventName :: T.Text,
        -- | Event data. Often encoded JSON.
        Event -> Text
eventData :: T.Text,
        -- | An optional socket ID of a connection you wish to exclude.
        Event -> Maybe Text
eventSocketId :: Maybe T.Text
      }

instance A.ToJSON Event where
  toJSON :: Event -> Value
toJSON (Event Text
channel Text
name Text
dat Maybe Text
socketId) =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ (Key
"name", Text -> Value
A.String Text
name),
        (Key
"channel", Text -> Value
A.String Text
channel),
        (Key
"data", Text -> Value
A.String Text
dat)
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe Pair -> [Pair]
forall a. Maybe a -> [a]
maybeToList ((Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
sID -> (Key
"socket_id", Text -> Value
A.String Text
sID)) Maybe Text
socketId)