{-# LANGUAGE GADTs              #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE OverloadedStrings  #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Network.XMPP.XEP.Delayed
-- Copyright   :  (c) pierre, 2007
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- Copyright   :  (c) riskbook, 2020
-- SPDX-License-Identifier:  BSD3
-- 
-- Maintainer  :  Dmitry Astapov <dastapov@gmail.com>, pierre <k.pierre.k@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- XEP-0091, old delayed delivery
--
-----------------------------------------------------------------------------
module Network.XMPP.XEP.Delayed
  (
    isDelayed
  ) where

import Network.XMPP.Stream
import Network.XMPP.Types

import Text.XML.HaXml.Xtract.Parse (xtract)

-- | True, if stanza is delivered delayed
isDelayed :: Stanza a 'Incoming () -> Bool
isDelayed :: Stanza a 'Incoming () -> Bool
isDelayed (MkMessage Maybe SomeJID
_ Maybe SomeJID
_ Text
_ MessageType
_ Text
_ Text
_ Text
_ DataByPurpose 'Incoming ()
ext Sing 'Incoming
_) =
  case DataByPurpose 'Incoming ()
ext of
    Right () -> Bool
False
    Left c -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"jabber:x:delay") ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ (Content Posn -> Text) -> [Content Posn] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Content Posn] -> Text
forall i. [Content i] -> Text
getText_ ([Content Posn] -> Text)
-> (Content Posn -> [Content Posn]) -> Content Posn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> Content Posn -> [Content Posn]
forall i. (String -> String) -> String -> CFilter i
xtract String -> String
forall a. a -> a
id String
"/x/@xmlns") [Content Posn]
c
isDelayed Stanza a 'Incoming ()
_ = Bool
False