module Network.Salvia.Handler.VirtualHosting where
import Data.List.Split
import Data.List
import Data.Maybe
import Network.Protocol.Uri
import Network.Protocol.Http
import Network.Salvia.Handler.Dispatching
import Network.Salvia.Interface
hVirtualHosting :: HttpM Request m => ListDispatcher String m b
hVirtualHosting = hListDispatch (hRequestDispatch hostname (\a -> False `maybe` (match a)))
where
match e f =
case parseAuthority f of
Right (Authority _ hst _) ->
case (e, hst) of
('.':_, Hostname (Domain d)) -> filter (not . null) (splitOn "." e) `isSuffixOf` d
(_, Hostname d) -> e == show d
(_, RegName r) -> e == r
(_, IP i) -> e == show i
_ -> False
hPortRouter :: HttpM Request m => ListDispatcher Int m b
hPortRouter = hListDispatch (hRequestDispatch hostname (\a -> False `maybe` (match a)))
where
match e f =
case parseAuthority f of
Right (Authority _ _ prt) -> fromMaybe 80 prt == e
_ -> False