packages feed

soap (empty) → 0.1.0.0

raw patch · 5 files changed

+235/−0 lines, 5 filesdep +basedep +http-conduitdep +iconvsetup-changed

Dependencies added: base, http-conduit, iconv, text, unordered-containers, xml-conduit

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2013 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ soap.cabal view
@@ -0,0 +1,30 @@+-- Initial soap.cabal generated by cabal init.  For further documentation, +-- see http://haskell.org/cabal/users-guide/++name:                soap+version:             0.1.0.0+synopsis:            SOAP client tools+description:         Tools to build SOAP clients using xml-conduit.+homepage:            https://bitbucket.org/dpwiz/haskell-soap+license:             MIT+license-file:        LICENSE+author:              Alexander Bondarenko+maintainer:          aenor.realm@gmail.com+-- copyright:           +category:            Web+build-type:          Simple+cabal-version:       >=1.8++library+  hs-source-dirs:    src/+  exposed-modules:+    Web.SOAP.Service+    Web.SOAP.Types+--  other-modules:+  build-depends:+    base ==4.*,+    http-conduit,+    xml-conduit,+    iconv,+    text,+    unordered-containers
+ src/Web/SOAP/Service.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module Web.SOAP.Service+    ( SOAPSettings(..)+    , invokeWS+    ) where++import           Text.XML+import           Text.XML.Cursor+import           Network.HTTP.Conduit+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Codec.Text.IConv as IC+import           Data.Monoid ((<>))++import Web.SOAP.Types++-- | SOAP service parameters+data SOAPSettings = SOAPSettings {+    soapURL :: String,+    soapNamespace :: Text,+    soapCodepage :: IC.EncodingName+} deriving (Read, Show)+++-- | Query a SOAP service.+invokeWS :: (ToNodes h, ToNodes i, FromCursor o)+         => SOAPSettings  -- ^ web service configuration+         -> Text          -- ^ SOAPAction header+         -> h             -- ^ request headers+         -> i             -- ^ request body+         -> IO o          -- ^ response++invokeWS SOAPSettings{..} methodHeader h b = do+    let doc = document $! envelope (toNodes h) (toNodes b)+    let stripEmptyNS = TL.replace " xmlns=\"\"" ""+    let body = stripEmptyNS . renderText def $! doc++    putStrLn "Request:"+    TL.putStrLn . stripEmptyNS . renderText def { rsPretty = True } $! doc++    request <- parseUrl soapURL+    res <- withManager $ httpLbs request { method          = "POST"+                                         , responseTimeout = Just 15000000+                                         , requestBody     = RequestBodyLBS $ TLE.encodeUtf8 body+                                         , requestHeaders  = [ ("Content-Type", "text/xml; charset=utf-8")+                                                             , ("SOAPAction", TE.encodeUtf8 methodHeader)+                                                             ]+                                         }++    let resBody = IC.convertFuzzy IC.Transliterate soapCodepage "utf-8" $ responseBody res++    case parseLBS def resBody of+        Left err -> do+            putStrLn $ "Error: " <> show err+            putStrLn "Raw response:"+            print $ responseBody res+            error $ show err++        Right replyDoc -> do+            putStrLn "Response:"+            TL.putStrLn . renderText def { rsPretty = True } $ replyDoc+            let reply = fromDocument replyDoc+            print reply+            return $! fromCursor reply++-- ** Request components++document :: Element -> Document+document r = Document (Prologue [] Nothing []) r []++envelope :: [Node] -> [Node] -> Element+envelope h b =+    Element+        "{http://schemas.xmlsoap.org/soap/envelope/}Envelope"+        def+        [ NodeElement $! Element "{http://schemas.xmlsoap.org/soap/envelope/}Header" def h+        , NodeElement $! Element "{http://schemas.xmlsoap.org/soap/envelope/}Body" def b+        ]
+ src/Web/SOAP/Types.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}++module Web.SOAP.Types+    ( ToNodes(..), (.=:), (.=)+    , ToAttribute(..)+    , FromCursor(..), readT, readC, readContent, Dict, asDict+    ) where++import           Data.Text (Text)+import qualified Data.Text as T+import           Text.XML+import           Text.XML.Cursor+import qualified Data.HashMap.Strict as HM+import           Data.Maybe++-- * Prepare data++-- ** Construct elements++-- | Convert data to a Node list.+--   One of the functions should be provided with others building up on it.+--   +--   Only use 'toNodes' to obtain a Node list.+class ToNodes a where+    toElement :: a -> Element+    toElement = undefined++    toElements :: a -> [Element]+    toElements x = [toElement x]++    toNodes :: a -> [Node]+    toNodes = map NodeElement . toElements++instance ToNodes () where+    toNodes () = []++instance ToNodes Text where+    toNodes x = [NodeContent x]++instance ToNodes [Node] where+    toNodes = id++instance (ToNodes a) => ToNodes (Name, a) where+    toElement (n, b) = Element n def (toNodes b)++instance (ToNodes a) => ToNodes [a] where+    toNodes = concat . map toNodes++(.=:) :: Name -> [Node] -> [Node]+n .=: ns = toNodes (n, ns)++(.=) :: Name -> Text -> Node+n .= t = head $ toNodes (n, toNodes t)++-- ** Construct attributes++class ToAttribute a where+    toAttribute :: a -> (Name, Text)++--instance (ToAttribute a) => (Name, Text) where+--    toAttribute (n, t) = (n, t)++-- * Extract data from XML cursor++class FromCursor a where+    fromCursor :: Cursor -> a++-- ** Single-element extraction.++readT :: Text -> Cursor -> Text+readT n c = T.concat $ c $/ laxElement n &/ content+{-# INLINE readT #-}++readC :: (Read a) => Text -> Cursor -> a+readC n c = read . T.unpack $ readT n c+{-# INLINE readC #-}++readContent :: (Read a) => Cursor -> a+readContent = error . show . T.unpack . T.concat . content++-- ** Multi-element extraction.++type Dict = HM.HashMap Text Text++asDict :: Axis -> Cursor -> Dict+asDict a c = fromCursor . head $ c $// a++instance FromCursor Dict where+    fromCursor cur = HM.fromList . mapMaybe dict . map node $ cur $| child++dict :: Node -> Maybe (Text, Text)+dict (NodeElement (Element (Name n _ _) _ [NodeContent c])) = Just (n, c)+dict (NodeElement (Element (Name n _ _) _ []))              = Just (n, T.empty)+dict _                                                      = Nothing+{-# INLINE dict #-}++instance (FromCursor a, FromCursor b) => FromCursor (a, b) where+    fromCursor c = (fromCursor c, fromCursor c)++instance (FromCursor a, FromCursor b, FromCursor c) => FromCursor (a, b, c) where+    fromCursor c = (fromCursor c, fromCursor c, fromCursor c)