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 =
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
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
}
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
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 :: 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
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
{
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 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)