git.iko.soy/servant-quickcheck
on master help sign in
Merge pull request #28 from declension/22-fix-path-delimiting

Fix path delimiting (#22)

commitf12034ccb6183358d25dbeb077d428ddb3edb5af authorJulian Arni <jkarni@gmail.com> dateSat 11 Mar 2017, 09:34 (10 years ago) parent41b2faad33214d
2 files changed+26−3
compare with master
unifiedsplit
src/Servant/QuickCheck/Internal/HasGenRequest.hs+6−1 test/Servant/QuickCheck/InternalSpec.hs+20−2
src/Servant/QuickCheck/Internal/HasGenRequest.hs+6−1
@@ -17,6 +17,7 @@ import Servant.Client (BaseUrl (..), Scheme (..))
1717import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)
1818
1919import qualified Data.ByteString as BS
20+import qualified Data.ByteString.Internal as BS (c2w)
2021
2122
2223class HasGenRequest a where
@@ -31,7 +32,11 @@ instance (HasGenRequest a, HasGenRequest b) => HasGenRequest (a :<|> b) where
3132instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
3233 genRequest _ = do
3334 old' <- old
34− return $ \burl -> let r = old' burl in r { path = new <> path r }
35+ return $ \burl -> let r = old' burl
36+ oldPath = path r
37+ oldPath' = BS.dropWhile (== BS.c2w '/') oldPath
38+ paths = filter (not . BS.null) [new, oldPath']
39+ in r { path = "/" <> BS.intercalate "/" paths }
3540 where
3641 old = genRequest (Proxy :: Proxy b)
3742 new = cs $ symbolVal (Proxy :: Proxy path)
test/Servant/QuickCheck/InternalSpec.hs+20−2
@@ -13,7 +13,7 @@ import Test.Hspec.Core.Spec (Arg, Example, Result (..),
1313 defaultParams, evaluateExample)
1414import Test.QuickCheck.Gen (unGen)
1515import Test.QuickCheck.Random (mkQCGen)
16−import Network.HTTP.Client (queryString)
16+import Network.HTTP.Client (queryString, path)
1717
1818#if MIN_VERSION_servant(0,8,0)
1919import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
@@ -34,6 +34,7 @@ spec = do
3434 notLongerThanSpec
3535 queryParamsSpec
3636 queryFlagsSpec
37+ deepPathSpec
3738
3839serversEqualSpec :: Spec
3940serversEqualSpec = describe "serversEqual" $ do
@@ -52,7 +53,7 @@ serversEqualSpec = describe "serversEqual" $ do
5253 evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
5354 show err `shouldContain` "Body: 1"
5455 show err `shouldContain` "Body: 2"
55− show err `shouldContain` "Path: failplz/"
56+ show err `shouldContain` "Path: /failplz"
5657
5758serverSatisfiesSpec :: Spec
5859serverSatisfiesSpec = describe "serverSatisfies" $ do
@@ -113,6 +114,17 @@ isComprehensiveSpec = describe "HasGenRequest" $ do
113114 let _g = genRequest comprehensiveAPIWithoutRaw
114115 True `shouldBe` True -- This is a type-level check
115116
117+deepPathSpec :: Spec
118+deepPathSpec = describe "Path components" $ do
119+
120+ it "are separated by slashes, without a trailing slash" $ do
121+ let rng = mkQCGen 0
122+ burl = BaseUrl Http "localhost" 80 ""
123+ gen = genRequest deepAPI
124+ req = (unGen gen rng 0) burl
125+ path req `shouldBe` ("/one/two/three")
126+
127+
116128queryParamsSpec :: Spec
117129queryParamsSpec = describe "QueryParams" $ do
118130
@@ -170,6 +182,12 @@ type API2 = "failplz" :> Get '[JSON] Int
170182api2 :: Proxy API2
171183api2 = Proxy
172184
185+type DeepAPI = "one" :> "two" :> "three":> Get '[JSON] ()
186+
187+deepAPI :: Proxy DeepAPI
188+deepAPI = Proxy
189+
190+
173191server2 :: IO (Server API2)
174192server2 = return $ return 1
175193