{-# LANGUAGE OverloadedStrings #-}
module Network.SOAP.Transport.Mock
(
initTransport
, Handler, Handlers
, handler, fault
, runQuery
) where
import Network.SOAP.Transport
import Text.XML
import Text.XML.Writer
import Data.ByteString.Lazy.Char8 as LBS
import Data.Text (Text)
type Handler = Document -> IO LBS.ByteString
type Handlers = [(String, Handler)]
initTransport :: Handlers -> IO Transport
initTransport :: Handlers -> IO Transport
initTransport handlers :: Handlers
handlers = Transport -> IO Transport
forall (m :: * -> *) a. Monad m => a -> m a
return (Transport -> IO Transport) -> Transport -> IO Transport
forall a b. (a -> b) -> a -> b
$ Handlers -> Transport
runQuery Handlers
handlers
runQuery :: [(String, Handler)] -> Transport
runQuery :: Handlers -> Transport
runQuery handlers :: Handlers
handlers soapAction :: String
soapAction doc :: Document
doc = do
case String -> Handlers -> Maybe Handler
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
soapAction Handlers
handlers of
Nothing -> String -> IO ByteString
forall a. HasCallStack => String -> a
error (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ "No handler for action " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
soapAction
Just h :: Handler
h -> Handler
h Document
doc
handler :: (ToXML a) => (Document -> IO a) -> Handler
handler :: (Document -> IO a) -> Handler
handler h :: Document -> IO a
h doc :: Document
doc = do
a
result <- Document -> IO a
h Document
doc
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> (a -> ByteString) -> a -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def
(Document -> ByteString) -> (a -> Document) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> XML -> Document
document (Text -> Name
sname "Envelope")
(XML -> Document) -> (a -> XML) -> a -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> XML -> XML
forall a. ToXML a => Name -> a -> XML
element (Text -> Name
sname "Body")
(XML -> XML) -> (a -> XML) -> a -> XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> XML
forall a. ToXML a => a -> XML
toXML
(a -> IO ByteString) -> a -> IO ByteString
forall a b. (a -> b) -> a -> b
$ a
result
where
sname :: Text -> Name
sname n :: Text
n = Text -> Maybe Text -> Maybe Text -> Name
Name Text
n (Text -> Maybe Text
forall a. a -> Maybe a
Just "http://schemas.xmlsoap.org/soap/envelope/") (Text -> Maybe Text
forall a. a -> Maybe a
Just "soapenv")
fault :: Text
-> Text
-> Text
-> Handler
fault :: Text -> Text -> Text -> Handler
fault c :: Text
c s :: Text
s d :: Text
d = (Document -> IO XML) -> Handler
forall a. ToXML a => (Document -> IO a) -> Handler
handler ((Document -> IO XML) -> Handler)
-> (XML -> Document -> IO XML) -> XML -> Handler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO XML -> Document -> IO XML
forall a b. a -> b -> a
const (IO XML -> Document -> IO XML)
-> (XML -> IO XML) -> XML -> Document -> IO XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XML -> IO XML
forall (m :: * -> *) a. Monad m => a -> m a
return (XML -> Handler) -> XML -> Handler
forall a b. (a -> b) -> a -> b
$
Name -> XML -> XML
forall a. ToXML a => Name -> a -> XML
element "Fault" (XML -> XML) -> XML -> XML
forall a b. (a -> b) -> a -> b
$ do
Name -> Text -> XML
forall a. ToXML a => Name -> a -> XML
element "faultcode" Text
c
Name -> Text -> XML
forall a. ToXML a => Name -> a -> XML
element "faultstring" Text
s
Name -> Text -> XML
forall a. ToXML a => Name -> a -> XML
element "detail" Text
d