diff --git a/Network/Wai/Middleware/Static.hs b/Network/Wai/Middleware/Static.hs --- a/Network/Wai/Middleware/Static.hs +++ b/Network/Wai/Middleware/Static.hs @@ -27,7 +27,7 @@ ) where import Caching.ExpiringCacheMap.HashECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration) -import Control.Monad.Trans (liftIO) +import Control.Monad import Data.List #if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..)) @@ -37,8 +37,7 @@ #endif import Data.Time import Data.Time.Clock.POSIX -import Network.HTTP.Types (status200, status304) -import Network.HTTP.Types.Header (RequestHeaders) +import Network.HTTP.Types import Network.Mime (MimeType, defaultMimeLookup) import Network.Wai import System.Directory (doesFileExist, getModificationTime) @@ -56,7 +55,7 @@ -- | Take an incoming URI and optionally modify or filter it. -- The result will be treated as a filepath. -newtype Policy = Policy { tryPolicy :: String -> Maybe String -- ^ Run a policy +newtype Policy = Policy { tryPolicy :: String -> Maybe FilePath -- ^ Run a policy } -- | Options for 'staticWithOptions' 'Middleware'. @@ -234,10 +233,15 @@ -- this has no policies enabled by default and is hence insecure. Takes 'Options'. unsafeStaticPolicyWithOptions :: Options -> Policy -> Middleware unsafeStaticPolicyWithOptions options p app req callback = - maybe (app req callback) - (\fp -> - do exists <- liftIO $ doesFileExist fp - if exists + maybe serveUpstream tryStaticFile mCandidateFile + where + serveUpstream :: IO ResponseReceived + serveUpstream = app req callback + + tryStaticFile :: FilePath -> IO ResponseReceived + tryStaticFile fp = do + exists <- doesFileExist fp + if exists then case cacheContainer options of CacheContainerEmpty -> sendFile fp [] @@ -248,9 +252,19 @@ if checkNotModified fileMeta (readHeader "If-Modified-Since") (readHeader "If-None-Match") then sendNotModified fileMeta strategy else sendFile fp (computeHeaders fileMeta strategy) - else app req callback) + else serveUpstream + + mCandidateFile :: Maybe FilePath + mCandidateFile = + guard isHeadOrGet >> (tryPolicy p $ T.unpack $ T.intercalate "/" $ pathInfo req) - where + where + method :: Method + method = requestMethod req + + isHeadOrGet :: Bool + isHeadOrGet = method == methodHead || method == methodGet + readHeader header = lookup header $ requestHeaders req checkNotModified fm modSince etag = diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,6 @@ +## 0.9.0 [2020.10.01] +* Only serve static files on `HEAD` or `GET` requests. + ## 0.8.3 [2019.10.20] * Add `Options`, `staticWithOptions`, `staticPolicyWithOptions`, and `unsafeStaticPolicyWithOptions`. * Parameterize Middleware with options allowing custom file name to MIME type mapping. diff --git a/test/Network/Wai/Middleware/StaticSpec.hs b/test/Network/Wai/Middleware/StaticSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Wai/Middleware/StaticSpec.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Wai.Middleware.StaticSpec (spec) where + +import Test.Hspec hiding (shouldReturn) +import Test.Hspec.Expectations.Lifted +import Test.Hspec.Wai +import Test.Mockery.Directory + +import Web.Scotty (scottyApp) +import Network.Wai.Test (SResponse(..)) +import Network.HTTP.Types.Status + +import Network.Wai.Middleware.Static + +spec :: Spec +spec = around_ inTempDirectory $ do + describe "static" $ with (static `fmap` scottyApp (return ())) $ do + before_ (writeFile "foo.html" "some content") $ do + context "on HEAD" $ do + it "serves static file" $ do + request "HEAD" "/foo.html" [] "" `shouldReturn` SResponse { + simpleStatus = status200 + , simpleHeaders = [("Content-Type", "text/html")] + , simpleBody = "some content" + } + + context "on GET" $ do + it "serves static file" $ do + get "/foo.html" `shouldReturn` SResponse { + simpleStatus = status200 + , simpleHeaders = [("Content-Type", "text/html")] + , simpleBody = "some content" + } + + context "otherwise" $ do + it "serves upstream" $ do + post "/foo.html" "" `shouldReturn` SResponse { + simpleStatus = status404 + , simpleHeaders = [("Content-Type", "text/html")] + , simpleBody = "

404: File Not Found!

" + } diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -fforce-recomp -F -pgmF hspec-discover #-} diff --git a/wai-middleware-static.cabal b/wai-middleware-static.cabal --- a/wai-middleware-static.cabal +++ b/wai-middleware-static.cabal @@ -1,5 +1,5 @@ Name: wai-middleware-static -Version: 0.8.3 +Version: 0.9.0 Synopsis: WAI middleware that serves requests to static files. Homepage: https://github.com/scotty-web/wai-middleware-static Bug-reports: https://github.com/scotty-web/wai-middleware-static/issues @@ -24,7 +24,8 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 - , GHC == 8.8.1 + , GHC == 8.8.3 + , GHC == 8.10.1 Extra-source-files: changelog.md, README.md Library @@ -41,14 +42,31 @@ filepath >= 1.3.0.1 && < 1.5, http-types >= 0.8.2 && < 0.13, mime-types >= 0.1.0.3 && < 0.2, - mtl >= 2.1.2 && < 2.3, old-locale >= 1.0 && < 1.1, semigroups >= 0.18 && < 1, text >= 0.11.3.1 && < 1.3, - time >= 1.4 && < 1.10, + time >= 1.4 && < 1.11, wai >= 3.0.0 && < 3.3 GHC-options: -Wall -fno-warn-orphans + +test-suite spec + main-is: Spec.hs + other-modules: Network.Wai.Middleware.StaticSpec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + build-depends: base, + hspec == 2.*, + hspec-expectations-lifted, + hspec-wai >= 0.6.3, + mockery, + scotty, + wai-extra, + http-types, + wai-middleware-static + build-tool-depends: hspec-discover:hspec-discover == 2.* + GHC-options: -Wall source-repository head type: git