-- |
-- 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Settings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ByteString
cluster <- (Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cluster"
      Maybe ByteString
host <- (Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"host"
      Maybe Word16
port <- Object
v 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) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Address
Cluster ByteString
c
            (Maybe ByteString
Nothing, Just ByteString
h, Just Word16
p) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Word16 -> Address
HostPort ByteString
h Word16
p
            (Maybe ByteString
Nothing, Maybe ByteString
Nothing, Maybe Word16
Nothing) -> forall a. Maybe a
Nothing
            (Maybe ByteString, Maybe ByteString, Maybe Word16)
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"`cluster` is mutually exclusive with `host` and `port`"
      Word32
appID <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"app_id"
      Token
token <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
      Maybe Bool
useTLS <- Object
v 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
              }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 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
    { 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Token" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      ByteString
key <- Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
      ByteString
secret <- Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"secret"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: forall (m :: * -> *). MonadIO m => Settings -> m Pusher
newPusher Settings
settings = do
  Manager
connManager <- forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
  forall (m :: * -> *) a. Monad m => a -> m a
return 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-" forall a. Semigroup a => a -> a -> a
<> ByteString
c 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/" forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, IsString b) => a -> b
show' (Settings -> Word32
pusherAppID Settings
settings) forall a. Semigroup a => a -> a -> a
<> ByteString
"/"
   in 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 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)
      ]
        forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (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)