1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
{-# 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` "<?xml version=\"1.0\" encoding=\"UTF-8\"?><soapenv:Envelope xmlns:soapenv=\"http://schemas.xmlsoap.org/soap/envelope/\"><soapenv:Body/></soapenv:Envelope>"
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"
]
|
