{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds  #-}
{-# LANGUAGE GADTs      #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Network.XMPP.IQ
-- Copyright   :  (c) pierre, 2007
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- Copyright   :  (c) riskbook, 2020
-- SPDX-License-Identifier:  BSD3
-- 
-- Maintainer  :  k.pierre.k@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- XMPP IQ utilites
--
-----------------------------------------------------------------------------

module Network.XMPP.IQ
  ( iqSend
  , iqReplyTo
  ) where 

import Network.XMPP.Types
import Network.XMPP.Stream
import Network.XMPP.Concurrent
import Text.XML (Node)
import qualified Data.Text as T
import Control.Monad.IO.Class

-- | Send IQ of specified type with supplied data
iqSend :: MonadIO m
       => T.Text -- ^ ID to use
       -> IQType -- ^ IQ type
       -> [Node] -- ^ request contents
       -> XmppMonad m ()
iqSend :: Text -> IQType -> [Node] -> XmppMonad m ()
iqSend Text
id IQType
t [Node]
body = Stanza 'IQ 'Outgoing Any -> XmppMonad m ()
forall (t :: * -> *) a. (XmppSendable t a, Monad t) => a -> t ()
xmppSend (Stanza 'IQ 'Outgoing Any -> XmppMonad m ())
-> Stanza 'IQ 'Outgoing Any -> XmppMonad m ()
forall a b. (a -> b) -> a -> b
$ Maybe SomeJID
-> Maybe SomeJID
-> Text
-> IQType
-> DataByPurpose 'Outgoing Any
-> Sing 'Outgoing
-> Stanza 'IQ 'Outgoing Any
forall (p :: StanzaPurpose) ext.
Maybe SomeJID
-> Maybe SomeJID
-> Text
-> IQType
-> DataByPurpose p ext
-> Sing p
-> Stanza 'IQ p ext
MkIQ Maybe SomeJID
forall a. Maybe a
Nothing Maybe SomeJID
forall a. Maybe a
Nothing Text
id IQType
t [Node]
DataByPurpose 'Outgoing Any
body Sing 'Outgoing
SOutgoing

-- Extract IQ reply that matches the supplied predicate from the event stream and send it (transformed)        
iqReplyTo :: (Stanza 'IQ 'Incoming e -> Bool) -- ^ Predicate used to match required IQ reply
          -> (Stanza 'IQ 'Incoming e -> [Node]) -- ^ transformer function
          -> XmppThreadT IO () e
iqReplyTo :: (Stanza 'IQ 'Incoming e -> Bool)
-> (Stanza 'IQ 'Incoming e -> [Node]) -> XmppThreadT IO () e
iqReplyTo Stanza 'IQ 'Incoming e -> Bool
p Stanza 'IQ 'Incoming e -> [Node]
t = do
  Either XmppError (SomeStanza e)
s <- (Either XmppError (SomeStanza e) -> Bool)
-> XmppThreadT IO (Either XmppError (SomeStanza e)) e
forall (m :: * -> *) e.
MonadIO m =>
(Either XmppError (SomeStanza e) -> Bool)
-> XmppThreadT m (Either XmppError (SomeStanza e)) e
waitFor (\case
            Right (SomeStanza xiq :: Stanza a p e
xiq@MkIQ{ iqPurpose :: forall (p :: StanzaPurpose) ext. Stanza 'IQ p ext -> Sing p
iqPurpose = Sing p
SIncoming }) -> Stanza 'IQ 'Incoming e -> Bool
p Stanza a p e
Stanza 'IQ 'Incoming e
xiq
            Either XmppError (SomeStanza e)
_                     -> Bool
False)
  case Either XmppError (SomeStanza e)
s of
    Right (SomeStanza stnz :: Stanza a p e
stnz@MkIQ{ iqPurpose :: forall (p :: StanzaPurpose) ext. Stanza 'IQ p ext -> Sing p
iqPurpose = Sing p
SIncoming }) -> SomeStanza () -> XmppThreadT IO () e
forall (m :: * -> *) e.
MonadIO m =>
SomeStanza () -> XmppThreadT m () e
writeChanS (SomeStanza () -> XmppThreadT IO () e)
-> SomeStanza () -> XmppThreadT IO () e
forall a b. (a -> b) -> a -> b
$ Stanza 'IQ 'Outgoing () -> SomeStanza ()
forall e (a :: StanzaType) (p :: StanzaPurpose).
Stanza a p e -> SomeStanza e
SomeStanza (Stanza 'IQ 'Outgoing () -> SomeStanza ())
-> Stanza 'IQ 'Outgoing () -> SomeStanza ()
forall a b. (a -> b) -> a -> b
$ (Stanza 'IQ 'Incoming e -> [Node])
-> Stanza 'IQ 'Incoming e -> Stanza 'IQ 'Outgoing ()
forall e.
(Stanza 'IQ 'Incoming e -> [Node])
-> Stanza 'IQ 'Incoming e -> Stanza 'IQ 'Outgoing ()
transform Stanza 'IQ 'Incoming e -> [Node]
t Stanza a p e
Stanza 'IQ 'Incoming e
stnz
    Either XmppError (SomeStanza e)
_                                                     -> () -> XmppThreadT IO () e
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    where
      transform :: (Stanza 'IQ 'Incoming e -> [Node]) -> Stanza 'IQ 'Incoming e -> Stanza 'IQ 'Outgoing ()
      transform :: (Stanza 'IQ 'Incoming e -> [Node])
-> Stanza 'IQ 'Incoming e -> Stanza 'IQ 'Outgoing ()
transform Stanza 'IQ 'Incoming e -> [Node]
t s :: Stanza 'IQ 'Incoming e
s@(MkIQ Maybe SomeJID
from' Maybe SomeJID
to' Text
id' IQType
_type' DataByPurpose 'Incoming e
_body' Sing 'Incoming
SIncoming) =
          Maybe SomeJID
-> Maybe SomeJID
-> Text
-> IQType
-> DataByPurpose 'Outgoing ()
-> Sing 'Outgoing
-> Stanza 'IQ 'Outgoing ()
forall (p :: StanzaPurpose) ext.
Maybe SomeJID
-> Maybe SomeJID
-> Text
-> IQType
-> DataByPurpose p ext
-> Sing p
-> Stanza 'IQ p ext
MkIQ Maybe SomeJID
to' Maybe SomeJID
from' Text
id' IQType
Result (Stanza 'IQ 'Incoming e -> [Node]
t Stanza 'IQ 'Incoming e
s) Sing 'Outgoing
SOutgoing