add S.Utils.StaticFiles

servant.cabal

@@ -46,6 +46,7 @@ library
     , http-types
     , network-uri >= 2.6
     , wai
+    , wai-app-static
     , warp
     , safe
     , transformers
@@ -94,6 +95,7 @@ test-suite spec
     , QuickCheck
     , servant
     , string-conversions
+    , temporary
     , text
     , transformers
     , wai

src/Servant.hs

@@ -12,6 +12,10 @@ module Servant (
   module Servant.Docs,
   -- | Helper module
   module Servant.Common.Text,
+  -- | Utilities on top of the servant core
+  module Servant.Utils.ApiQuasiQuoting,
+  module Servant.Utils.Links,
+  module Servant.Utils.StaticFiles,
   -- | Useful re-exports
   Proxy(..),
   ) where
@@ -23,3 +27,6 @@ import Servant.Common.BaseUrl
 import Servant.Common.Text
 import Servant.Docs
 import Servant.Server
+import Servant.Utils.ApiQuasiQuoting
+import Servant.Utils.Links
+import Servant.Utils.StaticFiles

src/Servant/Utils/StaticFiles.hs

@@ -0,0 +1,11 @@
+module Servant.Utils.StaticFiles where
+
+import Filesystem.Path.CurrentOS (decodeString)
+import Network.Wai.Application.Static
+
+import Servant.API
+import Servant.Server
+
+serveDirectory :: FilePath -> Server Raw
+serveDirectory documentRoot =
+  staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))

test/Servant/Utils/StaticFilesSpec.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+module Servant.Utils.StaticFilesSpec where
+
+import Test.Hspec hiding (pending)
+import System.IO.Temp
+import Test.Hspec.Wai
+import Network.Wai
+import Data.Proxy
+import System.Directory
+import Control.Exception
+
+import Servant.Utils.StaticFiles
+import Servant.API.Sub
+import Servant.API.Raw
+import Servant.Server
+
+type Api =
+       "static" :> Raw
+
+app :: Application
+app = serve (Proxy :: Proxy Api) server
+
+server :: Server Api
+server = serveDirectory "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) $
+    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"