diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog for servant-seo +## 0.1.2 -- 2020-07-16 + +- Add missing instance for HTML with headers (auth context). +- Switch API extension from `serve` to `serveWithContext`. + ## 0.1.1 -- 2020-07-12 - Fix frequency processing. diff --git a/example/Example.hs b/example/Example.hs --- a/example/Example.hs +++ b/example/Example.hs @@ -166,7 +166,7 @@ startServer :: IO () startServer = do Warp.runSettings Warp.defaultSettings - $ serveWithSeo website api server + $ serveWithSeo' website api server where website = "https://example.com" diff --git a/servant-seo.cabal b/servant-seo.cabal --- a/servant-seo.cabal +++ b/servant-seo.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: servant-seo -version: 0.1.1 +version: 0.1.2 synopsis: Generate Robots.txt and Sitemap.xml specification for your servant API. description: Please see the README on GitHub at homepage: https://github.com/swamp-agr/servant-seo#readme diff --git a/src/Servant/Seo.hs b/src/Servant/Seo.hs --- a/src/Servant/Seo.hs +++ b/src/Servant/Seo.hs @@ -52,7 +52,7 @@ -- >>> import Text.Blaze (ToMarkup) -- >>> import Data.Text (Text) -- >>> import Servant.API --- >>> import Servant (Proxy (..)) +-- >>> import Servant (Proxy (..), Context (..)) -- >>> import Servant.Server (runHandler) -- >>> import Servant.HTML.Blaze (HTML) -- >>> import Data.Aeson (FromJSON) @@ -113,8 +113,9 @@ -- -- Moreover, API could be easily extended with 'apiWithRobots'. -- --- >>> :t apiWithRobots (Proxy :: Proxy API) --- apiWithRobots (Proxy :: Proxy API) :: Proxy (RobotsAPI :<|> API) +-- >>> :t apiWithRobots (Proxy :: Proxy API) EmptyContext +-- apiWithRobots (Proxy :: Proxy API) EmptyContext +-- :: Proxy (RobotsAPI :<|> API) -- -- 'serveWithRobots' provides extension for both initial API and its implementation with 'RobotsAPI'. @@ -145,14 +146,15 @@ -- -- For 'SitemapInfo' there is also 'serveSitemap' function. -- --- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy API) +-- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy API) EmptyContext -- >>> BSL8.putStrLn sitemapResponse -- https://example.commonthly1.0https://example.com/aboutyearly0.1 -- -- Again, there is helper 'apiWithSitemap'. -- --- >>> :t apiWithSitemap (Proxy :: Proxy API) --- apiWithSitemap (Proxy :: Proxy API) :: Proxy (SitemapAPI :<|> API) +-- >>> :t apiWithSitemap (Proxy :: Proxy API) EmptyContext +-- apiWithSitemap (Proxy :: Proxy API) EmptyContext +-- :: Proxy (SitemapAPI :<|> API) -- -- 'serveWithSitemap' function will extend both API and corresponding handlers with 'SitemapAPI'. @@ -170,7 +172,7 @@ -- >>> instance ToSitemapPathPiece NewsUrl where getPathPiecesForIndexing _ _ = pure $ (NewsUrl . Text.pack . show) <$> [0 .. 10] -- >>> toSitemapInfo (Proxy :: Proxy PublicAPI) -- SitemapInfo {_sitemapInfoEntries = [SitemapEntry {_sitemapPathPieces = [], _sitemapQueryParts = [], _sitemapFrequency = Just Monthly, _sitemapPriority = Just "1.0"},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "about"], _sitemapQueryParts = [], _sitemapFrequency = Just Yearly, _sitemapPriority = Just "0.1"},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "news",CaptureValues ["0","1","2","3","4","5","6","7","8","9","10"]], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing}], _sitemapInfoPresent = Just ()} --- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy PublicAPI) +-- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy PublicAPI) EmptyContext -- >>> BSL8.putStrLn sitemapResponse -- https://example.commonthly1.0https://example.com/aboutyearly0.1https://example.com/news/0https://example.com/news/1https://example.com/news/2https://example.com/news/3https://example.com/news/4https://example.com/news/5https://example.com/news/6https://example.com/news/7https://example.com/news/8https://example.com/news/9https://example.com/news/10 -- @@ -188,7 +190,7 @@ -- >>> instance ToSitemapParamPart SearchPattern where getParamsForIndexing _ _ = pure $ (SearchPattern . Text.pack) <$> [ [ c1, c2 ] | c1 <- ['a' .. 'e'], c2 <- ['0' .. '3'] ] -- >>> toSitemapInfo (Proxy :: Proxy SearchAPI) -- SitemapInfo {_sitemapInfoEntries = [SitemapEntry {_sitemapPathPieces = [UrlPathPiece "search"], _sitemapQueryParts = [(ParamName "q",[ParamValue "a0",ParamValue "a1",ParamValue "a2",ParamValue "a3",ParamValue "b0",ParamValue "b1",ParamValue "b2",ParamValue "b3",ParamValue "c0",ParamValue "c1",ParamValue "c2",ParamValue "c3",ParamValue "d0",ParamValue "d1",ParamValue "d2",ParamValue "d3",ParamValue "e0",ParamValue "e1",ParamValue "e2",ParamValue "e3"])], _sitemapFrequency = Nothing, _sitemapPriority = Nothing}], _sitemapInfoPresent = Just ()} --- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy SearchAPI) +-- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy SearchAPI) EmptyContext -- >>> BSL8.putStrLn sitemapResponse -- https://example.com/search?q=a0https://example.com/search?q=a1https://example.com/search?q=a2https://example.com/search?q=a3https://example.com/search?q=b0https://example.com/search?q=b1https://example.com/search?q=b2https://example.com/search?q=b3https://example.com/search?q=c0https://example.com/search?q=c1https://example.com/search?q=c2https://example.com/search?q=c3https://example.com/search?q=d0https://example.com/search?q=d1https://example.com/search?q=d2https://example.com/search?q=d3https://example.com/search?q=e0https://example.com/search?q=e1https://example.com/search?q=e2https://example.com/search?q=e3 -- @@ -201,7 +203,7 @@ -- -- >>> instance ToSitemapPathPiece NewsUrl where getPathPiecesForIndexing _ _ = pure $ (NewsUrl . Text.pack . show) <$> [0 .. 50001] -- >>> type PublicAPI = HomeAPI :<|> AboutAPI :<|> AuthAPI :<|> NewsAPI --- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy PublicAPI) +-- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy PublicAPI) EmptyContext -- >>> BSL8.putStrLn sitemapResponse -- https://example.com/0/sitemap.xmlhttps://example.com/1/sitemap.xmlhttps://example.com/2/sitemap.xmlhttps://example.com/3/sitemap.xml -- @@ -211,9 +213,9 @@ -- $howto6 -- -- >>> type API = PublicAPI :<|> StaticAPI :<|> ProtectedAPI --- >>> Right robotsResponse <- runHandler (serveRobots (ServerUrl "https://example.com") (toRobots $ apiWithSitemap (Proxy :: Proxy API))) +-- >>> Right robotsResponse <- runHandler (serveRobots (ServerUrl "https://example.com") (toRobots $ apiWithSitemap (Proxy :: Proxy API) EmptyContext)) -- >>> robotsResponse -- "User-agent: *\nDisallow /cdn/static\nDisallow /admin\n\nSitemap: https://example.com/sitemap.xml\n" -- -- API extended with sitemap will automatically be populated with link to sitemap xml page. --- To serve both robots and sitemap in advance to your API look for 'serveWithSeo' helper function. +-- To serve both robots and sitemap in advance to your API look for 'serveWithSeo'' helper function. diff --git a/src/Servant/Seo/Sitemap.hs b/src/Servant/Seo/Sitemap.hs --- a/src/Servant/Seo/Sitemap.hs +++ b/src/Servant/Seo/Sitemap.hs @@ -286,6 +286,9 @@ instance {-# OVERLAPPING #-} (ToMarkup a) => HasSitemap (Get '[HTML] a) where toSitemapInfo _ = pure (SitemapInfo [mempty] (Just ())) +instance {-# OVERLAPPING #-} (ToMarkup a) => HasSitemap (Get '[HTML] (Headers headers a)) where + toSitemapInfo _ = toSitemapInfo (Proxy :: Proxy (Get '[HTML] a)) + -- | Extracts 'Frequency' from API branch. instance (HasPeriod period, HasSitemap api) => HasSitemap (Frequency period :> api) where -- FIXME: compare with previous values, choose frequent one. diff --git a/src/Servant/Seo/UI.hs b/src/Servant/Seo/UI.hs --- a/src/Servant/Seo/UI.hs +++ b/src/Servant/Seo/UI.hs @@ -7,7 +7,7 @@ {-# LANGUAGE TypeOperators #-} module Servant.Seo.UI where -import Control.Lens +import Control.Lens hiding (Context) import qualified Data.ByteString.Lazy as BSL import Data.Coerce (coerce) import qualified Data.List as List @@ -27,23 +27,25 @@ -- | Extends API with 'RobotsAPI'. apiWithRobots - :: forall (api :: *). (HasServer api '[], HasRobots api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasRobots api) => Proxy api + -> Context context -> Proxy ( RobotsAPI :<|> api ) -apiWithRobots _ = Proxy +apiWithRobots _ _ = Proxy -- | Provides "wrapper" around API. -- Both API and corresponding 'Server' wrapped with 'RobotsAPI' and 'serveRobots' handler. serveWithRobots - :: forall (api :: *). (HasServer api '[], HasRobots api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasRobots api) => ServerUrl -> Proxy api + -> Context context -> Server api -> Application -serveWithRobots serverUrl proxy appServer = serve extendedProxy extendedServer +serveWithRobots serverUrl proxy context appServer = serveWithContext extendedProxy context extendedServer where extendedProxy :: Proxy (RobotsAPI :<|> api) - extendedProxy = apiWithRobots proxy + extendedProxy = apiWithRobots proxy context extendedServer :: Server (RobotsAPI :<|> api) extendedServer = serveRobots serverUrl (toRobots proxy) :<|> appServer @@ -75,43 +77,47 @@ -- | Extends API with 'SitemapAPI'. apiWithSitemap - :: forall (api :: *). (HasServer api '[], HasSitemap api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasSitemap api) => Proxy api + -> Context context -> Proxy ( SitemapAPI :<|> api ) -apiWithSitemap _ = Proxy +apiWithSitemap _ _ = Proxy -- | Provides "wrapper" around API. -- Both API and corresponding 'Server' wrapped with 'SitemapAPI' and 'serveSitemap' handler. serveWithSitemap - :: forall (api :: *). (HasServer api '[], HasSitemap api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasSitemap api) => ServerUrl -> Proxy api + -> Context context -> Server api -> Application -serveWithSitemap serverUrl proxy appServer = serve extendedProxy extendedServer +serveWithSitemap serverUrl proxy context appServer = serveWithContext extendedProxy context extendedServer where extendedProxy :: Proxy (SitemapAPI :<|> api) - extendedProxy = apiWithSitemap proxy + extendedProxy = apiWithSitemap proxy context extendedServer :: Server (SitemapAPI :<|> api) - extendedServer = sitemapServer serverUrl proxy :<|> appServer + extendedServer = sitemapServer serverUrl proxy context :<|> appServer -- | 'Server' implementation for @sitemap.xml@ and indexed sitemaps (if present). sitemapServer - :: forall (api :: *). (HasServer api '[], HasSitemap api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasSitemap api) => ServerUrl -> Proxy api + -> Context context -> Server SitemapAPI -sitemapServer serverUrl proxy = serveSitemap serverUrl proxy - :<|> serveNestedSitemap serverUrl proxy +sitemapServer serverUrl proxy context = serveSitemap serverUrl proxy context + :<|> serveNestedSitemap serverUrl proxy context -- | Provides implementation for @sitemap.xml@. serveSitemap - :: forall (api :: *). (HasServer api '[], HasSitemap api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasSitemap api) => ServerUrl -> Proxy api + -> Context context -> Handler BSL.ByteString -serveSitemap serverUrl proxy = do +serveSitemap serverUrl proxy _ = do sitemap <- toSitemapInfo proxy pure $ sitemapUrlsToRootLBS serverUrl (urls sitemap) where @@ -119,12 +125,13 @@ -- | Provides implementation for nested sitemaps. serveNestedSitemap - :: forall (api :: *). (HasServer api '[], HasSitemap api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasSitemap api) => ServerUrl -> Proxy api + -> Context context -> SitemapIx -> Handler BSL.ByteString -serveNestedSitemap serverUrl proxy (SitemapIx sitemapIndex) = do +serveNestedSitemap serverUrl proxy _ (SitemapIx sitemapIndex) = do sitemap <- toSitemapInfo proxy let urls = getUrls sitemap if urls & concatMap _sitemapUrlLoc & length & (<= 50000) @@ -141,24 +148,32 @@ -- ** Both robots.txt and sitemap.xml --- | Useful wrapper to extend API with both @robots.txt@ and @sitemap.xml@. +-- | Useful wrapper to extend API with both @robots.txt@ and @sitemap.xml@ with servant context. serveWithSeo - :: forall (api :: *). (HasServer api '[], HasRobots api, HasSitemap api) + :: forall (api :: *) (context :: [*]). (HasServer api context, HasRobots api, HasSitemap api) => ServerUrl -> Proxy api + -> Context context -> Server api -> Application -serveWithSeo serverUrl appProxy appServer = serve extendedProxy extendedServer +serveWithSeo serverUrl appProxy appContext appServer = serveWithContext extendedProxy appContext extendedServer where extendedProxy :: Proxy (RobotsAPI :<|> SitemapAPI :<|> api) extendedProxy = Proxy extendedServer :: Server (RobotsAPI :<|> SitemapAPI :<|> api) extendedServer = serveRobots serverUrl (toRobots (Proxy :: Proxy (SitemapAPI :<|> api))) - :<|> sitemapServer serverUrl appProxy + :<|> sitemapServer serverUrl appProxy appContext :<|> appServer - +-- | Useful wrapper to extend API with both @robots.txt@ and @sitemap.xml@ without servant context. +serveWithSeo' + :: forall (api :: *). (HasServer api '[], HasRobots api, HasSitemap api) + => ServerUrl + -> Proxy api + -> Server api + -> Application +serveWithSeo' serverUrl appProxy appServer = serveWithSeo serverUrl appProxy EmptyContext appServer