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')
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
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
}
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
data Address
=
Cluster B.ByteString
|
HostPort B.ByteString Word16
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
}
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
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
{
Event -> Text
eventChannel :: T.Text,
Event -> Text
eventName :: T.Text,
Event -> Text
eventData :: T.Text,
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)