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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module Servant.Server.UsingContextSpec where
import Network.Wai
import Test.Hspec
(Spec, describe, it)
import Test.Hspec.Wai
import Servant
import Servant.Server.UsingContextSpec.TestCombinators
spec :: Spec
spec = do
spec1
spec2
spec3
spec4
-- * API
type OneEntryAPI =
ExtractFromContext :> Get '[JSON] String
testServer :: String -> Handler String
testServer s = return s
oneEntryApp :: Application
oneEntryApp =
serveWithContext (Proxy :: Proxy OneEntryAPI) context testServer
where
context :: Context '[String]
context = "contextEntry" :. EmptyContext
type OneEntryTwiceAPI =
"foo" :> ExtractFromContext :> Get '[JSON] String :<|>
"bar" :> ExtractFromContext :> Get '[JSON] String
oneEntryTwiceApp :: Application
oneEntryTwiceApp = serveWithContext (Proxy :: Proxy OneEntryTwiceAPI) context $
testServer :<|>
testServer
where
context :: Context '[String]
context = "contextEntryTwice" :. EmptyContext
-- * tests
spec1 :: Spec
spec1 = do
describe "accessing context entries from custom combinators" $ do
with (return oneEntryApp) $ do
it "allows retrieving a ContextEntry" $ do
get "/" `shouldRespondWith` "\"contextEntry\""
with (return oneEntryTwiceApp) $ do
it "allows retrieving the same ContextEntry twice" $ do
get "/foo" `shouldRespondWith` "\"contextEntryTwice\""
get "/bar" `shouldRespondWith` "\"contextEntryTwice\""
type InjectAPI =
InjectIntoContext :> "untagged" :> ExtractFromContext :>
Get '[JSON] String :<|>
InjectIntoContext :> "tagged" :> ExtractFromContext :>
Get '[JSON] String
injectApp :: Application
injectApp = serveWithContext (Proxy :: Proxy InjectAPI) context $
(\ s -> return s) :<|>
(\ s -> return ("tagged: " ++ s))
where
context = EmptyContext
spec2 :: Spec
spec2 = do
with (return injectApp) $ do
describe "inserting context entries with custom combinators" $ do
it "allows to inject context entries" $ do
get "/untagged" `shouldRespondWith` "\"injected\""
it "allows to inject tagged context entries" $ do
get "/tagged" `shouldRespondWith` "\"tagged: injected\""
type WithBirdfaceAPI =
"foo" :> ExtractFromContext :> Get '[JSON] String :<|>
NamedContextWithBirdface "sub" '[String] :>
"bar" :> ExtractFromContext :> Get '[JSON] String
withBirdfaceApp :: Application
withBirdfaceApp = serveWithContext (Proxy :: Proxy WithBirdfaceAPI) context $
testServer :<|>
testServer
where
context :: Context '[String, (NamedContext "sub" '[String])]
context =
"firstEntry" :.
(NamedContext ("secondEntry" :. EmptyContext)) :.
EmptyContext
spec3 :: Spec
spec3 = do
with (return withBirdfaceApp) $ do
it "allows retrieving different ContextEntries for the same combinator" $ do
get "/foo" `shouldRespondWith` "\"firstEntry\""
get "/bar" `shouldRespondWith` "\"secondEntry\""
type NamedContextAPI =
WithNamedContext "sub" '[String] (
ExtractFromContext :> Get '[JSON] String)
namedContextApp :: Application
namedContextApp = serveWithContext (Proxy :: Proxy NamedContextAPI) context return
where
context :: Context '[NamedContext "sub" '[String]]
context = NamedContext ("descend" :. EmptyContext) :. EmptyContext
spec4 :: Spec
spec4 = do
with (return namedContextApp) $ do
describe "WithNamedContext" $ do
it "allows descending into a subcontext for a given api" $ do
get "/" `shouldRespondWith` "\"descend\""
|
