Fix Path delimiting:

* Add test API with multiple Path elements
  * Add basic test using this API, generating an endpoint to validate that query path delimiting is happening correctly (that fails on `master`)
  * Fix (re)creation of path to prepend `/` to each new path section, but only if it's non-empty (this fixes the trailing slashes, but still allows users to use a `:> "foo/" :>...` if their API demands trailing slashes)
  * Update / fix the existing test that now fails slightly differently (i.e. the trailing slash in `failplz/` is gone)

Fixes #22.
This commit is contained in:
Nick B 2017-03-11 11:19:57 +00:00
parent 41b2faad45
commit d33214d376
2 changed files with 26 additions and 3 deletions

View File

@ -17,6 +17,7 @@ import Servant.Client (BaseUrl (..), Scheme (..))
import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof) import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
class HasGenRequest a where class HasGenRequest a where
@ -31,7 +32,11 @@ instance (HasGenRequest a, HasGenRequest b) => HasGenRequest (a :<|> b) where
instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
genRequest _ = do genRequest _ = do
old' <- old old' <- old
return $ \burl -> let r = old' burl in r { path = new <> path r } return $ \burl -> let r = old' burl
oldPath = path r
oldPath' = BS.dropWhile (== BS.c2w '/') oldPath
paths = filter (not . BS.null) [new, oldPath']
in r { path = "/" <> BS.intercalate "/" paths }
where where
old = genRequest (Proxy :: Proxy b) old = genRequest (Proxy :: Proxy b)
new = cs $ symbolVal (Proxy :: Proxy path) new = cs $ symbolVal (Proxy :: Proxy path)

View File

@ -13,7 +13,7 @@ import Test.Hspec.Core.Spec (Arg, Example, Result (..),
defaultParams, evaluateExample) defaultParams, evaluateExample)
import Test.QuickCheck.Gen (unGen) import Test.QuickCheck.Gen (unGen)
import Test.QuickCheck.Random (mkQCGen) import Test.QuickCheck.Random (mkQCGen)
import Network.HTTP.Client (queryString) import Network.HTTP.Client (queryString, path)
#if MIN_VERSION_servant(0,8,0) #if MIN_VERSION_servant(0,8,0)
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw) import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
@ -34,6 +34,7 @@ spec = do
notLongerThanSpec notLongerThanSpec
queryParamsSpec queryParamsSpec
queryFlagsSpec queryFlagsSpec
deepPathSpec
serversEqualSpec :: Spec serversEqualSpec :: Spec
serversEqualSpec = describe "serversEqual" $ do serversEqualSpec = describe "serversEqual" $ do
@ -52,7 +53,7 @@ serversEqualSpec = describe "serversEqual" $ do
evalExample $ serversEqual api2 burl1 burl2 args bodyEquality evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
show err `shouldContain` "Body: 1" show err `shouldContain` "Body: 1"
show err `shouldContain` "Body: 2" show err `shouldContain` "Body: 2"
show err `shouldContain` "Path: failplz/" show err `shouldContain` "Path: /failplz"
serverSatisfiesSpec :: Spec serverSatisfiesSpec :: Spec
serverSatisfiesSpec = describe "serverSatisfies" $ do serverSatisfiesSpec = describe "serverSatisfies" $ do
@ -113,6 +114,17 @@ isComprehensiveSpec = describe "HasGenRequest" $ do
let _g = genRequest comprehensiveAPIWithoutRaw let _g = genRequest comprehensiveAPIWithoutRaw
True `shouldBe` True -- This is a type-level check True `shouldBe` True -- This is a type-level check
deepPathSpec :: Spec
deepPathSpec = describe "Path components" $ do
it "are separated by slashes, without a trailing slash" $ do
let rng = mkQCGen 0
burl = BaseUrl Http "localhost" 80 ""
gen = genRequest deepAPI
req = (unGen gen rng 0) burl
path req `shouldBe` ("/one/two/three")
queryParamsSpec :: Spec queryParamsSpec :: Spec
queryParamsSpec = describe "QueryParams" $ do queryParamsSpec = describe "QueryParams" $ do
@ -170,6 +182,12 @@ type API2 = "failplz" :> Get '[JSON] Int
api2 :: Proxy API2 api2 :: Proxy API2
api2 = Proxy api2 = Proxy
type DeepAPI = "one" :> "two" :> "three":> Get '[JSON] ()
deepAPI :: Proxy DeepAPI
deepAPI = Proxy
server2 :: IO (Server API2) server2 :: IO (Server API2)
server2 = return $ return 1 server2 = return $ return 1