{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Handler.Warp.Types where
import qualified Data.ByteString as S
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Typeable (Typeable)
import qualified UnliftIO
#ifdef MIN_VERSION_crypton_x509
import Data.X509
#endif
import Network.Socket (SockAddr)
import Network.Socket.BufferPool
import System.Posix.Types (Fd)
import qualified System.TimeManager as T
import qualified Network.Wai.Handler.Warp.Date as D
import qualified Network.Wai.Handler.Warp.FdCache as F
import qualified Network.Wai.Handler.Warp.FileInfoCache as I
import Network.Wai.Handler.Warp.Imports
type Port = Int
type = ByteString
data InvalidRequest
= NotEnoughLines [String]
| BadFirstLine String
| NonHttp
|
| ConnectionClosedByPeer
|
| String
|
PayloadTooLarge
|
deriving (InvalidRequest -> InvalidRequest -> Bool
(InvalidRequest -> InvalidRequest -> Bool)
-> (InvalidRequest -> InvalidRequest -> Bool) -> Eq InvalidRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidRequest -> InvalidRequest -> Bool
== :: InvalidRequest -> InvalidRequest -> Bool
$c/= :: InvalidRequest -> InvalidRequest -> Bool
/= :: InvalidRequest -> InvalidRequest -> Bool
Eq, Typeable)
instance Show InvalidRequest where
show :: InvalidRequest -> String
show (NotEnoughLines [String]
xs) = String
"Warp: Incomplete request headers, received: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
xs
show (BadFirstLine String
s) = String
"Warp: Invalid first line of request: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
show InvalidRequest
NonHttp = String
"Warp: Request line specified a non-HTTP request"
show InvalidRequest
IncompleteHeaders = String
"Warp: Request headers did not finish transmission"
show InvalidRequest
ConnectionClosedByPeer = String
"Warp: Client closed connection prematurely"
show InvalidRequest
OverLargeHeader =
String
"Warp: Request headers too large, possible memory attack detected. Closing connection."
show (BadProxyHeader String
s) = String
"Warp: Invalid PROXY protocol header: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
show InvalidRequest
RequestHeaderFieldsTooLarge = String
"Request header fields too large"
show InvalidRequest
PayloadTooLarge = String
"Payload too large"
instance UnliftIO.Exception InvalidRequest
newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody UnliftIO.SomeException
deriving (Int -> ExceptionInsideResponseBody -> ShowS
[ExceptionInsideResponseBody] -> ShowS
ExceptionInsideResponseBody -> String
(Int -> ExceptionInsideResponseBody -> ShowS)
-> (ExceptionInsideResponseBody -> String)
-> ([ExceptionInsideResponseBody] -> ShowS)
-> Show ExceptionInsideResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExceptionInsideResponseBody -> ShowS
showsPrec :: Int -> ExceptionInsideResponseBody -> ShowS
$cshow :: ExceptionInsideResponseBody -> String
show :: ExceptionInsideResponseBody -> String
$cshowList :: [ExceptionInsideResponseBody] -> ShowS
showList :: [ExceptionInsideResponseBody] -> ShowS
Show, Typeable)
instance UnliftIO.Exception ExceptionInsideResponseBody
data FileId = FileId
{ FileId -> String
fileIdPath :: FilePath
, FileId -> Maybe Fd
fileIdFd :: Maybe Fd
}
type SendFile = FileId -> Integer -> Integer -> IO () -> [ByteString] -> IO ()
data WriteBuffer = WriteBuffer
{ WriteBuffer -> Buffer
bufBuffer :: Buffer
, WriteBuffer -> Int
bufSize :: !BufSize
, WriteBuffer -> IO ()
bufFree :: IO ()
}
type RecvBuf = Buffer -> BufSize -> IO Bool
data Connection = Connection
{ Connection -> [ByteString] -> IO ()
connSendMany :: [ByteString] -> IO ()
, Connection -> ByteString -> IO ()
connSendAll :: ByteString -> IO ()
, Connection -> SendFile
connSendFile :: SendFile
, Connection -> IO ()
connClose :: IO ()
, Connection -> Recv
connRecv :: Recv
, Connection -> RecvBuf
connRecvBuf :: RecvBuf
, Connection -> IORef WriteBuffer
connWriteBuffer :: IORef WriteBuffer
, Connection -> IORef Bool
connHTTP2 :: IORef Bool
, Connection -> SockAddr
connMySockAddr :: SockAddr
}
getConnHTTP2 :: Connection -> IO Bool
getConnHTTP2 :: Connection -> IO Bool
getConnHTTP2 = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool)
-> (Connection -> IORef Bool) -> Connection -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IORef Bool
connHTTP2
setConnHTTP2 :: Connection -> Bool -> IO ()
setConnHTTP2 :: Connection -> Bool -> IO ()
setConnHTTP2 = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (IORef Bool -> Bool -> IO ())
-> (Connection -> IORef Bool) -> Connection -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IORef Bool
connHTTP2
data InternalInfo = InternalInfo
{ InternalInfo -> Manager
timeoutManager :: T.Manager
, InternalInfo -> Recv
getDate :: IO D.GMTDate
, InternalInfo -> String -> IO (Maybe Fd, IO ())
getFd :: FilePath -> IO (Maybe F.Fd, F.Refresh)
, InternalInfo -> String -> IO FileInfo
getFileInfo :: FilePath -> IO I.FileInfo
}
data Source = Source !(IORef ByteString) !(IO ByteString)
mkSource :: IO ByteString -> IO Source
mkSource :: Recv -> IO Source
mkSource Recv
func = do
IORef ByteString
ref <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
S.empty
Source -> IO Source
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> IO Source) -> Source -> IO Source
forall a b. (a -> b) -> a -> b
$! IORef ByteString -> Recv -> Source
Source IORef ByteString
ref Recv
func
readSource :: Source -> IO ByteString
readSource :: Source -> Recv
readSource (Source IORef ByteString
ref Recv
func) = do
ByteString
bs <- IORef ByteString -> Recv
forall a. IORef a -> IO a
readIORef IORef ByteString
ref
if ByteString -> Bool
S.null ByteString
bs
then Recv
func
else do
IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
ref ByteString
S.empty
ByteString -> Recv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
readSource' :: Source -> IO ByteString
readSource' :: Source -> Recv
readSource' (Source IORef ByteString
_ Recv
func) = Recv
func
leftoverSource :: Source -> ByteString -> IO ()
leftoverSource :: Source -> ByteString -> IO ()
leftoverSource (Source IORef ByteString
ref Recv
_) = IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
ref
readLeftoverSource :: Source -> IO ByteString
readLeftoverSource :: Source -> Recv
readLeftoverSource (Source IORef ByteString
ref Recv
_) = IORef ByteString -> Recv
forall a. IORef a -> IO a
readIORef IORef ByteString
ref
data Transport
=
TCP
| TLS
{ Transport -> Int
tlsMajorVersion :: Int
, Transport -> Int
tlsMinorVersion :: Int
, Transport -> Maybe ByteString
tlsNegotiatedProtocol :: Maybe ByteString
, Transport -> Word16
tlsChiperID :: Word16
#ifdef MIN_VERSION_crypton_x509
, Transport -> Maybe CertificateChain
tlsClientCertificate :: Maybe CertificateChain
#endif
}
| QUIC
{ Transport -> Maybe ByteString
quicNegotiatedProtocol :: Maybe ByteString
, Transport -> Word16
quicChiperID :: Word16
#ifdef MIN_VERSION_crypton_x509
, Transport -> Maybe CertificateChain
quicClientCertificate :: Maybe CertificateChain
#endif
}
isTransportSecure :: Transport -> Bool
isTransportSecure :: Transport -> Bool
isTransportSecure Transport
TCP = Bool
False
isTransportSecure Transport
_ = Bool
True
isTransportQUIC :: Transport -> Bool
isTransportQUIC :: Transport -> Bool
isTransportQUIC QUIC{} = Bool
True
isTransportQUIC Transport
_ = Bool
False
#ifdef MIN_VERSION_crypton_x509
getTransportClientCertificate :: Transport -> Maybe CertificateChain
getTransportClientCertificate :: Transport -> Maybe CertificateChain
getTransportClientCertificate Transport
TCP = Maybe CertificateChain
forall a. Maybe a
Nothing
getTransportClientCertificate (TLS Int
_ Int
_ Maybe ByteString
_ Word16
_ Maybe CertificateChain
cc) = Maybe CertificateChain
cc
getTransportClientCertificate (QUIC Maybe ByteString
_ Word16
_ Maybe CertificateChain
cc) = Maybe CertificateChain
cc
#endif