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` * Use `NT` from `natural-transformation` for `Enter`
([#616](https://github.com/haskell-servant/servant/issues/616)) ([#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 0.9.1
------ ------

View file

@ -101,7 +101,7 @@ import Servant.API.Verbs (PostCreated, Delete, DeleteAccepte
ReflectMethod (reflectMethod), ReflectMethod (reflectMethod),
Verb, StdMethod(..)) Verb, StdMethod(..))
import Servant.API.WithNamedContext (WithNamedContext) import Servant.API.WithNamedContext (WithNamedContext)
import Servant.Utils.Links (HasLink (..), IsElem, IsElem', import Servant.Utils.Links (HasLink (..), Link, IsElem, IsElem',
URI (..), safeLink) URI (..), safeLink)
import Web.HttpApiData (FromHttpApiData (..), import Web.HttpApiData (FromHttpApiData (..),
ToHttpApiData (..)) ToHttpApiData (..))

View file

@ -30,7 +30,7 @@
-- you would like to restrict links to. The second argument is the destination -- 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 -- 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 -- 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. -- other end.
-- --
-- You may omit 'QueryParam's and the like should you not want to provide them, -- 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: -- with an example. Here, a link is generated with no parameters:
-- --
-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int) -- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
-- >>> print (safeLink api hello :: URI) -- >>> toUrlPiece (safeLink api hello :: Link)
-- hello -- "hello"
-- --
-- If the API has an endpoint with parameters then we can generate links with -- If the API has an endpoint with parameters then we can generate links with
-- or without those: -- or without those:
-- --
-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent) -- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent)
-- >>> print $ safeLink api with (Just "Hubert") -- >>> toUrlPiece $ safeLink api with (Just "Hubert")
-- bye?name=Hubert -- "bye?name=Hubert"
-- --
-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent) -- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
-- >>> print $ safeLink api without -- >>> toUrlPiece $ safeLink api without
-- bye -- "bye"
-- --
-- If you would like create a helper for generating links only within that API, -- 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 -- you can partially apply safeLink if you specify a correct type signature
@ -94,11 +94,11 @@ module Servant.Utils.Links (
, Or , Or
) where ) where
import qualified Data.ByteString.Char8 as BSC
import Data.List import Data.List
import Data.Monoid.Compat ( (<>) ) import Data.Monoid.Compat ( (<>) )
import Data.Proxy ( Proxy(..) ) import Data.Proxy ( Proxy(..) )
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import GHC.Exts (Constraint) import GHC.Exts (Constraint)
import GHC.TypeLits ( KnownSymbol, symbolVal ) import GHC.TypeLits ( KnownSymbol, symbolVal )
import Network.URI ( URI(..), escapeURIString, isUnreserved ) import Network.URI ( URI(..), escapeURIString, isUnreserved )
@ -126,8 +126,10 @@ data Link = Link
} deriving Show } deriving Show
instance ToHttpApiData Link where instance ToHttpApiData Link where
toUrlPiece = Text.pack . show toHeader = TE.encodeUtf8 . toUrlPiece
toHeader = BSC.pack . show 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. -- | If either a or b produce an empty constraint, produce an empty constraint.
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where 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 -- Verb (terminal) instances
instance HasLink (Verb m s ct a) where instance HasLink (Verb m s ct a) where
type MkLink (Verb m s ct a) = URI type MkLink (Verb m s ct a) = Link
toLink _ = linkURI toLink _ = id
instance HasLink Raw where instance HasLink Raw where
type MkLink Raw = URI type MkLink Raw = Link
toLink _ = linkURI toLink _ = id

View file

@ -7,6 +7,7 @@ module Servant.Utils.LinksSpec where
import Data.Proxy (Proxy (..)) import Data.Proxy (Proxy (..))
import Test.Hspec (Expectation, Spec, describe, it, import Test.Hspec (Expectation, Spec, describe, it,
shouldBe) shouldBe)
import Data.String (fromString)
import Servant.API 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 -- | Convert a link to a URI and ensure that this maps to the given string
-- given string -- given string
shouldBeURI :: URI -> String -> Expectation shouldBeLink :: Link -> String -> Expectation
shouldBeURI link expected = shouldBeLink link expected =
show link `shouldBe` expected toUrlPiece link `shouldBe` fromString expected
spec :: Spec spec :: Spec
spec = describe "Servant.Utils.Links" $ do spec = describe "Servant.Utils.Links" $ do
it "generates correct links for capture query params" $ do it "generates correct links for capture query params" $ do
let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] NoContent) 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 let l2 = Proxy :: Proxy ("hello" :> Capture "name" String
:> QueryParam "capital" Bool :> QueryParam "capital" Bool
:> Delete '[JSON] NoContent) :> 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 it "generates correct links for CaptureAll" $ do
apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent)) apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))
["roads", "lead", "to", "rome"] ["roads", "lead", "to", "rome"]
`shouldBeURI` "all/roads/lead/to/rome" `shouldBeLink` "all/roads/lead/to/rome"
it "generates correct links for query flags" $ do it "generates correct links for query flags" $ do
let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy" let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
:> QueryFlag "fast" :> Delete '[JSON] NoContent) :> QueryFlag "fast" :> Delete '[JSON] NoContent)
apiLink l1 True True `shouldBeURI` "balls?bouncy&fast" apiLink l1 True True `shouldBeLink` "balls?bouncy&fast"
apiLink l1 False True `shouldBeURI` "balls?fast" apiLink l1 False True `shouldBeLink` "balls?fast"
it "generates correct links for all of the verbs" $ do it "generates correct links for all of the verbs" $ do
apiLink (Proxy :: Proxy ("get" :> Get '[JSON] NoContent)) `shouldBeURI` "get" apiLink (Proxy :: Proxy ("get" :> Get '[JSON] NoContent)) `shouldBeLink` "get"
apiLink (Proxy :: Proxy ("put" :> Put '[JSON] NoContent)) `shouldBeURI` "put" apiLink (Proxy :: Proxy ("put" :> Put '[JSON] NoContent)) `shouldBeLink` "put"
apiLink (Proxy :: Proxy ("post" :> Post '[JSON] NoContent)) `shouldBeURI` "post" apiLink (Proxy :: Proxy ("post" :> Post '[JSON] NoContent)) `shouldBeLink` "post"
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeURI` "delete" apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw" apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
-- | -- |
@ -96,8 +97,8 @@ spec = describe "Servant.Utils.Links" $ do
-- ... -- ...
-- --
-- sanity check -- sanity check
-- >>> apiLink (Proxy :: Proxy AllGood) -- >>> toUrlPiece $ apiLink (Proxy :: Proxy AllGood)
-- get -- "get"
type WrongPath = "getTypo" :> Get '[JSON] NoContent type WrongPath = "getTypo" :> Get '[JSON] NoContent
type WrongReturnType = "get" :> Get '[JSON] Bool type WrongReturnType = "get" :> Get '[JSON] Bool
type WrongContentType = "get" :> Get '[OctetStream] NoContent type WrongContentType = "get" :> Get '[OctetStream] NoContent

View file

@ -15,5 +15,4 @@ extra-deps:
- hspec-core-2.3.2 - hspec-core-2.3.2
- hspec-wai-0.8.0 - hspec-wai-0.8.0
- hspec-expectations-0.8.2 - hspec-expectations-0.8.2
- call-stack-0.1.0 resolver: lts-6.27
resolver: lts-6.0