diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# happstack-server [![Hackage Status](https://img.shields.io/hackage/v/happstack-server.svg)][hackage] [![Build Status](https://travis-ci.org/Happstack/happstack-server.svg?branch=master)](https://travis-ci.org/Happstack/happstack-server) +# happstack-server [![Hackage Status](https://img.shields.io/hackage/v/happstack-server.svg)][hackage] [hackage]: https://hackage.haskell.org/package/happstack-server diff --git a/happstack-server.cabal b/happstack-server.cabal --- a/happstack-server.cabal +++ b/happstack-server.cabal @@ -1,5 +1,5 @@ Name: happstack-server -Version: 7.5.4 +Version: 7.9.3 Synopsis: Web related tools and services. Description: Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course License: BSD3 @@ -11,17 +11,27 @@ Build-Type: Simple Cabal-Version: >= 1.10 Extra-Source-Files: tests/Happstack/Server/Tests.hs README.md -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC==8.0.1, GHC==8.2.2, GHC==8.4.1, GHC==8.6.3 +tested-with: + GHC == 9.14.1 + GHC == 9.12.2 + GHC == 9.10.2 + GHC == 9.8.2 + GHC == 9.6.7 + GHC == 9.4.8 + GHC == 9.2.8 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + source-repository head type: git location: https://github.com/Happstack/happstack-server.git -Flag template_haskell - Description: Template Haskell is available on this system - Default: True - Manual: False - flag network-uri description: Get Network.URI from the network-uri package default: True @@ -33,7 +43,6 @@ Happstack.Server.Auth Happstack.Server.Cookie Happstack.Server.Compression - Happstack.Server.Client Happstack.Server.Error Happstack.Server.FileServe Happstack.Server.FileServe.BuildingBlocks @@ -54,7 +63,6 @@ Happstack.Server.Internal.TimeoutSocket Happstack.Server.Internal.Monads Happstack.Server.Monads - Happstack.Server.Proxy Happstack.Server.Response Happstack.Server.Routing Happstack.Server.RqData @@ -65,17 +73,16 @@ Other-modules: Happstack.Server.Internal.Clock Happstack.Server.Internal.LazyLiner - Happstack.Server.Internal.SocketTH Happstack.Server.SURI.ParseURI Paths_happstack_server if flag(network-uri) - build-depends: network > 2.6 && < 2.9, + build-depends: network >= 3.0.0 && < 3.3, network-uri >= 2.6 && < 2.7 else build-depends: network < 2.6 Build-Depends: base >= 4 && < 5, - base64-bytestring == 1.0.*, + base64-bytestring >= 1.0 && < 1.3, blaze-html >= 0.5 && < 0.10, bytestring, containers, @@ -85,37 +92,31 @@ filepath, hslogger >= 1.0.2, html, - monad-control >= 0.3 && < 1.1, - mtl >= 2 && < 2.3, - old-locale, + monad-control >= 1.0 && < 1.1, + mtl >= 2.2 && < 2.4, parsec < 4, process, - semigroups >= 0.16, sendfile >= 0.7.1 && < 0.8, system-filepath >= 0.3.1, syb, - text >= 0.10 && < 1.3, - template-haskell < 2.15, - time, + text >= 0.10 && < 2.2, + time >= 1.5, threads >= 0.5, - transformers >= 0.1.3 && < 0.6, + transformers >= 0.1.3 && < 0.7, transformers-base >= 0.4 && < 0.5, - transformers-compat >= 0.3 && < 0.7, utf8-string >= 0.3.4 && < 1.1, - xhtml, + xhtml < 3000.4, zlib - if flag(template_haskell) - cpp-options: -DTEMPLATE_HASKELL - other-extensions: TemplateHaskell - hs-source-dirs: src if !os(windows) Build-Depends: unix cpp-options: -DUNIX - Default-Extensions: OverlappingInstances + if impl(ghc < 8.6) + Default-Extensions: MonadFailDesugaring + Other-Extensions: DeriveDataTypeable, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, @@ -127,7 +128,7 @@ -- available 18 months ago. In order to avoid people spending time -- keeping the build working for older versions, we tell Cabal that -- it shouldn't allow builds with them. - if impl(ghc < 7.0) + if impl(ghc < 8.0) buildable: False Test-Suite happstack-server-tests diff --git a/src/Happstack/Server.hs b/src/Happstack/Server.hs --- a/src/Happstack/Server.hs +++ b/src/Happstack/Server.hs @@ -10,7 +10,7 @@ Happstack.Server provides a self-contained HTTP server and a rich collection of types and functions for routing Requests, generating Responses, working with query parameters, form data, and cookies, serving files and more. A very simple, \"Hello World!\" web app looks like: - + > import Happstack.Server > main = simpleHTTP nullConf $ ok "Hello World!" @@ -33,12 +33,12 @@ the client. But, that would be a pretty barren wasteland to work in. The model for 'ServerPart' is essential the same, except we use the -much richer 'ServerPart' monad instead of the 'IO' monad. +much richer 'ServerPart' monad instead of the 'IO' monad. For in-depth documentation and runnable examples I highly recommend The Happstack Crash Course . -} -module Happstack.Server +module Happstack.Server ( -- * HTTP Server module Happstack.Server.SimpleHTTP -- * Request Routing @@ -59,19 +59,14 @@ , module Happstack.Server.I18N -- * Web-related Monads , module Happstack.Server.Monads - -- * Proxying - , module Happstack.Server.Proxy -- * Output Validation , module Happstack.Server.Validation -- * HTTP Types , module Happstack.Server.Types - -- * Other - , module Happstack.Server.Client -- , module Happstack.Server.Internal.Monads ) where -import Happstack.Server.Client import Happstack.Server.SimpleHTTP (simpleHTTP , simpleHTTP' , simpleHTTP'' @@ -90,7 +85,6 @@ import Happstack.Server.I18N import Happstack.Server.Response import Happstack.Server.Routing -import Happstack.Server.Proxy import Happstack.Server.RqData import Happstack.Server.Validation import Happstack.Server.Types diff --git a/src/Happstack/Server/Auth.hs b/src/Happstack/Server/Auth.hs --- a/src/Happstack/Server/Auth.hs +++ b/src/Happstack/Server/Auth.hs @@ -2,8 +2,12 @@ -- | Support for basic access authentication module Happstack.Server.Auth where +import Data.Foldable (foldl') +import Data.Bits (xor, (.|.)) +import Data.Maybe (fromMaybe) import Control.Monad (MonadPlus(mzero, mplus)) import Data.ByteString.Base64 as Base64 +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B import qualified Data.Map as M import Happstack.Server.Monads (Happstack, escape, getHeaderM, setHeaderM) @@ -72,9 +76,28 @@ -- | Function that looks up the plain text password for username in a -- Map and returns True if it matches with the given password. +-- +-- Note: The implementation is hardened against timing attacks but not +-- completely safe. Ideally you should build your own predicate, using +-- a robust constant-time equality comparison from a cryptographic +-- library like sodium. validLoginPlaintext :: M.Map String String -- ^ the username password map -> B.ByteString -- ^ the username -> B.ByteString -- ^ the password -> Bool -validLoginPlaintext authMap name password = M.lookup (B.unpack name) authMap == Just (B.unpack password) +validLoginPlaintext authMap name password = fromMaybe False $ do + r <- M.lookup (B.unpack name) authMap + pure (constTimeEq (B.pack r) password) + where + -- (Mostly) constant time equality of bytestrings to prevent timing attacks by testing out passwords. This still + -- allows to extract the length of the configured password via timing attacks. This implementation is still brittle + -- in the sense that it relies on GHC not unrolling or vectorizing the loop. + {-# NOINLINE constTimeEq #-} + constTimeEq :: BS.ByteString -> BS.ByteString -> Bool + constTimeEq x y + | BS.length x /= BS.length y + = False + + | otherwise + = foldl' (.|.) 0 (BS.zipWith xor x y) == 0 diff --git a/src/Happstack/Server/Client.hs b/src/Happstack/Server/Client.hs deleted file mode 100644 --- a/src/Happstack/Server/Client.hs +++ /dev/null @@ -1,26 +0,0 @@ --- | a very simple interface for acting as an HTTP client. This is mostly used for things like "Happstack.Server.Proxy". You are more likely to want a library like http-enumerator . -module Happstack.Server.Client where - -import Happstack.Server.Internal.Handler (parseResponse, putRequest) -import Happstack.Server.Internal.Types (Response, Request, getHeader, readDec') -import Data.Maybe (fromJust) -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as L -import Network (PortID(PortNumber), connectTo, withSocketsDo) -import System.IO (BufferMode(NoBuffering), hFlush, hSetBuffering) - --- | Sends the serialized request to the host defined in the request --- and attempts to parse response upon arrival. -getResponse :: Request -> IO (Either String Response) -getResponse rq = withSocketsDo $ do - let (hostName,p) = span (/=':') $ fromJust $ fmap B.unpack $ getHeader "host" rq - portInt = if null p then 80 else readDec' $ tail p - portId = PortNumber $ toEnum $ portInt - h <- connectTo hostName portId - hSetBuffering h NoBuffering - - putRequest h rq - hFlush h - - inputStr <- L.hGetContents h - return $ parseResponse inputStr diff --git a/src/Happstack/Server/Cookie.hs b/src/Happstack/Server/Cookie.hs --- a/src/Happstack/Server/Cookie.hs +++ b/src/Happstack/Server/Cookie.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} -- | Functions for creating, adding, and expiring cookies. To lookup cookie values see "Happstack.Server.RqData". module Happstack.Server.Cookie ( Cookie(..) , CookieLife(..) + , SameSite(..) , mkCookie , addCookie , addCookies @@ -12,13 +13,13 @@ import Control.Monad.Trans (MonadIO(..)) import Happstack.Server.Internal.Monads (FilterMonad, composeFilter) -import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), calcLife, mkCookie, mkCookieHeader) +import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), SameSite(..), calcLife, mkCookie, mkCookieHeader) import Happstack.Server.Types (Response, addHeader) -- | Add the 'Cookie' to 'Response'. -- -- example --- +-- -- > main = simpleHTTP nullConf $ -- > do addCookie Session (mkCookie "name" "value") -- > ok $ "You now have a session cookie." @@ -32,7 +33,7 @@ addHeaderM a v = composeFilter $ \res-> addHeader a v res -- | Add the list 'Cookie' to the 'Response'. --- +-- -- see also: 'addCookie' addCookies :: (MonadIO m, FilterMonad Response m) => [(CookieLife, Cookie)] -> m () addCookies = mapM_ (uncurry addCookie) @@ -43,5 +44,5 @@ -- > do expireCookie "name" -- > ok $ "The cookie has been expired." -expireCookie :: (MonadIO m, FilterMonad Response m) => String -> m () +expireCookie :: (MonadIO m, FilterMonad Response m) => String -> m () expireCookie name = addCookie Expired (mkCookie name "") diff --git a/src/Happstack/Server/Error.hs b/src/Happstack/Server/Error.hs --- a/src/Happstack/Server/Error.hs +++ b/src/Happstack/Server/Error.hs @@ -1,7 +1,7 @@ -- | Some useful functions if you want to wrap the 'ServerPartT' monad transformer around the 'ErrorT' monad transformer. e.g., @'ServerPartT' ('ErrorT' e m) a@. This allows you to use 'throwError' and 'catchError' inside your monad. module Happstack.Server.Error where -import Control.Monad.Error (Error, ErrorT(runErrorT)) +import Control.Monad.Trans.Except (ExceptT, runExceptT) import Happstack.Server.Monads (ServerPartT) import Happstack.Server.Internal.Monads (WebT, UnWebT, withRequest, mkWebT, runServerPartT, ununWebT) import Happstack.Server.Response (ok, toResponse) @@ -22,10 +22,10 @@ -- see also: 'simpleErrorHandler' spUnwrapErrorT:: Monad m => (e -> ServerPartT m a) -> Request - -> UnWebT (ErrorT e m) a + -> UnWebT (ExceptT e m) a -> UnWebT m a spUnwrapErrorT handler rq = \x -> do - err <- runErrorT x + err <- runExceptT x case err of Left e -> ununWebT $ runServerPartT (handler e) rq Right a -> return a @@ -48,9 +48,9 @@ -- function. -- -- DEPRECATED: use 'spUnwrapErrorT' instead. -errorHandlerSP :: (Monad m, Error e) => (Request -> e -> WebT m a) -> ServerPartT (ErrorT e m) a -> ServerPartT m a +errorHandlerSP :: (Monad m) => (Request -> e -> WebT m a) -> ServerPartT (ExceptT e m) a -> ServerPartT m a errorHandlerSP handler sps = withRequest $ \req -> mkWebT $ do - eer <- runErrorT $ ununWebT $ runServerPartT sps req + eer <- runExceptT $ ununWebT $ runServerPartT sps req case eer of Left err -> ununWebT (handler req err) Right res -> return res diff --git a/src/Happstack/Server/FileServe/BuildingBlocks.hs b/src/Happstack/Server/FileServe/BuildingBlocks.hs --- a/src/Happstack/Server/FileServe/BuildingBlocks.hs +++ b/src/Happstack/Server/FileServe/BuildingBlocks.hs @@ -54,17 +54,18 @@ isDot ) where -import Control.Applicative ((<$>)) import Control.Exception.Extensible as E (IOException, bracket, catch) import Control.Monad (MonadPlus(mzero), msum) import Control.Monad.Trans (MonadIO(liftIO)) import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as S -import Data.Data (Data, Typeable) +import Data.Char (toLower) +import Data.Data (Data) import Data.List (sort) import Data.Maybe (fromMaybe) import Data.Map (Map) import qualified Data.Map as Map +import Data.Time (UTCTime, formatTime, defaultTimeLocale) import Filesystem.Path.CurrentOS (commonPrefix, encodeString, decodeString, collapse, append) import Happstack.Server.Monads (ServerMonad(askRq), FilterMonad, WebMonad) import Happstack.Server.Response (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther) @@ -77,13 +78,6 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -#if MIN_VERSION_time(1,5,0) -import Data.Time (UTCTime, formatTime, defaultTimeLocale) -#else -import System.Locale (defaultTimeLocale) -import Data.Time (UTCTime, formatTime) -#endif - -- * Mime-Type / Content-Type -- |a 'Map' from file extensions to content-types @@ -103,7 +97,7 @@ guessContentType mimeMap filepath = case getExt filepath of "" -> Nothing - ext -> Map.lookup ext mimeMap + ext -> Map.lookup (map toLower ext) mimeMap -- FIXME? @foldCase@ would be more proper than @map toLower@ but would add a dependency. But are those edge cases ever going to be relevant here? -- | try to guess the content-type of a file based on its extension -- @@ -128,7 +122,7 @@ -- | a list of common index files. Specifically: @index.html@, @index.xml@, @index.gif@ -- --- Typically used as an argument to 'serveDiretory'. +-- Typically used as an argumebnt to 'serveDiretory'. defaultIxFiles :: [FilePath] defaultIxFiles= ["index.html","index.xml","index.gif"] @@ -137,6 +131,8 @@ fileNotFound fp = return $ result 404 $ "File not found " ++ fp -- | Similar to 'takeExtension' but does not include the extension separator char +-- +-- NOTE: this does not perform case folding. So @example.jpg@ will return @.jpg@ and @example.JPG@ will return @.JPG@. getExt :: FilePath -> String getExt fp = drop 1 $ takeExtension fp @@ -530,7 +526,7 @@ listing <- renderFn localPath $ filter (/= ".") (sort c) ok $ toResponse $ listing -data EntryKind = File | Directory | UnknownKind deriving (Eq, Ord, Read, Show, Data, Typeable, Enum) +data EntryKind = File | Directory | UnknownKind deriving (Eq, Ord, Read, Show, Data, Enum) -- | a function to generate an HTML page showing the contents of a directory on the disk -- @@ -632,7 +628,7 @@ -- | see 'serveDirectory' data Browsing = EnableBrowsing | DisableBrowsing - deriving (Eq, Enum, Ord, Read, Show, Data, Typeable) + deriving (Eq, Enum, Ord, Read, Show, Data) -- | Serve files and directories from a directory and its subdirectories using 'sendFile'. -- @@ -715,7 +711,6 @@ -- | Ready collection of common mime types. --- Except for the first two entries, the mappings come from an Ubuntu 8.04 \/etc\/mime.types file. +-- Except for the first two entries, the mappings come from http://svn.apache.org/viewvc/httpd/httpd/branches/2.4.x/docs/conf/mime.types?view=co mimeTypes :: MimeMap -mimeTypes = Map.fromList [("gz","application/x-gzip"),("cabal","text/x-cabal"),("%","application/x-trash"),("323","text/h323"),("3gp","video/3gpp"),("7z","application/x-7z-compressed"),("abw","application/x-abiword"),("ai","application/postscript"),("aif","audio/x-aiff"),("aifc","audio/x-aiff"),("aiff","audio/x-aiff"),("alc","chemical/x-alchemy"),("art","image/x-jg"),("asc","text/plain"),("asf","video/x-ms-asf"),("asn","chemical/x-ncbi-asn1"),("aso","chemical/x-ncbi-asn1-binary"),("asx","video/x-ms-asf"),("atom","application/atom"),("atomcat","application/atomcat+xml"),("atomsrv","application/atomserv+xml"),("au","audio/basic"),("avi","video/x-msvideo"),("b","chemical/x-molconn-Z"),("bak","application/x-trash"),("bat","application/x-msdos-program"),("bcpio","application/x-bcpio"),("bib","text/x-bibtex"),("bin","application/octet-stream"),("bmp","image/x-ms-bmp"),("boo","text/x-boo"),("book","application/x-maker"),("bsd","chemical/x-crossfire"),("c","text/x-csrc"),("c++","text/x-c++src"),("c3d","chemical/x-chem3d"),("cab","application/x-cab"),("cac","chemical/x-cache"),("cache","chemical/x-cache"),("cap","application/cap"),("cascii","chemical/x-cactvs-binary"),("cat","application/vnd.ms-pki.seccat"),("cbin","chemical/x-cactvs-binary"),("cbr","application/x-cbr"),("cbz","application/x-cbz"),("cc","text/x-c++src"),("cdf","application/x-cdf"),("cdr","image/x-coreldraw"),("cdt","image/x-coreldrawtemplate"),("cdx","chemical/x-cdx"),("cdy","application/vnd.cinderella"),("cef","chemical/x-cxf"),("cer","chemical/x-cerius"),("chm","chemical/x-chemdraw"),("chrt","application/x-kchart"),("cif","chemical/x-cif"),("class","application/java-vm"),("cls","text/x-tex"),("cmdf","chemical/x-cmdf"),("cml","chemical/x-cml"),("cod","application/vnd.rim.cod"),("com","application/x-msdos-program"),("cpa","chemical/x-compass"),("cpio","application/x-cpio"),("cpp","text/x-c++src"),("cpt","application/mac-compactpro"),("crl","application/x-pkcs7-crl"),("crt","application/x-x509-ca-cert"),("csf","chemical/x-cache-csf"),("csh","application/x-csh"),("csm","chemical/x-csml"),("csml","chemical/x-csml"),("css","text/css"),("csv","text/csv"),("ctab","chemical/x-cactvs-binary"),("ctx","chemical/x-ctx"),("cu","application/cu-seeme"),("cub","chemical/x-gaussian-cube"),("cxf","chemical/x-cxf"),("cxx","text/x-c++src"),("d","text/x-dsrc"),("dat","chemical/x-mopac-input"),("dcr","application/x-director"),("deb","application/x-debian-package"),("dif","video/dv"),("diff","text/x-diff"),("dir","application/x-director"),("djv","image/vnd.djvu"),("djvu","image/vnd.djvu"),("dl","video/dl"),("dll","application/x-msdos-program"),("dmg","application/x-apple-diskimage"),("dms","application/x-dms"),("doc","application/msword"),("dot","application/msword"),("dv","video/dv"),("dvi","application/x-dvi"),("dx","chemical/x-jcamp-dx"),("dxr","application/x-director"),("emb","chemical/x-embl-dl-nucleotide"),("embl","chemical/x-embl-dl-nucleotide"),("eml","message/rfc822"),("ent","chemical/x-ncbi-asn1-ascii"),("eps","application/postscript"),("etx","text/x-setext"),("exe","application/x-msdos-program"),("ez","application/andrew-inset"),("fb","application/x-maker"),("fbdoc","application/x-maker"),("fch","chemical/x-gaussian-checkpoint"),("fchk","chemical/x-gaussian-checkpoint"),("fig","application/x-xfig"),("flac","application/x-flac"),("fli","video/fli"),("fm","application/x-maker"),("frame","application/x-maker"),("frm","application/x-maker"),("gal","chemical/x-gaussian-log"),("gam","chemical/x-gamess-input"),("gamin","chemical/x-gamess-input"),("gau","chemical/x-gaussian-input"),("gcd","text/x-pcs-gcd"),("gcf","application/x-graphing-calculator"),("gcg","chemical/x-gcg8-sequence"),("gen","chemical/x-genbank"),("gf","application/x-tex-gf"),("gif","image/gif"),("gjc","chemical/x-gaussian-input"),("gjf","chemical/x-gaussian-input"),("gl","video/gl"),("gnumeric","application/x-gnumeric"),("gpt","chemical/x-mopac-graph"),("gsf","application/x-font"),("gsm","audio/x-gsm"),("gtar","application/x-gtar"),("h","text/x-chdr"),("h++","text/x-c++hdr"),("hdf","application/x-hdf"),("hh","text/x-c++hdr"),("hin","chemical/x-hin"),("hpp","text/x-c++hdr"),("hqx","application/mac-binhex40"),("hs","text/x-haskell"),("hta","application/hta"),("htc","text/x-component"),("htm","text/html"),("html","text/html"),("hxx","text/x-c++hdr"),("ica","application/x-ica"),("ice","x-conference/x-cooltalk"),("ico","image/x-icon"),("ics","text/calendar"),("icz","text/calendar"),("ief","image/ief"),("iges","model/iges"),("igs","model/iges"),("iii","application/x-iphone"),("inp","chemical/x-gamess-input"),("ins","application/x-internet-signup"),("iso","application/x-iso9660-image"),("isp","application/x-internet-signup"),("ist","chemical/x-isostar"),("istr","chemical/x-isostar"),("jad","text/vnd.sun.j2me.app-descriptor"),("jar","application/java-archive"),("java","text/x-java"),("jdx","chemical/x-jcamp-dx"),("jmz","application/x-jmol"),("jng","image/x-jng"),("jnlp","application/x-java-jnlp-file"),("jpe","image/jpeg"),("jpeg","image/jpeg"),("jpg","image/jpeg"),("js","application/x-javascript"),("kar","audio/midi"),("key","application/pgp-keys"),("kil","application/x-killustrator"),("kin","chemical/x-kinemage"),("kml","application/vnd.google-earth.kml+xml"),("kmz","application/vnd.google-earth.kmz"),("kpr","application/x-kpresenter"),("kpt","application/x-kpresenter"),("ksp","application/x-kspread"),("kwd","application/x-kword"),("kwt","application/x-kword"),("latex","application/x-latex"),("lha","application/x-lha"),("lhs","text/x-literate-haskell"),("lsf","video/x-la-asf"),("lsx","video/x-la-asf"),("ltx","text/x-tex"),("lyx","application/x-lyx"),("lzh","application/x-lzh"),("lzx","application/x-lzx"),("m3u","audio/mpegurl"),("m4a","audio/mpeg"),("maker","application/x-maker"),("man","application/x-troff-man"),("mcif","chemical/x-mmcif"),("mcm","chemical/x-macmolecule"),("mdb","application/msaccess"),("me","application/x-troff-me"),("mesh","model/mesh"),("mid","audio/midi"),("midi","audio/midi"),("mif","application/x-mif"),("mm","application/x-freemind"),("mmd","chemical/x-macromodel-input"),("mmf","application/vnd.smaf"),("mml","text/mathml"),("mmod","chemical/x-macromodel-input"),("mng","video/x-mng"),("moc","text/x-moc"),("mol","chemical/x-mdl-molfile"),("mol2","chemical/x-mol2"),("moo","chemical/x-mopac-out"),("mop","chemical/x-mopac-input"),("mopcrt","chemical/x-mopac-input"),("mov","video/quicktime"),("movie","video/x-sgi-movie"),("mp2","audio/mpeg"),("mp3","audio/mpeg"),("mp4","video/mp4"),("mpc","chemical/x-mopac-input"),("mpe","video/mpeg"),("mpeg","video/mpeg"),("mpega","audio/mpeg"),("mpg","video/mpeg"),("mpga","audio/mpeg"),("ms","application/x-troff-ms"),("msh","model/mesh"),("msi","application/x-msi"),("mvb","chemical/x-mopac-vib"),("mxu","video/vnd.mpegurl"),("nb","application/mathematica"),("nc","application/x-netcdf"),("nwc","application/x-nwc"),("o","application/x-object"),("oda","application/oda"),("odb","application/vnd.oasis.opendocument.database"),("odc","application/vnd.oasis.opendocument.chart"),("odf","application/vnd.oasis.opendocument.formula"),("odg","application/vnd.oasis.opendocument.graphics"),("odi","application/vnd.oasis.opendocument.image"),("odm","application/vnd.oasis.opendocument.text-master"),("odp","application/vnd.oasis.opendocument.presentation"),("ods","application/vnd.oasis.opendocument.spreadsheet"),("odt","application/vnd.oasis.opendocument.text"),("oga","audio/ogg"),("ogg","application/ogg"),("ogv","video/ogg"),("ogx","application/ogg"),("old","application/x-trash"),("otg","application/vnd.oasis.opendocument.graphics-template"),("oth","application/vnd.oasis.opendocument.text-web"),("otp","application/vnd.oasis.opendocument.presentation-template"),("ots","application/vnd.oasis.opendocument.spreadsheet-template"),("ott","application/vnd.oasis.opendocument.text-template"),("oza","application/x-oz-application"),("p","text/x-pascal"),("p7r","application/x-pkcs7-certreqresp"),("pac","application/x-ns-proxy-autoconfig"),("pas","text/x-pascal"),("pat","image/x-coreldrawpattern"),("patch","text/x-diff"),("pbm","image/x-portable-bitmap"),("pcap","application/cap"),("pcf","application/x-font"),("pcf.Z","application/x-font"),("pcx","image/pcx"),("pdb","chemical/x-pdb"),("pdf","application/pdf"),("pfa","application/x-font"),("pfb","application/x-font"),("pgm","image/x-portable-graymap"),("pgn","application/x-chess-pgn"),("pgp","application/pgp-signature"),("php","application/x-httpd-php"),("php3","application/x-httpd-php3"),("php3p","application/x-httpd-php3-preprocessed"),("php4","application/x-httpd-php4"),("phps","application/x-httpd-php-source"),("pht","application/x-httpd-php"),("phtml","application/x-httpd-php"),("pk","application/x-tex-pk"),("pl","text/x-perl"),("pls","audio/x-scpls"),("pm","text/x-perl"),("png","image/png"),("pnm","image/x-portable-anymap"),("pot","text/plain"),("ppm","image/x-portable-pixmap"),("pps","application/vnd.ms-powerpoint"),("ppt","application/vnd.ms-powerpoint"),("prf","application/pics-rules"),("prt","chemical/x-ncbi-asn1-ascii"),("ps","application/postscript"),("psd","image/x-photoshop"),("py","text/x-python"),("pyc","application/x-python-code"),("pyo","application/x-python-code"),("qt","video/quicktime"),("qtl","application/x-quicktimeplayer"),("ra","audio/x-pn-realaudio"),("ram","audio/x-pn-realaudio"),("rar","application/rar"),("ras","image/x-cmu-raster"),("rd","chemical/x-mdl-rdfile"),("rdf","application/rdf+xml"),("rgb","image/x-rgb"),("rhtml","application/x-httpd-eruby"),("rm","audio/x-pn-realaudio"),("roff","application/x-troff"),("ros","chemical/x-rosdal"),("rpm","application/x-redhat-package-manager"),("rss","application/rss+xml"),("rtf","application/rtf"),("rtx","text/richtext"),("rxn","chemical/x-mdl-rxnfile"),("sct","text/scriptlet"),("sd","chemical/x-mdl-sdfile"),("sd2","audio/x-sd2"),("sda","application/vnd.stardivision.draw"),("sdc","application/vnd.stardivision.calc"),("sdd","application/vnd.stardivision.impress"),("sdf","application/vnd.stardivision.math"),("sds","application/vnd.stardivision.chart"),("sdw","application/vnd.stardivision.writer"),("ser","application/java-serialized-object"),("sgf","application/x-go-sgf"),("sgl","application/vnd.stardivision.writer-global"),("sh","application/x-sh"),("shar","application/x-shar"),("shtml","text/html"),("sid","audio/prs.sid"),("sik","application/x-trash"),("silo","model/mesh"),("sis","application/vnd.symbian.install"),("sisx","x-epoc/x-sisx-app"),("sit","application/x-stuffit"),("sitx","application/x-stuffit"),("skd","application/x-koan"),("skm","application/x-koan"),("skp","application/x-koan"),("skt","application/x-koan"),("smi","application/smil"),("smil","application/smil"),("snd","audio/basic"),("spc","chemical/x-galactic-spc"),("spl","application/futuresplash"),("spx","audio/ogg"),("src","application/x-wais-source"),("stc","application/vnd.sun.xml.calc.template"),("std","application/vnd.sun.xml.draw.template"),("sti","application/vnd.sun.xml.impress.template"),("stl","application/vnd.ms-pki.stl"),("stw","application/vnd.sun.xml.writer.template"),("sty","text/x-tex"),("sv4cpio","application/x-sv4cpio"),("sv4crc","application/x-sv4crc"),("svg","image/svg+xml"),("svgz","image/svg+xml"),("sw","chemical/x-swissprot"),("swf","application/x-shockwave-flash"),("swfl","application/x-shockwave-flash"),("sxc","application/vnd.sun.xml.calc"),("sxd","application/vnd.sun.xml.draw"),("sxg","application/vnd.sun.xml.writer.global"),("sxi","application/vnd.sun.xml.impress"),("sxm","application/vnd.sun.xml.math"),("sxw","application/vnd.sun.xml.writer"),("t","application/x-troff"),("tar","application/x-tar"),("taz","application/x-gtar"),("tcl","application/x-tcl"),("tex","text/x-tex"),("texi","application/x-texinfo"),("texinfo","application/x-texinfo"),("text","text/plain"),("tgf","chemical/x-mdl-tgf"),("tgz","application/x-gtar"),("tif","image/tiff"),("tiff","image/tiff"),("tk","text/x-tcl"),("tm","text/texmacs"),("torrent","application/x-bittorrent"),("tr","application/x-troff"),("ts","text/texmacs"),("tsp","application/dsptype"),("tsv","text/tab-separated-values"),("txt","text/plain"),("udeb","application/x-debian-package"),("uls","text/iuls"),("ustar","application/x-ustar"),("val","chemical/x-ncbi-asn1-binary"),("vcd","application/x-cdlink"),("vcf","text/x-vcard"),("vcs","text/x-vcalendar"),("vmd","chemical/x-vmd"),("vms","chemical/x-vamas-iso14976"),("vrm","x-world/x-vrml"),("vrml","model/vrml"),("vsd","application/vnd.visio"),("wad","application/x-doom"),("wav","audio/x-wav"),("wax","audio/x-ms-wax"),("wbmp","image/vnd.wap.wbmp"),("wbxml","application/vnd.wap.wbxml"),("webm","video/webm"),("webp","image/webp"),("wk","application/x-123"),("wm","video/x-ms-wm"),("wma","audio/x-ms-wma"),("wmd","application/x-ms-wmd"),("wml","text/vnd.wap.wml"),("wmlc","application/vnd.wap.wmlc"),("wmls","text/vnd.wap.wmlscript"),("wmlsc","application/vnd.wap.wmlscriptc"),("wmv","video/x-ms-wmv"),("wmx","video/x-ms-wmx"),("wmz","application/x-ms-wmz"),("wp5","application/wordperfect5.1"),("wpd","application/wordperfect"),("wrl","model/vrml"),("wsc","text/scriptlet"),("wvx","video/x-ms-wvx"),("wz","application/x-wingz"),("xbm","image/x-xbitmap"),("xcf","application/x-xcf"),("xht","application/xhtml+xml"),("xhtml","application/xhtml+xml"),("xlb","application/vnd.ms-excel"),("xls","application/vnd.ms-excel"),("xlt","application/vnd.ms-excel"),("xml","application/xml"),("xpi","application/x-xpinstall"),("xpm","image/x-xpixmap"),("xsl","application/xml"),("xtel","chemical/x-xtel"),("xul","application/vnd.mozilla.xul+xml"),("xwd","image/x-xwindowdump"),("xyz","chemical/x-xyz"),("zip","application/zip"),("zmt","chemical/x-mopac-input"),("~","application/x-trash")] - +mimeTypes = Map.fromList [("gz","application/x-gzip"),("cabal","text/x-cabal"),("ez","application/andrew-inset"),("aw","application/applixware"),("atom","application/atom+xml"),("atomcat","application/atomcat+xml"),("atomsvc","application/atomsvc+xml"),("ccxml","application/ccxml+xml"),("cdmia","application/cdmi-capability"),("cdmic","application/cdmi-container"),("cdmid","application/cdmi-domain"),("cdmio","application/cdmi-object"),("cdmiq","application/cdmi-queue"),("cu","application/cu-seeme"),("davmount","application/davmount+xml"),("dbk","application/docbook+xml"),("dssc","application/dssc+der"),("xdssc","application/dssc+xml"),("ecma","application/ecmascript"),("emma","application/emma+xml"),("epub","application/epub+zip"),("exi","application/exi"),("pfr","application/font-tdpfr"),("gml","application/gml+xml"),("gpx","application/gpx+xml"),("gxf","application/gxf"),("stk","application/hyperstudio"),("ink","application/inkml+xml"),("inkml","application/inkml+xml"),("ipfix","application/ipfix"),("jar","application/java-archive"),("ser","application/java-serialized-object"),("class","application/java-vm"),("js","application/javascript"),("json","application/json"),("jsonml","application/jsonml+json"),("lostxml","application/lost+xml"),("hqx","application/mac-binhex40"),("cpt","application/mac-compactpro"),("mads","application/mads+xml"),("mrc","application/marc"),("mrcx","application/marcxml+xml"),("ma","application/mathematica"),("nb","application/mathematica"),("mb","application/mathematica"),("mathml","application/mathml+xml"),("mbox","application/mbox"),("mscml","application/mediaservercontrol+xml"),("metalink","application/metalink+xml"),("meta4","application/metalink4+xml"),("mets","application/mets+xml"),("mods","application/mods+xml"),("m21","application/mp21"),("mp21","application/mp21"),("mp4s","application/mp4"),("doc","application/msword"),("dot","application/msword"),("mxf","application/mxf"),("bin","application/octet-stream"),("dms","application/octet-stream"),("lrf","application/octet-stream"),("mar","application/octet-stream"),("so","application/octet-stream"),("dist","application/octet-stream"),("distz","application/octet-stream"),("pkg","application/octet-stream"),("bpk","application/octet-stream"),("dump","application/octet-stream"),("elc","application/octet-stream"),("deploy","application/octet-stream"),("oda","application/oda"),("opf","application/oebps-package+xml"),("ogx","application/ogg"),("omdoc","application/omdoc+xml"),("onetoc","application/onenote"),("onetoc2","application/onenote"),("onetmp","application/onenote"),("onepkg","application/onenote"),("oxps","application/oxps"),("xer","application/patch-ops-error+xml"),("pdf","application/pdf"),("pgp","application/pgp-encrypted"),("asc","application/pgp-signature"),("sig","application/pgp-signature"),("prf","application/pics-rules"),("p10","application/pkcs10"),("p7m","application/pkcs7-mime"),("p7c","application/pkcs7-mime"),("p7s","application/pkcs7-signature"),("p8","application/pkcs8"),("ac","application/pkix-attr-cert"),("cer","application/pkix-cert"),("crl","application/pkix-crl"),("pkipath","application/pkix-pkipath"),("pki","application/pkixcmp"),("pls","application/pls+xml"),("ai","application/postscript"),("eps","application/postscript"),("ps","application/postscript"),("cww","application/prs.cww"),("pskcxml","application/pskc+xml"),("rdf","application/rdf+xml"),("rif","application/reginfo+xml"),("rnc","application/relax-ng-compact-syntax"),("rl","application/resource-lists+xml"),("rld","application/resource-lists-diff+xml"),("rs","application/rls-services+xml"),("gbr","application/rpki-ghostbusters"),("mft","application/rpki-manifest"),("roa","application/rpki-roa"),("rsd","application/rsd+xml"),("rss","application/rss+xml"),("rtf","application/rtf"),("sbml","application/sbml+xml"),("scq","application/scvp-cv-request"),("scs","application/scvp-cv-response"),("spq","application/scvp-vp-request"),("spp","application/scvp-vp-response"),("sdp","application/sdp"),("setpay","application/set-payment-initiation"),("setreg","application/set-registration-initiation"),("shf","application/shf+xml"),("smi","application/smil+xml"),("smil","application/smil+xml"),("rq","application/sparql-query"),("srx","application/sparql-results+xml"),("gram","application/srgs"),("grxml","application/srgs+xml"),("sru","application/sru+xml"),("ssdl","application/ssdl+xml"),("ssml","application/ssml+xml"),("tei","application/tei+xml"),("teicorpus","application/tei+xml"),("tfi","application/thraud+xml"),("tsd","application/timestamped-data"),("plb","application/vnd.3gpp.pic-bw-large"),("psb","application/vnd.3gpp.pic-bw-small"),("pvb","application/vnd.3gpp.pic-bw-var"),("tcap","application/vnd.3gpp2.tcap"),("pwn","application/vnd.3m.post-it-notes"),("aso","application/vnd.accpac.simply.aso"),("imp","application/vnd.accpac.simply.imp"),("acu","application/vnd.acucobol"),("atc","application/vnd.acucorp"),("acutc","application/vnd.acucorp"),("air","application/vnd.adobe.air-application-installer-package+zip"),("fcdt","application/vnd.adobe.formscentral.fcdt"),("fxp","application/vnd.adobe.fxp"),("fxpl","application/vnd.adobe.fxp"),("xdp","application/vnd.adobe.xdp+xml"),("xfdf","application/vnd.adobe.xfdf"),("ahead","application/vnd.ahead.space"),("azf","application/vnd.airzip.filesecure.azf"),("azs","application/vnd.airzip.filesecure.azs"),("azw","application/vnd.amazon.ebook"),("acc","application/vnd.americandynamics.acc"),("ami","application/vnd.amiga.ami"),("apk","application/vnd.android.package-archive"),("cii","application/vnd.anser-web-certificate-issue-initiation"),("fti","application/vnd.anser-web-funds-transfer-initiation"),("atx","application/vnd.antix.game-component"),("mpkg","application/vnd.apple.installer+xml"),("m3u8","application/vnd.apple.mpegurl"),("swi","application/vnd.aristanetworks.swi"),("iota","application/vnd.astraea-software.iota"),("aep","application/vnd.audiograph"),("mpm","application/vnd.blueice.multipass"),("bmi","application/vnd.bmi"),("rep","application/vnd.businessobjects"),("cdxml","application/vnd.chemdraw+xml"),("mmd","application/vnd.chipnuts.karaoke-mmd"),("cdy","application/vnd.cinderella"),("cla","application/vnd.claymore"),("rp9","application/vnd.cloanto.rp9"),("c4g","application/vnd.clonk.c4group"),("c4d","application/vnd.clonk.c4group"),("c4f","application/vnd.clonk.c4group"),("c4p","application/vnd.clonk.c4group"),("c4u","application/vnd.clonk.c4group"),("c11amc","application/vnd.cluetrust.cartomobile-config"),("c11amz","application/vnd.cluetrust.cartomobile-config-pkg"),("csp","application/vnd.commonspace"),("cdbcmsg","application/vnd.contact.cmsg"),("cmc","application/vnd.cosmocaller"),("clkx","application/vnd.crick.clicker"),("clkk","application/vnd.crick.clicker.keyboard"),("clkp","application/vnd.crick.clicker.palette"),("clkt","application/vnd.crick.clicker.template"),("clkw","application/vnd.crick.clicker.wordbank"),("wbs","application/vnd.criticaltools.wbs+xml"),("pml","application/vnd.ctc-posml"),("ppd","application/vnd.cups-ppd"),("car","application/vnd.curl.car"),("pcurl","application/vnd.curl.pcurl"),("dart","application/vnd.dart"),("rdz","application/vnd.data-vision.rdz"),("uvf","application/vnd.dece.data"),("uvvf","application/vnd.dece.data"),("uvd","application/vnd.dece.data"),("uvvd","application/vnd.dece.data"),("uvt","application/vnd.dece.ttml+xml"),("uvvt","application/vnd.dece.ttml+xml"),("uvx","application/vnd.dece.unspecified"),("uvvx","application/vnd.dece.unspecified"),("uvz","application/vnd.dece.zip"),("uvvz","application/vnd.dece.zip"),("fe_launch","application/vnd.denovo.fcselayout-link"),("dna","application/vnd.dna"),("mlp","application/vnd.dolby.mlp"),("dpg","application/vnd.dpgraph"),("dfac","application/vnd.dreamfactory"),("kpxx","application/vnd.ds-keypoint"),("ait","application/vnd.dvb.ait"),("svc","application/vnd.dvb.service"),("geo","application/vnd.dynageo"),("mag","application/vnd.ecowin.chart"),("nml","application/vnd.enliven"),("esf","application/vnd.epson.esf"),("msf","application/vnd.epson.msf"),("qam","application/vnd.epson.quickanime"),("slt","application/vnd.epson.salt"),("ssf","application/vnd.epson.ssf"),("es3","application/vnd.eszigno3+xml"),("et3","application/vnd.eszigno3+xml"),("ez2","application/vnd.ezpix-album"),("ez3","application/vnd.ezpix-package"),("fdf","application/vnd.fdf"),("mseed","application/vnd.fdsn.mseed"),("seed","application/vnd.fdsn.seed"),("dataless","application/vnd.fdsn.seed"),("gph","application/vnd.flographit"),("ftc","application/vnd.fluxtime.clip"),("fm","application/vnd.framemaker"),("frame","application/vnd.framemaker"),("maker","application/vnd.framemaker"),("book","application/vnd.framemaker"),("fnc","application/vnd.frogans.fnc"),("ltf","application/vnd.frogans.ltf"),("fsc","application/vnd.fsc.weblaunch"),("oas","application/vnd.fujitsu.oasys"),("oa2","application/vnd.fujitsu.oasys2"),("oa3","application/vnd.fujitsu.oasys3"),("fg5","application/vnd.fujitsu.oasysgp"),("bh2","application/vnd.fujitsu.oasysprs"),("ddd","application/vnd.fujixerox.ddd"),("xdw","application/vnd.fujixerox.docuworks"),("xbd","application/vnd.fujixerox.docuworks.binder"),("fzs","application/vnd.fuzzysheet"),("txd","application/vnd.genomatix.tuxedo"),("ggb","application/vnd.geogebra.file"),("ggt","application/vnd.geogebra.tool"),("gex","application/vnd.geometry-explorer"),("gre","application/vnd.geometry-explorer"),("gxt","application/vnd.geonext"),("g2w","application/vnd.geoplan"),("g3w","application/vnd.geospace"),("gmx","application/vnd.gmx"),("kml","application/vnd.google-earth.kml+xml"),("kmz","application/vnd.google-earth.kmz"),("gqf","application/vnd.grafeq"),("gqs","application/vnd.grafeq"),("gac","application/vnd.groove-account"),("ghf","application/vnd.groove-help"),("gim","application/vnd.groove-identity-message"),("grv","application/vnd.groove-injector"),("gtm","application/vnd.groove-tool-message"),("tpl","application/vnd.groove-tool-template"),("vcg","application/vnd.groove-vcard"),("hal","application/vnd.hal+xml"),("zmm","application/vnd.handheld-entertainment+xml"),("hbci","application/vnd.hbci"),("les","application/vnd.hhe.lesson-player"),("hpgl","application/vnd.hp-hpgl"),("hpid","application/vnd.hp-hpid"),("hps","application/vnd.hp-hps"),("jlt","application/vnd.hp-jlyt"),("pcl","application/vnd.hp-pcl"),("pclxl","application/vnd.hp-pclxl"),("sfd-hdstx","application/vnd.hydrostatix.sof-data"),("mpy","application/vnd.ibm.minipay"),("afp","application/vnd.ibm.modcap"),("listafp","application/vnd.ibm.modcap"),("list3820","application/vnd.ibm.modcap"),("irm","application/vnd.ibm.rights-management"),("sc","application/vnd.ibm.secure-container"),("icc","application/vnd.iccprofile"),("icm","application/vnd.iccprofile"),("igl","application/vnd.igloader"),("ivp","application/vnd.immervision-ivp"),("ivu","application/vnd.immervision-ivu"),("igm","application/vnd.insors.igm"),("xpw","application/vnd.intercon.formnet"),("xpx","application/vnd.intercon.formnet"),("i2g","application/vnd.intergeo"),("qbo","application/vnd.intu.qbo"),("qfx","application/vnd.intu.qfx"),("rcprofile","application/vnd.ipunplugged.rcprofile"),("irp","application/vnd.irepository.package+xml"),("xpr","application/vnd.is-xpr"),("fcs","application/vnd.isac.fcs"),("jam","application/vnd.jam"),("rms","application/vnd.jcp.javame.midlet-rms"),("jisp","application/vnd.jisp"),("joda","application/vnd.joost.joda-archive"),("ktz","application/vnd.kahootz"),("ktr","application/vnd.kahootz"),("karbon","application/vnd.kde.karbon"),("chrt","application/vnd.kde.kchart"),("kfo","application/vnd.kde.kformula"),("flw","application/vnd.kde.kivio"),("kon","application/vnd.kde.kontour"),("kpr","application/vnd.kde.kpresenter"),("kpt","application/vnd.kde.kpresenter"),("ksp","application/vnd.kde.kspread"),("kwd","application/vnd.kde.kword"),("kwt","application/vnd.kde.kword"),("htke","application/vnd.kenameaapp"),("kia","application/vnd.kidspiration"),("kne","application/vnd.kinar"),("knp","application/vnd.kinar"),("skp","application/vnd.koan"),("skd","application/vnd.koan"),("skt","application/vnd.koan"),("skm","application/vnd.koan"),("sse","application/vnd.kodak-descriptor"),("lasxml","application/vnd.las.las+xml"),("lbd","application/vnd.llamagraphics.life-balance.desktop"),("lbe","application/vnd.llamagraphics.life-balance.exchange+xml"),("123","application/vnd.lotus-1-2-3"),("apr","application/vnd.lotus-approach"),("pre","application/vnd.lotus-freelance"),("nsf","application/vnd.lotus-notes"),("org","application/vnd.lotus-organizer"),("scm","application/vnd.lotus-screencam"),("lwp","application/vnd.lotus-wordpro"),("portpkg","application/vnd.macports.portpkg"),("mcd","application/vnd.mcd"),("mc1","application/vnd.medcalcdata"),("cdkey","application/vnd.mediastation.cdkey"),("mwf","application/vnd.mfer"),("mfm","application/vnd.mfmp"),("flo","application/vnd.micrografx.flo"),("igx","application/vnd.micrografx.igx"),("mif","application/vnd.mif"),("daf","application/vnd.mobius.daf"),("dis","application/vnd.mobius.dis"),("mbk","application/vnd.mobius.mbk"),("mqy","application/vnd.mobius.mqy"),("msl","application/vnd.mobius.msl"),("plc","application/vnd.mobius.plc"),("txf","application/vnd.mobius.txf"),("mpn","application/vnd.mophun.application"),("mpc","application/vnd.mophun.certificate"),("xul","application/vnd.mozilla.xul+xml"),("cil","application/vnd.ms-artgalry"),("cab","application/vnd.ms-cab-compressed"),("xls","application/vnd.ms-excel"),("xlm","application/vnd.ms-excel"),("xla","application/vnd.ms-excel"),("xlc","application/vnd.ms-excel"),("xlt","application/vnd.ms-excel"),("xlw","application/vnd.ms-excel"),("xlam","application/vnd.ms-excel.addin.macroenabled.12"),("xlsb","application/vnd.ms-excel.sheet.binary.macroenabled.12"),("xlsm","application/vnd.ms-excel.sheet.macroenabled.12"),("xltm","application/vnd.ms-excel.template.macroenabled.12"),("eot","application/vnd.ms-fontobject"),("chm","application/vnd.ms-htmlhelp"),("ims","application/vnd.ms-ims"),("lrm","application/vnd.ms-lrm"),("thmx","application/vnd.ms-officetheme"),("cat","application/vnd.ms-pki.seccat"),("stl","application/vnd.ms-pki.stl"),("ppt","application/vnd.ms-powerpoint"),("pps","application/vnd.ms-powerpoint"),("pot","application/vnd.ms-powerpoint"),("ppam","application/vnd.ms-powerpoint.addin.macroenabled.12"),("pptm","application/vnd.ms-powerpoint.presentation.macroenabled.12"),("sldm","application/vnd.ms-powerpoint.slide.macroenabled.12"),("ppsm","application/vnd.ms-powerpoint.slideshow.macroenabled.12"),("potm","application/vnd.ms-powerpoint.template.macroenabled.12"),("mpp","application/vnd.ms-project"),("mpt","application/vnd.ms-project"),("docm","application/vnd.ms-word.document.macroenabled.12"),("dotm","application/vnd.ms-word.template.macroenabled.12"),("wps","application/vnd.ms-works"),("wks","application/vnd.ms-works"),("wcm","application/vnd.ms-works"),("wdb","application/vnd.ms-works"),("wpl","application/vnd.ms-wpl"),("xps","application/vnd.ms-xpsdocument"),("mseq","application/vnd.mseq"),("mus","application/vnd.musician"),("msty","application/vnd.muvee.style"),("taglet","application/vnd.mynfc"),("nlu","application/vnd.neurolanguage.nlu"),("ntf","application/vnd.nitf"),("nitf","application/vnd.nitf"),("nnd","application/vnd.noblenet-directory"),("nns","application/vnd.noblenet-sealer"),("nnw","application/vnd.noblenet-web"),("ngdat","application/vnd.nokia.n-gage.data"),("n-gage","application/vnd.nokia.n-gage.symbian.install"),("rpst","application/vnd.nokia.radio-preset"),("rpss","application/vnd.nokia.radio-presets"),("edm","application/vnd.novadigm.edm"),("edx","application/vnd.novadigm.edx"),("ext","application/vnd.novadigm.ext"),("odc","application/vnd.oasis.opendocument.chart"),("otc","application/vnd.oasis.opendocument.chart-template"),("odb","application/vnd.oasis.opendocument.database"),("odf","application/vnd.oasis.opendocument.formula"),("odft","application/vnd.oasis.opendocument.formula-template"),("odg","application/vnd.oasis.opendocument.graphics"),("otg","application/vnd.oasis.opendocument.graphics-template"),("odi","application/vnd.oasis.opendocument.image"),("oti","application/vnd.oasis.opendocument.image-template"),("odp","application/vnd.oasis.opendocument.presentation"),("otp","application/vnd.oasis.opendocument.presentation-template"),("ods","application/vnd.oasis.opendocument.spreadsheet"),("ots","application/vnd.oasis.opendocument.spreadsheet-template"),("odt","application/vnd.oasis.opendocument.text"),("odm","application/vnd.oasis.opendocument.text-master"),("ott","application/vnd.oasis.opendocument.text-template"),("oth","application/vnd.oasis.opendocument.text-web"),("xo","application/vnd.olpc-sugar"),("dd2","application/vnd.oma.dd2+xml"),("oxt","application/vnd.openofficeorg.extension"),("pptx","application/vnd.openxmlformats-officedocument.presentationml.presentation"),("sldx","application/vnd.openxmlformats-officedocument.presentationml.slide"),("ppsx","application/vnd.openxmlformats-officedocument.presentationml.slideshow"),("potx","application/vnd.openxmlformats-officedocument.presentationml.template"),("xlsx","application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"),("xltx","application/vnd.openxmlformats-officedocument.spreadsheetml.template"),("docx","application/vnd.openxmlformats-officedocument.wordprocessingml.document"),("dotx","application/vnd.openxmlformats-officedocument.wordprocessingml.template"),("mgp","application/vnd.osgeo.mapguide.package"),("dp","application/vnd.osgi.dp"),("esa","application/vnd.osgi.subsystem"),("pdb","application/vnd.palm"),("pqa","application/vnd.palm"),("oprc","application/vnd.palm"),("paw","application/vnd.pawaafile"),("str","application/vnd.pg.format"),("ei6","application/vnd.pg.osasli"),("efif","application/vnd.picsel"),("wg","application/vnd.pmi.widget"),("plf","application/vnd.pocketlearn"),("pbd","application/vnd.powerbuilder6"),("box","application/vnd.previewsystems.box"),("mgz","application/vnd.proteus.magazine"),("qps","application/vnd.publishare-delta-tree"),("ptid","application/vnd.pvi.ptid1"),("qxd","application/vnd.quark.quarkxpress"),("qxt","application/vnd.quark.quarkxpress"),("qwd","application/vnd.quark.quarkxpress"),("qwt","application/vnd.quark.quarkxpress"),("qxl","application/vnd.quark.quarkxpress"),("qxb","application/vnd.quark.quarkxpress"),("bed","application/vnd.realvnc.bed"),("mxl","application/vnd.recordare.musicxml"),("musicxml","application/vnd.recordare.musicxml+xml"),("cryptonote","application/vnd.rig.cryptonote"),("cod","application/vnd.rim.cod"),("rm","application/vnd.rn-realmedia"),("rmvb","application/vnd.rn-realmedia-vbr"),("link66","application/vnd.route66.link66+xml"),("st","application/vnd.sailingtracker.track"),("see","application/vnd.seemail"),("sema","application/vnd.sema"),("semd","application/vnd.semd"),("semf","application/vnd.semf"),("ifm","application/vnd.shana.informed.formdata"),("itp","application/vnd.shana.informed.formtemplate"),("iif","application/vnd.shana.informed.interchange"),("ipk","application/vnd.shana.informed.package"),("twd","application/vnd.simtech-mindmapper"),("twds","application/vnd.simtech-mindmapper"),("mmf","application/vnd.smaf"),("teacher","application/vnd.smart.teacher"),("sdkm","application/vnd.solent.sdkm+xml"),("sdkd","application/vnd.solent.sdkm+xml"),("dxp","application/vnd.spotfire.dxp"),("sfs","application/vnd.spotfire.sfs"),("sdc","application/vnd.stardivision.calc"),("sda","application/vnd.stardivision.draw"),("sdd","application/vnd.stardivision.impress"),("smf","application/vnd.stardivision.math"),("sdw","application/vnd.stardivision.writer"),("vor","application/vnd.stardivision.writer"),("sgl","application/vnd.stardivision.writer-global"),("smzip","application/vnd.stepmania.package"),("sm","application/vnd.stepmania.stepchart"),("sxc","application/vnd.sun.xml.calc"),("stc","application/vnd.sun.xml.calc.template"),("sxd","application/vnd.sun.xml.draw"),("std","application/vnd.sun.xml.draw.template"),("sxi","application/vnd.sun.xml.impress"),("sti","application/vnd.sun.xml.impress.template"),("sxm","application/vnd.sun.xml.math"),("sxw","application/vnd.sun.xml.writer"),("sxg","application/vnd.sun.xml.writer.global"),("stw","application/vnd.sun.xml.writer.template"),("sus","application/vnd.sus-calendar"),("susp","application/vnd.sus-calendar"),("svd","application/vnd.svd"),("sis","application/vnd.symbian.install"),("sisx","application/vnd.symbian.install"),("xsm","application/vnd.syncml+xml"),("bdm","application/vnd.syncml.dm+wbxml"),("xdm","application/vnd.syncml.dm+xml"),("tao","application/vnd.tao.intent-module-archive"),("pcap","application/vnd.tcpdump.pcap"),("cap","application/vnd.tcpdump.pcap"),("dmp","application/vnd.tcpdump.pcap"),("tmo","application/vnd.tmobile-livetv"),("tpt","application/vnd.trid.tpt"),("mxs","application/vnd.triscape.mxs"),("tra","application/vnd.trueapp"),("ufd","application/vnd.ufdl"),("ufdl","application/vnd.ufdl"),("utz","application/vnd.uiq.theme"),("umj","application/vnd.umajin"),("unityweb","application/vnd.unity"),("uoml","application/vnd.uoml+xml"),("vcx","application/vnd.vcx"),("vsd","application/vnd.visio"),("vst","application/vnd.visio"),("vss","application/vnd.visio"),("vsw","application/vnd.visio"),("vis","application/vnd.visionary"),("vsf","application/vnd.vsf"),("wbxml","application/vnd.wap.wbxml"),("wmlc","application/vnd.wap.wmlc"),("wmlsc","application/vnd.wap.wmlscriptc"),("wtb","application/vnd.webturbo"),("nbp","application/vnd.wolfram.player"),("wpd","application/vnd.wordperfect"),("wqd","application/vnd.wqd"),("stf","application/vnd.wt.stf"),("xar","application/vnd.xara"),("xfdl","application/vnd.xfdl"),("hvd","application/vnd.yamaha.hv-dic"),("hvs","application/vnd.yamaha.hv-script"),("hvp","application/vnd.yamaha.hv-voice"),("osf","application/vnd.yamaha.openscoreformat"),("osfpvg","application/vnd.yamaha.openscoreformat.osfpvg+xml"),("saf","application/vnd.yamaha.smaf-audio"),("spf","application/vnd.yamaha.smaf-phrase"),("cmp","application/vnd.yellowriver-custom-menu"),("zir","application/vnd.zul"),("zirz","application/vnd.zul"),("zaz","application/vnd.zzazz.deck+xml"),("vxml","application/voicexml+xml"),("wgt","application/widget"),("hlp","application/winhlp"),("wsdl","application/wsdl+xml"),("wspolicy","application/wspolicy+xml"),("7z","application/x-7z-compressed"),("abw","application/x-abiword"),("ace","application/x-ace-compressed"),("dmg","application/x-apple-diskimage"),("aab","application/x-authorware-bin"),("x32","application/x-authorware-bin"),("u32","application/x-authorware-bin"),("vox","application/x-authorware-bin"),("aam","application/x-authorware-map"),("aas","application/x-authorware-seg"),("bcpio","application/x-bcpio"),("torrent","application/x-bittorrent"),("blb","application/x-blorb"),("blorb","application/x-blorb"),("bz","application/x-bzip"),("bz2","application/x-bzip2"),("boz","application/x-bzip2"),("cbr","application/x-cbr"),("cba","application/x-cbr"),("cbt","application/x-cbr"),("cbz","application/x-cbr"),("cb7","application/x-cbr"),("vcd","application/x-cdlink"),("cfs","application/x-cfs-compressed"),("chat","application/x-chat"),("pgn","application/x-chess-pgn"),("nsc","application/x-conference"),("cpio","application/x-cpio"),("csh","application/x-csh"),("deb","application/x-debian-package"),("udeb","application/x-debian-package"),("dgc","application/x-dgc-compressed"),("dir","application/x-director"),("dcr","application/x-director"),("dxr","application/x-director"),("cst","application/x-director"),("cct","application/x-director"),("cxt","application/x-director"),("w3d","application/x-director"),("fgd","application/x-director"),("swa","application/x-director"),("wad","application/x-doom"),("ncx","application/x-dtbncx+xml"),("dtb","application/x-dtbook+xml"),("res","application/x-dtbresource+xml"),("dvi","application/x-dvi"),("evy","application/x-envoy"),("eva","application/x-eva"),("bdf","application/x-font-bdf"),("gsf","application/x-font-ghostscript"),("psf","application/x-font-linux-psf"),("pcf","application/x-font-pcf"),("snf","application/x-font-snf"),("pfa","application/x-font-type1"),("pfb","application/x-font-type1"),("pfm","application/x-font-type1"),("afm","application/x-font-type1"),("arc","application/x-freearc"),("spl","application/x-futuresplash"),("gca","application/x-gca-compressed"),("ulx","application/x-glulx"),("gnumeric","application/x-gnumeric"),("gramps","application/x-gramps-xml"),("gtar","application/x-gtar"),("hdf","application/x-hdf"),("install","application/x-install-instructions"),("iso","application/x-iso9660-image"),("jnlp","application/x-java-jnlp-file"),("latex","application/x-latex"),("lzh","application/x-lzh-compressed"),("lha","application/x-lzh-compressed"),("mie","application/x-mie"),("prc","application/x-mobipocket-ebook"),("mobi","application/x-mobipocket-ebook"),("application","application/x-ms-application"),("lnk","application/x-ms-shortcut"),("wmd","application/x-ms-wmd"),("wmz","application/x-ms-wmz"),("xbap","application/x-ms-xbap"),("mdb","application/x-msaccess"),("obd","application/x-msbinder"),("crd","application/x-mscardfile"),("clp","application/x-msclip"),("exe","application/x-msdownload"),("dll","application/x-msdownload"),("com","application/x-msdownload"),("bat","application/x-msdownload"),("msi","application/x-msdownload"),("mvb","application/x-msmediaview"),("m13","application/x-msmediaview"),("m14","application/x-msmediaview"),("wmf","application/x-msmetafile"),("wmz","application/x-msmetafile"),("emf","application/x-msmetafile"),("emz","application/x-msmetafile"),("mny","application/x-msmoney"),("pub","application/x-mspublisher"),("scd","application/x-msschedule"),("trm","application/x-msterminal"),("wri","application/x-mswrite"),("nc","application/x-netcdf"),("cdf","application/x-netcdf"),("nzb","application/x-nzb"),("p12","application/x-pkcs12"),("pfx","application/x-pkcs12"),("p7b","application/x-pkcs7-certificates"),("spc","application/x-pkcs7-certificates"),("p7r","application/x-pkcs7-certreqresp"),("rar","application/x-rar-compressed"),("ris","application/x-research-info-systems"),("sh","application/x-sh"),("shar","application/x-shar"),("swf","application/x-shockwave-flash"),("xap","application/x-silverlight-app"),("sql","application/x-sql"),("sit","application/x-stuffit"),("sitx","application/x-stuffitx"),("srt","application/x-subrip"),("sv4cpio","application/x-sv4cpio"),("sv4crc","application/x-sv4crc"),("t3","application/x-t3vm-image"),("gam","application/x-tads"),("tar","application/x-tar"),("tcl","application/x-tcl"),("tex","application/x-tex"),("tfm","application/x-tex-tfm"),("texinfo","application/x-texinfo"),("texi","application/x-texinfo"),("obj","application/x-tgif"),("ustar","application/x-ustar"),("src","application/x-wais-source"),("der","application/x-x509-ca-cert"),("crt","application/x-x509-ca-cert"),("fig","application/x-xfig"),("xlf","application/x-xliff+xml"),("xpi","application/x-xpinstall"),("xz","application/x-xz"),("z1","application/x-zmachine"),("z2","application/x-zmachine"),("z3","application/x-zmachine"),("z4","application/x-zmachine"),("z5","application/x-zmachine"),("z6","application/x-zmachine"),("z7","application/x-zmachine"),("z8","application/x-zmachine"),("xaml","application/xaml+xml"),("xdf","application/xcap-diff+xml"),("xenc","application/xenc+xml"),("xhtml","application/xhtml+xml"),("xht","application/xhtml+xml"),("xml","application/xml"),("xsl","application/xml"),("dtd","application/xml-dtd"),("xop","application/xop+xml"),("xpl","application/xproc+xml"),("xslt","application/xslt+xml"),("xspf","application/xspf+xml"),("mxml","application/xv+xml"),("xhvml","application/xv+xml"),("xvml","application/xv+xml"),("xvm","application/xv+xml"),("yang","application/yang"),("yin","application/yin+xml"),("zip","application/zip"),("adp","audio/adpcm"),("au","audio/basic"),("snd","audio/basic"),("mid","audio/midi"),("midi","audio/midi"),("kar","audio/midi"),("rmi","audio/midi"),("m4a","audio/mp4"),("mp4a","audio/mp4"),("mpga","audio/mpeg"),("mp2","audio/mpeg"),("mp2a","audio/mpeg"),("mp3","audio/mpeg"),("m2a","audio/mpeg"),("m3a","audio/mpeg"),("oga","audio/ogg"),("ogg","audio/ogg"),("spx","audio/ogg"),("s3m","audio/s3m"),("sil","audio/silk"),("uva","audio/vnd.dece.audio"),("uvva","audio/vnd.dece.audio"),("eol","audio/vnd.digital-winds"),("dra","audio/vnd.dra"),("dts","audio/vnd.dts"),("dtshd","audio/vnd.dts.hd"),("lvp","audio/vnd.lucent.voice"),("pya","audio/vnd.ms-playready.media.pya"),("ecelp4800","audio/vnd.nuera.ecelp4800"),("ecelp7470","audio/vnd.nuera.ecelp7470"),("ecelp9600","audio/vnd.nuera.ecelp9600"),("rip","audio/vnd.rip"),("weba","audio/webm"),("aac","audio/x-aac"),("aif","audio/x-aiff"),("aiff","audio/x-aiff"),("aifc","audio/x-aiff"),("caf","audio/x-caf"),("flac","audio/x-flac"),("mka","audio/x-matroska"),("m3u","audio/x-mpegurl"),("wax","audio/x-ms-wax"),("wma","audio/x-ms-wma"),("ram","audio/x-pn-realaudio"),("ra","audio/x-pn-realaudio"),("rmp","audio/x-pn-realaudio-plugin"),("wav","audio/x-wav"),("xm","audio/xm"),("cdx","chemical/x-cdx"),("cif","chemical/x-cif"),("cmdf","chemical/x-cmdf"),("cml","chemical/x-cml"),("csml","chemical/x-csml"),("xyz","chemical/x-xyz"),("ttc","font/collection"),("otf","font/otf"),("ttf","font/ttf"),("woff","font/woff"),("woff2","font/woff2"),("bmp","image/bmp"),("cgm","image/cgm"),("g3","image/g3fax"),("gif","image/gif"),("ief","image/ief"),("jpeg","image/jpeg"),("jpg","image/jpeg"),("jpe","image/jpeg"),("ktx","image/ktx"),("png","image/png"),("btif","image/prs.btif"),("sgi","image/sgi"),("svg","image/svg+xml"),("svgz","image/svg+xml"),("tiff","image/tiff"),("tif","image/tiff"),("psd","image/vnd.adobe.photoshop"),("uvi","image/vnd.dece.graphic"),("uvvi","image/vnd.dece.graphic"),("uvg","image/vnd.dece.graphic"),("uvvg","image/vnd.dece.graphic"),("djvu","image/vnd.djvu"),("djv","image/vnd.djvu"),("sub","image/vnd.dvb.subtitle"),("dwg","image/vnd.dwg"),("dxf","image/vnd.dxf"),("fbs","image/vnd.fastbidsheet"),("fpx","image/vnd.fpx"),("fst","image/vnd.fst"),("mmr","image/vnd.fujixerox.edmics-mmr"),("rlc","image/vnd.fujixerox.edmics-rlc"),("mdi","image/vnd.ms-modi"),("wdp","image/vnd.ms-photo"),("npx","image/vnd.net-fpx"),("wbmp","image/vnd.wap.wbmp"),("xif","image/vnd.xiff"),("webp","image/webp"),("3ds","image/x-3ds"),("ras","image/x-cmu-raster"),("cmx","image/x-cmx"),("fh","image/x-freehand"),("fhc","image/x-freehand"),("fh4","image/x-freehand"),("fh5","image/x-freehand"),("fh7","image/x-freehand"),("ico","image/x-icon"),("sid","image/x-mrsid-image"),("pcx","image/x-pcx"),("pic","image/x-pict"),("pct","image/x-pict"),("pnm","image/x-portable-anymap"),("pbm","image/x-portable-bitmap"),("pgm","image/x-portable-graymap"),("ppm","image/x-portable-pixmap"),("rgb","image/x-rgb"),("tga","image/x-tga"),("xbm","image/x-xbitmap"),("xpm","image/x-xpixmap"),("xwd","image/x-xwindowdump"),("eml","message/rfc822"),("mime","message/rfc822"),("igs","model/iges"),("iges","model/iges"),("msh","model/mesh"),("mesh","model/mesh"),("silo","model/mesh"),("dae","model/vnd.collada+xml"),("dwf","model/vnd.dwf"),("gdl","model/vnd.gdl"),("gtw","model/vnd.gtw"),("mts","model/vnd.mts"),("vtu","model/vnd.vtu"),("wrl","model/vrml"),("vrml","model/vrml"),("x3db","model/x3d+binary"),("x3dbz","model/x3d+binary"),("x3dv","model/x3d+vrml"),("x3dvz","model/x3d+vrml"),("x3d","model/x3d+xml"),("x3dz","model/x3d+xml"),("appcache","text/cache-manifest"),("ics","text/calendar"),("ifb","text/calendar"),("css","text/css"),("csv","text/csv"),("html","text/html"),("htm","text/html"),("n3","text/n3"),("txt","text/plain"),("text","text/plain"),("conf","text/plain"),("def","text/plain"),("list","text/plain"),("log","text/plain"),("in","text/plain"),("dsc","text/prs.lines.tag"),("rtx","text/richtext"),("sgml","text/sgml"),("sgm","text/sgml"),("tsv","text/tab-separated-values"),("t","text/troff"),("tr","text/troff"),("roff","text/troff"),("man","text/troff"),("me","text/troff"),("ms","text/troff"),("ttl","text/turtle"),("uri","text/uri-list"),("uris","text/uri-list"),("urls","text/uri-list"),("vcard","text/vcard"),("curl","text/vnd.curl"),("dcurl","text/vnd.curl.dcurl"),("mcurl","text/vnd.curl.mcurl"),("scurl","text/vnd.curl.scurl"),("sub","text/vnd.dvb.subtitle"),("fly","text/vnd.fly"),("flx","text/vnd.fmi.flexstor"),("gv","text/vnd.graphviz"),("3dml","text/vnd.in3d.3dml"),("spot","text/vnd.in3d.spot"),("jad","text/vnd.sun.j2me.app-descriptor"),("wml","text/vnd.wap.wml"),("wmls","text/vnd.wap.wmlscript"),("s","text/x-asm"),("asm","text/x-asm"),("c","text/x-c"),("cc","text/x-c"),("cxx","text/x-c"),("cpp","text/x-c"),("h","text/x-c"),("hh","text/x-c"),("dic","text/x-c"),("f","text/x-fortran"),("for","text/x-fortran"),("f77","text/x-fortran"),("f90","text/x-fortran"),("java","text/x-java-source"),("nfo","text/x-nfo"),("opml","text/x-opml"),("p","text/x-pascal"),("pas","text/x-pascal"),("etx","text/x-setext"),("sfv","text/x-sfv"),("uu","text/x-uuencode"),("vcs","text/x-vcalendar"),("vcf","text/x-vcard"),("3gp","video/3gpp"),("3g2","video/3gpp2"),("h261","video/h261"),("h263","video/h263"),("h264","video/h264"),("jpgv","video/jpeg"),("jpm","video/jpm"),("jpgm","video/jpm"),("mj2","video/mj2"),("mjp2","video/mj2"),("mp4","video/mp4"),("mp4v","video/mp4"),("mpg4","video/mp4"),("mpeg","video/mpeg"),("mpg","video/mpeg"),("mpe","video/mpeg"),("m1v","video/mpeg"),("m2v","video/mpeg"),("ogv","video/ogg"),("qt","video/quicktime"),("mov","video/quicktime"),("uvh","video/vnd.dece.hd"),("uvvh","video/vnd.dece.hd"),("uvm","video/vnd.dece.mobile"),("uvvm","video/vnd.dece.mobile"),("uvp","video/vnd.dece.pd"),("uvvp","video/vnd.dece.pd"),("uvs","video/vnd.dece.sd"),("uvvs","video/vnd.dece.sd"),("uvv","video/vnd.dece.video"),("uvvv","video/vnd.dece.video"),("dvb","video/vnd.dvb.file"),("fvt","video/vnd.fvt"),("mxu","video/vnd.mpegurl"),("m4u","video/vnd.mpegurl"),("pyv","video/vnd.ms-playready.media.pyv"),("uvu","video/vnd.uvvu.mp4"),("uvvu","video/vnd.uvvu.mp4"),("viv","video/vnd.vivo"),("webm","video/webm"),("f4v","video/x-f4v"),("fli","video/x-fli"),("flv","video/x-flv"),("m4v","video/x-m4v"),("mkv","video/x-matroska"),("mk3d","video/x-matroska"),("mks","video/x-matroska"),("mng","video/x-mng"),("asf","video/x-ms-asf"),("asx","video/x-ms-asf"),("vob","video/x-ms-vob"),("wm","video/x-ms-wm"),("wmv","video/x-ms-wmv"),("wmx","video/x-ms-wmx"),("wvx","video/x-ms-wvx"),("avi","video/x-msvideo"),("movie","video/x-sgi-movie"),("smv","video/x-smv"),("ice","x-conference/x-cooltalk")] diff --git a/src/Happstack/Server/I18N.hs b/src/Happstack/Server/I18N.hs --- a/src/Happstack/Server/I18N.hs +++ b/src/Happstack/Server/I18N.hs @@ -1,9 +1,7 @@ -module Happstack.Server.I18N +module Happstack.Server.I18N ( acceptLanguage , bestLanguage ) where - -import Control.Applicative ((<$>)) import Control.Arrow ((>>>), first, second) import Data.Function (on) diff --git a/src/Happstack/Server/Internal/Clock.hs b/src/Happstack/Server/Internal/Clock.hs --- a/src/Happstack/Server/Internal/Clock.hs +++ b/src/Happstack/Server/Internal/Clock.hs @@ -7,22 +7,14 @@ , formatHttpDate ) where -import Control.Applicative ((<$>)) import Control.Concurrent import Control.Monad +import qualified Data.ByteString.Char8 as B import Data.IORef import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime) -import System.IO.Unsafe - -#if MIN_VERSION_time(1,5,0) import Data.Time.Format (formatTime, defaultTimeLocale) -#else -import Data.Time.Format (formatTime) -import System.Locale (defaultTimeLocale) -#endif - -import qualified Data.ByteString.Char8 as B +import System.IO.Unsafe data DateCache = DateCache { cachedPOSIXTime :: !(IORef POSIXTime) diff --git a/src/Happstack/Server/Internal/Compression.hs b/src/Happstack/Server/Internal/Compression.hs --- a/src/Happstack/Server/Internal/Compression.hs +++ b/src/Happstack/Server/Internal/Compression.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-} +{-# LANGUAGE CPP,NoMonomorphismRestriction, FlexibleContexts #-} -- | Filter for compressing the 'Response' body. module Happstack.Server.Internal.Compression ( compressedResponseFilter @@ -14,6 +14,9 @@ import Happstack.Server.SimpleHTTP import Text.ParserCombinators.Parsec import Control.Monad +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail (MonadFail) +#endif import Data.Maybe import Data.List import qualified Data.ByteString.Char8 as BS @@ -32,7 +35,7 @@ -- > simpleHTTP nullConf $ -- > do str <- compressedResponseFilter -- > return $ toResponse ("This response compressed using: " ++ str) -compressedResponseFilter :: (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m) => +compressedResponseFilter :: (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m, MonadFail m) => m String -- ^ name of the encoding chosen compressedResponseFilter = compressedResponseFilter' standardEncodingHandlers @@ -65,7 +68,7 @@ -- > str <- compressedResponseFilter' -- > return $ toResponse ("This response compressed using: " ++ str) compressedResponseFilter' :: - (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m) + (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m, MonadFail m) => [(String, String -> Bool -> m ())] -- ^ compression filter assoc list -> m String -- ^ name of the encoding chosen compressedResponseFilter' encodingHandlers = do @@ -84,7 +87,7 @@ Right encs@(a:_) -> return (a , "identity" `elem` encs - , fromMaybe (fail badEncoding) + , fromMaybe (\ _ _ -> fail badEncoding) (lookup a encodingHandlers) ) Right [] -> fail badEncoding @@ -126,7 +129,7 @@ -- | compression filter for the * encoding -- -- This filter always fails. -starFilter :: (FilterMonad Response m) => +starFilter :: (FilterMonad Response m, MonadFail m) => String -- ^ encoding to use for Content-Encoding header -> Bool -- ^ fallback to identity for SendFile (irrelavant for this filter) -> m () @@ -202,7 +205,7 @@ -- e.g. -- -- > [("gzip", gzipFilter), ("identity", identityFilter), ("*",starFilter)] -standardEncodingHandlers :: (FilterMonad Response m) => +standardEncodingHandlers :: (FilterMonad Response m, MonadFail m) => [(String, String -> Bool -> m ())] standardEncodingHandlers = zip standardEncodings handlers @@ -217,7 +220,7 @@ ,"*" ] -handlers::(FilterMonad Response m) => [String -> Bool -> m ()] +handlers::(FilterMonad Response m, MonadFail m) => [String -> Bool -> m ()] handlers = [ gzipFilter , gzipFilter diff --git a/src/Happstack/Server/Internal/Cookie.hs b/src/Happstack/Server/Internal/Cookie.hs --- a/src/Happstack/Server/Internal/Cookie.hs +++ b/src/Happstack/Server/Internal/Cookie.hs @@ -4,6 +4,7 @@ module Happstack.Server.Internal.Cookie ( Cookie(..) , CookieLife(..) + , SameSite(..) , calcLife , mkCookie , mkCookieHeader @@ -17,23 +18,21 @@ where import Control.Monad +import Control.Monad.Fail (MonadFail) import qualified Data.ByteString.Char8 as C import Data.Char (chr, toLower) -import Data.Data (Data, Typeable) +import Data.Data (Data) import Data.List ((\\), intersperse) import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Time.Format (formatTime, defaultTimeLocale) import Happstack.Server.Internal.Clock (getApproximateUTCTime) import Network.URI (escapeURIString) import Text.ParserCombinators.Parsec hiding (token) -#if MIN_VERSION_time(1,5,0) -import Data.Time.Format (formatTime, defaultTimeLocale) -#else -import Data.Time.Format (formatTime) -import System.Locale (defaultTimeLocale) -#endif + + -- | a type for HTTP cookies. Usually created using 'mkCookie'. data Cookie = Cookie { cookieVersion :: String @@ -43,7 +42,9 @@ , cookieValue :: String , secure :: Bool , httpOnly :: Bool - } deriving(Show,Eq,Read,Typeable,Data) + , sameSite :: SameSite + , partitioned :: Bool + } deriving (Show, Eq, Read, Data) -- | Specify the lifetime of a cookie. -- @@ -57,8 +58,33 @@ | MaxAge Int -- ^ life time of cookie in seconds | Expires UTCTime -- ^ cookie expiration date | Expired -- ^ cookie already expired - deriving (Eq, Ord, Read, Show, Typeable) + deriving (Eq, Ord, Read, Show) +-- | Options for specifying third party cookie behaviour. +-- +-- Note that most or all web clients require the cookie to be secure if "none" is +-- specified. +data SameSite + = SameSiteLax + -- ^ The cookie is sent in first party contexts as well as linked requests initiated + -- from other contexts. + | SameSiteStrict + -- ^ The cookie is sent in first party contexts only. + | SameSiteNone + -- ^ The cookie is sent in first as well as third party contexts if the cookie is + -- secure. + | SameSiteNoValue + -- ^ The default; used if you do not wish a SameSite attribute present at all. + deriving (Eq, Ord, Data, Show, Read) + +displaySameSite :: SameSite -> String +displaySameSite ss = + case ss of + SameSiteLax -> "SameSite=Lax" + SameSiteStrict -> "SameSite=Strict" + SameSiteNone -> "SameSite=None" + SameSiteNoValue -> "" + -- convert 'CookieLife' to the argument needed for calling 'mkCookieHeader' calcLife :: CookieLife -> IO (Maybe (Int, UTCTime)) calcLife Session = return Nothing @@ -73,13 +99,14 @@ -- | Creates a cookie with a default version of 1, empty domain, a --- path of "/", secure == False and httpOnly == False +-- path of "/", secure == False, httpOnly == False and +-- sameSite == SameSiteNoValue and partitioned = False -- -- see also: 'addCookie' mkCookie :: String -- ^ cookie name -> String -- ^ cookie value -> Cookie -mkCookie key val = Cookie "1" "/" "" key val False False +mkCookie key val = Cookie "1" "/" "" key val False False SameSiteNoValue False -- | Set a Cookie in the Result. -- The values are escaped as per RFC 2109, but some browsers may @@ -116,8 +143,9 @@ (cookieName cookie++"="++s cookieValue):[ (k++v) | (k,v) <- l, "" /= v ] ++ (if secure cookie then ["Secure"] else []) ++ (if httpOnly cookie then ["HttpOnly"] else []) - - + ++ (if sameSite cookie /= SameSiteNoValue + then [displaySameSite . sameSite $ cookie] else []) + ++ (if partitioned cookie then ["Partitioned"] else []) -- | Not an supported api. Takes a cookie header and returns -- either a String error message or an array of parsed cookies @@ -141,7 +169,7 @@ val<-value path<-option "" $ try (cookieSep >> cookie_path) domain<-option "" $ try (cookieSep >> cookie_domain) - return $ Cookie ver path domain (low name) val False False + return $ Cookie ver path domain (low name) val False False SameSiteNoValue False cookie_version = cookie_special "$Version" cookie_path = cookie_special "$Path" cookie_domain = cookie_special "$Domain" @@ -177,13 +205,13 @@ -- | Get all cookies from the HTTP request. The cookies are ordered per RFC from -- the most specific to the least specific. Multiple cookies with the same -- name are allowed to exist. -getCookies :: Monad m => C.ByteString -> m [Cookie] +getCookies :: MonadFail m => C.ByteString -> m [Cookie] getCookies h = getCookies' h >>= either (fail. ("Cookie parsing failed!"++)) return -- | Get the most specific cookie with the given name. Fails if there is no such -- cookie or if the browser did not escape cookies in a proper fashion. -- Browser support for escaping cookies properly is very diverse. -getCookie :: Monad m => String -> C.ByteString -> m Cookie +getCookie :: MonadFail m => String -> C.ByteString -> m Cookie getCookie s h = getCookie' s h >>= either (const $ fail ("getCookie: " ++ show s)) return getCookies' :: Monad m => C.ByteString -> m (Either String [Cookie]) @@ -196,7 +224,7 @@ return $ do -- Either cooks <- cs case filter (\x->(==) (low s) (cookieName x) ) cooks of - [] -> fail "No cookie found" + [] -> Left "No cookie found" f -> return $ head f low :: String -> String diff --git a/src/Happstack/Server/Internal/Handler.hs b/src/Happstack/Server/Internal/Handler.hs --- a/src/Happstack/Server/Internal/Handler.hs +++ b/src/Happstack/Server/Internal/Handler.hs @@ -63,11 +63,13 @@ (topStr, restStr) <- required "failed to separate request" $ splitAtEmptyLine inputStr (rql, headerStr) <- required "failed to separate headers/body" $ splitAtCRLF topStr let (m,u,v) = requestLine rql - headers' <- parseHeaders "host" (L.unpack headerStr) + headers' <- case parseHeaders "host" (L.unpack headerStr) of + Nothing -> Left "failed to parse host header" + Just x -> Right x let headers = mkHeaders headers' let contentLen = fromMaybe 0 $ fmap fst (P.readInt =<< getHeaderUnsafe contentlengthC headers) (body, nextRequest) <- case () of - () | contentLen < 0 -> fail "negative content-length" + () | contentLen < 0 -> Left "negative content-length" | isJust $ getHeaderBS transferEncodingC headers -> return $ consumeChunks restStr | otherwise -> return (L.splitAt (fromIntegral contentLen) restStr) @@ -139,7 +141,9 @@ (rsl,headerStr) <- required "failed to separate headers/body" $ splitAtCRLF topStr let (_,code) = responseLine rsl - headers' <- parseHeaders "host" (L.unpack headerStr) + headers' <- case parseHeaders "host" (L.unpack headerStr) of + Nothing -> Left "failed to parse host header" + Just x -> Right x let headers = mkHeaders headers' let mbCL = fmap fst (B.readInt =<< getHeader "content-length" headers) (body,_) <- diff --git a/src/Happstack/Server/Internal/Listen.hs b/src/Happstack/Server/Internal/Listen.hs --- a/src/Happstack/Server/Internal/Listen.hs +++ b/src/Happstack/Server/Internal/Listen.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} module Happstack.Server.Internal.Listen(listen, listen',listenOn,listenOnIPv4) where +import Data.Maybe (isNothing) import Happstack.Server.Internal.Types (Conf(..), Request, Response) import Happstack.Server.Internal.Handler (request) import Happstack.Server.Internal.Socket (acceptLite) @@ -10,15 +11,10 @@ import Control.Exception.Extensible as E import Control.Concurrent (forkIO, killThread, myThreadId) import Control.Monad -import Network.BSD (getProtocolNumber) -import Network (Socket) -import Network.Socket as Socket (SocketOption(KeepAlive), close, setSocketOption, - socket, Family(..), SockAddr, - SocketOption(..), SockAddr(..), - iNADDR_ANY, maxListenQueue, SocketType(..), - bindSocket) -import qualified Network.Socket as Socket (listen, inet_addr) +import qualified Data.Maybe as Maybe +import qualified Network.Socket as Socket import System.IO.Error (isFullError) +import Foreign.C (CInt) {- #ifndef mingw32_HOST_OS -} @@ -30,6 +26,12 @@ log':: Priority -> String -> IO () log' = logM "Happstack.Server.HTTP.Listen" +-- Meant to be TCP in practise. +-- See https://www.gnu.org/software/libc/manual/html_node/Creating-a-Socket.html +-- which says "zero is usually right". It could theoretically be SCTP, but it +-- would be a bizarre system that defaults to SCTP over TCP. +proto :: CInt +proto = Socket.defaultProtocol {- Network.listenOn binds randomly to IPv4 or IPv6 or both, @@ -37,45 +39,56 @@ Lets make it use IPv4 only for now. -} -listenOn :: Int -> IO Socket +listenOn :: Int -> IO Socket.Socket listenOn portm = do - proto <- getProtocolNumber "tcp" E.bracketOnError - (socket AF_INET Stream proto) - (close) + (Socket.socket Socket.AF_INET Socket.Stream proto) + (Socket.close) (\sock -> do - setSocketOption sock ReuseAddr 1 - bindSocket sock (SockAddrInet (fromIntegral portm) iNADDR_ANY) - Socket.listen sock (max 1024 maxListenQueue) + Socket.setSocketOption sock Socket.ReuseAddr 1 + Socket.bind sock (Socket.SockAddrInet (fromIntegral portm) iNADDR_ANY) + Socket.listen sock (max 1024 Socket.maxListenQueue) return sock ) listenOnIPv4 :: String -- ^ IP address to listen on (must be an IP address not a host name) -> Int -- ^ port number to listen on - -> IO Socket + -> IO Socket.Socket listenOnIPv4 ip portm = do - proto <- getProtocolNumber "tcp" - hostAddr <- Socket.inet_addr ip + hostAddr <- inet_addr ip E.bracketOnError - (socket AF_INET Stream proto) - (close) + (Socket.socket Socket.AF_INET Socket.Stream proto) + (Socket.close) (\sock -> do - setSocketOption sock ReuseAddr 1 - bindSocket sock (SockAddrInet (fromIntegral portm) hostAddr) - Socket.listen sock (max 1024 maxListenQueue) + Socket.setSocketOption sock Socket.ReuseAddr 1 + Socket.bind sock (Socket.SockAddrInet (fromIntegral portm) hostAddr) + Socket.listen sock (max 1024 Socket.maxListenQueue) return sock ) +inet_addr :: String -> IO Socket.HostAddress +inet_addr ip = do + addrInfos <- Socket.getAddrInfo (Just Socket.defaultHints) (Just ip) Nothing + let getHostAddress addrInfo = case Socket.addrAddress addrInfo of + Socket.SockAddrInet _ hostAddress -> Just hostAddress + _ -> Nothing + maybe (fail "inet_addr: no HostAddress") pure + . Maybe.listToMaybe + $ Maybe.mapMaybe getHostAddress addrInfos + +iNADDR_ANY :: Socket.HostAddress +iNADDR_ANY = 0 + -- | Bind and listen port listen :: Conf -> (Request -> IO Response) -> IO () listen conf hand = do let port' = port conf lsocket <- listenOn port' - setSocketOption lsocket KeepAlive 1 + Socket.setSocketOption lsocket Socket.KeepAlive 1 listen' lsocket conf hand -- | Use a previously bind port and listen -listen' :: Socket -> Conf -> (Request -> IO Response) -> IO () +listen' :: Socket.Socket -> Conf -> (Request -> IO Response) -> IO () listen' s conf hand = do {- #ifndef mingw32_HOST_OS @@ -99,14 +112,14 @@ request timeoutIO (logAccess conf) (hn,fromIntegral p) hand `E.catch` eh -- remove thread from timeout table cancel thandle - close sock + Socket.close sock loop = forever $ do w <- acceptLite s fork $ work w pe e = log' ERROR ("ERROR in http accept thread: " ++ show e) infi :: IO () infi = loop `catchSome` pe >> infi - infi `finally` (close s >> forceTimeoutAll tm) + infi `finally` (Socket.close s >> when (isNothing $ threadGroup conf) (forceTimeoutAll tm)) {-- #ifndef mingw32_HOST_OS diff --git a/src/Happstack/Server/Internal/LogFormat.hs b/src/Happstack/Server/Internal/LogFormat.hs --- a/src/Happstack/Server/Internal/LogFormat.hs +++ b/src/Happstack/Server/Internal/LogFormat.hs @@ -4,12 +4,7 @@ , formatRequestCombined ) where -#if MIN_VERSION_time(1,5,0) import Data.Time.Format (FormatTime(..), formatTime, defaultTimeLocale) -#else -import Data.Time.Format (FormatTime(..), formatTime) -import System.Locale (defaultTimeLocale) -#endif -- | Format the time as describe in the Apache combined log format. -- http://httpd.apache.org/docs/2.2/logs.html#combined diff --git a/src/Happstack/Server/Internal/Monads.hs b/src/Happstack/Server/Internal/Monads.hs --- a/src/Happstack/Server/Internal/Monads.hs +++ b/src/Happstack/Server/Internal/Monads.hs @@ -12,9 +12,11 @@ ) import Control.Monad.Base ( MonadBase, liftBase ) import Control.Monad.Catch ( MonadCatch(..), MonadThrow(..) ) -import Control.Monad.Error ( ErrorT(ErrorT), runErrorT - , Error, MonadError, throwError - , catchError, mapErrorT +#if !MIN_VERSION_transformers(0,6,0) +import Control.Monad.Trans.Error ( ErrorT, Error, mapErrorT ) +#endif +import Control.Monad.Except ( MonadError, throwError + , catchError ) #if MIN_VERSION_base(4,9,0) import Control.Monad.Fail (MonadFail) @@ -26,7 +28,7 @@ import qualified Control.Monad.RWS.Lazy as Lazy ( RWST, mapRWST ) import qualified Control.Monad.RWS.Strict as Strict ( RWST, mapRWST ) -import Control.Monad.Trans.Except ( ExceptT, mapExceptT ) +import Control.Monad.Trans.Except ( ExceptT(ExceptT), mapExceptT, runExceptT ) import Control.Monad.State.Class ( MonadState, get, put ) import qualified Control.Monad.State.Lazy as Lazy ( StateT, mapStateT ) import qualified Control.Monad.State.Strict as Strict ( StateT, mapStateT ) @@ -93,7 +95,6 @@ liftIO = ServerPartT . liftIO {-# INLINE liftIO #-} -#if MIN_VERSION_monad_control(1,0,0) instance MonadTransControl ServerPartT where type StT ServerPartT a = StT WebT (StT (ReaderT Request) a) liftWith f = ServerPartT $ liftWith $ \runReader -> @@ -105,20 +106,7 @@ type StM (ServerPartT m) a = ComposeSt ServerPartT m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM -#else -instance MonadTransControl ServerPartT where - newtype StT ServerPartT a = StSP {unStSP :: StT WebT (StT (ReaderT Request) a)} - liftWith f = ServerPartT $ liftWith $ \runReader -> - liftWith $ \runWeb -> - f $ liftM StSP . runWeb . runReader . unServerPartT - restoreT = ServerPartT . restoreT . restoreT . liftM unStSP -instance MonadBaseControl b m => MonadBaseControl b (ServerPartT m) where - newtype StM (ServerPartT m) a = StMSP {unStMSP :: ComposeSt ServerPartT m a} - liftBaseWith = defaultLiftBaseWith StMSP - restoreM = defaultRestoreM unStMSP -#endif - -- | Particularly useful when combined with 'runWebT' to produce -- a @m ('Maybe' 'Response')@ from a 'Request'. runServerPartT :: ServerPartT m a -> Request -> WebT m a @@ -342,7 +330,6 @@ liftIO = FilterT . liftIO {-# INLINE liftIO #-} -#if MIN_VERSION_monad_control(1,0,0) instance MonadTransControl (FilterT a) where type StT (FilterT a) b = StT (Lazy.WriterT (FilterFun a)) b liftWith f = FilterT $ liftWith $ \run -> f $ run . unFilterT @@ -352,18 +339,7 @@ type StM (FilterT a m) c = ComposeSt (FilterT a) m c liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM -#else -instance MonadTransControl (FilterT a) where - newtype StT (FilterT a) b = StFilter {unStFilter :: StT (Lazy.WriterT (FilterFun a)) b} - liftWith f = FilterT $ liftWith $ \run -> f $ liftM StFilter . run . unFilterT - restoreT = FilterT . restoreT . liftM unStFilter -instance MonadBaseControl b m => MonadBaseControl b (FilterT a m) where - newtype StM (FilterT a m) c = StMFilter {unStMFilter :: ComposeSt (FilterT a) m c} - liftBaseWith = defaultLiftBaseWith StMFilter - restoreM = defaultRestoreM unStMFilter -#endif - -- | A set of functions for manipulating filters. -- -- 'ServerPartT' implements 'FilterMonad' 'Response' so these methods @@ -397,14 +373,9 @@ getFilter = FilterT . listens unFilterFun . unFilterT -- | The basic 'Response' building object. -newtype WebT m a = WebT { unWebT :: ErrorT Response (FilterT (Response) (MaybeT m)) a } +newtype WebT m a = WebT { unWebT :: ExceptT Response (FilterT (Response) (MaybeT m)) a } deriving (Functor) -#if MIN_VERSION_base(4,9,0) -instance MonadFail m => MonadFail (WebT m) where - fail s = lift (Fail.fail s) -#endif - instance MonadCatch m => MonadCatch (WebT m) where catch action handle = WebT $ catch (unWebT action) (unWebT . handle) @@ -418,41 +389,23 @@ liftIO = WebT . liftIO {-# INLINE liftIO #-} -#if MIN_VERSION_monad_control(1,0,0) instance MonadTransControl WebT where type StT WebT a = StT MaybeT (StT (FilterT Response) - (StT (ErrorT Response) a)) + (StT (ExceptT Response) a)) liftWith f = WebT $ liftWith $ \runError -> liftWith $ \runFilter -> liftWith $ \runMaybe -> f $ runMaybe . runFilter . - runError . unWebT + runExceptT . unWebT restoreT = WebT . restoreT . restoreT . restoreT instance MonadBaseControl b m => MonadBaseControl b (WebT m) where type StM (WebT m) a = ComposeSt WebT m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM -#else -instance MonadTransControl WebT where - newtype StT WebT a = StWeb {unStWeb :: StT MaybeT - (StT (FilterT Response) - (StT (ErrorT Response) a))} - liftWith f = WebT $ liftWith $ \runError -> - liftWith $ \runFilter -> - liftWith $ \runMaybe -> - f $ liftM StWeb . runMaybe . - runFilter . - runError . unWebT - restoreT = WebT . restoreT . restoreT . restoreT . liftM unStWeb -instance MonadBaseControl b m => MonadBaseControl b (WebT m) where - newtype StM (WebT m) a = StMWeb {unStMWeb :: ComposeSt WebT m a} - liftBaseWith = defaultLiftBaseWith StMWeb - restoreM = defaultRestoreM unStMWeb -#endif -- | 'UnWebT' is almost exclusively used with 'mapServerPartT'. If you -- are not using 'mapServerPartT' then you do not need to wrap your -- head around this type. If you are -- the type is not as complex as @@ -511,8 +464,13 @@ {-# INLINE (>>=) #-} return a = WebT $ return a {-# INLINE return #-} - fail s = lift (fail s) +#if MIN_VERSION_base(4,9,0) +instance MonadFail m => MonadFail (WebT m) where +#endif + + fail s = lift (Fail.fail s) + -- | 'WebMonad' provides a means to end the current computation -- and return a 'Response' immediately. This provides an -- alternate escape route. In particular it has a monadic value @@ -555,13 +513,13 @@ -- is exactly the semantics expected from objects that take lists -- of 'ServerPartT'. mzero = WebT $ lift $ lift $ mzero - mplus x y = WebT $ ErrorT $ FilterT $ (lower x) `mplus` (lower y) - where lower = (unFilterT . runErrorT . unWebT) + mplus x y = WebT $ ExceptT $ FilterT $ (lower x) `mplus` (lower y) + where lower = (unFilterT . runExceptT . unWebT) instance (Monad m) => FilterMonad Response (WebT m) where setFilter f = WebT $ lift $ setFilter $ f composeFilter f = WebT . lift . composeFilter $ f - getFilter m = WebT $ ErrorT $ liftM lft $ getFilter (runErrorT $ unWebT m) + getFilter m = WebT $ ExceptT $ liftM lft $ getFilter (runExceptT $ unWebT m) where lft (Left r, _) = Left r lft (Right a, f) = Right (a, f) @@ -576,11 +534,11 @@ -- | For when you really need to unpack a 'WebT' entirely (and not -- just unwrap the first layer with 'unWebT'). ununWebT :: WebT m a -> UnWebT m a -ununWebT = runMaybeT . Lazy.runWriterT . unFilterT . runErrorT . unWebT +ununWebT = runMaybeT . Lazy.runWriterT . unFilterT . runExceptT . unWebT -- | For wrapping a 'WebT' back up. @'mkWebT' . 'ununWebT' = 'id'@ mkWebT :: UnWebT m a -> WebT m a -mkWebT = WebT . ErrorT . FilterT . Lazy.WriterT . MaybeT +mkWebT = WebT . ExceptT . FilterT . Lazy.WriterT . MaybeT -- | See 'mapServerPartT' for a discussion of this function. mapWebT :: (UnWebT m a -> UnWebT n b) @@ -798,6 +756,7 @@ -- ErrorT +#if !MIN_VERSION_transformers(0,6,0) instance (Error e, ServerMonad m) => ServerMonad (ErrorT e m) where askRq = lift askRq localRq f = mapErrorT $ localRq f @@ -814,6 +773,7 @@ instance (Error e, WebMonad a m) => WebMonad a (ErrorT e m) where finishWith = lift . finishWith +#endif -- ExceptT diff --git a/src/Happstack/Server/Internal/RFC822Headers.hs b/src/Happstack/Server/Internal/RFC822Headers.hs --- a/src/Happstack/Server/Internal/RFC822Headers.hs +++ b/src/Happstack/Server/Internal/RFC822Headers.hs @@ -44,6 +44,7 @@ ) where import Control.Monad +import Control.Monad.Fail (MonadFail) import Data.Char import Data.List import Text.ParserCombinators.Parsec @@ -53,7 +54,7 @@ pHeaders :: Parser [Header] pHeaders = many pHeader -parseHeaders :: Monad m => SourceName -> String -> m [Header] +parseHeaders :: MonadFail m => SourceName -> String -> m [Header] parseHeaders = parseM pHeaders pHeader :: Parser Header @@ -149,10 +150,10 @@ -- | Parse the standard representation of a content-type. -- If the input cannot be parsed, this function calls -- 'fail' with a (hopefully) informative error message. -parseContentType :: Monad m => String -> m ContentType +parseContentType :: MonadFail m => String -> m ContentType parseContentType = parseM pContentType "Content-type" -getContentType :: Monad m => [Header] -> m ContentType +getContentType :: MonadFail m => [Header] -> m ContentType getContentType hs = lookupM "content-type" hs >>= parseContentType -- @@ -169,11 +170,11 @@ c_cte <- p_token return $ ContentTransferEncoding (map toLower c_cte) -parseContentTransferEncoding :: Monad m => String -> m ContentTransferEncoding +parseContentTransferEncoding :: MonadFail m => String -> m ContentTransferEncoding parseContentTransferEncoding = parseM pContentTransferEncoding "Content-transfer-encoding" -getContentTransferEncoding :: Monad m => [Header] -> m ContentTransferEncoding +getContentTransferEncoding :: MonadFail m => [Header] -> m ContentTransferEncoding getContentTransferEncoding hs = lookupM "content-transfer-encoding" hs >>= parseContentTransferEncoding @@ -192,10 +193,10 @@ c_parameters <- many p_parameter return $ ContentDisposition (map toLower c_cd) c_parameters -parseContentDisposition :: Monad m => String -> m ContentDisposition +parseContentDisposition :: MonadFail m => String -> m ContentDisposition parseContentDisposition = parseM pContentDisposition "Content-disposition" -getContentDisposition :: Monad m => [Header] -> m ContentDisposition +getContentDisposition :: MonadFail m => [Header] -> m ContentDisposition getContentDisposition hs = lookupM "content-disposition" hs >>= parseContentDisposition @@ -203,13 +204,13 @@ -- * Utilities -- -parseM :: Monad m => Parser a -> SourceName -> String -> m a +parseM :: MonadFail m => Parser a -> SourceName -> String -> m a parseM p n inp = case parse p n inp of Left e -> fail (show e) Right x -> return x -lookupM :: (Monad m, Eq a, Show a) => a -> [(a,b)] -> m b +lookupM :: (MonadFail m, Eq a, Show a) => a -> [(a,b)] -> m b lookupM n = maybe (fail ("No such field: " ++ show n)) return . lookup n -- diff --git a/src/Happstack/Server/Internal/Socket.hs b/src/Happstack/Server/Internal/Socket.hs --- a/src/Happstack/Server/Internal/Socket.hs +++ b/src/Happstack/Server/Internal/Socket.hs @@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-} -#ifdef TEMPLATE_HASKELL -{-# LANGUAGE TemplateHaskell #-} -#endif module Happstack.Server.Internal.Socket ( acceptLite , sockAddrToPeer @@ -9,13 +6,8 @@ import Data.List (intersperse) import Data.Word (Word32) -#ifdef TEMPLATE_HASKELL -import Happstack.Server.Internal.SocketTH(supportsIPv6) -import Language.Haskell.TH.Syntax -#endif - import qualified Network.Socket as S - ( Socket(..) + ( Socket , PortNumber() , SockAddr(..) , HostName @@ -57,44 +49,7 @@ sockAddrToPeer :: S.SockAddr -> (S.HostName, S.PortNumber) sockAddrToPeer addr = -#ifdef TEMPLATE_HASKELL - $(if supportsIPv6 - then - return $ CaseE (VarE (mkName "addr")) - [ Match - (ConP (mkName "S.SockAddrInet") - [VarP (mkName "p"),VarP (mkName "ha")]) - (NormalB - (TupE - [(AppE (VarE (mkName "showHostAddress")) - (VarE (mkName "ha"))) - , VarE (mkName "p") - ])) [] - , Match (ConP (mkName "S.SockAddrInet6") - [VarP (mkName "p"),WildP,VarP (mkName "ha"),WildP]) - (NormalB - (TupE - [ (AppE - (VarE (mkName "showHostAddress6")) - (VarE (mkName "ha"))) - , VarE (mkName "p") - ])) [] - , Match WildP - (NormalB (AppE (VarE (mkName "error")) - (LitE (StringL "Unsupported socket")))) []] - -- the above mess is the equivalent of this: - {-[| case addr of - (S.SockAddrInet p ha) -> (showHostAddress ha, p) - (S.SockAddrInet6 p _ ha _ ) -> (showHostAddress6 ha, p) - _ -> error "Unsupported socket" - |]-} - else - [| case addr of - (S.SockAddrInet p ha) -> (showHostAddress ha, p) - _ -> error "Unsupported socket" - |]) -#else - case addr of - (S.SockAddrInet p ha) -> (showHostAddress ha, p) - _ -> error "Unsupported socket" -#endif + case addr of + (S.SockAddrInet p ha) -> (showHostAddress ha, p) + (S.SockAddrInet6 p _ ha _) -> (showHostAddress6 ha, p) + _ -> error "sockAddrToPeer: Unsupported socket type" diff --git a/src/Happstack/Server/Internal/SocketTH.hs b/src/Happstack/Server/Internal/SocketTH.hs deleted file mode 100644 --- a/src/Happstack/Server/Internal/SocketTH.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE CPP #-} -#ifdef TEMPLATE_HASKELL -{-# LANGUAGE TemplateHaskell #-} -#endif -module Happstack.Server.Internal.SocketTH(supportsIPv6) where - -#ifdef TEMPLATE_HASKELL -import Language.Haskell.TH -#endif - -import Network.Socket(SockAddr(..)) - --- find out at compile time if the SockAddr6 / HostAddress6 constructors are available -supportsIPv6 :: Bool -#ifdef TEMPLATE_HASKELL -supportsIPv6 = $(let c = ["Network.Socket.SockAddrInet6", "Network.Socket.Internal.SockAddrInet6"] ; d = ''SockAddr - isInet6 :: Con -> Bool - isInet6 (NormalC n _) = show n `elem` c - isInet6 _ = False - in - do info <- reify d - case info of -#if MIN_VERSION_template_haskell(2,11,0) - TyConI (DataD _ _ _ _ cs _) -> -#else - TyConI (DataD _ _ _ cs _) -> -#endif - if any isInet6 cs - then [| True |] - else [| False |] - _ -> error "supportsIPv6: SockAddr is no longer a TyConI ?!?! Giving up." - ) -#else -supportsIPv6 = False -#endif diff --git a/src/Happstack/Server/Internal/TimeoutSocket.hs b/src/Happstack/Server/Internal/TimeoutSocket.hs --- a/src/Happstack/Server/Internal/TimeoutSocket.hs +++ b/src/Happstack/Server/Internal/TimeoutSocket.hs @@ -12,7 +12,7 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Internal as L import qualified Data.ByteString as S -import Network.Socket (sClose) +import Network.Socket (close) import qualified Network.Socket.ByteString as N import qualified Happstack.Server.Internal.TimeoutManager as TM import Happstack.Server.Internal.TimeoutIO (TimeoutIO(..)) @@ -88,7 +88,7 @@ timeoutSocketIO :: TM.Handle -> Socket -> TimeoutIO timeoutSocketIO handle socket = TimeoutIO { toHandle = handle - , toShutdown = sClose socket + , toShutdown = close socket , toPutLazy = sPutLazyTickle handle socket , toGet = sGet handle socket , toPut = sPutTickle handle socket diff --git a/src/Happstack/Server/Internal/Types.hs b/src/Happstack/Server/Internal/Types.hs --- a/src/Happstack/Server/Internal/Types.hs +++ b/src/Happstack/Server/Internal/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, FlexibleInstances, RankNTypes #-} +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, FlexibleInstances, RankNTypes, CPP #-} module Happstack.Server.Internal.Types (Request(..), Response(..), RqBody(..), Input(..), HeaderPair(..), @@ -21,7 +21,10 @@ import Control.Exception (Exception, SomeException) -import Control.Monad.Error (Error(strMsg)) +#if !MIN_VERSION_transformers(0,6,0) +import Control.Monad.Trans.Error (Error(strMsg)) +#endif +import Control.Monad.Fail (MonadFail) import Control.Monad.Trans (MonadIO(liftIO)) import qualified Control.Concurrent.Thread.Group as TG import Control.Concurrent.MVar @@ -29,7 +32,6 @@ import Data.Data (Data) import Data.String (fromString) import Data.Time.Format (FormatTime(..)) -import Data.Typeable(Typeable) import qualified Data.ByteString.Char8 as P import Data.ByteString.Char8 (ByteString,pack) import qualified Data.ByteString.Lazy.Char8 as L @@ -114,7 +116,7 @@ , validator :: Maybe (Response -> IO Response) -- ^ a function to validate the output on-the-fly , logAccess :: forall t. FormatTime t => Maybe (LogAccess t) -- ^ function to log access requests (see also: 'logMAccess') , timeout :: Int -- ^ number of seconds to wait before killing an inactive thread - , threadGroup :: Maybe TG.ThreadGroup -- ^ ThreadGroup for registering spawned threads for handling requests + , threadGroup :: Maybe TG.ThreadGroup -- ^ ThreadGroup for registering spawned threads for handling requests. } -- | Default configuration contains no validator and the port is set to 8000 @@ -136,7 +138,7 @@ -- | HTTP request method data Method = GET | HEAD | POST | PUT | DELETE | TRACE | OPTIONS | CONNECT | PATCH | EXTENSION ByteString - deriving (Show,Read,Eq,Ord,Typeable,Data) + deriving (Show, Read, Eq, Ord, Data) -- | Does the method support a message body? -- @@ -176,7 +178,7 @@ -- | Result flags data RsFlags = RsFlags { rsfLength :: Length - } deriving (Show,Read,Typeable) + } deriving (Show, Read) -- | Default RsFlags: automatically use @Transfer-Encoding: Chunked@. nullRsFlags :: RsFlags @@ -201,7 +203,7 @@ { inputValue :: Either FilePath L.ByteString , inputFilename :: Maybe FilePath , inputContentType :: ContentType - } deriving (Show, Read, Typeable) + } deriving (Show, Read) -- | hostname & port type Host = (String, Int) -- ^ (hostname, port) @@ -222,7 +224,6 @@ , sfOffset :: Integer -- ^ offset to start at , sfCount :: Integer -- ^ number of bytes to send } - deriving (Typeable) instance Show Response where showsPrec _ res@Response{} = @@ -245,11 +246,13 @@ showRsValidator :: Maybe (Response -> IO Response) -> String showRsValidator = maybe "Nothing" (const "Just ") +#if !MIN_VERSION_transformers(0,6,0) -- what should the status code be ? instance Error Response where strMsg str = setHeader "Content-Type" "text/plain; charset=UTF-8" $ result 500 str +#endif -- | an HTTP request data Request = Request @@ -265,7 +268,7 @@ , rqHeaders :: Headers -- ^ the HTTP request headers , rqBody :: MVar RqBody -- ^ the raw, undecoded request body , rqPeer :: Host -- ^ (hostname, port) of the client making the request - } deriving (Typeable) + } instance Show Request where showsPrec _ rq = @@ -324,7 +327,7 @@ headers = id -- | The body of an HTTP 'Request' -newtype RqBody = Body { unBody :: L.ByteString } deriving (Read,Show,Typeable) +newtype RqBody = Body { unBody :: L.ByteString } deriving (Read, Show) -- | Sets the Response status code to the provided Int and lifts the computation -- into a Monad. @@ -465,7 +468,7 @@ _ -> error "readDec' failed." -- | Read in any monad. -readM :: (Monad m, Read t) => String -> m t +readM :: (MonadFail m, Read t) => String -> m t readM s = case reads s of [(v,"")] -> return v _ -> fail "readM: parse error" @@ -526,7 +529,6 @@ -- | Escape from the HTTP world and get direct access to the underlying 'TimeoutIO' functions data EscapeHTTP = EscapeHTTP (TimeoutIO -> IO ()) - deriving (Typeable) instance Exception EscapeHTTP diff --git a/src/Happstack/Server/Monads.hs b/src/Happstack/Server/Monads.hs --- a/src/Happstack/Server/Monads.hs +++ b/src/Happstack/Server/Monads.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, CPP #-} -- | This module provides four classes and some related functions -- which provide 'ServerPartT' with much of its web-centric behavior. -- @@ -41,7 +41,9 @@ import Control.Applicative (Alternative, Applicative) import Control.Monad (MonadPlus(mzero)) -import Control.Monad.Error (Error, ErrorT) +#if !MIN_VERSION_transformers(0,6,0) +import Control.Monad.Trans.Error (Error, ErrorT) +#endif import Control.Monad.Trans (MonadIO(..),MonadTrans(lift)) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Reader (ReaderT) @@ -71,7 +73,9 @@ instance (Happstack m, Monoid w) => Happstack (Strict.WriterT w m) instance (Happstack m, Monoid w) => Happstack (Lazy.RWST r w s m) instance (Happstack m, Monoid w) => Happstack (Strict.RWST r w s m) +#if !MIN_VERSION_transformers(0,6,0) instance (Happstack m, Error e) => Happstack (ErrorT e m) +#endif instance (Happstack m, Monoid e) => Happstack (ExceptT e m) -- | Get a header out of the request. diff --git a/src/Happstack/Server/Proxy.hs b/src/Happstack/Server/Proxy.hs deleted file mode 100644 --- a/src/Happstack/Server/Proxy.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} --- |Support for creating a proxy or reverse-proxy server -module Happstack.Server.Proxy where - -import Control.Monad (MonadPlus(mzero), liftM) -import Control.Monad.Trans (MonadIO(liftIO)) -import qualified Data.ByteString.Char8 as B -import Data.List (isPrefixOf) -import Data.Maybe (fromJust, fromMaybe) -import Happstack.Server.Monads (ServerMonad(askRq), FilterMonad, WebMonad, escape') -import Happstack.Server.Response (badGateway, toResponse) -import Happstack.Server.Client (getResponse) -import Happstack.Server.Types (Request(rqPaths, rqHeaders, rqPeer), Response, setHeader, getHeader) - --- | 'proxyServe' is for creating a part that acts as a proxy. The --- sole argument @['String']@ is a list of allowed domains for --- proxying. This matches the domain part of the request and the --- wildcard * can be used. E.g. --- --- * \"*\" to match anything. --- --- * \"*.example.com\" to match anything under example.com --- --- * \"example.com\" to match just example.com --- --- --- TODO: annoyingly enough, this method eventually calls 'escape', so --- any headers you set won't be used, and the computation immediately --- ends. -proxyServe :: (MonadIO m, WebMonad Response m, ServerMonad m, MonadPlus m, FilterMonad Response m) => [String] -> m Response -proxyServe allowed = do - rq <- askRq - if cond rq then proxyServe' rq else mzero - where - cond rq - | "*" `elem` allowed = True - | domain `elem` allowed = True - | superdomain `elem` wildcards =True - | otherwise = False - where - domain = head (rqPaths rq) - superdomain = tail $ snd $ break (=='.') domain - wildcards = (map (drop 2) $ filter ("*." `isPrefixOf`) allowed) - --- | Take a proxy 'Request' and create a 'Response'. Your basic proxy --- building block. See 'unproxify'. --- --- TODO: this would be more useful if it didn\'t call 'escape' --- (e.g. it let you modify the response afterwards, or set additional --- headers) -proxyServe' :: (MonadIO m, FilterMonad Response m, WebMonad Response m) => Request-> m Response -proxyServe' rq = liftIO (getResponse (unproxify rq)) >>= - either (badGateway . toResponse . show) escape' - --- | This is a reverse proxy implementation. See 'unrproxify'. --- --- TODO: this would be more useful if it didn\'t call 'escape', just --- like 'proxyServe''. -rproxyServe :: (ServerMonad m, WebMonad Response m, FilterMonad Response m, MonadIO m) => - String -- ^ defaultHost - -> [(String, String)] -- ^ map to look up hostname mappings. For the reverse proxy - -> m Response -- ^ the result is a 'ServerPartT' that will reverse proxy for you. -rproxyServe defaultHost list = - do rq <- askRq - r <- liftIO (getResponse (unrproxify defaultHost list rq)) - either (badGateway . toResponse . show) (escape') r - - -unproxify :: Request -> Request -unproxify rq = rq {rqPaths = tail $ rqPaths rq, - rqHeaders = - forwardedFor $ forwardedHost $ - setHeader "host" (head $ rqPaths rq) $ - rqHeaders rq} - where - appendInfo hdr val = setHeader hdr (csv val $ - maybe "" B.unpack $ - getHeader hdr rq) - forwardedFor = appendInfo "X-Forwarded-For" (fst $ rqPeer rq) - forwardedHost = appendInfo "X-Forwarded-Host" - (B.unpack $ fromJust $ getHeader "host" rq) - csv v "" = v - csv v x = x++", " ++ v - -unrproxify :: String -> [(String, String)] -> Request -> Request -unrproxify defaultHost list rq = - let host::String - host = fromMaybe defaultHost $ flip lookup list =<< B.unpack `liftM` getHeader "host" rq - newrq = rq {rqPaths = host: rqPaths rq} - in unproxify newrq - - diff --git a/src/Happstack/Server/Response.hs b/src/Happstack/Server/Response.hs --- a/src/Happstack/Server/Response.hs +++ b/src/Happstack/Server/Response.hs @@ -26,6 +26,9 @@ , ifModifiedSince ) where +#if MIN_VERSION_xhtml(3000,3,0) +import qualified Data.ByteString.Builder as L +#endif import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.UTF8 as LU (fromString) @@ -34,6 +37,7 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT +import Data.Time (UTCTime, formatTime, defaultTimeLocale) import Happstack.Server.Internal.Monads (FilterMonad(composeFilter)) import Happstack.Server.Internal.Types import Happstack.Server.Types (Response(..), Request(..), nullRsFlags, getHeader, noContentLength, redirect, result, setHeader, setHeaderBS) @@ -43,12 +47,6 @@ import Text.Html (Html, renderHtml) import qualified Text.XHtml as XHtml (Html, renderHtml) -#if MIN_VERSION_time(1,5,0) -import Data.Time (UTCTime, formatTime, defaultTimeLocale) -#else -import Data.Time (UTCTime, formatTime) -import System.Locale (defaultTimeLocale) -#endif -- | A low-level function to build a 'Response' from a content-type -- and a 'ByteString'. @@ -140,8 +138,11 @@ instance ToMessage XHtml.Html where toContentType _ = B.pack "text/html; charset=UTF-8" +#if MIN_VERSION_xhtml(3000,3,0) + toMessage = L.toLazyByteString . XHtml.renderHtml +#else toMessage = LU.fromString . XHtml.renderHtml - +#endif instance ToMessage Blaze.Html where toContentType _ = B.pack "text/html; charset=UTF-8" toMessage = Blaze.renderHtml diff --git a/src/Happstack/Server/Routing.hs b/src/Happstack/Server/Routing.hs --- a/src/Happstack/Server/Routing.hs +++ b/src/Happstack/Server/Routing.hs @@ -109,7 +109,7 @@ -- -- > handler :: ServerPart Response -- > handler = --- > do methodOnly [GET, HEAD] +-- > do method [GET, HEAD] -- > ... method :: (ServerMonad m, MonadPlus m, MatchMethod method) => method -> m () method meth = guardRq $ \rq -> matchMethod meth (rqMethod rq) diff --git a/src/Happstack/Server/RqData.hs b/src/Happstack/Server/RqData.hs --- a/src/Happstack/Server/RqData.hs +++ b/src/Happstack/Server/RqData.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances #-} -- | Functions for extracting values from the query string, form data, cookies, etc. -- -- For in-depth documentation see the following section of the Happstack Crash Course: @@ -58,8 +58,8 @@ , HasRqData(askRqEnv, localRqEnv,rqDataError) ) where -import Control.Applicative (Applicative((<*>), pure), Alternative((<|>), empty), WrappedMonad(WrapMonad, unwrapMonad), (<$>)) -import Control.Monad (MonadPlus(mzero)) +import Control.Applicative (Applicative((<*>), pure), Alternative((<|>), empty), WrappedMonad(WrapMonad, unwrapMonad)) +import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.Reader (ReaderT(ReaderT, runReaderT), MonadReader(ask, local), mapReaderT) import qualified Control.Monad.State.Lazy as Lazy (StateT, mapStateT) import qualified Control.Monad.State.Strict as Strict (StateT, mapStateT) @@ -67,7 +67,10 @@ import qualified Control.Monad.Writer.Strict as Strict (WriterT, mapWriterT) import qualified Control.Monad.RWS.Lazy as Lazy (RWST, mapRWST) import qualified Control.Monad.RWS.Strict as Strict (RWST, mapRWST) -import Control.Monad.Error (Error(noMsg, strMsg), ErrorT, mapErrorT) +#if !MIN_VERSION_transformers(0,6,0) +import qualified Control.Monad.Trans.Error as DeprecatedError +#endif +import Control.Monad.Except (throwError) import Control.Monad.Trans (MonadIO(..), lift) import Control.Monad.Trans.Except (ExceptT, mapExceptT) import qualified Data.ByteString.Char8 as P @@ -75,7 +78,7 @@ import qualified Data.ByteString.Lazy.UTF8 as LU import Data.Char (toLower) import Data.Either (partitionEithers) -import Data.Generics (Data, Typeable) +import Data.Generics (Data) import Data.Maybe (fromJust) import Data.Monoid (Monoid(mempty, mappend, mconcat)) import qualified Data.Semigroup as SG @@ -90,18 +93,36 @@ import Network.URI (unEscapeString) newtype ReaderError r e a = ReaderError { unReaderError :: ReaderT r (Either e) a } - deriving (Functor, Monad, MonadPlus) + deriving (Functor, Monad) -instance (Error e, Monoid e) => MonadReader r (ReaderError r e) where +#if MIN_VERSION_transformers(0,6,0) +deriving instance (Monoid e, MonadPlus (Either e)) => MonadPlus (ReaderError r e) +#else +deriving instance (Monoid e, DeprecatedError.Error e, MonadPlus (Either e)) => MonadPlus (ReaderError r e) +#endif + +#if MIN_VERSION_transformers(0,6,0) +instance (Monoid e) => MonadReader r (ReaderError r e) where +#else +instance (DeprecatedError.Error e, Monoid e) => MonadReader r (ReaderError r e) where +#endif ask = ReaderError ask local f m = ReaderError $ local f (unReaderError m) -instance (Monoid e, Error e) => Applicative (ReaderError r e) where +#if MIN_VERSION_transformers(0,6,0) +instance (Monoid e) => Applicative (ReaderError r e) where +#else +instance (Monoid e, DeprecatedError.Error e) => Applicative (ReaderError r e) where +#endif pure = return (ReaderError (ReaderT f)) <*> (ReaderError (ReaderT a)) = ReaderError $ ReaderT $ \env -> (f env) `apEither` (a env) -instance (Monoid e, Error e) => Alternative (ReaderError r e) where +#if MIN_VERSION_transformers(0,6,0) +instance (MonadPlus (Either e), Monoid e) => Alternative (ReaderError r e) where +#else +instance (Monoid e, DeprecatedError.Error e) => Alternative (ReaderError r e) where +#endif empty = unwrapMonad empty f <|> g = unwrapMonad $ (WrapMonad f) <|> (WrapMonad g) @@ -113,7 +134,7 @@ -- | a list of errors newtype Errors a = Errors { unErrors :: [a] } - deriving (Eq, Ord, Show, Read, Data, Typeable) + deriving (Eq, Ord, Show, Read, Data) instance SG.Semigroup (Errors a) where (Errors x) <> (Errors y) = Errors (x ++ y) @@ -123,10 +144,27 @@ mappend = (SG.<>) mconcat errs = Errors $ concatMap unErrors errs -instance Error (Errors String) where +#if MIN_VERSION_transformers(0,6,0) +instance (Alternative (Either (Errors a))) => MonadPlus (Either (Errors a)) where + mzero = Left (Errors []) + (Left _) `mplus` n = n + m `mplus` _ = m + +instance Alternative (Either (Errors a)) where + empty = Left (Errors []) + (Left _) <|> n = n + m <|> _ = m +#endif + +#if !MIN_VERSION_transformers(0,6,0) +instance DeprecatedError.Error (Errors String) where noMsg = Errors [] strMsg str = Errors [str] +#endif +strMsg :: a -> Errors a +strMsg errMsg = Errors [errMsg] + {- commented out to avoid 'Defined but not used' warning. readerError :: (Monoid e, Error e) => e -> ReaderError r e b readerError e = mapReaderErrorT ((Left e) `apEither`) (return ()) @@ -204,10 +242,12 @@ localRqEnv f = Strict.mapRWST (localRqEnv f) rqDataError e = lift (rqDataError e) -instance (Monad m, Error e, HasRqData m) => HasRqData (ErrorT e m) where +#if !MIN_VERSION_transformers(0,6,0) +instance (Monad m, DeprecatedError.Error e, HasRqData m) => HasRqData (DeprecatedError.ErrorT e m) where askRqEnv = lift askRqEnv - localRqEnv f = mapErrorT (localRqEnv f) + localRqEnv f = DeprecatedError.mapErrorT (localRqEnv f) rqDataError e = lift (rqDataError e) +#endif instance (Monad m, HasRqData m) => HasRqData (ExceptT e m) where askRqEnv = lift askRqEnv @@ -264,7 +304,6 @@ (Just a) -> Right a _ -> Left $ "readRq failed while parsing key: " ++ key ++ " which has the value: " ++ val - -- | convert or validate a value -- -- This is similar to 'fmap' except that the function can fail by @@ -454,7 +493,7 @@ Nothing -> rqDataError $ strMsg $ "lookCookie: cookie not found: " ++ name Just c -> return c{cookieValue = f c} where - f = unEscapeString . cookieValue + f = unEscapeString . cookieValue -- | gets the named cookie as a string lookCookieValue :: (Functor m, Monad m, HasRqData m) => String -> m String diff --git a/src/Happstack/Server/SURI.hs b/src/Happstack/Server/SURI.hs --- a/src/Happstack/Server/SURI.hs +++ b/src/Happstack/Server/SURI.hs @@ -23,7 +23,7 @@ import Control.Arrow (first) import Data.Char (chr, digitToInt, isHexDigit) import Data.Maybe (fromJust, isJust) -import Data.Generics (Data, Typeable) +import Data.Generics (Data) import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText import qualified Network.URI as URI @@ -74,7 +74,7 @@ isAbs :: SURI -> Bool isAbs = not . null . URI.uriScheme . suri -newtype SURI = SURI {suri::URI.URI} deriving (Eq,Data,Typeable) +newtype SURI = SURI {suri::URI.URI} deriving (Eq,Data) instance Show SURI where showsPrec d (SURI uri) = showsPrec d $ show uri instance Read SURI where diff --git a/src/Happstack/Server/SimpleHTTP.hs b/src/Happstack/Server/SimpleHTTP.hs --- a/src/Happstack/Server/SimpleHTTP.hs +++ b/src/Happstack/Server/SimpleHTTP.hs @@ -30,9 +30,9 @@ -- > import Happstack.Server -- > main = simpleHTTP nullConf $ ok "Hello World!" -- --- By default the server will listen on port 8000. Run the app and point your browser at: +-- By default the server will listen on port 8000. Run the app and point your browser at: -- --- For FastCGI support see: +-- For FastCGI support see: ----------------------------------------------------------------------------- module Happstack.Server.SimpleHTTP ( -- * SimpleHTTP @@ -44,6 +44,7 @@ , bindPort , bindIPv4 , parseConfig + , runWebT , waitForTermination -- * Re-exported modules -- ** Basic ServerMonad functionality @@ -58,8 +59,6 @@ , module Happstack.Server.Response -- ** Request Routing , module Happstack.Server.Routing - -- ** Proxying - , module Happstack.Server.Proxy -- ** Looking up values in Query String, Request Body, and Cookies , module Happstack.Server.RqData -- ** Output Validation @@ -76,7 +75,6 @@ import Happstack.Server.Cookie import Happstack.Server.Error import Happstack.Server.Types -import Happstack.Server.Proxy import Happstack.Server.Routing import Happstack.Server.RqData import Happstack.Server.Response @@ -87,7 +85,7 @@ import qualified Data.Version as DV import Happstack.Server.Internal.Monads (FilterFun, WebT(..), unFilterFun, runServerPartT, ununWebT) import qualified Happstack.Server.Internal.Listen as Listen (listen, listen',listenOn, listenOnIPv4) -- So that we can disambiguate 'Writer.listen' -import Network (Socket) +import Network.Socket (Socket) import qualified Paths_happstack_server as Cabal import System.Console.GetOpt ( OptDescr(Option) , ArgDescr(ReqArg) diff --git a/tests/Happstack/Server/Tests.hs b/tests/Happstack/Server/Tests.hs --- a/tests/Happstack/Server/Tests.hs +++ b/tests/Happstack/Server/Tests.hs @@ -10,9 +10,11 @@ import Data.ByteString.Lazy.Char8 (pack, unpack) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L +import Data.List (intercalate) import qualified Data.Map as Map import Happstack.Server ( Request(..), Method(..), Response(..), ServerPart, Headers, RqBody(Body), HttpVersion(..) - , ToMessage(..), HeaderPair(..), ok, dir, simpleHTTP'', composeFilter, noContentLength, matchMethod) + , ToMessage(..), HeaderPair(..), ok, dir, simpleHTTP'', composeFilter, noContentLength, matchMethod + , look, getDataFn) import Happstack.Server.FileServe.BuildingBlocks (sendFileResponse) import Happstack.Server.Cookie import Happstack.Server.Internal.Compression @@ -34,6 +36,7 @@ , matchMethodTest , cookieHeaderOrderTest , pContentDispositionFilename + , applicativeTest ] cookieParserTest :: Test @@ -41,24 +44,24 @@ "cookieParserTest" ~: [parseCookies "$Version=1;Cookie1=value1;$Path=\"/testpath\";$Domain=example.com;cookie2=value2" @?= (Right [ - Cookie "1" "/testpath" "example.com" "cookie1" "value1" False False - , Cookie "1" "" "" "cookie2" "value2" False False + Cookie "1" "/testpath" "example.com" "cookie1" "value1" False False SameSiteNoValue False + , Cookie "1" "" "" "cookie2" "value2" False False SameSiteNoValue False ]) ,parseCookies " \t $Version = \"1\" ; cookie1 = \"randomcrap!@#%^&*()-_+={}[]:;'<>,.?/\\|\" , $Path=/ " @?= (Right [ - Cookie "1" "/" "" "cookie1" "randomcrap!@#%^&*()-_+={}[]:;'<>,.?/|" False False + Cookie "1" "/" "" "cookie1" "randomcrap!@#%^&*()-_+={}[]:;'<>,.?/|" False False SameSiteNoValue False ]) ,parseCookies " cookie1 = value1 " @?= (Right [ - Cookie "" "" "" "cookie1" "value1" False False + Cookie "" "" "" "cookie1" "value1" False False SameSiteNoValue False ]) ,parseCookies " $Version=\"1\";buggygooglecookie = valuewith=whereitshouldnotbe " @?= (Right [ - Cookie "1" "" "" "buggygooglecookie" "valuewith=whereitshouldnotbe" False False + Cookie "1" "" "" "buggygooglecookie" "valuewith=whereitshouldnotbe" False False SameSiteNoValue False ]) , parseCookies "foo=\"\\\"bar\\\"\"" @?= (Right [ - Cookie "" "" "" "foo" "\"bar\"" False False + Cookie "" "" "" "foo" "\"bar\"" False False SameSiteNoValue False ]) ] @@ -247,3 +250,13 @@ do let doesNotWorkWithOldParserButWithNew = "form-data; filename=\"file.pdf\"; name=\"file\"" :: String c <- parseContentDisposition doesNotWorkWithOldParserButWithNew assertEqual "parseContentDisposition" c (ContentDisposition "form-data" [("filename","file.pdf"),("name","file")]) + +applicativeTest :: Test +applicativeTest = + "applicativeTest" ~: + do req <- mkRequest GET "/response" [] mempty L.empty + res <- flip simpleHTTP'' req $ do + Left errors <- getDataFn $ (++) <$> look "a" <*> look "b" + pure $ intercalate "," errors + let ref = "Parameter not found: a,Parameter not found: b" + assertEqual "getDataFn/ReaderError doesn't short-circuit" ref (unpack (rsBody res))