{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Network.Pusher.Protocol
-- Description : Types representing Pusher messages
-- Copyright   : (c) Will Sewell, 2016
-- Licence     : MIT
-- Maintainer  : me@willsewell.com
-- Stability   : stable
--
-- Types representing the JSON format of Pusher messages.
--
-- There are also types for query string parameters.
module Network.Pusher.Protocol
  ( ChannelInfo (..),
    ChannelInfoAttributes (..),
    ChannelInfoQuery (..),
    ChannelsInfo (..),
    ChannelsInfoQuery (..),
    ChannelsInfoAttributes (..),
    FullChannelInfo (..),
    User (..),
    Users (..),
    ToURLParam,
    toURLParam,
  )
where

import Data.Aeson ((.:), (.:?))
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import Data.Hashable (Hashable)
import qualified Data.Text as T
import GHC.Generics (Generic)

-- | Types that can be serialised to a querystring parameter value.
class ToURLParam a where
  toURLParam :: a -> T.Text

-- | Enumeration of the attributes that can be queried about multiple channels.
data ChannelsInfoAttributes
  = ChannelsUserCount
  deriving (ChannelsInfoAttributes -> ChannelsInfoAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelsInfoAttributes -> ChannelsInfoAttributes -> Bool
$c/= :: ChannelsInfoAttributes -> ChannelsInfoAttributes -> Bool
== :: ChannelsInfoAttributes -> ChannelsInfoAttributes -> Bool
$c== :: ChannelsInfoAttributes -> ChannelsInfoAttributes -> Bool
Eq, forall x. Rep ChannelsInfoAttributes x -> ChannelsInfoAttributes
forall x. ChannelsInfoAttributes -> Rep ChannelsInfoAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelsInfoAttributes x -> ChannelsInfoAttributes
$cfrom :: forall x. ChannelsInfoAttributes -> Rep ChannelsInfoAttributes x
Generic)

instance ToURLParam ChannelsInfoAttributes where
  toURLParam :: ChannelsInfoAttributes -> Text
toURLParam ChannelsInfoAttributes
ChannelsUserCount = Text
"user_count"

instance Hashable ChannelsInfoAttributes

-- | A set of requested 'ChannelsInfoAttributes'.
newtype ChannelsInfoQuery
  = ChannelsInfoQuery (HS.HashSet ChannelsInfoAttributes)
  deriving (ChannelsInfoQuery -> Text
forall a. (a -> Text) -> ToURLParam a
toURLParam :: ChannelsInfoQuery -> Text
$ctoURLParam :: ChannelsInfoQuery -> Text
ToURLParam)

-- | Enumeration of the attributes that can be queried about a single channel.
data ChannelInfoAttributes
  = ChannelUserCount
  | ChannelSubscriptionCount
  deriving (ChannelInfoAttributes -> ChannelInfoAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelInfoAttributes -> ChannelInfoAttributes -> Bool
$c/= :: ChannelInfoAttributes -> ChannelInfoAttributes -> Bool
== :: ChannelInfoAttributes -> ChannelInfoAttributes -> Bool
$c== :: ChannelInfoAttributes -> ChannelInfoAttributes -> Bool
Eq, forall x. Rep ChannelInfoAttributes x -> ChannelInfoAttributes
forall x. ChannelInfoAttributes -> Rep ChannelInfoAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelInfoAttributes x -> ChannelInfoAttributes
$cfrom :: forall x. ChannelInfoAttributes -> Rep ChannelInfoAttributes x
Generic)

instance ToURLParam ChannelInfoAttributes where
  toURLParam :: ChannelInfoAttributes -> Text
toURLParam ChannelInfoAttributes
ChannelUserCount = Text
"user_count"
  toURLParam ChannelInfoAttributes
ChannelSubscriptionCount = Text
"subscription_count"

instance Hashable ChannelInfoAttributes

-- | A set of requested 'ChannelInfoAttributes'.
newtype ChannelInfoQuery
  = ChannelInfoQuery (HS.HashSet ChannelInfoAttributes)
  deriving (ChannelInfoQuery -> Text
forall a. (a -> Text) -> ToURLParam a
toURLParam :: ChannelInfoQuery -> Text
$ctoURLParam :: ChannelInfoQuery -> Text
ToURLParam)

instance ToURLParam a => ToURLParam (HS.HashSet a) where
  toURLParam :: HashSet a -> Text
toURLParam HashSet a
hs = Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a. ToURLParam a => a -> Text
toURLParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HashSet a -> [a]
HS.toList HashSet a
hs

-- | A map of channels to their 'ChannelInfo'. The result of querying channel
--  info from multiple channels.
newtype ChannelsInfo
  = ChannelsInfo (HM.HashMap T.Text ChannelInfo)
  deriving (ChannelsInfo -> ChannelsInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelsInfo -> ChannelsInfo -> Bool
$c/= :: ChannelsInfo -> ChannelsInfo -> Bool
== :: ChannelsInfo -> ChannelsInfo -> Bool
$c== :: ChannelsInfo -> ChannelsInfo -> Bool
Eq, Int -> ChannelsInfo -> ShowS
[ChannelsInfo] -> ShowS
ChannelsInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelsInfo] -> ShowS
$cshowList :: [ChannelsInfo] -> ShowS
show :: ChannelsInfo -> String
$cshow :: ChannelsInfo -> String
showsPrec :: Int -> ChannelsInfo -> ShowS
$cshowsPrec :: Int -> ChannelsInfo -> ShowS
Show)

