Merge pull request #658 from haskell-servant/file-serving

Revamp file serving module

Author: phadej

doc/tutorial/Javascript.lhs

@@ -136,7 +136,7 @@ server = randomPoint
 
 server' :: Server API'
 server' = server
-     :<|> serveDirectory "static"
+     :<|> serveDirectoryFileServer "static"
 
 app :: Application
 app = serve api' server'

doc/tutorial/Server.lhs

@@ -787,10 +787,10 @@ directory serving WAI application, namely:
 
 ``` haskell ignore
 -- exported by Servant and Servant.Server
-serveDirectory :: FilePath -> Server Raw
+serveDirectoryWebApp :: FilePath -> Server Raw
 ```
 
-`serveDirectory`'s argument must be a path to a valid directory.
+`serveDirectoryWebApp`'s argument must be a path to a valid directory.
 
 Here's an example API that will serve some static files:
 
@@ -807,7 +807,7 @@ staticAPI = Proxy
 
 ``` haskell
 server7 :: Server StaticAPI
-server7 = serveDirectory "static-files"
+server7 = serveDirectoryWebApp "static-files"
 
 app3 :: Application
 app3 = serve staticAPI server7
@@ -821,6 +821,10 @@ In other words: If a client requests `/static/foo.txt`, the server will look for
 `./static-files/foo.txt`. If that file exists it'll succeed and serve the file.
 If it doesn't exist, the handler will fail with a `404` status code.
 
+`serveDirectoryWebApp` uses some standard settings that fit the use case of
+serving static files for most web apps. You can find out about the other
+options in the documentation of the `Servant.Utils.StaticFiles` module.
+
 ## Nested APIs
 
 Let's see how you can define APIs in a modular way, while avoiding repetition.

servant-server/CHANGELOG.md

@@ -4,9 +4,14 @@
 * Add `err422` Unprocessable Entity
   ([#646](https://github.com/haskell-servant/servant/pull/646))
 
-* `Handler` is not abstract datatype. Migration hint: change `throwE` to `throwError`.
+* `Handler` is now an abstract datatype. Migration hint: change `throwE` to `throwError`.
   ([#641](https://github.com/haskell-servant/servant/issues/641))
 
+* Deprecate `serveDirectory` and introduce `serveDirectoryFileServer`,
+  `serveDirectoryWebApp`, `serveDirectoryWebAppLookup`, `serveDirectoryEmbedded`
+  and `serveDirectoryWith` which offer 4 default options and a more flexible
+  one for serving static files.
+
 0.7.1
 ------
 

servant-server/src/Servant/Utils/StaticFiles.hs

@@ -1,28 +1,37 @@
 {-# LANGUAGE CPP #-}
--- | This module defines a sever-side handler that lets you serve static files.
+-- | This module defines server-side handlers that lets you serve static files.
 --
--- - 'serveDirectory' lets you serve anything that lives under a particular
---   directory on your filesystem.
-module Servant.Utils.StaticFiles (
-  serveDirectory,
- ) where
-
-import           Network.Wai.Application.Static (defaultFileServerSettings,
-                                                 staticApp)
+-- 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                 (Server)
 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 = serveDirectory "\/var\/www"
+-- server = serveDirectoryWebApp "\/var\/www"
 -- @
 --
 -- would capture any request to @\/static\/\<something>@ and look for
@@ -33,13 +42,45 @@ import           Filesystem.Path.CurrentOS      (decodeString)
 --
 -- 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 'serveDirectory'
+-- 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 -> Server Raw
+serveDirectoryWebApp = staticApp . defaultWebAppSettings . fixPath
+
+-- | Same as 'serveDirectoryWebApp', but uses `defaultFileServerSettings`.
+serveDirectoryFileServer :: FilePath -> Server Raw
+serveDirectoryFileServer = staticApp . defaultFileServerSettings . fixPath
+
+-- | Same as 'serveDirectoryWebApp', but uses 'webAppSettingsWithLookup'.
+serveDirectoryWebAppLookup :: ETagLookup -> FilePath -> Server Raw
+serveDirectoryWebAppLookup etag =
+  staticApp . flip webAppSettingsWithLookup etag . fixPath
+
+-- | Uses 'embeddedSettings'.
+serveDirectoryEmbedded :: [(FilePath, ByteString)] -> Server Raw
+serveDirectoryEmbedded files = staticApp (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 -> Server Raw
+serveDirectoryWith = 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 -> Server Raw
-serveDirectory =
+serveDirectory = serveDirectoryFileServer
+{-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-}
+
+fixPath :: FilePath -> FilePath
+fixPath =
 #if MIN_VERSION_wai_app_static(3,1,0)
-    staticApp . defaultFileServerSettings . addTrailingPathSeparator
+    addTrailingPathSeparator
 #else
-    staticApp . defaultFileServerSettings . decodeString . addTrailingPathSeparator
+    decodeString . addTrailingPathSeparator
 #endif

servant-server/test/Servant/Utils/StaticFilesSpec.hs

@@ -18,7 +18,7 @@ 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 (serveDirectory)
+import           Servant.Utils.StaticFiles (serveDirectoryFileServer)
 
 type Api =
        "dummy_api" :> Capture "person_name" String :> Get '[JSON] Person
@@ -34,7 +34,7 @@ app = serve api server
 server :: Server Api
 server =
        (\ name_ -> return (Person name_ 42))
-  :<|> serveDirectory "static"
+  :<|> serveDirectoryFileServer "static"
 
 withStaticFiles :: IO () -> IO ()
 withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->