{-# LANGUAGE OverloadedStrings #-}

module Server.Authentication.Main
( handleRoot
, readUserIdentityFromCookies
) where

import Control.Monad (msum)
import Happstack.Server
import Server.Core
import qualified Server.Authentication.Google as Google
import qualified Server.Authentication.OpenID as OpenID
import qualified Server.Authentication.Handle as Handle
import qualified Server.Authentication.Mock as Mock
import Server.Authentication.Utils (redirectToCurrentRefererIfAllowed)

handleRoot :: ServerConfiguration -> ServerResources -> ServerPart Response
handleRoot :: ServerConfiguration -> ServerResources -> ServerPart Response
handleRoot ServerConfiguration
serverConfiguration ServerResources
serverResources = [ServerPart Response] -> ServerPart Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [ String -> ServerPart Response -> ServerPart Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"google" (ServerPart Response -> ServerPart Response)
-> ServerPart Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$ ServerConfiguration -> ServerResources -> ServerPart Response
Google.handleRoot ServerConfiguration
serverConfiguration ServerResources
serverResources
    , String -> ServerPart Response -> ServerPart Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"openid" (ServerPart Response -> ServerPart Response)
-> ServerPart Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$ ServerConfiguration -> ServerResources -> ServerPart Response
OpenID.handleRoot ServerConfiguration
serverConfiguration ServerResources
serverResources
    , String -> ServerPart Response -> ServerPart Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"handle" (ServerPart Response -> ServerPart Response)
-> ServerPart Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$ ServerConfiguration -> ServerResources -> ServerPart Response
Handle.handleRoot ServerConfiguration
serverConfiguration ServerResources
serverResources
    , String -> ServerPart Response -> ServerPart Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"mock" (ServerPart Response -> ServerPart Response)
-> ServerPart Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$ ServerConfiguration -> ServerResources -> ServerPart Response
Mock.handleRoot ServerConfiguration
serverConfiguration ServerResources
serverResources
    , String -> ServerPart Response -> ServerPart Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"logout" (ServerPart Response -> ServerPart Response)
-> ServerPart Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$ do
        ServerConfiguration -> ServerResources -> ServerPart ()
Google.handleLogout ServerConfiguration
serverConfiguration ServerResources
serverResources
        ServerConfiguration -> ServerResources -> ServerPart ()
OpenID.handleLogout ServerConfiguration
serverConfiguration ServerResources
serverResources
        ServerConfiguration -> ServerResources -> ServerPart ()
Handle.handleLogout ServerConfiguration
serverConfiguration ServerResources
serverResources
        ServerConfiguration -> ServerResources -> ServerPart ()
Mock.handleLogout ServerConfiguration
serverConfiguration ServerResources
serverResources
        ServerPart Response
redirectToCurrentRefererIfAllowed
    ]

readUserIdentityFromCookies :: ServerConfiguration -> ServerResources -> ServerPart (Maybe UserIdentity)
readUserIdentityFromCookies :: ServerConfiguration
-> ServerResources -> ServerPart (Maybe UserIdentity)
readUserIdentityFromCookies ServerConfiguration
serverConfiguration ServerResources
serverResources = [ServerPart (Maybe UserIdentity)]
-> ServerPart (Maybe UserIdentity)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [ ServerConfiguration
-> ServerResources -> ServerPart (Maybe UserIdentity)
Google.readUserIdentityFromCookies ServerConfiguration
serverConfiguration ServerResources
serverResources
    , ServerConfiguration
-> ServerResources -> ServerPart (Maybe UserIdentity)
OpenID.readUserIdentityFromCookies ServerConfiguration
serverConfiguration ServerResources
serverResources
    , ServerConfiguration
-> ServerResources -> ServerPart (Maybe UserIdentity)
Handle.readUserIdentityFromCookies ServerConfiguration
serverConfiguration ServerResources
serverResources
    , ServerConfiguration
-> ServerResources -> ServerPart (Maybe UserIdentity)
Mock.readUserIdentityFromCookies ServerConfiguration
serverConfiguration ServerResources
serverResources
    , Maybe UserIdentity -> ServerPart (Maybe UserIdentity)
forall a. a -> ServerPartT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UserIdentity
forall a. Maybe a
Nothing ]