    {-# 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 ((Request -> Bool, Application) -> Bool)
    -> [(Request -> Bool, Application)]
    -> [(Request -> Bool, Application)]
    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
            (Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (ByteString -> ByteString -> Bool
    BS.isPrefixOf ByteString
    "www") (Maybe ByteString -> Bool)
    -> (Request -> Maybe ByteString) -> Request -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "host" ([(HeaderName, ByteString)] -> Maybe ByteString)
    -> (Request -> [(HeaderName, ByteString)])
    -> Request
    -> Maybe ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> [(HeaderName, ByteString)]
    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 (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Response
    redirectTo (ByteString -> Response) -> ByteString -> Response
    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 -> [(HeaderName, ByteString)] -> 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 (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "redirecting to: " Text -> Text -> Text
    forall a. Monoid a => a -> a -> a
    `mappend` ByteString -> Text
    TE.decodeUtf8 ByteString
    loc
        Response -> IO Response
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response -> IO Response) -> Response -> IO Response
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Response
    redirectTo ByteString
    loc