happstack-server 7.4.6.4 → 7.9.3
raw patch · 31 files changed
Files
- README.md +1/−1
- happstack-server.cabal +39/−34
- src/Happstack/Server.hs +3/−9
- src/Happstack/Server/Auth.hs +63/−10
- src/Happstack/Server/Client.hs +0/−26
- src/Happstack/Server/Cookie.hs +6/−5
- src/Happstack/Server/Error.hs +5/−5
- src/Happstack/Server/FileServe/BuildingBlocks.hs +16/−22
- src/Happstack/Server/I18N.hs +1/−3
- src/Happstack/Server/Internal/Clock.hs +3/−10
- src/Happstack/Server/Internal/Compression.hs +10/−7
- src/Happstack/Server/Internal/Cookie.hs +67/−32
- src/Happstack/Server/Internal/Handler.hs +19/−7
- src/Happstack/Server/Internal/Listen.hs +40/−27
- src/Happstack/Server/Internal/LogFormat.hs +1/−5
- src/Happstack/Server/Internal/Monads.hs +55/−66
- src/Happstack/Server/Internal/Multipart.hs +6/−1
- src/Happstack/Server/Internal/RFC822Headers.hs +15/−10
- src/Happstack/Server/Internal/Socket.hs +5/−50
- src/Happstack/Server/Internal/SocketTH.hs +0/−35
- src/Happstack/Server/Internal/TimeoutIO.hs +1/−0
- src/Happstack/Server/Internal/TimeoutSocket.hs +14/−2
- src/Happstack/Server/Internal/Types.hs +31/−12
- src/Happstack/Server/Monads.hs +9/−2
- src/Happstack/Server/Proxy.hs +0/−92
- src/Happstack/Server/Response.hs +10/−9
- src/Happstack/Server/Routing.hs +1/−1
- src/Happstack/Server/RqData.hs +62/−16
- src/Happstack/Server/SURI.hs +2/−2
- src/Happstack/Server/SimpleHTTP.hs +4/−6
- tests/Happstack/Server/Tests.hs +31/−7
README.md view
@@ -1,4 +1,4 @@-# happstack-server [][hackage] [](https://travis-ci.org/Happstack/happstack-server)+# happstack-server [][hackage] [hackage]: https://hackage.haskell.org/package/happstack-server
happstack-server.cabal view
@@ -1,5 +1,5 @@ Name: happstack-server-Version: 7.4.6.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 <http://happstack.com/docs/crashcourse/index.html> License: BSD3@@ -11,28 +11,38 @@ 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 +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 Library+ Default-language: Haskell2010 Exposed-modules: Happstack.Server Happstack.Server.Auth Happstack.Server.Cookie Happstack.Server.Compression- Happstack.Server.Client Happstack.Server.Error Happstack.Server.FileServe Happstack.Server.FileServe.BuildingBlocks@@ -46,13 +56,13 @@ Happstack.Server.Internal.LogFormat Happstack.Server.Internal.MessageWrap Happstack.Server.Internal.Multipart+ Happstack.Server.Internal.RFC822Headers Happstack.Server.Internal.Socket Happstack.Server.Internal.TimeoutIO Happstack.Server.Internal.TimeoutManager Happstack.Server.Internal.TimeoutSocket Happstack.Server.Internal.Monads Happstack.Server.Monads- Happstack.Server.Proxy Happstack.Server.Response Happstack.Server.Routing Happstack.Server.RqData@@ -63,61 +73,54 @@ Other-modules: Happstack.Server.Internal.Clock Happstack.Server.Internal.LazyLiner- Happstack.Server.Internal.RFC822Headers- Happstack.Server.Internal.SocketTH Happstack.Server.SURI.ParseURI Paths_happstack_server if flag(network-uri)- build-depends: network > 2.6 && < 2.7,+ 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,- directory,+ directory >=1.2, exceptions, extensible-exceptions, 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, sendfile >= 0.7.1 && < 0.8, system-filepath >= 0.3.1, syb,- text >= 0.10 && < 1.3,- template-haskell < 2.12,- time,- time-compat,+ 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.6, 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 - Extensions: DeriveDataTypeable, MultiParamTypeClasses,- TypeFamilies, FlexibleContexts, OverlappingInstances,- FlexibleInstances, UndecidableInstances, ScopedTypeVariables,- TypeSynonymInstances, PatternGuards+ if impl(ghc < 8.6)+ Default-Extensions: MonadFailDesugaring++ Other-Extensions: DeriveDataTypeable, MultiParamTypeClasses,+ TypeFamilies, FlexibleContexts,+ FlexibleInstances, UndecidableInstances,+ ScopedTypeVariables, TypeSynonymInstances, PatternGuards CPP, ForeignFunctionInterface ghc-options: -Wall -fwarn-tabs -- The policy is to support GHC versions no older than the GHC stable@@ -125,16 +128,18 @@ -- 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+ Default-language: Haskell2010 Type: exitcode-stdio-1.0 Main-Is: Test.hs+ Other-Modules: Happstack.Server.Tests GHC-Options: -threaded hs-source-dirs: tests Build-depends: HUnit,- base,+ base >= 4 && < 5, bytestring, containers, happstack-server,
src/Happstack/Server.hs view
@@ -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 <http://happstack.com/docs/crashcourse/index.html>. -}-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
src/Happstack/Server/Auth.hs view
@@ -2,8 +2,12 @@ -- | Support for basic access authentication <http://en.wikipedia.org/wiki/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)@@ -25,26 +29,75 @@ -> M.Map String String -- ^ the username password map -> m a -- ^ the part to guard -> m a-basicAuth realmName authMap xs = basicAuthImpl `mplus` xs+basicAuth realmName authMap = basicAuthBy (validLoginPlaintext authMap) realmName+++-- | Generalized version of 'basicAuth'.+--+-- The function that checks the username password combination must be+-- supplied as first argument.+--+-- example:+--+-- > main = simpleHTTP nullConf $+-- > msum [ basicAuth' (validLoginPlaintext (fromList [("happstack","rocks")])) "127.0.0.1" $ ok "You are in the secret club"+-- > , ok "You are not in the secret club."+-- > ]+--+basicAuthBy :: (Happstack m) =>+ (B.ByteString -> B.ByteString -> Bool) -- ^ function that returns true if the name password combination is valid+ -> String -- ^ the realm name+ -> m a -- ^ the part to guard+ -> m a+basicAuthBy validLogin realmName xs = basicAuthImpl `mplus` xs where basicAuthImpl = do aHeader <- getHeaderM "authorization" case aHeader of Nothing -> err- Just x -> - do r <- parseHeader x - case r of- (name, ':':password) | validLogin name password -> mzero- | otherwise -> err- _ -> err- validLogin name password = M.lookup name authMap == Just password- parseHeader h = + Just x ->+ do (name, password) <- parseHeader x+ if B.length password > 0+ && B.head password == ':'+ && validLogin name (B.tail password)+ then mzero+ else err+ parseHeader h = case Base64.decode . B.drop 6 $ h of (Left _) -> err- (Right bs) -> return (break (':'==) (B.unpack bs))+ (Right bs) -> return (B.break (':'==) bs) headerName = "WWW-Authenticate" headerValue = "Basic realm=\"" ++ realmName ++ "\"" err :: (Happstack m) => m a err = escape $ do setHeaderM headerName headerValue unauthorized $ toResponse "Not authorized"+++-- | 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 = 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
− src/Happstack/Server/Client.hs
@@ -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 <http://hackage.haskell.org/package/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
src/Happstack/Server/Cookie.hs view
@@ -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 "")
src/Happstack/Server/Error.hs view
@@ -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
src/Happstack/Server/FileServe/BuildingBlocks.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, ScopedTypeVariables, Rank2Types #-}+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, ScopedTypeVariables, Rank2Types #-} -- | Build your own file serving functions -- -- If the functions in "Happstack.Server.FileServe" do not quite do@@ -54,18 +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.Compat (toUTCTime)+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)@@ -78,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@@ -104,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 --@@ -129,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"] @@ -138,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 @@ -219,7 +214,7 @@ do count <- liftIO $ withBinaryFile fp ReadMode hFileSize -- garbage collection should close this modtime <- liftIO $ getModificationTime fp rq <- askRq- return $ sendFileResponse contentType fp (Just (toUTCTime modtime, rq)) 0 count+ return $ sendFileResponse contentType fp (Just (modtime, rq)) 0 count -- | Send the specified file with the specified mime-type using lazy ByteStrings --@@ -236,7 +231,7 @@ modtime <- liftIO $ getModificationTime fp count <- liftIO $ hFileSize handle rq <- askRq- return $ lazyByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count+ return $ lazyByteStringResponse contentType contents (Just (modtime, rq)) 0 count -- | Send the specified file with the specified mime-type using strict ByteStrings --@@ -252,7 +247,7 @@ modtime <- liftIO $ getModificationTime fp count <- liftIO $ withBinaryFile fp ReadMode hFileSize rq <- askRq- return $ strictByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count+ return $ strictByteStringResponse contentType contents (Just (modtime, rq)) 0 count -- * High-level functions for serving files @@ -531,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 --@@ -614,7 +609,7 @@ -> IO (FilePath, Maybe UTCTime, Maybe Integer, EntryKind) getMetaData localPath fp = do let localFp = localPath </> fp- modTime <- (Just . toUTCTime <$> getModificationTime localFp) `E.catch`+ modTime <- (Just <$> getModificationTime localFp) `E.catch` (\(_ :: IOException) -> return Nothing) count <- do de <- doesDirectoryExist localFp if de@@ -633,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'. --@@ -716,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"),("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")]
src/Happstack/Server/I18N.hs view
@@ -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)
src/Happstack/Server/Internal/Clock.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# OPTIONS -fno-cse #-} module Happstack.Server.Internal.Clock ( getApproximateTime@@ -6,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)
src/Happstack/Server/Internal/Compression.hs view
@@ -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
src/Happstack/Server/Internal/Cookie.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-} -- http://tools.ietf.org/html/rfc2109 module Happstack.Server.Internal.Cookie ( Cookie(..) , CookieLife(..)+ , SameSite(..) , calcLife , mkCookie , mkCookieHeader@@ -17,22 +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@@ -42,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. --@@ -56,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@@ -72,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@@ -95,21 +123,29 @@ -- the first argument to this function. mkCookieHeader :: Maybe (Int, UTCTime) -> Cookie -> String mkCookieHeader mLife cookie =- let l = [("Domain=", cookieDomain cookie)- ,("Max-Age=", maybe "" (show . max 0 . fst) mLife)- ,("expires=", maybe "" (formatTime defaultTimeLocale "%a, %d-%b-%Y %X GMT" . snd) mLife)- ,("Path=", cookiePath cookie)- ,("Version=", s cookieVersion)]- s f | f cookie == "" = ""- s f = '\"' : concatMap e (f cookie) ++ "\""- e c | fctl c || c == '"' = ['\\',c]- | otherwise = [c]- in concat $ intersperse ";" ((cookieName cookie++"="++s cookieValue):[ (k++v) | (k,v) <- l, "" /= v ] ++- (if secure cookie then ["Secure"] else []) ++- (if httpOnly cookie then ["HttpOnly"] else []))--fctl :: Char -> Bool-fctl ch = ch == chr 127 || ch <= chr 31+ let+ l =+ [ (,) "Domain=" (cookieDomain cookie)+ , (,) "Max-Age=" (maybe "" (show . max 0 . fst) mLife)+ , (,) "expires=" (maybe "" (formatTime' . snd) mLife)+ , (,) "Path=" (cookiePath cookie)+ , (,) "Version=" (s cookieVersion)+ ]+ formatTime' =+ formatTime defaultTimeLocale "%a, %d-%b-%Y %X GMT"+ encode =+ escapeURIString+ (\c -> c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"))+ s f | f cookie == "" = ""+ | otherwise = '\"' : (encode $ f cookie) ++ "\""+ in+ concat $ intersperse ";" $+ (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@@ -133,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"@@ -169,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])@@ -188,9 +224,8 @@ 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 low = map toLower-
src/Happstack/Server/Internal/Handler.hs view
@@ -8,6 +8,7 @@ import qualified Paths_happstack_server as Paths import qualified Data.Version as DV+import Control.Applicative (pure) import Control.Concurrent (newMVar, newEmptyMVar, tryTakeMVar) import Control.Exception.Extensible as E import Control.Monad@@ -56,17 +57,19 @@ rloop timeoutIO mlog host handler inputStr | L.null inputStr = return () | otherwise- = join $+ = (join $ do let parseRequest = do (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)@@ -76,7 +79,7 @@ case parseRequest of Left err -> error $ "failed to parse HTTP request: " ++ err Right (m, u, cookies, v, headers, body, nextRequest)- -> return $+ -> pure $ do bodyRef <- newMVar (Body body) bodyInputRef <- newEmptyMVar let req = Request (toSecure timeoutIO) m (pathEls (path u)) (path u) (query u)@@ -85,7 +88,9 @@ let ioseq act = act >>= \x -> x `seq` return x (res, handlerKilled) <- ((, False) `liftM` ioseq (handler req))- `E.catch` \(e::E.SomeException) -> return (failResponse (show e), fromException e == Just ThreadKilled)+ `E.catches` [ Handler $ \(e::EscapeHTTP) -> throwIO e -- need to handle this higher up+ , Handler $ \(e::E.SomeException) -> pure (failResponse (show e), fromException e == Just ThreadKilled)+ ] case mlog of Nothing -> return ()@@ -106,8 +111,13 @@ cleanupTempFiles req -- do not continue if handler was killed when (not handlerKilled && continueHTTP req res) $- rloop timeoutIO mlog host handler nextRequest+ rloop timeoutIO mlog host handler nextRequest) `E.catch` (escapeHttpHandler timeoutIO) +escapeHttpHandler :: TimeoutIO+ -> EscapeHTTP+ -> IO ()+escapeHttpHandler tio (EscapeHTTP f) = f tio+ -- NOTE: if someone took the inputs and never put them back, then they are responsible for the cleanup cleanupTempFiles :: Request -> IO () cleanupTempFiles req =@@ -131,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,_) <-
src/Happstack/Server/Internal/Listen.hs view
@@ -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
src/Happstack/Server/Internal/LogFormat.hs view
@@ -1,14 +1,10 @@+{-# LANGUAGE CPP #-} module Happstack.Server.Internal.LogFormat ( formatTimeCombined , 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
src/Happstack/Server/Internal/Monads.hs view
@@ -6,22 +6,29 @@ import Control.Applicative (Applicative, pure, (<*>), Alternative(empty,(<|>))) import Control.Concurrent (newMVar)+import Control.Exception (throwIO) import Control.Monad ( MonadPlus(mzero, mplus), ap, liftM, msum ) 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)+import qualified Control.Monad.Fail as Fail+#endif import Control.Monad.Reader ( ReaderT(ReaderT), runReaderT , MonadReader, ask, local, mapReaderT ) 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 )@@ -44,13 +51,15 @@ import Data.List (inits, isPrefixOf, stripPrefix, tails) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(mempty, mappend), Dual(..), Endo(..))+import qualified Data.Semigroup as SG import qualified Paths_happstack_server as Cabal import qualified Data.Version as DV import Debug.Trace (trace) import Happstack.Server.Internal.Cookie (Cookie) import Happstack.Server.Internal.RFC822Headers (parseContentType)-import Happstack.Server.Internal.Types (canHaveBody)+import Happstack.Server.Internal.Types (EscapeHTTP(..), canHaveBody)+import Happstack.Server.Internal.TimeoutIO (TimeoutIO) import Happstack.Server.Types import Prelude (Bool(..), Either(..), Eq(..), Functor(..), IO, Monad(..), Char, Maybe(..), String, Show(..), ($), (.), (>), (++), (&&), (||), (=<<), const, concatMap, flip, id, otherwise, zip) @@ -67,7 +76,11 @@ -- -- see also: 'simpleHTTP', 'ServerMonad', 'FilterMonad', 'WebMonad', and 'HasRqData' newtype ServerPartT m a = ServerPartT { unServerPartT :: ReaderT Request (WebT m) a }+#if MIN_VERSION_base(4,9,0)+ deriving (Monad, MonadFail, MonadPlus, Functor)+#else deriving (Monad, MonadPlus, Functor)+#endif instance MonadCatch m => MonadCatch (ServerPartT m) where catch action handle = ServerPartT $ catch (unServerPartT action) (unServerPartT . handle)@@ -82,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 ->@@ -94,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@@ -182,9 +181,12 @@ instance MonadTrans (ServerPartT) where lift m = withRequest (\_ -> lift m) +instance (Monad m, MonadPlus m) => SG.Semigroup (ServerPartT m a) where+ (<>) = mplus+ instance (Monad m, MonadPlus m) => Monoid (ServerPartT m a) where mempty = mzero- mappend = mplus+ mappend = (SG.<>) instance (Monad m, Functor m) => Applicative (ServerPartT m) where pure = return@@ -280,12 +282,14 @@ data SetAppend a = Set a | Append a deriving (Eq, Show) -instance Monoid a => Monoid (SetAppend a) where- mempty = Append mempty+instance Monoid a => SG.Semigroup (SetAppend a) where+ Set x <> Append y = Set (x `mappend` y)+ Append x <> Append y = Append (x `mappend` y)+ _ <> Set y = Set y - Set x `mappend` Append y = Set (x `mappend` y)- Append x `mappend` Append y = Append (x `mappend` y)- _ `mappend` Set y = Set y+instance Monoid a => Monoid (SetAppend a) where+ mempty = Append mempty+ mappend = (SG.<>) -- | Extract the value from a 'SetAppend'. -- Note that a 'SetAppend' is actually a @CoPointed@ from:@@ -326,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@@ -336,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@@ -381,7 +373,7 @@ 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) instance MonadCatch m => MonadCatch (WebT m) where@@ -397,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@@ -490,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@@ -534,29 +513,32 @@ -- 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) +instance (Monad m, MonadPlus m) => SG.Semigroup (WebT m a) where+ (<>) = mplus+ instance (Monad m, MonadPlus m) => Monoid (WebT m a) where- mempty = mzero- mappend = mplus+ mempty = mzero+ mappend = (SG.<>) -- | 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)@@ -774,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@@ -790,6 +773,7 @@ instance (Error e, WebMonad a m) => WebMonad a (ErrorT e m) where finishWith = lift . finishWith+#endif -- ExceptT @@ -809,3 +793,8 @@ instance WebMonad a m => WebMonad a (ExceptT e m) where finishWith = lift . finishWith++escapeHTTP :: (ServerMonad m, MonadIO m) =>+ (TimeoutIO -> IO ())+ -> m a+escapeHTTP h = liftIO (throwIO (EscapeHTTP h))
src/Happstack/Server/Internal/Multipart.hs view
@@ -72,11 +72,16 @@ -> IO (Bool, Int64 , FilePath) -- ^ truncated?, saved bytes, saved filename defaultFileSaver :: FilePath -> Int64 -> FilePath -> ByteString -> IO (Bool, Int64, FilePath)-defaultFileSaver tmpDir diskQuota filename b =+defaultFileSaver tmpDir diskQuota filename b+ | pathSeparator filename = error ("Filename contains path separators: " ++ show filename)+ | otherwise = do (fn, h) <- openBinaryTempFile tmpDir filename (trunc, len) <- hPutLimit diskQuota h b hClose h return (trunc, len, fn)+ where+ pathSeparator :: String -> Bool+ pathSeparator template = any (\x-> x == '/' || x == '\\') template defaultInputIter :: FileSaver -> FilePath -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Work -> IO InputIter defaultInputIter fileSaver tmpDir diskCount ramCount headerCount maxDisk maxRAM maxHeader (BodyWork ctype ps b)
src/Happstack/Server/Internal/RFC822Headers.hs view
@@ -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@@ -94,7 +95,11 @@ -- where nothing is escaped in the filename parameter -- of the content-disposition header in multipart/form-data let litStr = if p_name == "filename"- then buggyLiteralString+ then choice [ try ((lookAhead $ do+ void (literalString >>+ p_parameter))+ >> literalString)+ , buggyLiteralString] else literalString p_value <- litStr <|> p_token return (map toLower p_name, p_value)@@ -145,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 --@@ -165,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 @@ -188,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 @@ -199,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 --
src/Happstack/Server/Internal/Socket.hs view
@@ -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"
− src/Happstack/Server/Internal/SocketTH.hs
@@ -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
src/Happstack/Server/Internal/TimeoutIO.hs view
@@ -15,6 +15,7 @@ { toHandle :: Handle , toPutLazy :: L.ByteString -> IO () , toPut :: B.ByteString -> IO ()+ , toGet :: IO (Maybe B.ByteString) , toGetContents :: IO L.ByteString , toSendFile :: FilePath -> Offset -> ByteCount -> IO () , toShutdown :: IO ()
src/Happstack/Server/Internal/TimeoutSocket.hs view
@@ -4,6 +4,7 @@ -} module Happstack.Server.Internal.TimeoutSocket where +import Control.Applicative (pure) import Control.Concurrent (threadWaitWrite) import Control.Exception as E (catch, throw) import Control.Monad (liftM, when)@@ -11,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(..))@@ -34,6 +35,16 @@ return () {-# INLINE sPutTickle #-} +sGet :: TM.Handle+ -> Socket+ -> IO (Maybe B.ByteString)+sGet handle socket =+ do s <- N.recv socket 65536+ TM.tickle handle+ if S.null s+ then pure Nothing+ else pure (Just s)+ sGetContents :: TM.Handle -> Socket -- ^ Connected socket -> IO L.ByteString -- ^ Data received@@ -77,8 +88,9 @@ 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 , toGetContents = sGetContents handle socket , toSendFile = sendFileTickle handle socket
src/Happstack/Server/Internal/Types.hs view
@@ -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(..),@@ -16,10 +16,15 @@ HttpVersion(..), Length(..), Method(..), canHaveBody, Headers, continueHTTP, Host, ContentType(..), readDec', fromReadS, readM, FromReqURI(..),- showRsValidator+ showRsValidator, EscapeHTTP(..) ) where -import Control.Monad.Error (Error(strMsg))++import Control.Exception (Exception, SomeException)+#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@@ -27,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@@ -43,6 +47,7 @@ import Happstack.Server.Internal.RFC822Headers ( ContentType(..) ) import Happstack.Server.Internal.Cookie import Happstack.Server.Internal.LogFormat (formatRequestCombined)+import Happstack.Server.Internal.TimeoutIO (TimeoutIO) import Numeric (readDec, readSigned) import System.Log.Logger (Priority(..), logM) @@ -111,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@@ -133,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? --@@ -173,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@@ -198,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)@@ -219,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{} =@@ -242,11 +246,13 @@ showRsValidator :: Maybe (Response -> IO Response) -> String showRsValidator = maybe "Nothing" (const "Just <function>") +#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@@ -262,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 =@@ -321,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.@@ -462,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"@@ -515,3 +521,16 @@ "1" -> Just True "true" -> Just True _ -> Nothing++------------------------------------------------------------------------------+-- EscapeHTTP - escape hatched use by websockets+------------------------------------------------------------------------------++-- | Escape from the HTTP world and get direct access to the underlying 'TimeoutIO' functions+data EscapeHTTP+ = EscapeHTTP (TimeoutIO -> IO ())++instance Exception EscapeHTTP++instance Show EscapeHTTP where+ show (EscapeHTTP {}) = "<EscapeHTTP _>"
src/Happstack/Server/Monads.hs view
@@ -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. --@@ -35,11 +35,15 @@ -- * MonadPlus helpers , require , requireM+ -- * escapeHTTP+ , escapeHTTP ) where 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)@@ -69,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.@@ -109,3 +115,4 @@ case mbVal of Nothing -> mzero Just a -> handle a+
− src/Happstack/Server/Proxy.hs
@@ -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--
src/Happstack/Server/Response.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances, ScopedTypeVariables #-}+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, ScopedTypeVariables #-} -- | Functions and classes related to generating a 'Response' and setting the response code. For detailed instruction see the Happstack Crash Course: <http://www.happstack.com/docs/crashcourse/index.html#creating-a-response> module Happstack.Server.Response ( -- * Converting values to a 'Response'@@ -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'.@@ -97,7 +95,7 @@ toContentType _ = B.pack "text/plain" toMessage :: a -> L.ByteString toMessage = error "Happstack.Server.SimpleHTTP.ToMessage.toMessage: Not defined"- toResponse:: a -> Response+ toResponse :: a -> Response toResponse val = let bs = toMessage val res = Response 200 M.empty nullRsFlags bs Nothing@@ -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
src/Happstack/Server/Routing.hs view
@@ -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)
src/Happstack/Server/RqData.hs view
@@ -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,9 +78,10 @@ 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 import Data.Text (Text) import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText@@ -86,20 +90,39 @@ import Happstack.Server.Types import Happstack.Server.Internal.MessageWrap (BodyPolicy(..), bodyInput, defaultBodyPolicy) import Happstack.Server.Response (requestEntityTooLarge, toResponse)+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) @@ -111,17 +134,37 @@ -- | 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)+ instance Monoid (Errors a) where mempty = Errors []- (Errors x) `mappend` (Errors y) = Errors (x ++ y)+ 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 ())@@ -199,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@@ -259,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@@ -447,7 +491,9 @@ = do (_query,_body, cookies) <- askRqEnv case lookup (map toLower name) cookies of -- keys are lowercased Nothing -> rqDataError $ strMsg $ "lookCookie: cookie not found: " ++ name- Just c -> return c+ Just c -> return c{cookieValue = f c}+ where+ f = unEscapeString . cookieValue -- | gets the named cookie as a string lookCookieValue :: (Functor m, Monad m, HasRqData m) => String -> m String
src/Happstack/Server/SURI.hs view
@@ -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
src/Happstack/Server/SimpleHTTP.hs view
@@ -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: <http://localhost:8000/>+-- By default the server will listen on port 8000. Run the app and point your browser at: <http:\/\/localhost:8000\/> ----- For FastCGI support see: <http://hackage.haskell.org/package/happstack-fastcgi>+-- For FastCGI support see: <http:\/\/hackage.haskell.org\/package\/happstack-fastcgi> ----------------------------------------------------------------------------- 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)
tests/Happstack/Server/Tests.hs view
@@ -10,15 +10,18 @@ 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 import Happstack.Server.Internal.Cookie import Happstack.Server.Internal.Multipart import Happstack.Server.Internal.MessageWrap+import Happstack.Server.Internal.RFC822Headers (ContentDisposition(..), parseContentDisposition) import Happstack.Server.SURI(ToSURI(..), path, query) import Test.HUnit as HU (Test(..), (~:), (@?=), (@=?), assertEqual) import Text.ParserCombinators.Parsec@@ -32,6 +35,8 @@ , compressFilterResponseTest , matchMethodTest , cookieHeaderOrderTest+ , pContentDispositionFilename+ , applicativeTest ] cookieParserTest :: Test@@ -39,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 ]) ] @@ -236,3 +241,22 @@ where gethead = [GET, HEAD] others = [POST, PUT, DELETE, TRACE, OPTIONS, CONNECT]+++-- | https://github.com/Happstack/happstack-server/pull/56+pContentDispositionFilename :: Test+pContentDispositionFilename =+ "pContentDispositionFilename" ~:+ 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))