Merge pull request #666 from phadej/bug-fix-for-haslink

Bug fix for haslink
This commit is contained in:
Oleg Grenrus 2017-01-16 11:01:45 +02:00 committed by GitHub
commit 8822c12530
5 changed files with 38 additions and 32 deletions

View file

@ -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
------

View file

@ -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 (..))

View file

@ -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

View file

@ -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

View file

@ -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