{-# LANGUAGE CPP #-}

module Network.Wai.Application.Classic.Types where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL (ByteString)
import qualified Network.HTTP.Client as H
import Network.Wai.Application.Classic.Path

----------------------------------------------------------------

data ClassicAppSpec = ClassicAppSpec {
    -- | Name specified to Server: in HTTP response.
    ClassicAppSpec -> ByteString
softwareName :: ByteString
    -- | A function to get HTTP's GMT Date.
  , ClassicAppSpec -> ByteString
statusFileDir :: Path
  }

data StatusInfo =
  -- | HTTP status body is created from 'LB.ByteString'.
    StatusByteString BL.ByteString
  -- | HTTP status body is created from 'FilePath'.
  | StatusFile Path Integer
  -- | No HTTP status body.
  | StatusNone
  deriving (StatusInfo -> StatusInfo -> Bool
(StatusInfo -> StatusInfo -> Bool)
-> (StatusInfo -> StatusInfo -> Bool) -> Eq StatusInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusInfo -> StatusInfo -> Bool
== :: StatusInfo -> StatusInfo -> Bool
$c/= :: StatusInfo -> StatusInfo -> Bool
/= :: StatusInfo -> StatusInfo -> Bool
Eq,Int -> StatusInfo -> ShowS
[StatusInfo] -> ShowS
StatusInfo -> String
(Int -> StatusInfo -> ShowS)
-> (StatusInfo -> String)
-> ([StatusInfo] -> ShowS)
-> Show StatusInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatusInfo -> ShowS
showsPrec :: Int -> StatusInfo -> ShowS
$cshow :: StatusInfo -> String
show :: StatusInfo -> String
$cshowList :: [StatusInfo] -> ShowS
showList :: [StatusInfo] -> ShowS
Show)

----------------------------------------------------------------

data FileAppSpec = FileAppSpec {
    -- | A file name of an index file.
    FileAppSpec -> ByteString
indexFile :: Path
    -- | Whether this is an HTML or not.
  , FileAppSpec -> ByteString -> Bool
isHTML :: Path -> Bool
  }

data FileRoute = FileRoute {
    -- | Path prefix to be matched to 'rawPathInfo'.
    FileRoute -> ByteString
fileSrc :: Path
    -- | Path prefix to an actual file system.
  , FileRoute -> ByteString
fileDst :: Path
  } deriving (FileRoute -> FileRoute -> Bool
(FileRoute -> FileRoute -> Bool)
-> (FileRoute -> FileRoute -> Bool) -> Eq FileRoute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileRoute -> FileRoute -> Bool
== :: FileRoute -> FileRoute -> Bool
$c/= :: FileRoute -> FileRoute -> Bool
/= :: FileRoute -> FileRoute -> Bool
Eq,Int -> FileRoute -> ShowS
[FileRoute] -> ShowS
FileRoute -> String
(Int -> FileRoute -> ShowS)
-> (FileRoute -> String)
-> ([FileRoute] -> ShowS)
-> Show FileRoute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileRoute -> ShowS
showsPrec :: Int -> FileRoute -> ShowS
$cshow :: FileRoute -> String
show :: FileRoute -> String
$cshowList :: [FileRoute] -> ShowS
showList :: [FileRoute] -> ShowS
Show)

----------------------------------------------------------------

data RedirectRoute = RedirectRoute {
    -- | Path prefix to be matched to 'rawPathInfo'.
    RedirectRoute -> ByteString
redirectSrc :: Path
    -- | Path prefix to an actual file system.
  , RedirectRoute -> ByteString
redirectDst :: Path
  } deriving (RedirectRoute -> RedirectRoute -> Bool
(RedirectRoute -> RedirectRoute -> Bool)
-> (RedirectRoute -> RedirectRoute -> Bool) -> Eq RedirectRoute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RedirectRoute -> RedirectRoute -> Bool
== :: RedirectRoute -> RedirectRoute -> Bool
$c/= :: RedirectRoute -> RedirectRoute -> Bool
/= :: RedirectRoute -> RedirectRoute -> Bool
Eq,Int -> RedirectRoute -> ShowS
[RedirectRoute] -> ShowS
RedirectRoute -> String
(Int -> RedirectRoute -> ShowS)
-> (RedirectRoute -> String)
-> ([RedirectRoute] -> ShowS)
-> Show RedirectRoute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RedirectRoute -> ShowS
showsPrec :: Int -> RedirectRoute -> ShowS
$cshow :: RedirectRoute -> String
show :: RedirectRoute -> String
$cshowList :: [RedirectRoute] -> ShowS
showList :: [RedirectRoute] -> ShowS
Show)

----------------------------------------------------------------

data CgiAppSpec = CgiAppSpec {
    -- | A file name of the default CGI.
    CgiAppSpec -> ByteString
indexCgi :: Path
  } deriving (CgiAppSpec -> CgiAppSpec -> Bool
(CgiAppSpec -> CgiAppSpec -> Bool)
-> (CgiAppSpec -> CgiAppSpec -> Bool) -> Eq CgiAppSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CgiAppSpec -> CgiAppSpec -> Bool
== :: CgiAppSpec -> CgiAppSpec -> Bool
$c/= :: CgiAppSpec -> CgiAppSpec -> Bool
/= :: CgiAppSpec -> CgiAppSpec -> Bool
Eq,Int -> CgiAppSpec -> ShowS
[CgiAppSpec] -> ShowS
CgiAppSpec -> String
(Int -> CgiAppSpec -> ShowS)
-> (CgiAppSpec -> String)
-> ([CgiAppSpec] -> ShowS)
-> Show CgiAppSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CgiAppSpec -> ShowS
showsPrec :: Int -> CgiAppSpec -> ShowS
$cshow :: CgiAppSpec -> String
show :: CgiAppSpec -> String
$cshowList :: [CgiAppSpec] -> ShowS
showList :: [CgiAppSpec] -> ShowS
Show)

data CgiRoute = CgiRoute {
    -- | Path prefix to be matched to 'rawPathInfo'.
    CgiRoute -> ByteString
cgiSrc :: Path
    -- | Path prefix to an actual file system.
  , CgiRoute -> ByteString
cgiDst :: Path
  } deriving (CgiRoute -> CgiRoute -> Bool
(CgiRoute -> CgiRoute -> Bool)
-> (CgiRoute -> CgiRoute -> Bool) -> Eq CgiRoute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CgiRoute -> CgiRoute -> Bool
== :: CgiRoute -> CgiRoute -> Bool
$c/= :: CgiRoute -> CgiRoute -> Bool
/= :: CgiRoute -> CgiRoute -> Bool
Eq,Int -> CgiRoute -> ShowS
[CgiRoute] -> ShowS
CgiRoute -> String
(Int -> CgiRoute -> ShowS)
-> (CgiRoute -> String) -> ([CgiRoute] -> ShowS) -> Show CgiRoute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CgiRoute -> ShowS
showsPrec :: Int -> CgiRoute -> ShowS
$cshow :: CgiRoute -> String
show :: CgiRoute -> String
$cshowList :: [CgiRoute] -> ShowS
showList :: [CgiRoute] -> ShowS
Show)

----------------------------------------------------------------

data RevProxyAppSpec = RevProxyAppSpec {
    -- | Connection manager
    RevProxyAppSpec -> Manager
revProxyManager :: H.Manager
  }

data RevProxyRoute = RevProxyRoute {
    -- | Path prefix to be matched to 'rawPathInfo'.
    RevProxyRoute -> ByteString
revProxySrc :: Path
    -- | Destination path prefix.
  , RevProxyRoute -> ByteString
revProxyDst :: Path
    -- | Destination domain name.
  , RevProxyRoute -> ByteString
revProxyDomain :: ByteString
    -- | Destination port number.
  , RevProxyRoute -> Int
revProxyPort :: Int
  } deriving (RevProxyRoute -> RevProxyRoute -> Bool
(RevProxyRoute -> RevProxyRoute -> Bool)
-> (RevProxyRoute -> RevProxyRoute -> Bool) -> Eq RevProxyRoute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RevProxyRoute -> RevProxyRoute -> Bool
== :: RevProxyRoute -> RevProxyRoute -> Bool
$c/= :: RevProxyRoute -> RevProxyRoute -> Bool
/= :: RevProxyRoute -> RevProxyRoute -> Bool
Eq,Int -> RevProxyRoute -> ShowS
[RevProxyRoute] -> ShowS
RevProxyRoute -> String
(Int -> RevProxyRoute -> ShowS)
-> (RevProxyRoute -> String)
-> ([RevProxyRoute] -> ShowS)
-> Show RevProxyRoute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevProxyRoute -> ShowS
showsPrec :: Int -> RevProxyRoute -> ShowS
$cshow :: RevProxyRoute -> String
show :: RevProxyRoute -> String
$cshowList :: [RevProxyRoute] -> ShowS
showList :: [RevProxyRoute] -> ShowS
Show)

----------------------------------------------------------------

type Lang = Path -> Path