module Network.SOAP
(
invokeWS, Transport
, ResponseParser(..)
, Parser
, SOAPFault(..), SOAPParsingError(..)
) where
import Network.SOAP.Transport (Transport)
import Network.SOAP.Exception
import qualified Control.Exception as E
import Data.Conduit
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Default (def)
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
data ResponseParser a = StreamParser (Parser a)
| CursorParser (XML.Cursor -> a)
| DocumentParser (XML.Document -> a)
| RawParser (LBS.ByteString -> a)
type Parser a = Sink Event (ResourceT IO) a
invokeWS :: (ToXML h, ToXML b)
=> Transport
-> String
-> h
-> b
-> ResponseParser a
-> IO a
invokeWS transport soapAction header body parser = do
lbs <- transport soapAction $! soap header body
case parser of
StreamParser sink -> runResourceT $ XSP.parseLBS def lbs $$ unwrapEnvelopeSink sink
CursorParser func -> checkFault func . unwrapEnvelopeCursor . XML.fromDocument $ XML.parseLBS_ def lbs
DocumentParser func -> return . func $ XML.parseLBS_ def lbs
RawParser func -> return . func $ lbs
unwrapEnvelopeSink :: Parser a -> Parser a
unwrapEnvelopeSink sink = XSP.force "No SOAP Envelope" $ XSP.tagNoAttr "{http://schemas.xmlsoap.org/soap/envelope/}Envelope"
$ XSP.force "No SOAP Body" $ XSP.tagNoAttr "{http://schemas.xmlsoap.org/soap/envelope/}Body"
$ sink
unwrapEnvelopeCursor :: Cursor -> Cursor
unwrapEnvelopeCursor c = forceCur $ c $| laxElement "Envelope" &/ laxElement "Body"
where forceCur [] = E.throw $ SOAPParsingError "No SOAP Body"
forceCur (x:_) = x
checkFault :: (XML.Cursor -> a) -> Cursor -> IO a
checkFault fun c = tryCur $ c $/ laxElement "Fault"
where
tryCur [] = return $! fun c
tryCur (f:_) = E.throwIO $ SOAPFault (peek "faultcode" f) (peek "faultstring" f) (peek "detail" f)
peek name cur = T.concat $! cur $/ laxElement name &/ content