{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, ViewPatterns, RecordWildCards, DeriveFunctor #-}

module General.Web(
    Input(..),
    Output(..), readInput, server, general_web_test
    ) where

import Network.Wai.Handler.Warp hiding (Port, Handle)
import Network.Wai.Handler.WarpTLS

import Action.CmdLine
import Network.Wai.Logger
import Network.Wai
import Control.DeepSeq
import Network.HTTP.Types (parseQuery, decodePathSegments)
import Network.HTTP.Types.Status
import qualified Data.Text as Text
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.List.Extra
import Data.Aeson.Encoding
import Data.Char
import Data.String
import Data.Tuple.Extra
import Data.Maybe
import Data.Monoid
import System.FilePath
import Control.Exception.Extra
import System.Time.Extra
import General.Log
import General.Util
import Prelude
import qualified Data.ByteString.UTF8 as UTF8


data Input = Input
    {Input -> [FilePath]
inputURL :: [String]
    ,Input -> [(FilePath, FilePath)]
inputArgs :: [(String, String)]
    } deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
/= :: Input -> Input -> Bool
Eq, Int -> Input -> ShowS
[Input] -> ShowS
Input -> FilePath
(Int -> Input -> ShowS)
-> (Input -> FilePath) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> FilePath
show :: Input -> FilePath
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)

readInput :: String -> Maybe Input
readInput :: FilePath -> Maybe Input
readInput (FilePath -> FilePath -> (FilePath, FilePath)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn FilePath
"?" -> (FilePath
a,FilePath
b)) =
  if ([FilePath] -> Bool
badPath [FilePath]
path Bool -> Bool -> Bool
|| [(FilePath, FilePath)] -> Bool
forall {b}. [(FilePath, b)] -> Bool
badArgs [(FilePath, FilePath)]
args) then Maybe Input
forall a. Maybe a
Nothing else Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [(FilePath, FilePath)] -> Input
Input [FilePath]
path [(FilePath, FilePath)]
args
  where
    path :: [FilePath]
path = FilePath -> [FilePath]
parsePath FilePath
a
    parsePath :: FilePath -> [FilePath]
parsePath = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack
              ([Text] -> [FilePath])
-> (FilePath -> [Text]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Text]
decodePathSegments
              (ByteString -> [Text])
-> (FilePath -> ByteString) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BS.pack
    -- Note that there is a difference between URL paths
    -- which split on / and only that and file paths where
    -- an escaped %2f is equivalent to /. decodePathSegments
    -- (correctly) only considers the former so here
    -- we add an extra check that the result (which has unescaped %2f to /)
    -- does not contain path separators.
    badPath :: [FilePath] -> Bool
badPath = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
forall {t :: * -> *}. Foldable t => t Char -> Bool
badSegment ([FilePath] -> Bool)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"")
    badSegment :: t Char -> Bool
