Presence/ClientState.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

module ClientState where

import Control.Concurrent.STM
import Data.Text ( Text )
import Data.Int  ( Int8 )
import Data.Bits ( (.&.) )

import UTmp       ( ProcessID )
import XMPPServer ( Stanza )

data ClientState = ClientState
      -- | The unix tty or the jabber resource for this client.
    { clientResource :: Text
      -- | Unix user that is running this client.
    , clientUser     :: Text
      -- | The specific roster/identity of the user that this client presenting.
    , clientProfile  :: Text
      -- | The unix process id of the client if we know it.
    , clientPid      :: Maybe ProcessID
      -- | The presence (away/available) stanza this client is indicating.
    , clientStatus   :: TVar (Maybe Stanza)
      -- | XMPP client flags (read access via 'clientIsAvailable' and 'clientIsInterested')
    , clientFlags    :: TVar Int8
    }

cf_available :: Int8
cf_available = 0x1
cf_interested :: Int8
cf_interested = 0x2

-- | True if the client has sent an initial presence
clientIsAvailable :: ClientState -> STM Bool
clientIsAvailable c  = do
    flgs <- readTVar (clientFlags c)
    return $ flgs .&. cf_available /= 0

-- | True if the client has requested a roster
clientIsInterested :: ClientState -> STM Bool
clientIsInterested c = do
    flgs <- readTVar (clientFlags c)
    return $ flgs .&. cf_interested /= 0