packages feed

Nomyx-0.2.0: src/Web/Login.hs

{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, RecordWildCards#-}

module Web.Login where


import Prelude hiding (div)
import Text.Blaze.Html5 hiding (map, label, br)
import Text.Blaze.Html5.Attributes hiding (dir, label)
import qualified Text.Blaze.Html5 as H
import Web.Routes.RouteT
import Text.Blaze.Internal
import Control.Monad.State
import Control.Concurrent.STM
import Happstack.Server
import Types as T
import Multi as M
import Web.Common
import Web.Routes.Happstack()
import Data.Text hiding (map, zip, concatMap)
import Happstack.Auth (AuthProfileURL(..), AuthURL(..), handleAuthProfile)
import Happstack.Auth.Core.Profile
import Facebook (Credentials(..))
default (Integer, Double, Data.Text.Text)

-- | function which generates the homepage
homePage :: (TVar Session) -> RoutedNomyxServer Response
homePage ts = do
   (T.Session _ _ (Profiles acidAuth acidProfile _)) <- liftIO $ readTVarIO ts
   do mUserId <- getUserId acidAuth acidProfile
      case mUserId of
         Nothing ->
            do loginURL <- showURL (U_AuthProfile $ AuthURL A_Login)
               mainPage'  "Nomyx"
                          "Not logged in"
                          (H.div $ p $ do
                             "Welcome to Nomyx! You can login "
                             H.a ! href (toValue loginURL) $ "here.")
                          True
         (Just _) -> do
            link <- showURL MainPage
            seeOther link (toResponse $ string "to game page")

-- | add a new player
createNewPlayer :: (TVar Session) -> RoutedNomyxServer Response
createNewPlayer ts = do
   pn <- getPlayerNumber ts
   webCommand ts $ M.newPlayer pn defaultPlayerSettings Nothing Nothing
   link <- showURL $ PSettings
   seeOther link (toResponse $ string "to settings page")

authenticate :: (TVar Session) -> AuthProfileURL -> RoutedNomyxServer Response
authenticate ts authProfileURL = do
   (T.Session _ _ Profiles{..}) <- liftIO $ atomically $ readTVar ts
   postPickedURL <- showURL NewPlayer
   nestURL U_AuthProfile $ handleAuthProfile acidAuth acidProfile appTemplate (Just facebookAuth) Nothing postPickedURL authProfileURL

facebookAuth =
    Credentials {appName = "Nomyx",
                 appId = "161007670738608",
                 appSecret = "c0509c1c753f89d1d1fc181984042824"}