module Network.Pusher.Protocol
( Channel(..)
, ChannelInfo(..)
, ChannelInfoAttributes(..)
, ChannelInfoQuery(..)
, ChannelsInfo(..)
, ChannelsInfoQuery(..)
, ChannelsInfoAttributes(..)
, ChannelType(..)
, FullChannelInfo(..)
, User(..)
, Users(..)
, parseChannel
, renderChannel
, renderChannelPrefix
, toURLParam
) where
import Control.Applicative ((<$>), (<*>))
import Data.Aeson ((.:), (.:?))
import Data.Foldable (asum)
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import GHC.Generics (Generic)
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.Text as T
import Network.Pusher.Internal.Util (failExpectObj)
data ChannelType = Public | Private | Presence deriving (Eq, Generic, Show)
instance Hashable ChannelType
instance Arbitrary ChannelType where
arbitrary = elements [Public, Private, Presence]
renderChannelPrefix :: ChannelType -> T.Text
renderChannelPrefix Public = ""
renderChannelPrefix Private = "private-"
renderChannelPrefix Presence = "presence-"
data Channel = Channel
{ channelType :: ChannelType
, channelName :: T.Text
} deriving (Eq, Generic, Show)
instance Hashable Channel
instance Arbitrary Channel where
arbitrary = Channel <$> arbitrary <*> (T.pack <$> arbitrary)
renderChannel :: Channel -> T.Text
renderChannel (Channel cType cName) = renderChannelPrefix cType <> cName
parseChannel :: T.Text -> Channel
parseChannel chan =
fromMaybe
(Channel Public chan)
(asum [parseChanAs Private, parseChanAs Presence])
where
parseChanAs chanType =
let split = T.splitOn (renderChannelPrefix chanType) chan in
if length split > 1 && T.null (head split) then
Just $ Channel chanType (T.concat $ tail split)
else
Nothing
class ToURLParam a where
toURLParam :: a -> T.Text
data ChannelsInfoAttributes = ChannelsUserCount deriving (Eq, Generic)
instance ToURLParam ChannelsInfoAttributes where
toURLParam ChannelsUserCount = "user_count"
instance Hashable ChannelsInfoAttributes
newtype ChannelsInfoQuery =
ChannelsInfoQuery (HS.HashSet ChannelsInfoAttributes)
deriving ToURLParam
data ChannelInfoAttributes = ChannelUserCount | ChannelSubscriptionCount
deriving (Eq, Generic)
instance ToURLParam ChannelInfoAttributes where
toURLParam ChannelUserCount = "user_count"
toURLParam ChannelSubscriptionCount = "subscription_count"
instance Hashable ChannelInfoAttributes
newtype ChannelInfoQuery = ChannelInfoQuery (HS.HashSet ChannelInfoAttributes)
deriving ToURLParam
instance ToURLParam a => ToURLParam (HS.HashSet a) where
toURLParam hs = T.intercalate "," $ toURLParam <$> HS.toList hs
newtype ChannelsInfo =
ChannelsInfo (HM.HashMap Channel ChannelInfo)
deriving (Eq, Show)
instance A.FromJSON ChannelsInfo where
parseJSON (A.Object v) = do
chansV <- v .: "channels"
case chansV of
A.Object cs ->
ChannelsInfo . HM.fromList
<$> mapM
(\(channel, info) -> (parseChannel channel,) <$> A.parseJSON info)
(HM.toList cs)
v1 -> failExpectObj v1
parseJSON v2 = failExpectObj v2
data ChannelInfo = ChannelInfo
{ channelInfoUserCount :: Maybe Int
} deriving (Eq, Show)
instance A.FromJSON ChannelInfo where
parseJSON (A.Object v) = ChannelInfo <$> v .:? "user_count"
parseJSON v = failExpectObj v
data FullChannelInfo = FullChannelInfo
{ fullChannelInfoOccupied :: Bool
, fullChannelInfoUserCount :: Maybe Int
, fullChannelInfoSubCount :: Maybe Int
} deriving (Eq, Show)
instance A.FromJSON FullChannelInfo where
parseJSON (A.Object v) =
FullChannelInfo
<$> v .: "occupied"
<*> v .:? "user_count"
<*> v .:? "subscription_count"
parseJSON v = failExpectObj v
newtype Users = Users [User] deriving (Eq, Show)
instance A.FromJSON Users where
parseJSON (A.Object v) = do
users <- v .: "users"
Users <$> A.parseJSON users
parseJSON v = failExpectObj v
data User = User { userID :: T.Text } deriving (Eq, Show)
instance A.FromJSON User where
parseJSON (A.Object v) = User <$> v .: "id"
parseJSON v = failExpectObj v