-----------------------------------------------------------------------------
--
-- Module      :  Types
-- Copyright   :  Copyright © 2011, Jon Kristensen
-- License     :  LGPL (Just (Version {versionBranch = [3], versionTags = []}))
--
-- Maintainer  :  jon.kristensen@pontarius.org
-- Stability   :  alpha
-- Portability :
--
-----------------------------------------------------------------------------

{-# LANGUAGE MultiParamTypeClasses #-}

module Network.XMPP.Types (
                            HostName
                            , Password
                            , PortNumber
                            , Resource
                            , UserName,

EnumeratorEvent (..),
Challenge (..),
Success (..),
TLSState (..),
JID (..),
StanzaID (..),
From,
To,
XMLLang,
Stanza (..),
MessageType (..),
Message (..),
PresenceType (..),
Presence (..),
IQ (..),
InternalEvent (..),
XMLEvent (..),
ConnectionState (..),
ClientEvent (..),
StreamState (..),
AuthenticationState (..),
Certificate,
ConnectResult (..),
OpenStreamResult (..),
SecureWithTLSResult (..),
AuthenticateResult (..),
ServerAddress (..),
XMPPError (..),
StanzaError (..),
StanzaErrorType (..),
StanzaErrorCondition (..),
Timeout,
TimeoutEvent (..),
StreamError (..),
XMLString
) where

import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)

import qualified Network as N

import qualified Control.Exception as CE

import Control.Monad.State hiding (State)

import Data.XML.Types

import Network.TLS
import Network.TLS.Cipher

import qualified Control.Monad.Error as CME


type XMLString = String

instance Eq ConnectionState where
  Disconnected == Disconnected = True
  (Connected p h) == (Connected p_ h_) = p == p_ && h == h_
  -- (ConnectedPostFeatures s p h t) == (ConnectedPostFeatures s p h t) = True
  -- (ConnectedAuthenticated s p h t) == (ConnectedAuthenticated s p h t) = True
  _ == _ = False

data XMPPError = UncaughtEvent deriving (Eq, Show)

instance CME.Error XMPPError where
  strMsg "UncaughtEvent" = UncaughtEvent


-- | Readability type for host name Strings.

type HostName = String -- This is defined in Network as well


-- | Readability type for port number Integers.

type PortNumber = Integer -- We use N(etwork).PortID (PortNumber) internally


-- | Readability type for user name Strings.

type UserName = String


-- | Readability type for password Strings.

type Password = String


-- | Readability type for (JID) resource identifier Strings.

type Resource = String


-- An XMLEvent is triggered by an XML stanza or some other XML event, and is
-- sent through the internal event channel, just like client action events.

data XMLEvent = XEBeginStream String | XEFeatures String |
                XEChallenge Challenge | XESuccess Success |
                XEEndStream | XEIQ IQ | XEPresence Presence |
                XEMessage Message | XEProceed |
                XEOther String deriving (Show)

data EnumeratorEvent = EnumeratorDone |
                       EnumeratorXML XMLEvent |
                       EnumeratorException CE.SomeException
                       deriving (Show)


-- Type to contain the internal events.

data InternalEvent s m = IEC (ClientEvent s m) | IEE EnumeratorEvent | IET (TimeoutEvent s m) deriving (Show)

data TimeoutEvent s m = TimeoutEvent StanzaID Timeout (StateT s m ())

instance Show (TimeoutEvent s m) where
    show (TimeoutEvent (SID i) t _) = "TimeoutEvent (ID: " ++ (show i) ++ ", timeout: " ++ (show t) ++ ")"


data StreamState = PreStream |
                   PreFeatures StreamProperties |
                   PostFeatures StreamProperties StreamFeatures


data AuthenticationState = NoAuthentication | AuthenticatingPreChallenge1 String String (Maybe Resource) | AuthenticatingPreChallenge2 String String (Maybe Resource) | AuthenticatingPreSuccess String String (Maybe Resource) | AuthenticatedUnbound String (Maybe Resource) | AuthenticatedBound String Resource


-- Client actions that needs to be performed in the (main) state loop are
-- converted to ClientEvents and sent through the internal event channel.

