{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK hide #-}
module Network.Xmpp.Concurrent.IQ where

import           Control.Applicative ((<$>))
import           Control.Concurrent (forkIO)
import           Control.Concurrent.STM
import           Control.Concurrent.Thread.Delay (delay)
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.Trans
import qualified Data.Map as Map
import qualified Data.Map.Strict as Map.Strict
import           Data.Maybe
import           Data.Text (Text)
import           Data.XML.Pickle
import           Data.XML.Types
import           Lens.Family2 (toListOf, (&), (^.))
import           Network.Xmpp.Concurrent.Basic
import           Network.Xmpp.Concurrent.Types
import           Network.Xmpp.Lens
import           Network.Xmpp.Stanza
import           Network.Xmpp.Types
import           System.Log.Logger

-- | Sends an IQ, returns an STM action that returns the first inbound IQ with a
-- matching ID that has type @result@ or @error@ or Nothing if the timeout was
-- reached.
--
-- When sending the action fails, an XmppFailure is returned.
sendIQ :: Maybe Integer -- ^ Timeout . When the timeout is reached the response
                        -- TMVar will be filled with 'IQResponseTimeout' and the
                        -- id is removed from the list of IQ handlers. 'Nothing'
                        -- deactivates the timeout
       -> Maybe Jid -- ^ Recipient (to)
       -> IQRequestType  -- ^ IQ type (@Get@ or @Set@)
       -> Maybe LangTag  -- ^ Language tag of the payload (@Nothing@ for
                         -- default)
       -> Element -- ^ The IQ body (there has to be exactly one)
       -> [ExtendedAttribute] -- ^ Additional stanza attributes
       -> Session
       -> IO (Either XmppFailure (STM (Maybe (Annotated IQResponse))))
sendIQ :: Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either XmppFailure (STM (Maybe (Annotated IQResponse))))
sendIQ Maybe Integer
timeOut Maybe Jid
t IQRequestType
tp Maybe LangTag
lang Element
body [ExtendedAttribute]
attrs Session
session = do
    Text
newId <- Session -> IO Text
idGenerator Session
session
    Either (Maybe Jid) Jid
j <- case Maybe Jid
t of
        Just Jid
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Jid
t
        Maybe Jid
Nothing -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session -> IO (Maybe Jid)
getJid Session
session
    TMVar (Maybe (Annotated IQResponse))
ref <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
        TMVar (Maybe (Annotated IQResponse))
