{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Network.Wai.Handler.Warp.Types where
import qualified UnliftIO
import qualified Data.ByteString as S
import Data.IORef (IORef, readIORef, writeIORef, newIORef)
import Data.Typeable (Typeable)
#ifdef MIN_VERSION_x509
import Data.X509
#endif
import Foreign.Ptr (Ptr)
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
deriving (InvalidRequest -> InvalidRequest -> Bool
(InvalidRequest -> InvalidRequest -> Bool)
-> (InvalidRequest -> InvalidRequest -> Bool) -> Eq InvalidRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidRequest -> InvalidRequest -> Bool
$c/= :: InvalidRequest -> InvalidRequest -> Bool
== :: InvalidRequest -> InvalidRequest -> Bool
$c== :: 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
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
showList :: [ExceptionInsideResponseBody] -> ShowS
$cshowList :: [ExceptionInsideResponseBody] -> ShowS
show :: ExceptionInsideResponseBody -> String
$cshow :: ExceptionInsideResponseBody -> String
showsPrec :: Int -> ExceptionInsideResponseBody -> ShowS
$cshowsPrec :: Int -> 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 ()
type BufferPool = IORef ByteString
type Buffer = Ptr Word8
type BufSize = Int
type Recv = IO ByteString
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 -> IO ()
connFree :: IO ()
, Connection -> Recv
connRecv :: Recv
, Connection -> RecvBuf
connRecvBuf :: RecvBuf
, Connection -> Buffer
connWriteBuffer :: Buffer
, Connection -> Int
connBufferSize :: BufSize
, Connection -> IORef Bool
connHTTP2 :: IORef Bool
}
getConnHTTP2 :: Connection -> IO Bool
getConnHTTP2 :: Connection -> IO Bool
getConnHTTP2 Connection
conn = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (Connection -> IORef Bool
connHTTP2 Connection
conn)
setConnHTTP2 :: Connection -> Bool -> IO ()
setConnHTTP2 :: Connection -> Bool -> IO ()
setConnHTTP2 Connection
conn Bool
b = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
connHTTP2 Connection
conn) Bool
b
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 (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 (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
_) ByteString
bs = IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
ref ByteString
bs
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_x509
, Transport -> Maybe CertificateChain
tlsClientCertificate :: Maybe CertificateChain
#endif
}
| QUIC {
Transport -> Maybe ByteString
quicNegotiatedProtocol :: Maybe ByteString
, Transport -> Word16
quicChiperID :: Word16
#ifdef MIN_VERSION_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_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