sws 0.4.3.0 → 0.4.5.0
raw patch · 3 files changed
+31/−24 lines, 3 filesdep +containersdep +network-uridep ~wai-middleware-static
Dependencies added: containers, network-uri
Dependency ranges changed: wai-middleware-static
Files
- CHANGELOG.md +8/−0
- Main.hs +19/−6
- sws.cabal +4/−18
CHANGELOG.md view
@@ -1,6 +1,14 @@ # Change Log All notable changes to this project will be documented in this file. +## 0.4.5.0 - 2019-10-14+### Added+- `--content-type` option to override content types for a given file extension.++## 0.4.4.0 - 2019-02-04+### Changed+- Unescape URIs before generating directory listings.+ ## 0.4.3.0 - 2018-09-15 ### Changed - Upper bound bumps.
Main.hs view
@@ -8,20 +8,23 @@ import qualified Data.ByteString.Char8 as CBS -- bytestring import qualified Data.ByteString.Lazy as LBS -- bytestring import Data.Bits ( (.&.), unsafeShiftR, xor ) -- base+import Data.Char ( toLower ) -- base import Data.Foldable ( forM_ ) -- base import Data.Int ( Int64 ) -- base import Data.Word ( Word8 ) -- base import Data.List ( sort ) -- base+import qualified Data.Map as M -- containers import Data.Monoid ( (<>) ) -- base import Data.String ( fromString ) -- base import System.Console.GetOpt ( getOpt, usageInfo, OptDescr(..), ArgDescr(..), ArgOrder(..) ) -- base import System.Directory ( getDirectoryContents, doesDirectoryExist, getModificationTime, renameFile, doesFileExist ) -- directory import System.Environment ( getArgs ) -- base-import System.FilePath ( makeRelative, (</>), takeDirectory, takeFileName ) -- filepath+import System.FilePath ( makeRelative, (</>), takeDirectory, takeExtension, takeFileName ) -- filepath import System.IO ( putStrLn, hPutStrLn, hPutStr, stderr, hClose, openBinaryTempFileWithDefaultPermissions ) -- base import System.IO.Error ( userError, ioError, catchIOError, isUserError, ioeGetErrorString ) -- base import Network.HTTP.Types.Status ( status200, status403, status404, status409 ) -- http-types import Network.HTTP.Types.Method ( methodPost ) -- http-types+import Network.URI ( unEscapeString ) -- network-uri import Network.Wai ( Application, Middleware, requestMethod, rawPathInfo, responseLBS ) -- wai import qualified Network.Wai.Handler.Warp as Warp -- warp import qualified Network.Wai.Handler.WarpTLS as Warp -- warp-tls@@ -30,7 +33,8 @@ import Network.Wai.Middleware.HttpAuth ( basicAuth, AuthSettings ) -- wai-extra import Network.Wai.Middleware.Local ( local ) -- wai-extra import Network.Wai.Middleware.RequestLogger ( logStdout ) -- wai-extra-import Network.Wai.Middleware.Static ( staticPolicy, addBase, isNotAbsolute, noDots, Policy, tryPolicy ) -- wai-middleware-static+import Network.Wai.Middleware.Static ( staticPolicyWithOptions, addBase, getMimeType, isNotAbsolute, noDots, Policy, tryPolicy) -- wai-middleware-static+import qualified Network.Wai.Middleware.Static as Static ( Options(mimeTypes), defaultOptions ) -- wai-middleware-static import Network.Wai.Middleware.StripHeaders ( stripHeadersIf ) -- wai-extra import Network.Wai.Parse ( tempFileBackEndOpts, parseRequestBody, fileName, fileContent ) -- wai-extra @@ -65,7 +69,7 @@ -- Not future things: CGI etc of any sort, "extensibility" -- vERSION :: String-vERSION = "0.4.3.0"+vERSION = "0.4.4.0" -- STUN code @@ -209,7 +213,7 @@ -- TODO: Make this less fugly. directoryListing :: Options -> FilePath -> Middleware -- TODO: Handle exceptions. Note, this isn't critical. It will carry on. directoryListing opts baseDir app req k = do- let path = baseDir </> CBS.unpack (BS.tail $ rawPathInfo req) -- TODO: This unpack is ugly.+ let path = baseDir </> unEscapeString (CBS.unpack (BS.tail $ rawPathInfo req)) -- TODO: This unpack is ugly. b <- doesDirectoryExist path if not b then app req k else do when (optVerbose opts) $ putStrLn $ "Rendering listing for " ++ path@@ -270,6 +274,7 @@ optStunPort :: !Net.PortNumber, optHeaders :: ![String],+ optContentTypeOverrides :: ![(String, String)], -- Basic authentication options optAuthentication :: !Bool,@@ -285,7 +290,7 @@ optAllowUploads :: !Bool, optUploadOnly :: !Bool,- optOverwriteOption :: !OverwriteOption}+ optOverwriteOption :: !OverwriteOption } defOptions :: Options defOptions = Options {@@ -300,6 +305,7 @@ optStunHost = "stun.l.google.com", optStunPort = 19302 , optHeaders = [],+ optContentTypeOverrides = [], optAuthentication = True, optRealm = "", optUserName = fromString "guest",@@ -336,6 +342,10 @@ "Equivalent to --no-auth --no-https.", Option "X" [] (ReqArg (\h opt -> opt { optHeaders = h : optHeaders opt }) "HEADER") "Add HEADER to all server responses.",+ Option "" ["content-type"] (ReqArg (\h opt -> opt {+ optContentTypeOverrides = (takeWhile ('='/=) h, drop 1 (dropWhile ('='/=) h))+ : optContentTypeOverrides opt }) "CONTENT-TYPE-OVERRIDE")+ "With argument EXT=MIME, use MIME type MIME for files with extension EXT.", Option "z" ["gzip", "compress"] (NoArg (\opt -> opt { optCompress = True })) "Enable compression. (Default)", Option "" ["no-compress"] (NoArg (\opt -> opt { optCompress = False }))@@ -451,7 +461,7 @@ $ enableIf (optCompress opts) (gzip def { gzipFiles = GzipCompress }) $ enableIf (not (null headers)) (addHeaders headers . stripHeadersIf (map fst headers) (const True)) $ enableIf (optAllowUploads opts || optUploadOnly opts) (update opts policy (overwritePolicy (optOverwriteOption opts)))- $ (if optUploadOnly opts then uploadForm opts policy else staticPolicy policy)+ $ (if optUploadOnly opts then uploadForm opts policy else staticPolicyWithOptions staticOpts policy) $ enableIf (optDirectoryListings opts) (directoryListing opts dir) $ app404 where runner now g | optHTTPS opts && certProvided@@ -468,6 +478,9 @@ certProvided = not (null (optCertificate opts)) && not (null (optKeyFile opts)) policy = basePolicy <> addBase dir+ contentTypeOverrides = M.fromList (map (\(e, m) -> (map toLower e, CBS.pack m)) $ optContentTypeOverrides opts)+ getMimeTypes f = maybe (getMimeType f) id $ M.lookup (map toLower $ drop 1 $ takeExtension f) contentTypeOverrides+ staticOpts = Static.defaultOptions { Static.mimeTypes = getMimeTypes } main :: IO () main = do
sws.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.3.0+version: 0.4.5.0 -- A short (one-line) description of the package. synopsis: A simple web server for serving directories.@@ -63,36 +63,22 @@ -- other-extensions: -- Other library packages from which modules are imported.- --build-depends: - -- base >= 4.9.1 && < 4.11,- -- bytestring >= 0.10.8 && < 0.11,- -- cryptonite >= 0.24 && < 0.26,- -- directory >= 1.3.0 && < 1.4,- -- filepath >= 1.4.1 && < 1.5,- -- hourglass >= 0.2.10 && < 0.3,- -- http-types >= 0.9.1 && < 0.13,- -- network >= 2.6.3 && < 2.7,- -- resourcet >= 1.1.9 && < 1.3,- -- transformers >= 0.5.2 && < 0.6,- -- wai >= 3.2.1 && < 3.3,- -- wai-extra >= 3.0.20 && < 3.1,- -- wai-middleware-static >= 0.8.1 && < 0.9,- -- warp >= 3.2.13 && < 3.3,- -- warp-tls >= 3.2.4 && < 3.3 build-depends: base >= 4.11.1 && < 4.13, bytestring >= 0.10.8 && < 0.11,+ containers >= 0.6.0 && < 0.7, cryptonite >= 0.25 && < 0.26, directory >= 1.3.1 && < 1.4, filepath >= 1.4.2 && < 1.5, hourglass >= 0.2.11 && < 0.3, http-types >= 0.12.1 && < 0.13, network >= 2.7.0 && < 2.9,+ network-uri >= 2.6.0 && < 2.7, resourcet >= 1.2.1 && < 1.3, transformers >= 0.5.5 && < 0.6, wai >= 3.2.1 && < 3.3, wai-extra >= 3.0.22 && < 3.1,- wai-middleware-static >= 0.8.2 && < 0.9,+ wai-middleware-static >= 0.8.3 && < 0.9, warp >= 3.2.22 && < 3.3, warp-tls >= 3.2.4 && < 3.3