module Network.Pusher.Data
( Settings (..),
defaultSettings,
Token (..),
Address (..),
Pusher (..),
newPusher,
newPusherWithConnManager,
)
where
import Control.Monad.IO.Class (MonadIO)
import Data.Aeson ((.:), (.:?))
import qualified Data.Aeson as A
import qualified Data.ByteString as B
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
{ pusherAddress :: Address,
pusherAppID :: Word32,
pusherToken :: Token,
pusherUseTLS :: Bool
}
instance A.FromJSON Settings where
parseJSON =
A.withObject "Settings" $ \v -> do
cluster <- (encodeUtf8 <$>) <$> v .:? "cluster"
host <- (encodeUtf8 <$>) <$> v .:? "host"
port <- v .:? "port"
let address = case (cluster, host, port) of
(Just c, Nothing, Nothing) -> Just $ Cluster c
(Nothing, Just h, Just p) -> Just $ HostPort h p
(Nothing, Nothing, Nothing) -> Nothing
_ -> fail "`cluster` is mutually exclusive with `host` and `port`"
appID <- v .: "app_id"
token <- v .: "token"
useTLS <- v .:? "use_tls"
let settings =
defaultSettings
{ pusherAppID = appID,
pusherToken = token
}
pure $ setOptionals address useTLS settings
where
setOptionals maybeAddress maybeUseTLS =
setAddress maybeAddress . setUseTLS maybeUseTLS
setAddress (Just address) settings = settings {pusherAddress = address}
setAddress Nothing settings = settings
setUseTLS (Just useTLS) settings = settings {pusherUseTLS = useTLS}
setUseTLS Nothing settings = settings
defaultSettings :: Settings
defaultSettings =
Settings
{ pusherAddress = Cluster "mt1",
pusherAppID = 1,
pusherToken = Token "" "",
pusherUseTLS = True
}
data Token
= Token
{ tokenKey :: B.ByteString,
tokenSecret :: B.ByteString
}
instance A.FromJSON Token where
parseJSON =
A.withObject "Token" $ \v -> do
key <- encodeUtf8 <$> v .: "key"
secret <- encodeUtf8 <$> v .: "secret"
pure $ Token key secret
data Address
=
Cluster B.ByteString
|
HostPort B.ByteString Word16
data Pusher
= Pusher
{ pUseTLS :: Bool,
pHost :: B.ByteString,
pPort :: Word16,
pPath :: B.ByteString,
pToken :: Token,
pConnectionManager :: Manager
}
newPusher :: MonadIO m => Settings -> m Pusher
newPusher settings = do
connManager <- newTlsManager
return $ newPusherWithConnManager connManager settings
newPusherWithConnManager :: Manager -> Settings -> Pusher
newPusherWithConnManager connectionManager settings =
let (host, port) = case pusherAddress settings of
HostPort h p -> (h, p)
Cluster c -> ("api-" <> c <> ".pusher.com", if pusherUseTLS settings then 443 else 80)
path = "/apps/" <> show' (pusherAppID settings) <> "/"
in Pusher
{ pUseTLS = pusherUseTLS settings,
pHost = host,
pPort = port,
pPath = path,
pToken = pusherToken settings,
pConnectionManager = connectionManager
}