data ClientEvent s m = CEOpenStream N.HostName PortNumber
                       (OpenStreamResult -> StateT s m ()) |
                       CESecureWithTLS Certificate (Certificate -> Bool)
                       (SecureWithTLSResult -> StateT s m ()) |
                       CEAuthenticate UserName Password (Maybe Resource)
                       (AuthenticateResult -> StateT s m ()) |
                       CEMessage Message (Maybe (Message -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) |
                       CEPresence Presence (Maybe (Presence -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) |
                       CEIQ IQ (Maybe (IQ -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) |
                       CEAction (Maybe (StateT s m Bool)) (StateT s m ())

instance Show (ClientEvent s m) where
  show (CEOpenStream h p _) = "CEOpenStream " ++ h ++ " " ++ (show p)
  show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ c
  show (CEAuthenticate u p r _) = "CEAuthenticate " ++ u ++ " " ++ p ++ " " ++
                                    (show r)
  show (CEIQ s _ _ _) = "CEIQ"
  show (CEMessage s _ _ _) = "CEMessage"
  show (CEPresence s _ _ _) = "CEPresence"

  show (CEAction _ _) = "CEAction"


type StreamID = String

data ConnectionState = Disconnected | Connected ServerAddress Handle

data TLSState = NoTLS | PreProceed | PreHandshake | PostHandshake TLSCtx

data Challenge = Chal String deriving (Show)

data Success = Succ String deriving (Show)


data StanzaID = SID String deriving (Eq, Show)
type From = JID
type To = JID
type XMLLang = String -- Validate, protect


data Stanza = Stanza { stanzaID :: Maybe StanzaID
                     , stanzaFrom :: Maybe From
                     , stanzaTo :: Maybe To
                     , stanzaLang :: Maybe XMLLang } deriving (Eq, Show)


data MessageType = Chat |
                   Error_ |
                   Groupchat |
                   Headline |
                   Normal | -- Default
                   OtherMessageType String deriving (Eq, Show)


data Message = Message { messageStanza :: Stanza
                       , messageType :: MessageType
                       , messagePayload :: [Element] } |
               MessageError { messageErrorStanza :: Stanza
                            , messageErrorPayload :: Maybe [Element]
                            , messageErrorStanzaError :: StanzaError } deriving (Eq, Show)

data PresenceType = Subscribe    | -- ^ Sender wants to subscribe to presence
                    Subscribed   | -- ^ Sender has approved the subscription
                    Unsubscribe  | -- ^ Sender is unsubscribing from presence
                    Unsubscribed | -- ^ Sender has denied or cancelled a
                                   --   subscription
                    Probe        | -- ^ Sender requests current presence;
                                   --   should only be used by servers
                    -- PresenceError | -- ^ Processing or delivery of previously
                                   --   sent presence stanza failed
                    Available    | -- Not part of type='' [...]
                    -- Away         |
                    -- Chat         |
                    -- DoNotDisturb |
                    -- ExtendedAway |
                    Unavailable
                  deriving (Eq, Show)


-- | Presence stanzas are used to express an entity's network availability.

data Presence = Presence { presenceStanza :: Stanza
                         , presenceType :: PresenceType
                         , presencePayload :: [Element] } |
                PresenceError { presenceErrorStanza :: Stanza
                              , presenceErrorPayload :: Maybe [Element]
                              , presenceErrorStanzaError :: StanzaError } deriving (Eq, Show)


-- | All stanzas (IQ, message, presence) can cause errors, which looks like
--   <stanza-kind to='sender' type='error'>. These errors are of one of the
--   types listed below.

data StanzaErrorType = Cancel   | -- ^ Error is unrecoverable - do not retry
                       Continue | -- ^ Conditition was a warning - proceed
                       Modify   | -- ^ Change the data and retry
                       Auth     | -- ^ Provide credentials and retry
                       Wait       -- ^ Error is temporary - wait and retry
                       deriving (Eq, Show)


-- | The stanza errors are accommodated with one of the error conditions listed
--   below. The ones that are not self-explainatory should be documented below.

data StanzaErrorCondition = BadRequest            | -- ^ Malformed XML
                            Conflict              | -- ^ Resource or session
                                                    --   with name already
                                                    --   exists
                            FeatureNotImplemented |
                            Forbidden             | -- ^ Insufficient
                                                    --   permissions
                            Gone                  | -- ^ Entity can no longer
                                                    --   be contacted at this
                                                    --   address
                            InternalServerError   |
                            ItemNotFound          |
                            JIDMalformed          |
                            NotAcceptable         | -- ^ Does not meet policy
                                                    --   criteria
                            NotAllowed            | -- ^ No entity may perform
                                                    --   this action
                            NotAuthorized         | -- ^ Must provide proper
                                                    --   credentials
                            PaymentRequired       |
                            RecipientUnavailable  | -- ^ Temporarily
                                                    --   unavailable
                            Redirect              | -- ^ Redirecting to other
                                                    --   entity, usually
                                                    --   temporarily
                            RegistrationRequired  |
                            RemoteServerNotFound  |
                            RemoteServerTimeout   |
                            ResourceConstraint    | -- ^ Entity lacks the
                                                    --   necessary system
                                                    --   resources
                            ServiceUnavailable    |
                            SubscriptionRequired  |
                            UndefinedCondition    | -- ^ Application-specific
                                                    --   condition
                            UnexpectedRequest       -- ^ Badly timed request
                            deriving (Eq, Show)


data IQ = IQGet { iqGetStanza :: Stanza, iqGetPayload :: Element } |
          IQSet { iqSetStanza :: Stanza, iqSetPayload :: Element } |
          IQResult { iqResultStanza :: Stanza
                   , iqResultPayload :: Maybe Element } |
          IQError { iqErrorStanza :: Stanza, iqErrorPayload :: Maybe Element, iqErrorStanzaError :: StanzaError } deriving (Eq, Show)


data StanzaError = StanzaError { stanzaErrorType :: StanzaErrorType
                               , stanzaErrorCondition :: StanzaErrorCondition
                               , stanzaErrorText :: Maybe String
                               , stanzaErrorApplicationSpecificCondition ::
                                 Maybe Element } deriving (Eq, Show)


type StreamProperties = Float
type StreamFeatures = String


data ConnectResult = ConnectSuccess StreamProperties StreamFeatures (Maybe Resource) |
                     ConnectOpenStreamFailure |
                     ConnectSecureWithTLSFailure |
                     ConnectAuthenticateFailure

data OpenStreamResult = OpenStreamSuccess StreamProperties StreamFeatures |
                        OpenStreamFailure

data SecureWithTLSResult = SecureWithTLSSuccess StreamProperties StreamFeatures | SecureWithTLSFailure

data AuthenticateResult = AuthenticateSuccess StreamProperties StreamFeatures Resource | AuthenticateFailure

type Certificate = String -- TODO

-- JID is a data type that has to be constructed in this module using either jid
-- or stringToJID.

data JID = JID { jidNode :: Maybe String
               , jidServer :: String
               , jidResource :: Maybe String } deriving (Eq, Show)

data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq)

type Timeout = Int

data StreamError = StreamError