soap 0.2.1.3 → 0.2.2.0
raw patch · 4 files changed
+168/−148 lines, 4 filesdep +http-clientdep −http-conduitdep −resourcetdep −tls-extra
Dependencies added: http-client
Dependencies removed: http-conduit, resourcet, tls-extra
Files
- changelog +5/−0
- soap.cabal +3/−5
- src/Network/SOAP/Transport/HTTP.hs +160/−0
- src/Network/SOAP/Transport/HTTP/Conduit.hs +0/−143
changelog view
@@ -1,3 +1,8 @@+0.2.2:++ * Switch to http-client transport.+ Bring soap-tls or soap-openssl to use HTTPS connections.+ 0.2.1.3: * Cabal-only tweaks: remove -O2, add changelog.
soap.cabal view
@@ -1,5 +1,5 @@ name: soap-version: 0.2.1.3+version: 0.2.2.0 synopsis: SOAP client tools description: Tools to build SOAP clients using xml-conduit.@@ -50,15 +50,13 @@ Network.SOAP Network.SOAP.Transport Network.SOAP.Exception- Network.SOAP.Transport.HTTP.Conduit+ Network.SOAP.Transport.HTTP Network.SOAP.Transport.Mock Network.SOAP.Parsing.Cursor Network.SOAP.Parsing.Stream build-depends: base ==4.*- , http-conduit ==1.9.*- , resourcet- , tls-extra+ , http-client >=0.2 && <0.3 , http-types , configurator
+ src/Network/SOAP/Transport/HTTP.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A feature-rich http-conduit based transport allowing to deal with+-- HTTPS, authentication and other stuff using request and body processors.++module Network.SOAP.Transport.HTTP+ (+ -- * Initialization+ initTransport, initTransport_+ , confTransport, confTransportWith+ , EndpointURL+ -- * Making a request+ , RequestP, traceRequest -- clientCert+ -- * Processing a response+ , BodyP, iconv, traceBody+ -- * Raw transport function+ , runQuery+ ) where++import Text.XML+import Network.HTTP.Client+-- import Control.Monad.Trans.Resource++import qualified Data.Configurator as Conf+import Data.Configurator.Types (Config)+import Codec.Text.IConv (EncodingName, convertFuzzy, Fuzzy(Transliterate))+-- import qualified Network.TLS.Extra as TLS++import Data.Text (Text)+import qualified Data.ByteString.Char8 as BS+import Data.ByteString.Lazy.Char8 (ByteString, unpack)++import Debug.Trace (trace)+--import Control.Exception as E+import Data.Monoid ((<>))++import Network.SOAP.Transport++-- | Update request record after defaults and method-specific fields are set.+type RequestP = Request -> Request++-- | Process response body to make it a nice UTF8-encoded XML document.+type BodyP = ByteString -> ByteString++-- | Web service URL. Configured at initialization, but you can tweak it+-- dynamically with a request processor.+type EndpointURL = String+++-- | Create a http-client transport. Use identity transformers if you+-- don't need any special treatment.+initTransport :: EndpointURL+ -> RequestP+ -> BodyP+ -> IO Transport+initTransport = initTransportWith defaultManagerSettings++-- | Create a transport without any request and body processing.+initTransport_ :: EndpointURL -> IO Transport+initTransport_ url = initTransport url id id++-- | Create a http-client transport using manager settings (for plugging tls etc.).+initTransportWith :: ManagerSettings+ -> EndpointURL+ -> RequestP+ -> BodyP+ -> IO Transport+initTransportWith settings url updateReq updateBody = do+ manager <- newManager settings+ return $! runQuery manager url updateReq updateBody++-- | Load common transport parameters from a configurator file.+--+-- > soap {+-- > url = "https://vendor.tld/service/"+-- > trace = true+-- > timeout = 15+-- > }+--+-- Only url field is required.+--+-- > import Data.Configurator (load, Worth(Required))+-- > main = do+-- > transport <- confTransport "soap" =<< load [Required "etc/example.conf"]++confTransport :: Text -> Config -> IO Transport+confTransport section conf = confTransportWith defaultManagerSettings section conf id id++-- | A more extensible transport parameter loader.+confTransportWith :: ManagerSettings+ -> Text+ -> Config+ -> RequestP+ -> BodyP+ -> IO Transport+confTransportWith settings section conf brp bbp = do+ url <- Conf.require conf (section <> ".url")++ tracer <- Conf.lookupDefault False conf (section <> ".trace")+ let (tr, tb) = if tracer+ then (traceRequest, traceBody)+ else (id, id)++ timeout <- Conf.lookupDefault 15 conf (section <> ".timeout")+ let to r = r { responseTimeout = Just (timeout * 1000000) }++ encoding <- Conf.lookup conf (section <> ".encoding")+ let ic = maybe id iconv encoding++ initTransportWith settings url (to . tr . brp) (tb . ic . bbp)++-- | Render document, submit it as a POST request and retrieve a body.+runQuery :: Manager+ -> EndpointURL+ -> RequestP+ -> BodyP+ -> Transport+runQuery manager url updateReq updateBody soapAction doc = do+ let body = renderLBS def $! doc++ request <- parseUrl url+ let request' = request { method = "POST"+ , responseTimeout = Just 15000000+ , requestBody = RequestBodyLBS body+ , requestHeaders = [ ("Content-Type", "text/xml; charset=utf-8")+ , ("SOAPAction", BS.pack soapAction)+ ]+ , checkStatus = \_ _ _ -> Nothing+ }+ res <- httpLbs (updateReq request') manager+ return . updateBody . responseBody $ res++-- * Some common processors.++-- | Create an IConv-based processor.+iconv :: EncodingName -> BodyP+iconv src = convertFuzzy Transliterate src "UTF-8"++-- | Show a debug dump of a response body.+traceBody :: BodyP+traceBody lbs = trace "response:" $ trace (unpack lbs) lbs++-- | Show a debug dump of a request body.+traceRequest :: RequestP+traceRequest r = trace "request:" $ trace (showBody $ requestBody r) r+ where+ showBody (RequestBodyLBS body) = unpack body+ showBody _ = "<dynamic body>"++{-+-- | Load certificate, key and make a request processor setting them.+clientCert :: FilePath -- ^ Path to a certificate.+ -> FilePath -- ^ Path to a private key.+ -> IO RequestP+clientCert certPath keyPath = do+ cert <- TLS.fileReadCertificate certPath+ pkey <- TLS.fileReadPrivateKey keyPath++ return $ \req -> req { clientCertificates = [(cert, Just pkey)] }+-}
− src/Network/SOAP/Transport/HTTP/Conduit.hs
@@ -1,143 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | A feature-rich http-conduit based transport allowing to deal with--- HTTPS, authentication and other stuff using request and body processors.--module Network.SOAP.Transport.HTTP.Conduit- (- -- * Initialization- initTransport, initTransport_, confTransport- , EndpointURL- -- * Making a request- , RequestP, clientCert, traceRequest- -- * Processing a response- , BodyP, iconv, traceBody- -- * Raw transport function- , runQuery- ) where--import Text.XML-import Network.HTTP.Conduit-import Control.Monad.Trans.Resource--import Data.Configurator (require, lookupDefault)-import Data.Configurator.Types (Config)-import Codec.Text.IConv (EncodingName, convertFuzzy, Fuzzy(Transliterate))-import qualified Network.TLS.Extra as TLS--import Data.Text (Text)-import qualified Data.ByteString.Char8 as BS-import Data.ByteString.Lazy.Char8 (ByteString, unpack)--import Debug.Trace (trace)---import Control.Exception as E-import Data.Monoid ((<>))--import Network.SOAP.Transport---- | Update request record after defaults and method-specific fields are set.-type RequestP = Request (ResourceT IO) -> Request (ResourceT IO)---- | Process response body to make it a nice UTF8-encoded XML document.-type BodyP = ByteString -> ByteString---- | Web service URL. Configured at initialization, but you can tweak it--- dynamically with a request processor.-type EndpointURL = String---- | Create a http-conduit transport. Use identity transformers if you--- don't need any special treatment.-initTransport :: EndpointURL- -> RequestP- -> BodyP- -> IO Transport-initTransport url updateReq updateBody = do- manager <- newManager def- return $! runQuery manager url updateReq updateBody---- | Create a transport without any request and body processing.-initTransport_ :: EndpointURL -> IO Transport-initTransport_ url = initTransport url id id---- | Load common transport parameters from a configurator file.------ > soap {--- > url = "https://vendor.tld/service/"--- > client_cert = "etc/client.pem"--- > client_key = "etc/client.key"--- > trace = true--- > timeout = 15--- > }------ Only url field is required.------ > import Data.Configurator (load, Worth(Required))--- > main = do--- > transport <- confTransport "soap" =<< load [Required "etc/example.conf"]-confTransport :: Text -> Config -> IO Transport-confTransport section conf = do- url <- require conf (section <> ".url")-- cCert <- lookupDefault "" conf (section <> ".client_cert")- cKey <- lookupDefault "" conf (section <> ".client_key")- cc <- if null cCert- then return id- else clientCert cCert cKey-- tracer <- lookupDefault False conf (section <> ".trace")- let (tr, tb) = if tracer- then (traceRequest, traceBody)- else (id, id)-- timeout <- lookupDefault 15 conf (section <> ".timeout")- let to r = r { responseTimeout = Just (timeout * 1000000) }-- initTransport url (to . tr . cc) tb---- | Render document, submit it as a POST request and retrieve a body.-runQuery :: Manager- -> EndpointURL- -> RequestP- -> BodyP- -> Transport-runQuery manager url updateReq updateBody soapAction doc = do- let body = renderLBS def $! doc-- request <- parseUrl url- let request' = request { method = "POST"- , responseTimeout = Just 15000000- , requestBody = RequestBodyLBS body- , requestHeaders = [ ("Content-Type", "text/xml; charset=utf-8")- , ("SOAPAction", BS.pack soapAction)- ]- , checkStatus = \_ _ _ -> Nothing- }- res <- (runResourceT $ httpLbs (updateReq request') manager)- return . updateBody . responseBody $ res---- * Some common processors.---- | Create an IConv-based processor.-iconv :: EncodingName -> BodyP-iconv src = convertFuzzy Transliterate src "UTF-8"---- | Show a debug dump of a response body.-traceBody :: BodyP-traceBody lbs = trace "response:" $ trace (unpack lbs) lbs---- | Show a debug dump of a request body.-traceRequest :: RequestP-traceRequest r = trace "request:" $ trace (showBody $ requestBody r) r- where- showBody (RequestBodyLBS body) = unpack body- showBody _ = "<dynamic body>"---- | Load certificate, key and make a request processor setting them.-clientCert :: FilePath -- ^ Path to a certificate.- -> FilePath -- ^ Path to a private key.- -> IO RequestP-clientCert certPath keyPath = do- cert <- TLS.fileReadCertificate certPath- pkey <- TLS.fileReadPrivateKey keyPath-- return $ \req -> req { clientCertificates = [(cert, Just pkey)] }