resRef <- forall a. STM (TMVar a)
newEmptyTMVar
        let value :: (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
value = (Either (Maybe Jid) Jid
j, TMVar (Maybe (Annotated IQResponse))
resRef)
        (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS, Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byId) <- forall a. TVar a -> STM a
readTVar (Session
-> TVar
     (Map (IQRequestType, Text) (TChan IQRequestTicket),
      Map
        Text
        (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
iqHandlers Session
session)
        forall a. TVar a -> a -> STM ()
writeTVar (Session
-> TVar
     (Map (IQRequestType, Text) (TChan IQRequestTicket),
      Map
        Text
        (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
iqHandlers Session
session) (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS, forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
newId (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
value Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byId)
        forall (m :: * -> *) a. Monad m => a -> m a
return TMVar (Maybe (Annotated IQResponse))
resRef
    Either XmppFailure ()
res <- Stanza -> Session -> IO (Either XmppFailure ())
sendStanza (IQRequest -> Stanza
IQRequestS forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> IQRequestType
-> Element
-> [ExtendedAttribute]
-> IQRequest
IQRequest Text
newId forall a. Maybe a
Nothing Maybe Jid
t Maybe LangTag
lang IQRequestType
tp Element
body [ExtendedAttribute]
attrs)
                      Session
session
    case Either XmppFailure ()
res of
        Right () -> do
            case Maybe Integer
timeOut of
                Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just Integer
t -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
                          Integer -> IO ()
delay Integer
t
                          TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
-> Text -> TMVar (Maybe (Annotated IQResponse)) -> IO ()
doTimeOut (Session
-> TVar
     (Map (IQRequestType, Text) (TChan IQRequestTicket),
      Map
        Text
        (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
iqHandlers Session
session) Text
newId TMVar (Maybe (Annotated IQResponse))
ref
            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar (Maybe (Annotated IQResponse))
ref
        Left XmppFailure
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left XmppFailure
e
  where
    doTimeOut :: TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
-> Text -> TMVar (Maybe (Annotated IQResponse)) -> IO ()
doTimeOut TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers Text
iqid TMVar (Maybe (Annotated IQResponse))
var = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
      Bool
p <- forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar (Maybe (Annotated IQResponse))
var forall a. Maybe a
Nothing
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
p forall a b. (a -> b) -> a -> b
$ do
          (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS, Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byId) <- forall a. TVar a -> STM a
readTVar (Session
-> TVar
     (Map (IQRequestType, Text) (TChan IQRequestTicket),
      Map
        Text
        (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
iqHandlers Session
session)
          forall a. TVar a -> a -> STM ()
writeTVar TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS, forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
iqid Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byId)
      forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like 'sendIQ', but waits for the answer IQ.
sendIQA' :: Maybe Integer
         -> Maybe Jid
         -> IQRequestType
         -> Maybe LangTag
         -> Element
         -> [ExtendedAttribute]
         -> Session
         -> IO (Either IQSendError (Annotated IQResponse))
sendIQA' :: Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
sendIQA' Maybe Integer
timeout Maybe Jid
to IQRequestType
tp Maybe LangTag
lang Element
body [ExtendedAttribute]
attrs Session
session = do
    Either XmppFailure (STM (Maybe (Annotated IQResponse)))
ref <- Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either XmppFailure (STM (Maybe (Annotated IQResponse))))
sendIQ Maybe Integer
timeout Maybe Jid
to IQRequestType
tp Maybe LangTag
lang Element
body [ExtendedAttribute]
attrs Session
session
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmppFailure -> IQSendError
IQSendError) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left IQSendError
IQTimeOut) forall a b. b -> Either a b
Right)
                                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically) Either XmppFailure (STM (Maybe (Annotated IQResponse)))
ref

-- | Like 'sendIQ', but waits for the answer IQ. Discards plugin Annotations
sendIQ' :: Maybe Integer
        -> Maybe Jid
        -> IQRequestType
        -> Maybe LangTag
        -> Element
        -> [ExtendedAttribute]
        -> Session
        -> IO (Either IQSendError IQResponse)
sendIQ' :: Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError IQResponse)
sendIQ' Maybe Integer
timeout Maybe Jid
to IQRequestType
tp Maybe LangTag
lang Element
body [ExtendedAttribute]
attrs Session
session =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
sendIQA' Maybe Integer
timeout Maybe Jid
to IQRequestType
tp Maybe LangTag
lang Element
body [ExtendedAttribute]
attrs Session
session

-- | Register your interest in inbound IQ stanzas of a specific type and
-- namespace. The returned STM action yields the received, matching IQ stanzas.
--
-- If a handler for IQ stanzas with the given type and namespace is already
-- registered, the producer will be wrapped in Left. In this case the returned
-- request tickets may already be processed elsewhere.
listenIQ :: IQRequestType  -- ^ Type of IQs to receive ('Get' or 'Set')
         -> Text -- ^ Namespace of the child element
         -> Session
         -> IO (Either (STM IQRequestTicket) (STM IQRequestTicket))
listenIQ :: IQRequestType
-> Text
-> Session
-> IO (Either (STM IQRequestTicket) (STM IQRequestTicket))
listenIQ IQRequestType
tp Text
ns Session
session = do
    let handlers :: TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers = (Session
-> TVar
     (Map (IQRequestType, Text) (TChan IQRequestTicket),
      Map
        Text
        (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
iqHandlers Session
session)
    forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
        (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS, Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byID) <- forall a. TVar a -> STM a
readTVar TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers
        TChan IQRequestTicket
iqCh <- forall a. STM (TChan a)
newTChan
        let (Maybe (TChan IQRequestTicket)
present, Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS') = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
Map.Strict.insertLookupWithKey
                (\(IQRequestType, Text)
_ TChan IQRequestTicket
_ TChan IQRequestTicket
old -> TChan IQRequestTicket
old)
                (IQRequestType
tp, Text
ns)
                TChan IQRequestTicket
iqCh
                Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS
        forall a. TVar a -> a -> STM ()
writeTVar TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS', Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byID)
        case Maybe (TChan IQRequestTicket)
present of
            Maybe (TChan IQRequestTicket)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> STM a
readTChan TChan IQRequestTicket
iqCh
            Just TChan IQRequestTicket
iqCh' -> do
                TChan IQRequestTicket
clonedChan <- forall a. TChan a -> STM (TChan a)
cloneTChan TChan IQRequestTicket
iqCh'
                forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> STM a
readTChan TChan IQRequestTicket
clonedChan


-- | Unregister a previously registered IQ handler. No more IQ stanzas will be
-- delivered to any of the returned producers.
unlistenIQ :: IQRequestType  -- ^ Type of IQ ('Get' or 'Set')
           -> Text -- ^ Namespace of the child element
           -> Session
           -> IO ()
unlistenIQ :: IQRequestType -> Text -> Session -> IO ()
unlistenIQ IQRequestType
tp Text
ns Session
session = do
    let handlers :: TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers = (Session
-> TVar
     (Map (IQRequestType, Text) (TChan IQRequestTicket),
      Map
        Text
        (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
iqHandlers Session
session)
    forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
        (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS, Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byID) <- forall a. TVar a -> STM a
readTVar TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers
        let byNS' :: Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS' = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (IQRequestType
tp, Text
ns) Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS
        forall a. TVar a -> a -> STM ()
writeTVar TVar
  (Map (IQRequestType, Text) (TChan IQRequestTicket),
   Map
     Text
     (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse))))
handlers (Map (IQRequestType, Text) (TChan IQRequestTicket)
byNS', Map
  Text (Either (Maybe Jid) Jid, TMVar (Maybe (Annotated IQResponse)))
byID)
        forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Answer an IQ request. Only the first answer ist sent and Just True is
-- returned when the answer is sucessfully sent. If an error occured during
-- sending Just False is returned (and another attempt can be
-- undertaken). Subsequent answers after the first sucessful one are dropped and
-- (False is returned in that case)
answerIQ :: IQRequestTicket
         -> Either StanzaError (Maybe Element)
         -> [ExtendedAttribute]
         -> IO (Maybe (Either XmppFailure ()))
answerIQ :: IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerIQ = IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerTicket


-- Class

class IQRequestClass a where
    data IQResponseType a
    pickleRequest :: PU Element a
    pickleResponse :: PU [Element] (IQResponseType a)
    requestType :: a -> IQRequestType
    requestNamespace :: a -> Text

data IQRequestError = IQRequestSendError XmppFailure
                    | IQRequestTimeout
                    | IQRequestUnpickleError UnpickleError
                      deriving Int -> IQRequestError -> ShowS
[IQRequestError] -> ShowS
IQRequestError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IQRequestError] -> ShowS
$cshowList :: [IQRequestError] -> ShowS
show :: IQRequestError -> String
$cshow :: IQRequestError -> String
showsPrec :: Int -> IQRequestError -> ShowS
$cshowsPrec :: Int -> IQRequestError -> ShowS
Show

-- | Send an IQ request. May throw IQSendError, UnpickleError,

sendIQRequest  :: (IQRequestClass a, MonadError IQRequestError m, MonadIO m) =>
                  Maybe Integer
               -> Maybe Jid
               -> a
               -> Session
               -> m (Either IQError (IQResponseType a))
sendIQRequest :: forall a (m :: * -> *).
(IQRequestClass a, MonadError IQRequestError m, MonadIO m) =>
Maybe Integer
-> Maybe Jid
-> a
-> Session
-> m (Either IQError (IQResponseType a))
sendIQRequest Maybe Integer
timeout Maybe Jid
t a
req Session
con = do
    Either IQSendError IQResponse
mbRes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError IQResponse)
sendIQ' Maybe Integer
timeout Maybe Jid
t (forall a. IQRequestClass a => a -> IQRequestType
requestType a
req) forall a. Maybe a
Nothing
                              (forall t a. PU t a -> a -> t
pickle forall a. IQRequestClass a => PU Element a
pickleRequest a
req) [] Session
con
    case Either IQSendError IQResponse
mbRes of
        Left (IQSendError
IQTimeOut) -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError IQRequestError
IQRequestTimeout
        Left (IQSendError XmppFailure
e) -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ XmppFailure -> IQRequestError
IQRequestSendError XmppFailure
e
        Right (IQResponseError IQError
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left IQError
e
        Right (IQResponseResult IQResult
res) ->
              case forall t a. PU t a -> t -> Either UnpickleError a
unpickle forall a. IQRequestClass a => PU [Element] (IQResponseType a)
pickleResponse (IQResult
res forall s t. s -> (s -> t) -> t
& forall s t a b. Fold s t a b -> s -> [a]
toListOf forall s. IsStanza s => Traversal s Element
payloadT) of
                   Left UnpickleError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ UnpickleError -> IQRequestError
IQRequestUnpickleError UnpickleError
e
                   Right IQResponseType a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right IQResponseType a
r

type IQRequestHandler a = a -> IO (Either StanzaError (IQResponseType a))

runIQHandler :: IQRequestClass a =>
                IQRequestHandler a
             -> Session
             -> IO ()
runIQHandler :: forall a.
IQRequestClass a =>
IQRequestHandler a -> Session -> IO ()
runIQHandler (a -> IO (Either StanzaError (IQResponseType a))
handler :: a -> IO (Either StanzaError (IQResponseType a)))
             Session
sess = do
    let prx :: a
prx = forall a. HasCallStack => a
undefined :: a
        ns :: Text
ns = (forall a. IQRequestClass a => a -> Text
requestNamespace a
prx)
    Either (STM IQRequestTicket) (STM IQRequestTicket)
mbChan <- IQRequestType
-> Text
-> Session
-> IO (Either (STM IQRequestTicket) (STM IQRequestTicket))
listenIQ (forall a. IQRequestClass a => a -> IQRequestType
requestType a
prx) Text
ns Session
sess
    case Either (STM IQRequestTicket) (STM IQRequestTicket)
mbChan of
        Left STM IQRequestTicket
_ -> String -> String -> IO ()
warningM String
"Pontarius.Xmpp" forall a b. (a -> b) -> a -> b
$ String
"IQ namespace " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
ns
                            forall a. [a] -> [a] -> [a]
++ String
" is already handled"
        Right STM IQRequestTicket
getNext -> forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
            IQRequestTicket
ticket <- forall a. STM a -> IO a
atomically STM IQRequestTicket
getNext
            case forall t a. PU t a -> t -> Either UnpickleError a
unpickle forall a. IQRequestClass a => PU Element a
pickleRequest (IQRequestTicket -> IQRequest
iqRequestBody IQRequestTicket
ticket forall s a t b. s -> FoldLike a s t a b -> a
^. forall s p. HasStanzaPayload s p => Lens s p
payload) of
                Left UnpickleError
_ -> IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerIQ IQRequestTicket
ticket (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ StanzaErrorCondition -> StanzaError
mkStanzaError StanzaErrorCondition
BadRequest) []
                Right a
req -> do
                    Either StanzaError (IQResponseType a)
res <- a -> IO (Either StanzaError (IQResponseType a))
handler a
req
                    case Either StanzaError (IQResponseType a)
res of
                        Left StanzaError
e -> IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerIQ IQRequestTicket
ticket (forall a b. a -> Either a b
Left StanzaError
e) []
                        Right IQResponseType a
r -> do
                            let answer :: [Element]
answer = (forall t a. PU t a -> a -> t
pickle forall a. IQRequestClass a => PU [Element] (IQResponseType a)
pickleResponse IQResponseType a
r)
                            IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerIQ IQRequestTicket
ticket (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [Element]
answer ) []