Merge pull request #666 from phadej/bug-fix-for-haslink
Bug fix for haslink
This commit is contained in:
commit
8822c12530
5 changed files with 38 additions and 32 deletions
|
@ -4,6 +4,10 @@
|
|||
* Use `NT` from `natural-transformation` for `Enter`
|
||||
([#616](https://github.com/haskell-servant/servant/issues/616))
|
||||
|
||||
* Change to `MkLink (Verb ...) = Link` (previously `URI`). To consume `Link`
|
||||
use its `ToHttpApiData` instance or `linkURI`.
|
||||
([#527](https://github.com/haskell-servant/servant/issues/527))
|
||||
|
||||
0.9.1
|
||||
------
|
||||
|
||||
|
|
|
@ -101,7 +101,7 @@ import Servant.API.Verbs (PostCreated, Delete, DeleteAccepte
|
|||
ReflectMethod (reflectMethod),
|
||||
Verb, StdMethod(..))
|
||||
import Servant.API.WithNamedContext (WithNamedContext)
|
||||
import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
|
||||
import Servant.Utils.Links (HasLink (..), Link, IsElem, IsElem',
|
||||
URI (..), safeLink)
|
||||
import Web.HttpApiData (FromHttpApiData (..),
|
||||
ToHttpApiData (..))
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
-- you would like to restrict links to. The second argument is the destination
|
||||
-- endpoint you would like the link to point to, this will need to end with a
|
||||
-- verb like GET or POST. Further arguments may be required depending on the
|
||||
-- type of the endpoint. If everything lines up you will get a 'URI' out the
|
||||
-- type of the endpoint. If everything lines up you will get a 'Link' out the
|
||||
-- other end.
|
||||
--
|
||||
-- You may omit 'QueryParam's and the like should you not want to provide them,
|
||||
|
@ -41,19 +41,19 @@
|
|||
-- with an example. Here, a link is generated with no parameters:
|
||||
--
|
||||
-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
|
||||
-- >>> print (safeLink api hello :: URI)
|
||||
-- hello
|
||||
-- >>> toUrlPiece (safeLink api hello :: Link)
|
||||
-- "hello"
|
||||
--
|
||||
-- If the API has an endpoint with parameters then we can generate links with
|
||||
-- or without those:
|
||||
--
|
||||
-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent)
|
||||
-- >>> print $ safeLink api with (Just "Hubert")
|
||||
-- bye?name=Hubert
|
||||
-- >>> toUrlPiece $ safeLink api with (Just "Hubert")
|
||||
-- "bye?name=Hubert"
|
||||
--
|
||||
-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
|
||||
-- >>> print $ safeLink api without
|
||||
-- bye
|
||||
-- >>> toUrlPiece $ safeLink api without
|
||||
-- "bye"
|
||||
--
|
||||
-- If you would like create a helper for generating links only within that API,
|
||||
-- you can partially apply safeLink if you specify a correct type signature
|
||||
|
@ -94,11 +94,11 @@ module Servant.Utils.Links (
|
|||
, Or
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import Data.List
|
||||
import Data.Monoid.Compat ( (<>) )
|
||||
import Data.Proxy ( Proxy(..) )
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import GHC.Exts (Constraint)
|
||||
import GHC.TypeLits ( KnownSymbol, symbolVal )
|
||||
import Network.URI ( URI(..), escapeURIString, isUnreserved )
|
||||
|
@ -126,8 +126,10 @@ data Link = Link
|
|||
} deriving Show
|
||||
|
||||
instance ToHttpApiData Link where
|
||||
toUrlPiece = Text.pack . show
|
||||
toHeader = BSC.pack . show
|
||||
toHeader = TE.encodeUtf8 . toUrlPiece
|
||||
toUrlPiece l =
|
||||
let uri = linkURI l
|
||||
in Text.pack $ uriPath uri ++ uriQuery uri
|
||||
|
||||
-- | If either a or b produce an empty constraint, produce an empty constraint.
|
||||
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
|
||||
|
@ -307,9 +309,9 @@ instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
|
|||
|
||||
-- Verb (terminal) instances
|
||||
instance HasLink (Verb m s ct a) where
|
||||
type MkLink (Verb m s ct a) = URI
|
||||
toLink _ = linkURI
|
||||
type MkLink (Verb m s ct a) = Link
|
||||
toLink _ = id
|
||||
|
||||
instance HasLink Raw where
|
||||
type MkLink Raw = URI
|
||||
toLink _ = linkURI
|
||||
type MkLink Raw = Link
|
||||
toLink _ = id
|
||||
|
|
|
@ -7,6 +7,7 @@ module Servant.Utils.LinksSpec where
|
|||
import Data.Proxy (Proxy (..))
|
||||
import Test.Hspec (Expectation, Spec, describe, it,
|
||||
shouldBe)
|
||||
import Data.String (fromString)
|
||||
|
||||
import Servant.API
|
||||
|
||||
|
@ -32,38 +33,38 @@ apiLink = safeLink (Proxy :: Proxy TestApi)
|
|||
|
||||
-- | Convert a link to a URI and ensure that this maps to the given string
|
||||
-- given string
|
||||
shouldBeURI :: URI -> String -> Expectation
|
||||
shouldBeURI link expected =
|
||||
show link `shouldBe` expected
|
||||
shouldBeLink :: Link -> String -> Expectation
|
||||
shouldBeLink link expected =
|
||||
toUrlPiece link `shouldBe` fromString expected
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Servant.Utils.Links" $ do
|
||||
it "generates correct links for capture query params" $ do
|
||||
let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] NoContent)
|
||||
apiLink l1 "hi" `shouldBeURI` "hello/hi"
|
||||
apiLink l1 "hi" `shouldBeLink` "hello/hi"
|
||||
|
||||
let l2 = Proxy :: Proxy ("hello" :> Capture "name" String
|
||||
:> QueryParam "capital" Bool
|
||||
:> Delete '[JSON] NoContent)
|
||||
apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
|
||||
apiLink l2 "bye" (Just True) `shouldBeLink` "hello/bye?capital=true"
|
||||
|
||||
it "generates correct links for CaptureAll" $ do
|
||||
apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))
|
||||
["roads", "lead", "to", "rome"]
|
||||
`shouldBeURI` "all/roads/lead/to/rome"
|
||||
`shouldBeLink` "all/roads/lead/to/rome"
|
||||
|
||||
it "generates correct links for query flags" $ do
|
||||
let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
|
||||
:> QueryFlag "fast" :> Delete '[JSON] NoContent)
|
||||
apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
|
||||
apiLink l1 False True `shouldBeURI` "balls?fast"
|
||||
apiLink l1 True True `shouldBeLink` "balls?bouncy&fast"
|
||||
apiLink l1 False True `shouldBeLink` "balls?fast"
|
||||
|
||||
it "generates correct links for all of the verbs" $ do
|
||||
apiLink (Proxy :: Proxy ("get" :> Get '[JSON] NoContent)) `shouldBeURI` "get"
|
||||
apiLink (Proxy :: Proxy ("put" :> Put '[JSON] NoContent)) `shouldBeURI` "put"
|
||||
apiLink (Proxy :: Proxy ("post" :> Post '[JSON] NoContent)) `shouldBeURI` "post"
|
||||
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeURI` "delete"
|
||||
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
|
||||
apiLink (Proxy :: Proxy ("get" :> Get '[JSON] NoContent)) `shouldBeLink` "get"
|
||||
apiLink (Proxy :: Proxy ("put" :> Put '[JSON] NoContent)) `shouldBeLink` "put"
|
||||
apiLink (Proxy :: Proxy ("post" :> Post '[JSON] NoContent)) `shouldBeLink` "post"
|
||||
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
|
||||
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
|
||||
|
||||
|
||||
-- |
|
||||
|
@ -96,8 +97,8 @@ spec = describe "Servant.Utils.Links" $ do
|
|||
-- ...
|
||||
--
|
||||
-- sanity check
|
||||
-- >>> apiLink (Proxy :: Proxy AllGood)
|
||||
-- get
|
||||
-- >>> toUrlPiece $ apiLink (Proxy :: Proxy AllGood)
|
||||
-- "get"
|
||||
type WrongPath = "getTypo" :> Get '[JSON] NoContent
|
||||
type WrongReturnType = "get" :> Get '[JSON] Bool
|
||||
type WrongContentType = "get" :> Get '[OctetStream] NoContent
|
||||
|
|
|
@ -15,5 +15,4 @@ extra-deps:
|
|||
- hspec-core-2.3.2
|
||||
- hspec-wai-0.8.0
|
||||
- hspec-expectations-0.8.2
|
||||
- call-stack-0.1.0
|
||||
resolver: lts-6.0
|
||||
resolver: lts-6.27
|
||||
|
|
Loading…
Reference in a new issue