{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Network.Xmpp.Concurrent.Types where

import           Control.Concurrent
import           Control.Concurrent.STM
import qualified Control.Exception.Lifted as Ex
import           Control.Monad.Except
import qualified Data.ByteString as BS
import           Data.Default
import qualified Data.Map as Map
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Typeable
import           Data.XML.Types (Element)
import           Network.Socket
import           Network.Xmpp.IM.Roster.Types
import           Network.Xmpp.IM.PresenceTracker.Types
import           Network.Xmpp.Sasl.Types
import           Network.Xmpp.Types

type StanzaHandler = (XmppElement -> IO (Either XmppFailure ()) ) -- ^ outgoing
                                                                  -- stanza
                   -> XmppElement  -- ^ stanza to handle
                   -> [Annotation] -- ^ annotations added by previous handlers
                   -> IO [(XmppElement, [Annotation])]  -- ^ modified stanzas and
                                                        -- /additional/ annotations

type Resource = Text

-- | SASL handlers and the desired JID resource
--
-- Nothing to disable authentication
--
-- The allowed SASL mecahnism can depend on the connection state. For example,
-- 'plain' should be avoided unless the connection state is 'Secured'
--
-- It is recommended to leave the resource up to the server
type AuthData = Maybe (ConnectionState -> [SaslHandler] , Maybe Resource)

-- | Annotations are auxiliary data attached to received stanzas by 'Plugin's to
-- convey information regarding their operation. For example, a plugin for
-- encryption might attach information about whether a received stanza was
-- encrypted and which algorithm was used.
data Annotation = forall f.(Typeable f, Show f) => Annotation{()
fromAnnotation :: f}

instance Show Annotation where
    show :: Annotation -> String
show (Annotation f
x) = String
"Annotation{ fromAnnotation = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show f
x forall a. [a] -> [a] -> [a]
++ String
"}"

type Annotated a = (a, [Annotation])

-- | Retrieve the first matching annotation
getAnnotation :: Typeable b => Annotated a -> Maybe b
getAnnotation :: forall b a. Typeable b => Annotated a -> Maybe b
getAnnotation = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Annotation f
a) Maybe b
b -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
b forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
a) forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

data Plugin' = Plugin'
    { -- | Resulting stanzas and additional Annotations
      Plugin'
-> XmppElement -> [Annotation] -> IO [(XmppElement, [Annotation])]
inHandler :: XmppElement
                -> [Annotation]
                -> IO [(XmppElement, [Annotation])]
    , Plugin' -> XmppElement -> IO (Either XmppFailure ())
outHandler :: XmppElement -> IO (Either XmppFailure ())
    -- | In order to allow plugins to tie the knot (Plugin / Session) we pass
    -- the plugin the completed Session once it exists
    , Plugin' -> Session -> IO ()
onSessionUp :: Session -> IO ()
    }

type Plugin = (XmppElement -> IO (Either XmppFailure ())) -- ^ pass stanza to
                                                          -- next plugin
              -> ExceptT XmppFailure IO Plugin'

type RosterPushCallback = Roster -> RosterUpdate -> IO ()

-- | Configuration for the @Session@ object.
data SessionConfiguration = SessionConfiguration
    { -- | Configuration for the @Stream@ object.
      SessionConfiguration -> StreamConfiguration
sessionStreamConfiguration :: StreamConfiguration
      -- | Handler to be run when the conection to the XMPP server is
      -- closed. See also 'reconnect' and 'reconnect\'' for easy
      -- reconnection. The default does nothing
    , SessionConfiguration -> Session -> XmppFailure -> IO ()
onConnectionClosed         :: Session -> XmppFailure -> IO ()
      -- | Function to generate new stanza identifiers.
    , SessionConfiguration -> IO (IO Text)
sessionStanzaIDs           :: IO (IO Text)
      -- | Plugins can modify incoming and outgoing stanzas, for example to en-
      -- and decrypt them, respectively
    , SessionConfiguration -> [Plugin]
plugins                    :: [Plugin]
      -- | Enable roster handling according to rfc 6121. See 'getRoster' to
      -- acquire the current roster
    , SessionConfiguration -> Bool
enableRoster               :: Bool
      -- | Initial Roster to user when versioned rosters are supported
    , SessionConfiguration -> IO (Maybe Roster)
initialRoster              :: IO (Maybe Roster)
      -- | Callback called on a roster Push. The callback is called after the
      -- roster is updated
    , SessionConfiguration -> Maybe RosterPushCallback
onRosterPush               :: Maybe RosterPushCallback
      -- | Track incomming presence stancas.
    , SessionConfiguration -> Bool
enablePresenceTracking     :: Bool
      -- | Callback that is invoked when the presence status of a peer changes,
      -- i.e. it comes online, goes offline or its IM presence changes. The
      -- arguments are the (full) JID of the peer, the old state and the new
      -- state. The function is called in a new thread to avoid blocking
      -- handling stanzas
    , SessionConfiguration
-> Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
onPresenceChange           :: Maybe ( Jid
                                          -> PeerStatus
                                          -> PeerStatus
                                          -> IO ())
      -- | How often to send keep-alives
      --   'Nothing' disables keep-alive
    , SessionConfiguration -> Maybe Int
keepAlive                  :: Maybe Int
    }

instance Default SessionConfiguration where
    def :: SessionConfiguration
