diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,16 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.14.1 +------ + +- Merge in `servant-generic` (by [Patrick Chilton](https://github.com/chpatrick)) + into `servant` (`Servant.API.Generic`), + `servant-client-code` (`Servant.Client.Generic`) + and `servant-server` (`Servant.Server.Generic`). + +- *servant-server* Deprecate `Servant.Utils.StaticUtils`, use `Servant.Server.StaticUtils`. + 0.14 ---- diff --git a/servant-server.cabal b/servant-server.cabal --- a/servant-server.cabal +++ b/servant-server.cabal @@ -1,5 +1,5 @@ name: servant-server -version: 0.14 +version: 0.14.1 synopsis: A family of combinators for defining webservices APIs and serving them description: A family of combinators for defining webservices APIs and serving them @@ -47,6 +47,7 @@ Servant Servant.Server Servant.Server.Experimental.Auth + Servant.Server.Generic Servant.Server.Internal Servant.Server.Internal.BasicAuth Servant.Server.Internal.Context @@ -54,6 +55,10 @@ Servant.Server.Internal.Router Servant.Server.Internal.RoutingApplication Servant.Server.Internal.ServantErr + Servant.Server.StaticFiles + + -- deprecated + exposed-modules: Servant.Utils.StaticFiles -- Bundled with GHC: Lower bound to not force re-installs @@ -75,7 +80,7 @@ -- Servant dependencies build-depends: - servant == 0.14.* + servant >= 0.14.1 && <0.15 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. @@ -133,12 +138,12 @@ Servant.Server.Internal.ContextSpec Servant.Server.Internal.RoutingApplicationSpec Servant.Server.RouterSpec + Servant.Server.StaticFilesSpec Servant.Server.StreamingSpec Servant.Server.UsingContextSpec Servant.Server.UsingContextSpec.TestCombinators Servant.HoistSpec Servant.ServerSpec - Servant.Utils.StaticFilesSpec -- Dependencies inherited from the library. No need to specify bounds. build-depends: @@ -176,7 +181,7 @@ build-depends: base , servant-server - , doctest >= 0.15.0 && <0.16 + , doctest >= 0.15.0 && <0.17 type: exitcode-stdio-1.0 main-is: test/doctests.hs buildable: True diff --git a/src/Servant.hs b/src/Servant.hs --- a/src/Servant.hs +++ b/src/Servant.hs @@ -6,7 +6,7 @@ -- | For implementing servers for servant APIs. module Servant.Server, -- | Utilities on top of the servant core - module Servant.Utils.Links, + module Servant.Links, module Servant.Utils.StaticFiles, -- | Useful re-exports Proxy(..), @@ -17,5 +17,5 @@ import Data.Proxy import Servant.API import Servant.Server -import Servant.Utils.Links +import Servant.Links import Servant.Utils.StaticFiles diff --git a/src/Servant/Server/Generic.hs b/src/Servant/Server/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Server/Generic.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +-- | @since 0.14.1 +module Servant.Server.Generic ( + AsServerT, + AsServer, + genericServe, + genericServer, + genericServerT, + ) where + +import Data.Proxy + (Proxy (..)) + +import Servant.API.Generic +import Servant.Server + +-- | A type that specifies that an API record contains a server implementation. +data AsServerT (m :: * -> *) +instance GenericMode (AsServerT m) where + type AsServerT m :- api = ServerT api m + +type AsServer = AsServerT Handler + +-- | Transform record of routes into a WAI 'Application'. +genericServe + :: forall routes. + ( HasServer (ToServantApi routes) '[] + , GenericServant routes AsServer + , Server (ToServantApi routes) ~ ToServant routes AsServer + ) + => routes AsServer -> Application +genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer + +-- | Transform record of endpoints into a 'Server'. +genericServer + :: GenericServant routes AsServer + => routes AsServer + -> ToServant routes AsServer +genericServer = toServant + +genericServerT + :: GenericServant routes (AsServerT m) + => routes (AsServerT m) + -> ToServant routes (AsServerT m) +genericServerT = toServant diff --git a/src/Servant/Server/Internal/Context.hs b/src/Servant/Server/Internal/Context.hs --- a/src/Servant/Server/Internal/Context.hs +++ b/src/Servant/Server/Internal/Context.hs @@ -18,7 +18,7 @@ -- | 'Context's are used to pass values to combinators. (They are __not__ meant -- to be used to pass parameters to your handlers, i.e. they should not replace -- any custom 'Control.Monad.Trans.Reader.ReaderT'-monad-stack that you're using --- with 'Servant.Utils.Enter'.) If you don't use combinators that +-- with 'hoistServer'.) If you don't use combinators that -- require any context entries, you can just use 'Servant.Server.serve' as always. -- -- If you are using combinators that require a non-empty 'Context' you have to diff --git a/src/Servant/Server/StaticFiles.hs b/src/Servant/Server/StaticFiles.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Server/StaticFiles.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} +-- | This module defines server-side handlers that lets you serve static files. +-- +-- The most common needs for a web application are covered by +-- 'serveDirectoryWebApp`, but the other variants allow you to use +-- different `StaticSettings` and 'serveDirectoryWith' even allows you +-- to specify arbitrary 'StaticSettings' to be used for serving static files. +module Servant.Server.StaticFiles + ( serveDirectoryWebApp + , serveDirectoryWebAppLookup + , serveDirectoryFileServer + , serveDirectoryEmbedded + , serveDirectoryWith + , -- * Deprecated + serveDirectory + ) where + +import Data.ByteString + (ByteString) +import Network.Wai.Application.Static +import Servant.API.Raw + (Raw) +import Servant.Server + (ServerT, Tagged (..)) +import System.FilePath + (addTrailingPathSeparator) +#if !MIN_VERSION_wai_app_static(3,1,0) +import Filesystem.Path.CurrentOS + (decodeString) +#endif +import WaiAppStatic.Storage.Filesystem + (ETagLookup) + +-- | Serve anything under the specified directory as a 'Raw' endpoint. +-- +-- @ +-- type MyApi = "static" :> Raw +-- +-- server :: Server MyApi +-- server = serveDirectoryWebApp "\/var\/www" +-- @ +-- +-- would capture any request to @\/static\/\@ and look for +-- @\@ under @\/var\/www@. +-- +-- It will do its best to guess the MIME type for that file, based on the extension, +-- and send an appropriate /Content-Type/ header if possible. +-- +-- If your goal is to serve HTML, CSS and Javascript files that use the rest of the API +-- as a webapp backend, you will most likely not want the static files to be hidden +-- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectoryWebApp' +-- handler in the last position, because /servant/ will try to match the handlers +-- in order. +-- +-- Corresponds to the `defaultWebAppSettings` `StaticSettings` value. +serveDirectoryWebApp :: FilePath -> ServerT Raw m +serveDirectoryWebApp = serveDirectoryWith . defaultWebAppSettings . fixPath + +-- | Same as 'serveDirectoryWebApp', but uses `defaultFileServerSettings`. +serveDirectoryFileServer :: FilePath -> ServerT Raw m +serveDirectoryFileServer = serveDirectoryWith . defaultFileServerSettings . fixPath + +-- | Same as 'serveDirectoryWebApp', but uses 'webAppSettingsWithLookup'. +serveDirectoryWebAppLookup :: ETagLookup -> FilePath -> ServerT Raw m +serveDirectoryWebAppLookup etag = + serveDirectoryWith . flip webAppSettingsWithLookup etag . fixPath + +-- | Uses 'embeddedSettings'. +serveDirectoryEmbedded :: [(FilePath, ByteString)] -> ServerT Raw m +serveDirectoryEmbedded files = serveDirectoryWith (embeddedSettings files) + +-- | Alias for 'staticApp'. Lets you serve a directory +-- with arbitrary 'StaticSettings'. Useful when you want +-- particular settings not covered by the four other +-- variants. This is the most flexible method. +serveDirectoryWith :: StaticSettings -> ServerT Raw m +serveDirectoryWith = Tagged . staticApp + +-- | Same as 'serveDirectoryFileServer'. It used to be the only +-- file serving function in servant pre-0.10 and will be kept +-- around for a few versions, but is deprecated. +serveDirectory :: FilePath -> ServerT Raw m +serveDirectory = serveDirectoryFileServer +{-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-} + +fixPath :: FilePath -> FilePath +fixPath = +#if MIN_VERSION_wai_app_static(3,1,0) + addTrailingPathSeparator +#else + decodeString . addTrailingPathSeparator +#endif diff --git a/src/Servant/Utils/StaticFiles.hs b/src/Servant/Utils/StaticFiles.hs --- a/src/Servant/Utils/StaticFiles.hs +++ b/src/Servant/Utils/StaticFiles.hs @@ -1,86 +1,6 @@ -{-# LANGUAGE CPP #-} --- | This module defines server-side handlers that lets you serve static files. --- --- The most common needs for a web application are covered by --- 'serveDirectoryWebApp`, but the other variants allow you to use --- different `StaticSettings` and 'serveDirectoryWith' even allows you --- to specify arbitrary 'StaticSettings' to be used for serving static files. module Servant.Utils.StaticFiles - ( serveDirectoryWebApp - , serveDirectoryWebAppLookup - , serveDirectoryFileServer - , serveDirectoryEmbedded - , serveDirectoryWith - , -- * Deprecated - serveDirectory - ) where - -import Data.ByteString (ByteString) -import Network.Wai.Application.Static -import Servant.API.Raw (Raw) -import Servant.Server (ServerT, Tagged (..)) -import System.FilePath (addTrailingPathSeparator) -#if !MIN_VERSION_wai_app_static(3,1,0) -import Filesystem.Path.CurrentOS (decodeString) -#endif -import WaiAppStatic.Storage.Filesystem (ETagLookup) - --- | Serve anything under the specified directory as a 'Raw' endpoint. --- --- @ --- type MyApi = "static" :> Raw --- --- server :: Server MyApi --- server = serveDirectoryWebApp "\/var\/www" --- @ --- --- would capture any request to @\/static\/\@ and look for --- @\@ under @\/var\/www@. --- --- It will do its best to guess the MIME type for that file, based on the extension, --- and send an appropriate /Content-Type/ header if possible. --- --- If your goal is to serve HTML, CSS and Javascript files that use the rest of the API --- as a webapp backend, you will most likely not want the static files to be hidden --- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectoryWebApp' --- handler in the last position, because /servant/ will try to match the handlers --- in order. --- --- Corresponds to the `defaultWebAppSettings` `StaticSettings` value. -serveDirectoryWebApp :: FilePath -> ServerT Raw m -serveDirectoryWebApp = serveDirectoryWith . defaultWebAppSettings . fixPath - --- | Same as 'serveDirectoryWebApp', but uses `defaultFileServerSettings`. -serveDirectoryFileServer :: FilePath -> ServerT Raw m -serveDirectoryFileServer = serveDirectoryWith . defaultFileServerSettings . fixPath - --- | Same as 'serveDirectoryWebApp', but uses 'webAppSettingsWithLookup'. -serveDirectoryWebAppLookup :: ETagLookup -> FilePath -> ServerT Raw m -serveDirectoryWebAppLookup etag = - serveDirectoryWith . flip webAppSettingsWithLookup etag . fixPath - --- | Uses 'embeddedSettings'. -serveDirectoryEmbedded :: [(FilePath, ByteString)] -> ServerT Raw m -serveDirectoryEmbedded files = serveDirectoryWith (embeddedSettings files) - --- | Alias for 'staticApp'. Lets you serve a directory --- with arbitrary 'StaticSettings'. Useful when you want --- particular settings not covered by the four other --- variants. This is the most flexible method. -serveDirectoryWith :: StaticSettings -> ServerT Raw m -serveDirectoryWith = Tagged . staticApp - --- | Same as 'serveDirectoryFileServer'. It used to be the only --- file serving function in servant pre-0.10 and will be kept --- around for a few versions, but is deprecated. -serveDirectory :: FilePath -> ServerT Raw m -serveDirectory = serveDirectoryFileServer -{-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-} + {-# DEPRECATED "Use Servant.ServerStaticFiles." #-} + ( module Servant.Server.StaticFiles ) + where -fixPath :: FilePath -> FilePath -fixPath = -#if MIN_VERSION_wai_app_static(3,1,0) - addTrailingPathSeparator -#else - decodeString . addTrailingPathSeparator -#endif +import Servant.Server.StaticFiles diff --git a/test/Servant/Server/StaticFilesSpec.hs b/test/Servant/Server/StaticFilesSpec.hs new file mode 100644 --- /dev/null +++ b/test/Servant/Server/StaticFilesSpec.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Servant.Server.StaticFilesSpec where + +import Control.Exception + (bracket) +import Data.Proxy + (Proxy (Proxy)) +import Network.Wai + (Application) +import System.Directory + (createDirectory, getCurrentDirectory, setCurrentDirectory) +import System.IO.Temp + (withSystemTempDirectory) +import Test.Hspec + (Spec, around_, describe, it) +import Test.Hspec.Wai + (get, shouldRespondWith, with) + +import Servant.API + ((:<|>) ((:<|>)), (:>), Capture, Get, JSON, Raw) +import Servant.Server + (Server, serve) +import Servant.Server.StaticFiles + (serveDirectoryFileServer) +import Servant.ServerSpec + (Person (Person)) + +type Api = + "dummy_api" :> Capture "person_name" String :> Get '[JSON] Person + :<|> "static" :> Raw + + +api :: Proxy Api +api = Proxy + +app :: Application +app = serve api server + +server :: Server Api +server = + (\ name_ -> return (Person name_ 42)) + :<|> serveDirectoryFileServer "static" + +withStaticFiles :: IO () -> IO () +withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir -> + bracket (setup tmpDir) teardown (const action) + where + setup tmpDir = do + outer <- getCurrentDirectory + setCurrentDirectory tmpDir + createDirectory "static" + writeFile "static/foo.txt" "bar" + writeFile "static/index.html" "index" + return outer + + teardown outer = do + setCurrentDirectory outer + +spec :: Spec +spec = do + around_ withStaticFiles $ with (return app) $ do + describe "serveDirectory" $ do + it "successfully serves files" $ do + get "/static/foo.txt" `shouldRespondWith` "bar" + + it "serves the contents of index.html when requesting the root of a directory" $ do + get "/static/" `shouldRespondWith` "index" diff --git a/test/Servant/Utils/StaticFilesSpec.hs b/test/Servant/Utils/StaticFilesSpec.hs deleted file mode 100644 --- a/test/Servant/Utils/StaticFilesSpec.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Servant.Utils.StaticFilesSpec where - -import Control.Exception (bracket) -import Data.Proxy (Proxy (Proxy)) -import Network.Wai (Application) -import System.Directory (createDirectory, - getCurrentDirectory, - setCurrentDirectory) -import System.IO.Temp (withSystemTempDirectory) -import Test.Hspec (Spec, around_, describe, it) -import Test.Hspec.Wai (get, shouldRespondWith, with) - -import Servant.API ((:<|>) ((:<|>)), Capture, Get, Raw, (:>), JSON) -import Servant.Server (Server, serve) -import Servant.ServerSpec (Person (Person)) -import Servant.Utils.StaticFiles (serveDirectoryFileServer) - -type Api = - "dummy_api" :> Capture "person_name" String :> Get '[JSON] Person - :<|> "static" :> Raw - - -api :: Proxy Api -api = Proxy - -app :: Application -app = serve api server - -server :: Server Api -server = - (\ name_ -> return (Person name_ 42)) - :<|> serveDirectoryFileServer "static" - -withStaticFiles :: IO () -> IO () -withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir -> - bracket (setup tmpDir) teardown (const action) - where - setup tmpDir = do - outer <- getCurrentDirectory - setCurrentDirectory tmpDir - createDirectory "static" - writeFile "static/foo.txt" "bar" - writeFile "static/index.html" "index" - return outer - - teardown outer = do - setCurrentDirectory outer - -spec :: Spec -spec = do - around_ withStaticFiles $ with (return app) $ do - describe "serveDirectory" $ do - it "successfully serves files" $ do - get "/static/foo.txt" `shouldRespondWith` "bar" - - it "serves the contents of index.html when requesting the root of a directory" $ do - get "/static/" `shouldRespondWith` "index"