badSegment t Char
seg = (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') t Char
seg Bool -> Bool -> Bool
|| (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPathSeparator t Char
seg
    args :: [(FilePath, FilePath)]
args = FilePath -> [(FilePath, FilePath)]
parseArgs FilePath
b
    parseArgs :: FilePath -> [(FilePath, FilePath)]
parseArgs = ((ByteString, Maybe ByteString) -> (FilePath, FilePath))
-> [(ByteString, Maybe ByteString)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> FilePath
UTF8.toString (ByteString -> FilePath)
-> (Maybe ByteString -> FilePath)
-> (ByteString, Maybe ByteString)
-> (FilePath, FilePath)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** FilePath
-> (ByteString -> FilePath) -> Maybe ByteString -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ByteString -> FilePath
UTF8.toString)
              ([(ByteString, Maybe ByteString)] -> [(FilePath, FilePath)])
-> (FilePath -> [(ByteString, Maybe ByteString)])
-> FilePath
-> [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, Maybe ByteString)]
parseQuery
              (ByteString -> [(ByteString, Maybe ByteString)])
-> (FilePath -> ByteString)
-> FilePath
-> [(ByteString, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
UTF8.fromString
    badArgs :: [(FilePath, b)] -> Bool
badArgs = Bool -> Bool
not (Bool -> Bool)
-> ([(FilePath, b)] -> Bool) -> [(FilePath, b)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, b) -> Bool) -> [(FilePath, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLower (FilePath -> Bool)
-> ((FilePath, b) -> FilePath) -> (FilePath, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, b) -> FilePath
forall a b. (a, b) -> a
fst)

data Output
    = OutputText LBS.ByteString
    | OutputHTML LBS.ByteString
    | OutputJavascript LBS.ByteString
    | OutputJSON Encoding
    | OutputFail LBS.ByteString
    | OutputFile FilePath
      deriving Int -> Output -> ShowS
[Output] -> ShowS
Output -> FilePath
(Int -> Output -> ShowS)
-> (Output -> FilePath) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> FilePath
show :: Output -> FilePath
$cshowList :: [Output] -> ShowS
showList :: [Output] -> ShowS
Show

-- | Force all the output (no delayed exceptions) and produce bytestrings
forceBS :: Output -> LBS.ByteString
forceBS :: Output -> ByteString
forceBS (OutputText ByteString
x) = ByteString -> ByteString
forall a. NFData a => a -> a
force ByteString
x
forceBS (OutputJSON Encoding
x) = ByteString -> ByteString
forall a. NFData a => a -> a
force (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString Encoding
x
forceBS (OutputHTML ByteString
x) = ByteString -> ByteString
forall a. NFData a => a -> a
force ByteString
x
forceBS (OutputJavascript ByteString
x) = ByteString -> ByteString
forall a. NFData a => a -> a
force ByteString
x
forceBS (OutputFail ByteString
x) = ByteString -> ByteString
forall a. NFData a => a -> a
force ByteString
x
forceBS (OutputFile FilePath
x) = FilePath -> ()
forall a. NFData a => a -> ()
rnf FilePath
x () -> ByteString -> ByteString
forall a b. a -> b -> b
`seq` ByteString
LBS.empty

instance NFData Output where
    rnf :: Output -> ()
rnf Output
x = Output -> ByteString
forceBS Output
x ByteString -> () -> ()
forall a b. a -> b -> b
`seq` ()

server :: Log -> CmdLine -> (Input -> IO Output) -> IO ()
server :: Log -> CmdLine -> (Input -> IO Output) -> IO ()
server Log
log Server{Bool
Int
FilePath
Maybe FilePath
Language
port :: Int
database :: FilePath
cdn :: FilePath
logs :: FilePath
local :: Bool
haddock :: Maybe FilePath
links :: Bool
language :: Language
scope :: FilePath
home :: FilePath
host :: FilePath
https :: Bool
cert :: FilePath
key :: FilePath
datadir :: Maybe FilePath
no_security_headers :: Bool
database :: CmdLine -> FilePath
language :: CmdLine -> Language
haddock :: CmdLine -> Maybe FilePath
port :: CmdLine -> Int
cdn :: CmdLine -> FilePath
logs :: CmdLine -> FilePath
local :: CmdLine -> Bool
links :: CmdLine -> Bool
scope :: CmdLine -> FilePath
home :: CmdLine -> FilePath
host :: CmdLine -> FilePath
https :: CmdLine -> Bool
cert :: CmdLine -> FilePath
key :: CmdLine -> FilePath
datadir :: CmdLine -> Maybe FilePath
no_security_headers :: CmdLine -> Bool
..} Input -> IO Output
act = do
    let
        host' :: HostPreference
host' = FilePath -> HostPreference
forall a. IsString a => FilePath -> a
fromString (FilePath -> HostPreference) -> FilePath -> HostPreference
forall a b. (a -> b) -> a -> b
$
                  if FilePath
host FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" then
                    if Bool
local then
                      FilePath
"127.0.0.1"
                    else
                      FilePath
"*"
                  else
                    FilePath
host
        set :: Settings
set = (SomeException -> Response) -> Settings -> Settings
setOnExceptionResponse SomeException -> Response
exceptionResponseForDebug
            (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostPreference -> Settings -> Settings
setHost HostPreference
host'
            (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Settings -> Settings
setPort Int
port (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$
            Settings
defaultSettings
        runServer :: Application -> IO ()
        runServer :: Application -> IO ()
runServer = if Bool
https then TLSSettings -> Settings -> Application -> IO ()
runTLS (FilePath -> FilePath -> TLSSettings
tlsSettings FilePath
cert FilePath
key) Settings
set
                             else Settings -> Application -> IO ()
runSettings Settings
set
        secH :: [(HeaderName, ByteString)]
secH = if Bool
no_security_headers then []
                                      else [
             -- The CSP is giving additional instructions to the browser.
             (HeaderName
"Content-Security-Policy",
              -- For any content type not specifically enumerated in this CSP
              -- (e.g. fonts), the only valid origin is the same as the current
              -- page.
              ByteString
"default-src 'self';"
              -- As an exception to the default rule, allow scripts from jquery
              -- and the CDN.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" script-src 'self' https://code.jquery.com/ https://rawcdn.githack.com;"
              -- As an exception to the default rule, allow stylesheets from
              -- the CDN. TODO: for now, we are also enabling inline styles,
              -- because it the chosen plugin uses them.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" style-src 'self' 'unsafe-inline' https://rawcdn.githack.com;"
              -- As an exception to the default rule, allow images from the
              -- CDN.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" img-src 'self' https://rawcdn.githack.com;"
              -- Only allow this request in an iframe if the containing page
              -- has the same origin.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" frame-ancestors 'self';"
              -- Forms are only allowed to target addresses under the same
              -- origin as the page.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" form-action 'self';"
              -- Any request originating from this page and specifying http as
              -- its protocol will be automatically upgraded to https.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" upgrade-insecure-requests;"
              -- Do not display http content if the page was loaded under
              -- https.
              ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" block-all-mixed-content"),

             -- Tells the browser this web page should not be rendered inside a
             -- frame, except if the framing page comes from the same origin
             -- (i.e. DNS name + port). This is to thwart invisible, keylogging
             -- framing pages.
             (HeaderName
"X-Frame-Options", ByteString
"sameorigin"),

             -- Tells browsers to trust the Content-Type header and not try to
             -- otherwise guess at response types. In particular, prevents
             -- dangerous browser behaviour that would execute a file loaded
             -- from a <script> or <style> tag despite not having a
             -- text/javascript or text/css Content-Type.
             (HeaderName
"X-Content-Type-Options", ByteString
"nosniff"),

             -- Browser should try to detect "reflected" XSS attacks, where
             -- some suspicious payload of the request appears in the response.
             -- How browsers do that is unspecified. On detection, browser
             -- should block the page from rendering at all.
             (HeaderName
"X-XSS-Protection", ByteString
"1; mode=block"),

             -- Do not include referrer information if user-agent generates a
             -- request from an HTTPS page to an HTTP one. Note: this is
             -- technically redundant as this should be the browser default
             -- behaviour.
             (HeaderName
"Referrer-Policy", ByteString
"no-referrer-when-downgrade"),

             -- Strict Transport Security (aka HSTS) tells the browser that,
             -- from now on and until max-age seconds have passed, it should
             -- never try to connect to this domain name through unprotected
             -- HTTP. The browser will automatically upgrade any HTTP request
             -- to this domain name to HTTPS, client side, before any network
             -- call happens.
             (HeaderName
"Strict-Transport-Security", ByteString
"max-age=31536000; includeSubDomains")]

    Log -> FilePath -> IO ()
logAddMessage Log
log (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Server starting on port " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
port FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" and host/IP " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ HostPreference -> FilePath
forall a. Show a => a -> FilePath
show HostPreference
host'

    Application -> IO ()
runServer (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$ \Request
req Response -> IO ResponseReceived
reply -> do
        let pq :: FilePath
pq = ByteString -> FilePath
BS.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rawPathInfo Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
rawQueryString Request
req
        FilePath -> IO ()
putStrLn FilePath
pq
        (Seconds
time, Either FilePath (Output, ByteString)
res) <- IO (Either FilePath (Output, ByteString))
-> IO (Seconds, Either FilePath (Output, ByteString))
forall (m :: * -> *) a. MonadIO m => m a -> m (Seconds, a)
duration (IO (Either FilePath (Output, ByteString))
 -> IO (Seconds, Either FilePath (Output, ByteString)))
-> IO (Either FilePath (Output, ByteString))
-> IO (Seconds, Either FilePath (Output, ByteString))
forall a b. (a -> b) -> a -> b
$ case FilePath -> Maybe Input
readInput FilePath
pq of
            Maybe Input
Nothing -> Either FilePath (Output, ByteString)
-> IO (Either FilePath (Output, ByteString))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (Output, ByteString)
 -> IO (Either FilePath (Output, ByteString)))
-> Either FilePath (Output, ByteString)
-> IO (Either FilePath (Output, ByteString))
forall a b. (a -> b) -> a -> b
$ (Output, ByteString) -> Either FilePath (Output, ByteString)
forall a b. b -> Either a b
Right (ByteString -> Output
OutputFail ByteString
"", FilePath -> ByteString
LBS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"Bad URL: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pq)
            Just Input
pay ->
                (SomeException -> IO (Either FilePath (Output, ByteString)))
-> IO (Either FilePath (Output, ByteString))
-> IO (Either FilePath (Output, ByteString))
forall a. (SomeException -> IO a) -> IO a -> IO a
handle_ ((FilePath -> Either FilePath (Output, ByteString))
-> IO FilePath -> IO (Either FilePath (Output, ByteString))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Either FilePath (Output, ByteString)
forall a b. a -> Either a b
Left (IO FilePath -> IO (Either FilePath (Output, ByteString)))
-> (SomeException -> IO FilePath)
-> SomeException
-> IO (Either FilePath (Output, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> IO FilePath
forall e. Show e => e -> IO FilePath
showException) (IO (Either FilePath (Output, ByteString))
 -> IO (Either FilePath (Output, ByteString)))
-> IO (Either FilePath (Output, ByteString))
-> IO (Either FilePath (Output, ByteString))
forall a b. (a -> b) -> a -> b
$ do
                    Output
s <- Input -> IO Output
act Input
pay; ByteString
bs <- ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Output -> ByteString
forceBS Output
s; Either FilePath (Output, ByteString)
-> IO (Either FilePath (Output, ByteString))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (Output, ByteString)
 -> IO (Either FilePath (Output, ByteString)))
-> Either FilePath (Output, ByteString)
-> IO (Either FilePath (Output, ByteString))
forall a b. (a -> b) -> a -> b
$ (Output, ByteString) -> Either FilePath (Output, ByteString)
forall a b. b -> Either a b
Right (Output
s, ByteString
bs)
        Log -> FilePath -> FilePath -> Seconds -> Maybe FilePath -> IO ()
logAddEntry Log
log (SockAddr -> FilePath
showSockAddr (SockAddr -> FilePath) -> SockAddr -> FilePath
forall a b. (a -> b) -> a -> b
$ Request -> SockAddr
remoteHost Request
req) FilePath
pq Seconds
time ((FilePath -> Maybe FilePath)
-> ((Output, ByteString) -> Maybe FilePath)
-> Either FilePath (Output, ByteString)
-> Maybe FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Maybe FilePath -> (Output, ByteString) -> Maybe FilePath
forall a b. a -> b -> a
const Maybe FilePath
forall a. Maybe a
Nothing) Either FilePath (Output, ByteString)
res)
        case Either FilePath (Output, ByteString)
res of
            Left FilePath
s -> Response -> IO ResponseReceived
reply (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status500 [] (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
LBS.pack FilePath
s
            Right (Output
v, ByteString
bs) -> Response -> IO ResponseReceived
reply (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ case Output
v of
                OutputFile FilePath
file -> Status
-> [(HeaderName, ByteString)]
-> FilePath
-> Maybe FilePart
-> Response
responseFile Status
status200
                    ([(HeaderName
"content-type",ByteString
c) | Just ByteString
c <- [FilePath -> [(FilePath, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
takeExtension FilePath
file) [(FilePath, ByteString)]
contentType]] [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(HeaderName, ByteString)]
secH) FilePath
file Maybe FilePart
forall a. Maybe a
Nothing
                OutputText{} -> Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status200 ((HeaderName
"content-type",ByteString
"text/plain") (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
secH) ByteString
bs
                OutputJSON{} -> Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status200 ((HeaderName
"content-type",ByteString
"application/json") (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: (HeaderName
"access-control-allow-origin",ByteString
"*") (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
secH) ByteString
bs
                OutputFail{} -> Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status400 ((HeaderName
"content-type",ByteString
"text/plain") (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
secH) ByteString
bs
                OutputHTML{} -> Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status200 ((HeaderName
"content-type",ByteString
"text/html") (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
secH) ByteString
bs
                OutputJavascript{} -> Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status200 ((HeaderName
"content-type",ByteString
"text/javascript") (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
secH) ByteString
bs

contentType :: [(FilePath, ByteString)]
contentType = [(FilePath
".html",ByteString
"text/html"),(FilePath
".css",ByteString
"text/css"),(FilePath
".js",ByteString
"text/javascript")]

general_web_test :: IO ()
general_web_test :: IO ()
general_web_test = do
    FilePath -> IO () -> IO ()
testing FilePath
"General.Web.readInput" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let b
a === :: b -> b -> IO ()
=== b
b = if b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then Char -> IO ()
putChar Char
'.' else FilePath -> IO ()
forall a. Partial => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ (b, b) -> FilePath
forall a. Show a => a -> FilePath
show (b
a,b
b)
        FilePath -> Maybe Input
readInput FilePath
"abc" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Input -> Maybe Input
forall a. a -> Maybe a
Just ([FilePath] -> [(FilePath, FilePath)] -> Input
Input [FilePath
"abc"] [])
        FilePath -> Maybe Input
readInput FilePath
"/abc" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Input -> Maybe Input
forall a. a -> Maybe a
Just ([FilePath] -> [(FilePath, FilePath)] -> Input
Input [FilePath
"abc"] [])
        FilePath -> Maybe Input
readInput FilePath
"/abc/" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Input -> Maybe Input
forall a. a -> Maybe a
Just ([FilePath] -> [(FilePath, FilePath)] -> Input
Input [FilePath
"abc", FilePath
""] [])
        FilePath -> Maybe Input
readInput FilePath
"abc?ab=cd&ef=gh" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Input -> Maybe Input
forall a. a -> Maybe a
Just ([FilePath] -> [(FilePath, FilePath)] -> Input
Input [FilePath
"abc"] [(FilePath
"ab", FilePath
"cd"), (FilePath
"ef", FilePath
"gh")])
        FilePath -> Maybe Input
readInput FilePath
"%2fabc" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"%2F" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"def%2fabc" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"." Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
".." Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"..a" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Input -> Maybe Input
forall a. a -> Maybe a
Just ([FilePath] -> [(FilePath, FilePath)] -> Input
Input [FilePath
"..a"] [])
        FilePath -> Maybe Input
readInput FilePath
"../a" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"a/../a" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"%2e" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing
        FilePath -> Maybe Input
readInput FilePath
"%2E" Maybe Input -> Maybe Input -> IO ()
forall {b}. (Eq b, Show b) => b -> b -> IO ()
=== Maybe Input
forall a. Maybe a
Nothing