    -- | A heart of the package, 'invokeWS' assembles and executes requests.

    {-# LANGUAGE BangPatterns, CPP, OverloadedStrings, Rank2Types, FlexibleContexts #-}
    module Network.SOAP
        (
        -- * Requests
          invokeWS, Transport
        -- * Response parsing
        , runResponseParser
        , ResponseParser(..)
        , Parser
        -- * Exceptions
        , SOAPFault(..), SOAPParsingError(..)
        ) where

    import Network.SOAP.Transport (Transport)
    import Network.SOAP.Exception
    import qualified Control.Exception as E

    import Data.Conduit
    #if MIN_VERSION_conduit(1,1,0)
    import Control.Monad.Trans.Resource (runResourceT, ResourceT)
    #endif

    import qualified Data.ByteString.Lazy.Char8 as LBS

    import           Data.Default (def)
    import           Data.Void (Void)
    import qualified Text.XML as XML
    import           Text.XML.Cursor as XML
    import qualified Text.XML.Stream.Parse as XSP
    import           Data.XML.Types (Event)
    import           Text.XML.Writer (ToXML, soap)
    import qualified Data.Text as T

    import           Network.SOAP.Parsing.Stream (laxTag)

    -- | Different parsing modes available to extract reply contents.
    data ResponseParser a = StreamParser (Parser a)            -- ^ Streaming parser from Text.XML.Stream.Parse
                          | CursorParser (XML.Cursor -> a)     -- ^ XPath-like parser from Text.XML.Cursor
                          | DocumentParser (XML.Document -> a) -- ^ Parse raw XML document.
                          | RawParser (LBS.ByteString -> a)    -- ^ Work with a raw bytestring.

    -- | Stream parser from Text.XML.Stream.Parse.
    type Parser a = ConduitM Event Void (ResourceT IO) a

    -- | Prepare data, assemble request and apply a parser to a response.
    invokeWS :: (ToXML h, ToXML b)
             => Transport        -- ^ Configured transport to make requests with.
             -> String           -- ^ SOAPAction header.
             -> h                -- ^ SOAP Header element. () or Nothing will result in omiting the Header node. Put a comment if you need an empty element present.
             -> b                -- ^ SOAP Body element.
             -> ResponseParser a -- ^ Parser to use on a request reply.
             -> IO a
    invokeWS :: forall h b a.
    (ToXML h, ToXML b) =>
    Transport -> String -> h -> b -> ResponseParser a -> IO a
    invokeWS Transport
    transport String
    soapAction h
    header b
    body ResponseParser a
    parser =
        Transport
    transport String
    soapAction Document
    doc IO ByteString -> (ByteString -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ResponseParser a -> ByteString -> IO a
    forall a. ResponseParser a -> ByteString -> IO a
    runResponseParser ResponseParser a
    parser
      where
        !doc :: Document
    doc = h -> b -> Document
    forall h b. (ToXML h, ToXML b) => h -> b -> Document
    soap h
    header b
    body

    runResponseParser :: ResponseParser a -> LBS.ByteString -> IO a
    runResponseParser :: forall a. ResponseParser a -> ByteString -> IO a
    runResponseParser ResponseParser a
    parser ByteString
    lbs =
        case ResponseParser a
    parser of
            StreamParser Parser a
    sink ->
                ResourceT IO a -> IO a
    forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
    runResourceT (ResourceT IO a -> IO a)
    -> (ConduitT () Void (ResourceT IO) a -> ResourceT IO a)
    -> ConduitT () Void (ResourceT IO) a
    -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConduitT () Void (ResourceT IO) a -> ResourceT IO a
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (ResourceT IO) a -> IO a)
    -> ConduitT () Void (ResourceT IO) a -> IO a
    forall a b. (a -> b) -> a -> b
    $
                    ConduitT () Event (ResourceT IO) ()
    -> Parser a -> ConduitT () Void (ResourceT IO) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    fuse (ParseSettings -> ByteString -> ConduitT () Event (ResourceT IO) ()
    forall (m :: * -> *) i.
    MonadThrow m =>
    ParseSettings -> ByteString -> ConduitT i Event m ()
    XSP.parseLBS ParseSettings
    forall a. Default a => a
    def ByteString
    lbs) (Parser a -> Parser a
    forall a. Parser a -> Parser a
    unwrapEnvelopeSink Parser a
    sink)

            CursorParser Cursor -> a
    func ->
                (Cursor -> a) -> Cursor -> IO a
    forall a. (Cursor -> a) -> Cursor -> IO a
    checkFault Cursor -> a
    func (Cursor -> IO a) -> (Document -> Cursor) -> Document -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> Cursor
    unwrapEnvelopeCursor
                                (Cursor -> Cursor) -> (Document -> Cursor) -> Document -> Cursor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document -> Cursor
    XML.fromDocument
                                (Document -> IO a) -> Document -> IO a
    forall a b. (a -> b) -> a -> b
    $ ParseSettings -> ByteString -> Document
    XML.parseLBS_ ParseSettings
    forall a. Default a => a
    def ByteString
    lbs

            DocumentParser Document -> a
    func ->
                a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a) -> (Document -> a) -> Document -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document -> a
    func (Document -> IO a) -> Document -> IO a
    forall a b. (a -> b) -> a -> b
    $ ParseSettings -> ByteString -> Document
    XML.parseLBS_ ParseSettings
    forall a. Default a => a
    def ByteString
    lbs

            RawParser ByteString -> a
    func ->
                a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> a
    func (ByteString -> IO a) -> ByteString -> IO a
    forall a b. (a -> b) -> a -> b
    $ ByteString
    lbs

    unwrapEnvelopeSink :: Parser a -> Parser a
    unwrapEnvelopeSink :: forall a. Parser a -> Parser a
    unwrapEnvelopeSink Parser a
    sink = String -> ConduitT Event Void (ResourceT IO) (Maybe a) -> Parser a
    forall (m :: * -> *) a.
    MonadThrow m =>
    String -> m (Maybe a) -> m a
    XSP.force String
    "No SOAP Envelope" (ConduitT Event Void (ResourceT IO) (Maybe a) -> Parser a)
    -> ConduitT Event Void (ResourceT IO) (Maybe a) -> Parser a
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser a -> ConduitT Event Void (ResourceT IO) (Maybe a)
    forall (m :: * -> *) a.
    MonadThrow m =>
    Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a)
    laxTag Text
    "Envelope"
                            (Parser a -> ConduitT Event Void (ResourceT IO) (Maybe a))
    -> Parser a -> ConduitT Event Void (ResourceT IO) (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ String -> ConduitT Event Void (ResourceT IO) (Maybe a) -> Parser a
    forall (m :: * -> *) a.
    MonadThrow m =>
    String -> m (Maybe a) -> m a
    XSP.force String
    "No SOAP Body" (ConduitT Event Void (ResourceT IO) (Maybe a) -> Parser a)
    -> ConduitT Event Void (ResourceT IO) (Maybe a) -> Parser a
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser a -> ConduitT Event Void (ResourceT IO) (Maybe a)
    forall (m :: * -> *) a.
    MonadThrow m =>
    Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a)
    laxTag Text
    "Body"
                            (Parser a -> ConduitT Event Void (ResourceT IO) (Maybe a))
    -> Parser a -> ConduitT Event Void (ResourceT IO) (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ Parser a
    sink

    unwrapEnvelopeCursor :: Cursor -> Cursor
    unwrapEnvelopeCursor :: Cursor -> Cursor
    unwrapEnvelopeCursor Cursor
    c = [Cursor] -> Cursor
    forall {a}. [a] -> a
    forceCur ([Cursor] -> Cursor) -> [Cursor] -> Cursor
    forall a b. (a -> b) -> a -> b
    $ Cursor
    c Cursor -> (Cursor -> [Cursor]) -> [Cursor]
    forall node a. Cursor node -> (Cursor node -> a) -> a
    $| Text -> Cursor -> [Cursor]
    laxElement Text
    "Envelope" (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Text -> Cursor -> [Cursor]
    laxElement Text
    "Body"
        where forceCur :: [a] -> a
    forceCur [] = SOAPParsingError -> a
    forall a e. (HasCallStack, Exception e) => e -> a
    E.throw (SOAPParsingError -> a) -> SOAPParsingError -> a
    forall a b. (a -> b) -> a -> b
    $ String -> SOAPParsingError
    SOAPParsingError String
    "No SOAP Body"
              forceCur (a
    x:[a]
    _) = a
    x

    checkFault :: (XML.Cursor -> a) -> Cursor -> IO a
    checkFault :: forall a. (Cursor -> a) -> Cursor -> IO a
    checkFault Cursor -> a
    fun Cursor
    c = [Cursor] -> IO a
    tryCur ([Cursor] -> IO a) -> [Cursor] -> IO a
    forall a b. (a -> b) -> a -> b
    $ Cursor
    c Cursor -> (Cursor -> [Cursor]) -> [Cursor]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Text -> Cursor -> [Cursor]
    laxElement Text
    "Fault"
        where
            tryCur :: [Cursor] -> IO a
    tryCur [] = a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a) -> a -> IO a
    forall a b. (a -> b) -> a -> b
    $! Cursor -> a
    fun Cursor
    c
            tryCur (Cursor
    f:[Cursor]
    _) = SOAPFault -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (SOAPFault -> IO a) -> SOAPFault -> IO a
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> Text -> SOAPFault
    SOAPFault (Text -> Cursor -> Text
    peek Text
    "faultcode" Cursor
    f) (Text -> Cursor -> Text
    peek Text
    "faultstring" Cursor
    f) (Text -> Cursor -> Text
    peek Text
    "detail" Cursor
    f)

            peek :: Text -> Cursor -> Text
    peek Text
    name Cursor
    cur = [Text] -> Text
    T.concat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $! Cursor
    cur Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Text -> Cursor -> [Cursor]
    laxElement Text
    name (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content