{-# LANGUAGE CPP #-}
module Network.Wai.Middleware.Vhost
    ( vhost
    , redirectWWW
    , redirectTo
    , redirectToLogged
    ) where


import qualified Data.ByteString as BS
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mappend)
#endif
import Data.Text (Text)
import qualified Data.Text.Encoding as TE
import Network.HTTP.Types as H
import Network.Wai

vhost :: [(Request -> Bool, Application)] -> Application -> Application
vhost :: [(Request -> Bool, Application)] -> Application -> Application
vhost [(Request -> Bool, Application)]
vhosts Application
def Request
req =
    case forall a. (a -> Bool) -> [a] -> [a]
filter (\(Request -> Bool
b, Application
_) -> Request -> Bool
b Request
req) [(Request -> Bool, Application)]
vhosts of
        [] -> Application
def Request
req
        (Request -> Bool
_, Application
app):[(Request -> Bool, Application)]
_ -> Application
app Request
req

redirectWWW :: Text -> Application -> Application -- W.MiddleWare
redirectWWW :: Text -> Application -> Application
redirectWWW Text
home =
  Text -> (Request -> Bool) -> Application -> Application
redirectIf Text
home (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"www") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"host" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> RequestHeaders
requestHeaders)

redirectIf :: Text -> (Request -> Bool) -> Application -> Application
redirectIf :: Text -> (Request -> Bool) -> Application -> Application
redirectIf Text
home Request -> Bool
cond Application
app Request
req Response -> IO ResponseReceived
sendResponse =
  if Request -> Bool
cond Request
req
    then Response -> IO ResponseReceived
sendResponse forall a b. (a -> b) -> a -> b
$ ByteString -> Response
redirectTo forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
home
    else Application
app Request
req Response -> IO ResponseReceived
sendResponse

redirectTo :: BS.ByteString -> Response
redirectTo :: ByteString -> Response
redirectTo ByteString
location = Status -> RequestHeaders -> ByteString -> Response
responseLBS Status
H.status301
    [ (HeaderName
H.hContentType, ByteString
"text/plain") , (HeaderName
H.hLocation, ByteString
location) ] ByteString
"Redirect"

redirectToLogged :: (Text -> IO ()) -> BS.ByteString -> IO Response
redirectToLogged :: (Text -> IO ()) -> ByteString -> IO Response
redirectToLogged Text -> IO ()
logger ByteString
loc = do
  Text -> IO ()
logger forall a b. (a -> b) -> a -> b
$ Text
"redirecting to: " forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Text
TE.decodeUtf8 ByteString
loc
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Response
redirectTo ByteString
loc