diff --git a/servant/CHANGELOG.md b/servant/CHANGELOG.md index 04a6bd57..81c638d3 100644 --- a/servant/CHANGELOG.md +++ b/servant/CHANGELOG.md @@ -5,7 +5,7 @@ ([#616](https://github.com/haskell-servant/servant/issues/616)) * Change to `MkLink (Verb ...) = Link` (previously `URI`). To consume `Link` - use its `ToHttpApiData` instance. + use its `ToHttpApiData` instance or `linkURI`. ([#527](https://github.com/haskell-servant/servant/issues/527)) 0.9.1 diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 0711c790..08594137 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -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 (..)) diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index 844032f4..c4cfea26 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -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 @@ -311,5 +313,5 @@ instance HasLink (Verb m s ct a) where toLink _ = id instance HasLink Raw where - type MkLink Raw = URI - toLink _ = linkURI + type MkLink Raw = Link + toLink _ = id diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs index 2040fc55..6a6bb8dc 100644 --- a/servant/test/Servant/Utils/LinksSpec.hs +++ b/servant/test/Servant/Utils/LinksSpec.hs @@ -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