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 qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
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
genRequest _ = do
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
old = genRequest (Proxy :: Proxy b)
new = cs $ symbolVal (Proxy :: Proxy path)

View File

@ -13,7 +13,7 @@ import Test.Hspec.Core.Spec (Arg, Example, Result (..),
defaultParams, evaluateExample)
import Test.QuickCheck.Gen (unGen)
import Test.QuickCheck.Random (mkQCGen)
import Network.HTTP.Client (queryString)
import Network.HTTP.Client (queryString, path)
#if MIN_VERSION_servant(0,8,0)
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
@ -34,6 +34,7 @@ spec = do
notLongerThanSpec
queryParamsSpec
queryFlagsSpec
deepPathSpec
serversEqualSpec :: Spec
serversEqualSpec = describe "serversEqual" $ do
@ -52,7 +53,7 @@ serversEqualSpec = describe "serversEqual" $ do
evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
show err `shouldContain` "Body: 1"
show err `shouldContain` "Body: 2"
show err `shouldContain` "Path: failplz/"
show err `shouldContain` "Path: /failplz"
serverSatisfiesSpec :: Spec
serverSatisfiesSpec = describe "serverSatisfies" $ do
@ -113,6 +114,17 @@ isComprehensiveSpec = describe "HasGenRequest" $ do
let _g = genRequest comprehensiveAPIWithoutRaw
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 = describe "QueryParams" $ do
@ -170,6 +182,12 @@ type API2 = "failplz" :> Get '[JSON] Int
api2 :: Proxy API2
api2 = Proxy
type DeepAPI = "one" :> "two" :> "three":> Get '[JSON] ()
deepAPI :: Proxy DeepAPI
deepAPI = Proxy
server2 :: IO (Server API2)
server2 = return $ return 1