{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TupleSections #-} {-| Module : Network.Pusher.Protocol Description : Types representing Pusher messages Copyright : (c) Will Sewell, 2015 Licence : MIT Maintainer : me@willsewell.com Stability : experimental Types representing the JSON format of Pusher messages. There are also types for query string parameters. -} 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') -- |The possible types of Pusher channe. 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] -- |The channel name (not including the channel type prefix) and its type. 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) -- |Convert string representation, e.g. private-chan into the datatype parseChannel :: T.Text -> Channel parseChannel chan = -- Attempt to parse it as a private or presence channel; default to public fromMaybe (Channel Public chan) (asum [parseChanAs Private, parseChanAs Presence]) where parseChanAs chanType = let split = T.splitOn (show' chanType) chan in -- If the prefix appears at the start, then the first element will be empty if length split > 1 && T.null (head split) then Just $ Channel chanType (T.concat $ tail split) else Nothing -- |Types that can be serialised to a querystring parameter value. class ToURLParam a where -- |Convert the data into a querystring parameter value. toURLParam :: a -> T.Text -- |Enumeration of the attributes that can be queried about multiple channels. data ChannelsInfoAttributes = ChannelsUserCount deriving (Eq, Generic) instance ToURLParam ChannelsInfoAttributes where toURLParam ChannelsUserCount = "user_count" instance Hashable ChannelsInfoAttributes -- |A set of requested ChannelsInfoAttributes. newtype ChannelsInfoQuery = ChannelsInfoQuery (HS.HashSet ChannelsInfoAttributes) deriving ToURLParam -- |Enumeration of the attributes that can be queried about a single channel. data ChannelInfoAttributes = ChannelUserCount | ChannelSubscriptionCount deriving (Eq, Generic) instance ToURLParam ChannelInfoAttributes where toURLParam ChannelUserCount = "user_count" toURLParam ChannelSubscriptionCount = "subscription_count" instance Hashable ChannelInfoAttributes -- |A set of requested 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 -- |A map of channels to their ChannelInfo. The result of querying channel -- info from multuple channels. 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 -> -- Need to go to and from list in order to map (parse) the keys ChannelsInfo . HM.fromList <$> mapM (\(channel, info) -> (parseChannel channel,) <$> A.parseJSON info) (HM.toList cs) v1 -> failExpectObj v1 parseJSON v2 = failExpectObj v2 -- |A set of returned channel attributes for a single channel. 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 -- |An enumeration of possible returned channel attributes when multiple -- when multiple channels are queried. data ChannelInfoAttributeResp = UserCountResp Int deriving (Eq, Generic, Show) instance Hashable ChannelInfoAttributeResp -- |A set of returned channel attributes for a single channel. 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 -- |An enumeration of possible returned channel attributes when a single -- channel is queried data FullChannelAttributeResp = OccupiedResp Bool | FullUserCountResp Int | SubscriptionCountResp Int deriving (Eq, Generic, Show) instance Hashable FullChannelAttributeResp -- |A list of users returned by querying for users in a presence channel. 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 -- |The data about a user returned when querying for users in a presence channel. 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