module Network.Pusher.Protocol
( Channel(..)
, ChannelInfo(..)
, ChannelInfoAttributes(..)
, ChannelInfoAttributeResp(..)
, ChannelInfoQuery(..)
, ChannelsInfo(..)
, ChannelsInfoQuery(..)
, ChannelsInfoAttributes(..)
, ChannelType(..)
, FullChannelInfo(..)
, FullChannelAttributeResp(..)
, User(..)
, Users(..)
, parseChannel
, toURLParam
) where
import Control.Applicative ((<$>), (<*>))
import Data.Aeson ((.:), (.:?))
import Data.Foldable (asum)
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
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, show')
data ChannelType = Public | Private | Presence deriving (Eq, Generic)
instance Hashable ChannelType
instance Show ChannelType where
show Public = ""
show Private = "private-"
show Presence = "presence-"
instance Arbitrary ChannelType where
arbitrary = elements [Public, Private, Presence]
data Channel = Channel
{ channelType :: ChannelType
, channelName :: T.Text
} deriving (Eq, Generic)
instance Hashable Channel
instance Show Channel where
show (Channel chanType name) = show chanType ++ T.unpack name
instance Arbitrary Channel where
arbitrary = Channel <$> arbitrary <*> (T.pack <$> arbitrary)
parseChannel :: T.Text -> Channel
parseChannel chan =
fromMaybe
(Channel Public chan)
(asum [parseChanAs Private, parseChanAs Presence])
where
parseChanAs chanType =
let split = T.splitOn (show' 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
newtype ChannelInfo =
ChannelInfo (HS.HashSet ChannelInfoAttributeResp)
deriving (Eq, Show)
instance A.FromJSON ChannelInfo where
parseJSON (A.Object v) = do
maybeUserCount <- v .:? "user_count"
return $ ChannelInfo $ maybe
HS.empty
(HS.singleton . UserCountResp)
maybeUserCount
parseJSON v = failExpectObj v
data ChannelInfoAttributeResp = UserCountResp Int deriving (Eq, Generic, Show)
instance Hashable ChannelInfoAttributeResp
newtype FullChannelInfo =
FullChannelInfo (HS.HashSet FullChannelAttributeResp)
deriving (Eq, Show)
instance A.FromJSON FullChannelInfo where
parseJSON (A.Object v) = do
occupied <- v .: "occupied"
maybeUserCount <- v .:? "user_count"
maybeSubCount <- v .:? "subscription_count"
let
hs = HS.singleton (OccupiedResp occupied)
hs' = maybeInsert (FullUserCountResp <$> maybeUserCount) hs
hs'' = maybeInsert (SubscriptionCountResp <$> maybeSubCount) hs'
return $ FullChannelInfo hs''
where
maybeInsert :: (Eq a, Hashable a) => Maybe a -> HS.HashSet a -> HS.HashSet a
maybeInsert maybeVal hs = maybe hs (`HS.insert` hs) maybeVal
parseJSON v = failExpectObj v
data FullChannelAttributeResp
= OccupiedResp Bool
| FullUserCountResp Int
| SubscriptionCountResp Int
deriving (Eq, Generic, Show)
instance Hashable FullChannelAttributeResp
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