Unviersal wrapper for POX protocols.

PlainOldXML.hs

module PlainOldXML where

import           Network.HTTP.Conduit
import           Text.XML
import           Text.XML.Cursor

xmlQuery :: Manager -> String -> Document -> IO Cursor
xmlQuery manager url doc = do
    putStrLn "Request:" >> BSL.putStrLn (renderLBS (def { rsPretty = True }) doc)

    req <- parseUrl url
    let request = req { method = "POST"
                      , responseTimeout = Just 15000000
                      , requestHeaders  = [ ("Content-Type", "text/xml; charset=utf-8") ]
                      , requestBody = RequestBodyLBS $ renderLBS def doc
                      , checkStatus = \_ _ _ -> Nothing
                      }

    resp <- httpLbs request manager
    BSL.putStrLn (responseBody resp)

    let reply = parseLBS_ def
--              . convertFuzzy Transliterate "windows-1251" "utf-8"
              . responseBody
              $ resp

    putStrLn "Reply:" >> BSL.putStrLn (renderLBS (def { rsPretty = True }) reply)
    return $ fromDocument reply