def = SessionConfiguration { sessionStreamConfiguration :: StreamConfiguration
sessionStreamConfiguration = forall a. Default a => a
def
                               , onConnectionClosed :: Session -> XmppFailure -> IO ()
onConnectionClosed = \Session
_ XmppFailure
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                               , sessionStanzaIDs :: IO (IO Text)
sessionStanzaIDs = do
                                     TVar Integer
idRef <- forall a. a -> IO (TVar a)
newTVarIO Integer
1
                                     forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
                                         Integer
curId <- forall a. TVar a -> STM a
readTVar TVar Integer
idRef
                                         forall a. TVar a -> a -> STM ()
writeTVar TVar Integer
idRef (Integer
curId forall a. Num a => a -> a -> a
+ Integer
1 :: Integer)
                                         forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
curId
                               , plugins :: [Plugin]
plugins = []
                               , enableRoster :: Bool
enableRoster = Bool
True
                               , initialRoster :: IO (Maybe Roster)
initialRoster = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                               , onRosterPush :: Maybe RosterPushCallback
onRosterPush = forall a. Maybe a
Nothing
                               , enablePresenceTracking :: Bool
enablePresenceTracking = Bool
True
                               , onPresenceChange :: Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
onPresenceChange = forall a. Maybe a
Nothing
                               , keepAlive :: Maybe Int
keepAlive = forall a. a -> Maybe a
Just Int
30
                               }

-- | Handlers to be run when the Xmpp session ends and when the Xmpp connection is
-- closed.
data EventHandlers = EventHandlers
    { EventHandlers -> XmppFailure -> IO ()
connectionClosedHandler :: XmppFailure -> IO ()
    }

-- | Interrupt is used to signal to the reader thread that it should stop. Th contained semphore signals the reader to resume it's work.
data Interrupt = Interrupt (TMVar ()) deriving Typeable
instance Show Interrupt where show :: Interrupt -> String
show Interrupt
_ = String
"<Interrupt>"

instance Ex.Exception Interrupt

type WriteSemaphore = TMVar (BS.ByteString -> IO (Either XmppFailure ()))

-- | The Session object represents a single session with an XMPP server. You can
-- use 'session' to establish a session
data Session = Session
    { Session -> TChan (Stanza, [Annotation])
stanzaCh :: TChan (Stanza, [Annotation]) -- All stanzas
    , Session -> TVar IQHandlers
iqHandlers :: TVar IQHandlers
      -- Writing lock, so that only one thread could write to the stream at any
      -- given time.
      -- Fields below are from Context.
    , Session -> WriteSemaphore
writeSemaphore :: WriteSemaphore
    , Session -> ThreadId
readerThread :: ThreadId
    , Session -> IO Text
idGenerator :: IO Text
      -- | Lock (used by withStream) to make sure that a maximum of one
      -- Stream action is executed at any given time.
    , Session -> TMVar Stream
streamRef :: TMVar Stream
    , Session -> TMVar EventHandlers
eventHandlers :: TMVar EventHandlers
    , Session -> IO ()
stopThreads :: IO ()
    , Session -> TVar Roster
rosterRef :: TVar Roster
    , Session -> TVar Peers
presenceRef :: TVar Peers
    , Session -> SessionConfiguration
conf :: SessionConfiguration
    , Session -> Stanza -> IO (Either XmppFailure ())
sendStanza' :: Stanza -> IO (Either XmppFailure ())
    , Session -> String
sRealm :: HostName
    , Session -> Maybe (ConnectionState -> [SaslHandler], Maybe Text)
sSaslCredentials :: Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
    , Session -> TVar Int
reconnectWait :: TVar Int
    }

-- | IQHandlers holds the registered channels for incoming IQ requests and
-- TMVars of and TMVars for expected IQ responses (the second Text represent a
-- stanza identifier.
type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
                  , Map.Map Text (Either (Maybe Jid) Jid,
                                  TMVar (Maybe (Annotated IQResponse)))
                  )

-- | A received and wrapped up IQ request. Prevents you from (illegally)
-- answering a single IQ request multiple times
data IQRequestTicket = IQRequestTicket
    {   -- | Send an answer to an IQ request once. Subsequent calls will do
        -- nothing and return Nothing
      IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerTicket :: Either StanzaError (Maybe Element)
                      -> [ExtendedAttribute]
                      -> IO (Maybe (Either XmppFailure ()))
      -- | The actual IQ request that created this ticket.
    , IQRequestTicket -> IQRequest
iqRequestBody :: IQRequest
      -- | Annotations set by plugins in receive
    , IQRequestTicket -> [Annotation]
iqRequestAnnotations :: [Annotation]
    }

-- | Error that can occur during sendIQ'
data IQSendError = IQSendError XmppFailure -- There was an error sending the IQ
                                           -- stanza
                 | IQTimeOut -- No answer was received during the allotted time
                   deriving (Int -> IQSendError -> ShowS
[IQSendError] -> ShowS
IQSendError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IQSendError] -> ShowS
$cshowList :: [IQSendError] -> ShowS
show :: IQSendError -> String
$cshow :: IQSendError -> String
showsPrec :: Int -> IQSendError -> ShowS
$cshowsPrec :: Int -> IQSendError -> ShowS
Show, IQSendError -> IQSendError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IQSendError -> IQSendError -> Bool
$c/= :: IQSendError -> IQSendError -> Bool
== :: IQSendError -> IQSendError -> Bool
$c== :: IQSendError -> IQSendError -> Bool
Eq, Typeable)

instance Ex.Exception IQSendError