instance A.FromJSON ChannelsInfo where
  parseJSON :: Value -> Parser ChannelsInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ChannelsInfo" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Value
channelsV <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channels"
      HashMap Text ChannelInfo -> ChannelsInfo
ChannelsInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
channelsV

-- | The possible returned channel attributes when multiple when multiple
--  channels are queried.
newtype ChannelInfo
  = ChannelInfo
      { ChannelInfo -> Maybe Int
channelInfoUserCount :: Maybe Int
      }
  deriving (ChannelInfo -> ChannelInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelInfo -> ChannelInfo -> Bool
$c/= :: ChannelInfo -> ChannelInfo -> Bool
== :: ChannelInfo -> ChannelInfo -> Bool
$c== :: ChannelInfo -> ChannelInfo -> Bool
Eq, Int -> ChannelInfo -> ShowS
[ChannelInfo] -> ShowS
ChannelInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelInfo] -> ShowS
$cshowList :: [ChannelInfo] -> ShowS
show :: ChannelInfo -> String
$cshow :: ChannelInfo -> String
showsPrec :: Int -> ChannelInfo -> ShowS
$cshowsPrec :: Int -> ChannelInfo -> ShowS
Show)

instance A.FromJSON ChannelInfo where
  parseJSON :: Value -> Parser ChannelInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ChannelInfo" forall a b. (a -> b) -> a -> b
$ \Object
v -> Maybe Int -> ChannelInfo
ChannelInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_count"

-- | The possible values returned by a query to a single channel.
data FullChannelInfo
  = FullChannelInfo
      { FullChannelInfo -> Bool
fullChannelInfoOccupied :: Bool,
        FullChannelInfo -> Maybe Int
fullChannelInfoUserCount :: Maybe Int,
        FullChannelInfo -> Maybe Int
fullChannelInfoSubCount :: Maybe Int
      }
  deriving (FullChannelInfo -> FullChannelInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullChannelInfo -> FullChannelInfo -> Bool
$c/= :: FullChannelInfo -> FullChannelInfo -> Bool
== :: FullChannelInfo -> FullChannelInfo -> Bool
$c== :: FullChannelInfo -> FullChannelInfo -> Bool
Eq, Int -> FullChannelInfo -> ShowS
[FullChannelInfo] -> ShowS
FullChannelInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullChannelInfo] -> ShowS
$cshowList :: [FullChannelInfo] -> ShowS
show :: FullChannelInfo -> String
$cshow :: FullChannelInfo -> String
showsPrec :: Int -> FullChannelInfo -> ShowS
$cshowsPrec :: Int -> FullChannelInfo -> ShowS
Show)

instance A.FromJSON FullChannelInfo where
  parseJSON :: Value -> Parser FullChannelInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FullChannelInfo" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Bool -> Maybe Int -> Maybe Int -> FullChannelInfo
FullChannelInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"occupied" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_count"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscription_count"

-- | A list of users returned by querying for users in a presence channel.
newtype Users
  = Users [User]
  deriving (Users -> Users -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Users -> Users -> Bool
$c/= :: Users -> Users -> Bool
== :: Users -> Users -> Bool
$c== :: Users -> Users -> Bool
Eq, Int -> Users -> ShowS
[Users] -> ShowS
Users -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Users] -> ShowS
$cshowList :: [Users] -> ShowS
show :: Users -> String
$cshow :: Users -> String
showsPrec :: Int -> Users -> ShowS
$cshowsPrec :: Int -> Users -> ShowS
Show)

instance A.FromJSON Users where
  parseJSON :: Value -> Parser Users
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FullChannelInfo" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Value
users <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"users"
      [User] -> Users
Users forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
users

-- | The data about a user returned when querying for users in a presence
--  channel.
newtype User
  = User
      { User -> Text
userID :: T.Text
      }
  deriving (User -> User -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, Int -> User -> ShowS
[User] -> ShowS
User -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show)

instance A.FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FullChannelInfo" forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> User
User forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"