mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-11-25 21:42:59 +03:00
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:
parent
41b2faad45
commit
d33214d376
@ -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)
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user