soap-0.2.3.6/src/0000755000000000000000000000000013235062213011574 5ustar0000000000000000soap-0.2.3.6/src/Network/0000755000000000000000000000000013235062213013225 5ustar0000000000000000soap-0.2.3.6/src/Network/SOAP/0000755000000000000000000000000013235062213013767 5ustar0000000000000000soap-0.2.3.6/src/Network/SOAP/Parsing/0000755000000000000000000000000013252731457015406 5ustar0000000000000000soap-0.2.3.6/src/Network/SOAP/Transport/0000755000000000000000000000000013235062213015763 5ustar0000000000000000soap-0.2.3.6/test/0000755000000000000000000000000013235062213011764 5ustar0000000000000000soap-0.2.3.6/src/Network/SOAP.hs0000644000000000000000000000704013252734174014337 0ustar0000000000000000-- | A heart of the package, 'invokeWS' assembles and executes requests. {-# LANGUAGE BangPatterns, CPP, OverloadedStrings, Rank2Types, FlexibleContexts #-} module Network.SOAP ( -- * Requests invokeWS, Transport -- * Response parsing , runResponseParser , ResponseParser(..) , Parser -- * Exceptions , SOAPFault(..), SOAPParsingError(..) ) where import Network.SOAP.Transport (Transport) import Network.SOAP.Exception import qualified Control.Exception as E import Data.Conduit #if MIN_VERSION_conduit(1,1,0) import Control.Monad.Trans.Resource (runResourceT, ResourceT) #endif import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Default (def) import Data.Void (Void) 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 import Network.SOAP.Parsing.Stream (laxTag) -- | Different parsing modes available to extract reply contents. data ResponseParser a = StreamParser (Parser a) -- ^ Streaming parser from Text.XML.Stream.Parse | CursorParser (XML.Cursor -> a) -- ^ XPath-like parser from Text.XML.Cursor | DocumentParser (XML.Document -> a) -- ^ Parse raw XML document. | RawParser (LBS.ByteString -> a) -- ^ Work with a raw bytestring. -- | Stream parser from Text.XML.Stream.Parse. type Parser a = ConduitM Event Void (ResourceT IO) a -- | Prepare data, assemble request and apply a parser to a response. invokeWS :: (ToXML h, ToXML b) => Transport -- ^ Configured transport to make requests with. -> String -- ^ SOAPAction header. -> h -- ^ SOAP Header element. () or Nothing will result in omiting the Header node. Put a comment if you need an empty element present. -> b -- ^ SOAP Body element. -> ResponseParser a -- ^ Parser to use on a request reply. -> IO a invokeWS transport soapAction header body parser = transport soapAction doc >>= runResponseParser parser where !doc = soap header body runResponseParser :: ResponseParser a -> LBS.ByteString -> IO a runResponseParser parser lbs = case parser of StreamParser sink -> runResourceT . runConduit $ fuse (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" $ laxTag "Envelope" $ XSP.force "No SOAP Body" $ laxTag "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 soap-0.2.3.6/src/Network/SOAP/Transport.hs0000644000000000000000000000112413235062213016315 0ustar0000000000000000-- | This package comes with a single transport, but the your vendor's -- SOAP implementation can behave very differently, so invokeWS can be -- rigged to use anything that follows a simple interface. module Network.SOAP.Transport ( Transport ) where import Text.XML (Document) import Data.ByteString.Lazy.Char8 (ByteString) -- | Common transport type. Get a request and deliver it to an endpoint -- specified during initialization. type Transport = String -- ^ SOAPAction header -> Document -- ^ XML document with a SOAP request -> IO ByteString soap-0.2.3.6/src/Network/SOAP/Exception.hs0000644000000000000000000000257513235062213016272 0ustar0000000000000000{-# 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 (Show, Typeable) instance Exception SOAPParsingError -- | Exception to be thrown when transport encounters an exception that is -- acutally a SOAP Fault. data SOAPFault = SOAPFault { faultCode :: T.Text , faultString :: T.Text , faultDetail :: T.Text } deriving (Eq, Show, Typeable) instance Exception SOAPFault -- | Try to find a SOAP Fault in a document. extractSoapFault :: Document -> Maybe SOAPFault extractSoapFault doc = case cur' of [] -> Nothing cur:_ -> Just $ SOAPFault { faultCode = peek "faultcode" cur , faultString = peek "faultstring" cur , faultDetail = peek "detail" cur } where cur' = fromDocument doc $| laxElement "Envelope" &/ laxElement "Body" &/ laxElement "Fault" peek name cur = T.concat $ cur $/ laxElement name &/ content soap-0.2.3.6/src/Network/SOAP/Transport/HTTP.hs0000644000000000000000000001412713235062213017103 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Network.SOAP.Transport.HTTP ( -- * Initialization initTransportWithM , EndpointURL -- * Making a request , RequestProc, printRequest -- * Processing a response , BodyProc, printBody -- * Raw transport function , runQueryM -- * Deprecated , initTransport, initTransport_, initTransportWith , confTransport, confTransportWith , RequestP, traceRequest , BodyP, iconv, traceBody , runQuery ) where import Text.XML import Network.HTTP.Client import qualified Data.Configurator as Conf import Data.Configurator.Types (Config) import Codec.Text.IConv (EncodingName, convertFuzzy, Fuzzy(Transliterate)) import Data.Text (Text) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.ByteString.Lazy.Char8 (ByteString, unpack) import Control.Applicative import Debug.Trace (trace) import Data.Monoid ((<>)) import Prelude import Network.SOAP.Transport -- | Update request record after defaults and method-specific fields are set. type RequestProc = Request -> IO Request type RequestP = Request -> Request -- | Process response body to make it a nice UTF8-encoded XML document. type BodyProc = ByteString -> IO ByteString 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 initTransportWith :: ManagerSettings -> EndpointURL -> RequestP -> BodyP -> IO Transport initTransportWith settings url updateReq updateBody = do manager <- newManager settings return $! runQuery manager url updateReq updateBody -- | Create a http-client transport using manager settings (for plugging tls etc.). initTransportWithM :: ManagerSettings -> EndpointURL -> RequestProc -> BodyProc -> IO Transport initTransportWithM settings url requestProc bodyProc = do manager <- newManager settings return $! runQueryM manager url requestProc bodyProc -- | 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") #if MIN_VERSION_http_client(0,5,0) let to r = r { responseTimeout = responseTimeoutMicro (timeout * 1000000) } #else let to r = r { responseTimeout = Just (timeout * 1000000) } #endif encoding <- Conf.lookup conf (section <> ".encoding") let ic = maybe id iconv encoding initTransportWith settings url (to . tr . brp) (tb . ic . bbp) runQuery :: Manager -> EndpointURL -> RequestP -> BodyP -> Transport runQuery manager url updateReq updateBody = runQueryM manager url (pure . updateReq) (pure . updateBody) -- | Render document, submit it as a POST request and retrieve a body. runQueryM :: Manager -> EndpointURL -> RequestProc -> BodyProc -> Transport runQueryM manager url requestProc bodyProc soapAction doc = do let body = renderLBS def $! doc #if MIN_VERSION_http_client(0,4,30) request <- parseRequest url #else request <- parseUrl url #endif request' <- requestProc request { method = "POST" , requestBody = RequestBodyLBS body , requestHeaders = [ ("Content-Type", "text/xml; charset=utf-8") , ("SOAPAction", BS.pack soapAction) ] #if MIN_VERSION_http_client(0,5,0) , responseTimeout = responseTimeoutMicro 15000000 #else , responseTimeout = Just 15000000 , checkStatus = \_ _ _ -> Nothing #endif } httpLbs request' manager >>= bodyProc . responseBody -- * 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 printBody :: BodyProc printBody lbs = do BSL.putStrLn $ "response:" <> lbs pure 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 _ = "" printRequest :: RequestProc printRequest req = do BSL.putStrLn $ "request:" <> bslBody (requestBody req) pure req where bslBody (RequestBodyLBS body) = body bslBody _ = "" {-# DEPRECATED initTransportWith, RequestP, traceRequest, BodyP, traceBody, runQuery "Processors were lifted to IO." #-} soap-0.2.3.6/src/Network/SOAP/Transport/Mock.hs0000644000000000000000000000305113235062213017207 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Debug transport to train your parsers without bugging real services. 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)] -- | Wrap a collection of handlers into a transport. initTransport :: Handlers -> IO Transport initTransport handlers = return $ runQuery handlers -- | Choose and apply a handler. runQuery :: [(String, Handler)] -> Transport runQuery handlers soapAction doc = do case lookup soapAction handlers of Nothing -> error $ "No handler for action " ++ soapAction Just h -> h doc -- | Process a Document and wrap result in a SOAP Envelope. handler :: (ToXML a) => (Document -> IO a) -> Handler handler h doc = do result <- h doc return . renderLBS def . document (sname "Envelope") . element (sname "Body") . toXML $ result where sname n = Name n (Just "http://schemas.xmlsoap.org/soap/envelope/") (Just "soapenv") -- | Emulate a SOAP fault. fault :: Text -- ^ SOAP Fault code (e.g. «soap:Server») -> Text -- ^ Fault string -> Text -- ^ Fault detail -> Handler fault c s d = handler . const . return $ element "Fault" $ do element "faultcode" c element "faultstring" s element "detail" d soap-0.2.3.6/src/Network/SOAP/Parsing/Cursor.hs0000644000000000000000000000371713235062213017213 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -- | Some helpers to parse documents with Text.XML.Cursor. module Network.SOAP.Parsing.Cursor ( -- * Extract single element readT, readC -- * Extract from multiple elements , Dict, readDict, dictBy ) where import Network.SOAP (ResponseParser(CursorParser)) import Text.XML import Text.XML.Cursor import Data.Text (Text) import qualified Data.Text as T import qualified Data.HashMap.Strict as HM import Data.Maybe (mapMaybe) -- ** Single-element extraction. -- | Grab node content by element name. -- -- > pair cur = (readT "fst" cur, readT "snd" cur) readT :: Text -> Cursor -> Text readT n c = T.concat $ c $/ laxElement n &/ content {-# INLINE readT #-} -- | Extract a read-able type from a content of a node with given name. -- -- > age = readC "age" :: Cursor -> Integer readC :: (Read a) => Text -> Cursor -> a readC n c = read . T.unpack $ readT n c {-# INLINE readC #-} -- ** Multi-element extraction. -- | Very generic type to catch server reply when you don't care about types. type Dict = HM.HashMap Text Text -- | Apply an axis and extract a key-value from child elements. -- -- > invokeWS … (CursorParser . readDict $ laxElement "WebScaleResponse" &/ laxElement "BigDataResult") readDict :: Axis -> Cursor -> Dict readDict a c = extract . head $ c $/ a where extract cur = HM.fromList . mapMaybe dict . map node $ cur $| child dict (NodeElement (Element (Name n _ _) _ [NodeContent cont])) = Just (n, cont) dict (NodeElement (Element (Name n _ _) _ [])) = Just (n, T.empty) dict _ = Nothing -- | Simple parser to grab a flat response by an element name. -- -- > result <- invokeWS … (dictBy "BigDataResult") -- > case HM.lookup "SuccessError" result of … dictBy :: T.Text -> ResponseParser Dict dictBy n = CursorParser . readDict $ anyElement &/ laxElement n soap-0.2.3.6/src/Network/SOAP/Parsing/Stream.hs0000644000000000000000000000407413252734133017174 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Collection of helpers to use with Text.XML.Stream.Parse parsers. -- -- > let sink = flaxTag "MethodNameResponse" -- > $ flaxTag "MethodNameResult" $ do -- > info <- flaxTag "Info" $ do -- > q <- readTag "quantity" -- > b <- readTag "balance" -- > return $ Info q b -- > rc <- readTag "ResponseCode" -- > return (rc, info) module Network.SOAP.Parsing.Stream ( -- * Tags laxTag, flaxTag -- * Content , laxContent, flaxContent , readContent, readTag -- * Types to use in custom parser sinks , Event , ConduitM, Void , Sink ) where #if MIN_VERSION_conduit(1,1,0) import Control.Monad.Catch (MonadThrow) #endif import Data.Conduit (ConduitM, Sink) import Data.Void (Void) import Data.XML.Types (Event) import Text.XML (Name(..)) import qualified Text.XML.Stream.Parse as XSP import Data.Text (Text, unpack) -- | Namespace- and attribute- ignorant tagNoAttr. laxTag :: (MonadThrow m) => Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a) #if MIN_VERSION_xml_conduit(1,5,0) laxTag ln = XSP.tag' (XSP.matching $ (== ln) . nameLocalName) XSP.ignoreAttrs . const #else laxTag ln = XSP.tagPredicate ((== ln) . nameLocalName) XSP.ignoreAttrs . const #endif -- | Non-maybe version of laxTag/tagNoAttr. flaxTag :: (MonadThrow m) => Text -> ConduitM Event Void m a -> ConduitM Event Void m a flaxTag ln s = XSP.force ("got no " ++ show ln) $ laxTag ln s laxContent :: (MonadThrow m) => Text -> ConduitM Event Void m (Maybe Text) laxContent ln = laxTag ln XSP.content flaxContent :: (MonadThrow m) => Text -> ConduitM Event Void m Text flaxContent ln = flaxTag ln XSP.content -- | Unpack and read a current tag content. readContent :: (Read a, MonadThrow m) => ConduitM Event Void m a readContent = fmap (read . unpack) XSP.content -- | Unpack and read tag content by local name. readTag :: (Read a, MonadThrow m) => Text -> ConduitM Event Void m a readTag n = flaxTag n readContent soap-0.2.3.6/test/Main.hs0000644000000000000000000001244013235062213013205 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} import Network.SOAP import Network.SOAP.Exception import Network.SOAP.Parsing.Cursor import Network.SOAP.Parsing.Stream import qualified Network.SOAP.Transport.Mock as Mock import Text.XML import Text.XML.Writer import Text.XML.Cursor as Cur hiding (element) import Text.XML.Stream.Parse as Parse import Data.Text (Text) import qualified Data.Text as T import qualified Data.HashMap.Strict as HM import Test.Hspec main :: IO () main = hspec $ do describe "Transport.Mock" $ do it "dispatches requests" $ do t <- Mock.initTransport [ ("ping", const $ return "pong") ] result <- t "ping" (document "request" empty) result `shouldBe` "pong" it "generates a soap response" $ do t <- Mock.initTransport [ ("foo", Mock.handler $ \_ -> return ())] result <- t "foo" (document "request" empty) result `shouldBe` "" context "SOAP" $ do it "Smoke-test with RawParser" $ do t <- Mock.initTransport [ ("ping", const $ return "pong") ] result <- invokeWS t "ping" () () (RawParser id) result `shouldBe` "pong" describe "CursorParser" $ do let salad cur = head $ cur $/ laxElement "salad" let checkCP parser = do t <- Mock.initTransport [ ("spam", saladHandler )] invokeWS t "spam" () () (CursorParser parser) it "reads content" $ do result <- checkCP $ readT "bacon" . salad result `shouldBe` "many" it "reads and converts" $ do result <- checkCP $ readC "eggs" . salad result `shouldBe` (2 :: Integer) it "reads dict" $ do result <- checkCP $ readDict $ laxElement "salad" result `shouldBe` HM.fromList [ ("bacon","many") , ("sausage","some") , ("eggs","2") ] describe "StreamParser" $ do #if MIN_VERSION_xml_conduit(1,5,0) let parseAnyName = Parse.anyName #else let parseAnyName = Just #endif it "extracts stuff" $ do let recipeParser = do Parse.force "no salad" . Parse.tagNoAttr "salad" $ do ings <- Parse.many $ Parse.tag parseAnyName pure $ \name -> do quantity <- Parse.content pure $ RecipeEntry (nameLocalName name) quantity pure $ Recipe ings t <- spamTransport result <- invokeWS t "spam" () () $ StreamParser recipeParser result `shouldBe` saladRecipe it "extracts using lax helpers" $ do let recipeParser = flaxTag "salad" $ do s <- flaxContent "sausage" b <- laxContent "bacon" e <- readTag "eggs" return $ Recipe [ RecipeEntry "sausage" s , RecipeEntry "bacon" $ maybe "" id b , RecipeEntry "eggs" . T.pack $ show (e :: Int) ] result <- invokeSpam $ StreamParser recipeParser result `shouldBe` saladRecipe describe "DocumentParser" $ do it "gives out raw document" $ do let poach doc = read . T.unpack . T.concat $ fromDocument doc $// laxElement "eggs" &/ Cur.content t <- spamTransport result <- invokeWS t "spam" () () $ DocumentParser poach result `shouldBe` (2 :: Int) describe "Exception" $ do it "parses a SOAP Fault document" $ do t <- Mock.initTransport [ ("crash", Mock.fault "soap:Server" "The server made a boo boo." "") ] lbs <- t "crash" (document "request" empty) let Just e = extractSoapFault . parseLBS_ def $ lbs e `shouldBe` SOAPFault { faultCode = "soap:Server" , faultString = "The server made a boo boo." , faultDetail = "" } invokeSpam :: ResponseParser b -> IO b invokeSpam parser = do t <- spamTransport invokeWS t "spam" () () parser spamTransport :: IO Transport spamTransport = Mock.initTransport [ ("spam", saladHandler) ] saladHandler :: Mock.Handler saladHandler = Mock.handler $ \_ -> do return . element "salad" $ do element "sausage" ("some" :: Text) element "bacon" ("many" :: Text) element "eggs" (2 :: Integer) data RecipeEntry = RecipeEntry Text Text deriving (Eq, Show) data Recipe = Recipe [RecipeEntry] deriving (Eq, Show) saladRecipe :: Recipe saladRecipe = Recipe [ RecipeEntry "sausage" "some" , RecipeEntry "bacon" "many" , RecipeEntry "eggs" "2" ] soap-0.2.3.6/LICENSE0000644000000000000000000000205513235062213012014 0ustar0000000000000000Copyright (c) 2013-2017 Alexander Bondarenko Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. soap-0.2.3.6/Setup.hs0000644000000000000000000000005613235062213012442 0ustar0000000000000000import Distribution.Simple main = defaultMain soap-0.2.3.6/soap.cabal0000644000000000000000000000623113252732406012744 0ustar0000000000000000name: soap version: 0.2.3.6 synopsis: SOAP client tools description: Tools to build SOAP clients using xml-conduit. . A mildly-complicated example: . > import Network.SOAP > import Network.SOAP.Transport.HTTP > > import Text.XML.Writer > import Text.XML.Stream.Parse as Parse > import Data.Text (Text) > import qualified Data.Text as T > > main :: IO () > main = do > -- Initial one-time preparations. > transport <- initTransport "http://example.com/soap/endpoint" id (iconv "cp-1251") > > -- Making queries > activeStaff <- listStaff transport True > print activeStaff > > data Person = Person Text Int deriving Show > > listStaff :: Transport -> Bool -> IO [Person] > listStaff t active = invokeWS t "urn:dummy:listStaff" () body parser > where > body = element "request" $ element "listStaff" $ do > element "active" active > element "order" $ T.pack "age" > element "limit" (10 :: Int) > > parser = StreamParser $ force "no people" $ tagNoAttr "people" $ Parse.many parsePerson > > parsePerson = tagName "person" (requireAttr "age") $ \age -> do > name <- Parse.content > return $ Person name (read . T.unpack $ age) . Notice: to invoke HTTPS services you need to initialize a transport from soap-tls or soap-openssl. . Full examples available at source repo: homepage: https://bitbucket.org/dpwiz/haskell-soap license: MIT license-file: LICENSE author: Alexander Bondarenko maintainer: aenor.realm@gmail.com copyright: (c) 2013-2017 Alexander Bondarenko category: Web build-type: Simple cabal-version: >=1.8 extra-source-files: changelog library hs-source-dirs: src/ ghc-options: -Wall exposed-modules: Network.SOAP Network.SOAP.Transport Network.SOAP.Exception Network.SOAP.Transport.HTTP Network.SOAP.Transport.Mock Network.SOAP.Parsing.Cursor Network.SOAP.Parsing.Stream build-depends: base >= 4.8 && <5.0 , bytestring >= 0.10.6 && < 0.11 , conduit >= 1.2.6.6 && < 1.4 , configurator >= 0.3 && < 1.0 , data-default >= 0.5.3 && < 1.0 , exceptions >= 0.8.2.1 && < 0.11 , http-client >= 0.2 && < 1.0 , http-types >= 0.9 && < 1.0 , iconv >= 0.4.1.3 && < 0.5 , mtl >= 2.2.1 && < 3.0 , resourcet >= 1.1.7.4 && < 1.3 , text >= 1.2.2.1 && < 1.3 , unordered-containers >= 0.2.5.1 && < 0.3 , xml-conduit >= 1.3.5 && < 2.0 , xml-conduit-writer >= 0.1.1.2 && < 0.2 , xml-types >= 0.3.6 && < 0.4 test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test/ build-depends: base, soap, hspec, HUnit, xml-conduit, xml-conduit-writer, text, bytestring, unordered-containers soap-0.2.3.6/changelog0000644000000000000000000000344413252732466012701 0ustar00000000000000000.2.3.6: * Fix conduit-1.3 deprecations. 0.2.3.5: * Fix tests 0.2.3.4: * Prepare for xml-conduit-1.5 series. 0.2.3.3: * Relax envelope parser. 0.2.3.2: * Unbreak the build with GHC 7.8. 0.2.3.1: * Sprinkle some CPP to prepare for next http-client. 0.2.3.0: + Add monadic request and response processors. * Deprecate pure processors. 0.2.2.7: ! Add missing export for parser runner. 0.2.2.6: * Extract parser runner. `invokeWS` now is a mere default pipeline. 0.2.2.5: * Drop upper bounds entirely. 0.2.2.4: ! Haddock breaks on LANGUAGE in example. 0.2.2.3: * Raise http-client upper boundary. 0.2.2.2: ! Fix missing imports after conduit stopped reexporting in 1.1. 0.2.2.1: + Add basic http transport initializer to exports. 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. 0.2.1.2: + Add timeout option to confTransport. 0.2.1.1: ! Pin http-conduit version to 1.9.x. 0.2.1.0: * Throw SOAPParsingError instead of plain error. * Update SOAPFault detection. 0.2.0.4: + Add configurator-based transport initialization. 0.2.0.3: ! Switch to a recent http-conduit version. 0.2.0.2: * Detect SOAPFault in response and throw a proper Exception. 0.2.0.1: + Tag content helpers for stream parsers. + Dict helper for cursor parsers. + Document-based parser for "medium rare" cursor parsers. + Request and response tracing helpers. 0.2: * Switch to xml-conduit-writer for more clean serializers. + Pluggable transports. + Raw and streaming parsers. 0.1: Initial implementation, somewhat inflexible and warty, but working with diverse services.