module Network.Pusher.WebSockets.Util where
import Control.Concurrent (ThreadId, forkIO, myThreadId)
import Control.Exception (bracket_)
import Data.Version (Version(..), showVersion)
import Control.Monad.Trans.Reader (ReaderT(..))
import qualified Data.Set as S
import Data.Text (Text, unpack)
import Network.Socket (HostName, PortNumber)
import Network.Pusher.WebSockets.Internal
import Paths_pusher_ws (version)
fork :: PusherClient () -> PusherClient ThreadId
fork (PusherClient (ReaderT action)) = PusherClient $ ReaderT (forkIO . run)
where
run s = bracket_ setup teardown (action s) where
setup = do
tid <- myThreadId
strictModifyTVarIO (threadStore s) (S.insert tid)
teardown = do
tid <- myThreadId
strictModifyTVarIO (threadStore s) (S.delete tid)
makeURL :: Options -> (HostName, PortNumber, String)
makeURL opts = case pusherURL opts of
Just (host, port, path) -> (host, port, path ++ queryString)
Nothing -> (defaultHost, defaultPort, defaultPath)
where
defaultHost
| cluster opts == MT1 = "ws.pusherapp.com"
| otherwise = "ws-" ++ theCluster ++ ".pusher.com"
theCluster = unpack . clusterName $ cluster opts
defaultPort
| encrypted opts = 443
| otherwise = 80
defaultPath = case appKey opts of
AppKey k -> "/app/" ++ k ++ queryString
queryString = "?client=haskell-pusher-ws&protocol=7&version="
++ showVersion semver
semver :: Version
semver = Version
{ versionBranch = take 3 (versionBranch version)
, versionTags = []
}
clusterName :: Cluster -> Text
clusterName MT1 = "us-east-1"
clusterName EU = "eu-west-1"
clusterName AP1 = "ap-southeast-1"
connectionEvent :: ConnectionState -> Text
connectionEvent Initialized = "initialized"
connectionEvent Connecting = "connecting"
connectionEvent Connected = "connected"
connectionEvent Unavailable = "unavailable"
connectionEvent (Disconnected _) = "disconnected"