{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}

module Network.SOAP.Exception
    ( SOAPParsingError(..)
    , SOAPFault(..), extractSoapFault
    ) where

import Control.Exception as E
import Data.Typeable
import Text.XML (Document)
import Text.XML.Cursor
import qualified Data.Text as T

data SOAPParsingError = SOAPParsingError String deriving (Int -> SOAPParsingError -> ShowS
[SOAPParsingError] -> ShowS
SOAPParsingError -> String
(Int -> SOAPParsingError -> ShowS)
-> (SOAPParsingError -> String)
-> ([SOAPParsingError] -> ShowS)
-> Show SOAPParsingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SOAPParsingError] -> ShowS
$cshowList :: [SOAPParsingError] -> ShowS
show :: SOAPParsingError -> String
$cshow :: SOAPParsingError -> String
showsPrec :: Int -> SOAPParsingError -> ShowS
$cshowsPrec :: Int -> SOAPParsingError -> ShowS
Show, Typeable)
instance Exception SOAPParsingError

-- | Exception to be thrown when transport encounters an exception that is
--   acutally a SOAP Fault.
data SOAPFault = SOAPFault { SOAPFault -> Text
faultCode   :: T.Text
                           , SOAPFault -> Text
faultString :: T.Text
                           , SOAPFault -> Text
faultDetail :: T.Text
                           } deriving (SOAPFault -> SOAPFault -> Bool
(SOAPFault -> SOAPFault -> Bool)
-> (SOAPFault -> SOAPFault -> Bool) -> Eq SOAPFault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SOAPFault -> SOAPFault -> Bool
$c/= :: SOAPFault -> SOAPFault -> Bool
== :: SOAPFault -> SOAPFault -> Bool
$c== :: SOAPFault -> SOAPFault -> Bool
Eq, Int -> SOAPFault -> ShowS
[SOAPFault] -> ShowS
SOAPFault -> String
(Int -> SOAPFault -> ShowS)
-> (SOAPFault -> String)
-> ([SOAPFault] -> ShowS)
-> Show SOAPFault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SOAPFault] -> ShowS
$cshowList :: [SOAPFault] -> ShowS
show :: SOAPFault -> String
$cshow :: SOAPFault -> String
showsPrec :: Int -> SOAPFault -> ShowS
$cshowsPrec :: Int -> SOAPFault -> ShowS
Show, Typeable)

instance Exception SOAPFault

-- | Try to find a SOAP Fault in a document.
extractSoapFault :: Document -> Maybe SOAPFault
extractSoapFault :: Document -> Maybe SOAPFault
extractSoapFault doc :: Document
doc =
    case [Cursor]
cur' of
        []    -> Maybe SOAPFault
forall a. Maybe a
Nothing
        cur :: Cursor
cur:_ -> SOAPFault -> Maybe SOAPFault
forall a. a -> Maybe a
Just (SOAPFault -> Maybe SOAPFault) -> SOAPFault -> Maybe SOAPFault
forall a b. (a -> b) -> a -> b
$ SOAPFault :: Text -> Text -> Text -> SOAPFault
SOAPFault { faultCode :: Text
faultCode   = Text -> Cursor -> Text
peek "faultcode" Cursor
cur
                                  , faultString :: Text
faultString = Text -> Cursor -> Text
peek "faultstring" Cursor
cur
                                  , faultDetail :: Text
faultDetail = Text -> Cursor -> Text
peek "detail" Cursor
cur
                                  }
    where
        cur' :: [Cursor]
cur' = Document -> Cursor
fromDocument Document
doc Cursor -> (Cursor -> [Cursor]) -> [Cursor]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Cursor]
laxElement "Envelope"
                                (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
laxElement "Body"
                                (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Cursor]
laxElement "Fault"

        peek :: Text -> Cursor -> Text
peek name :: Text
name cur :: 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