module Controller.Index ( getIndex , signOut ) where import Control.Monad.IO.Class (liftIO) import Web.Scotty import Network.HTTP.Types.Status (ok200) import Data.Text (Text) import Data.Time.Clock (getCurrentTime, diffUTCTime) import Database.Persist hiding (Key) import Conf (Conf(..)) import qualified LoginSession import Secure (getUserFromToken) import Model.Database import qualified Model.Json.Conf as M import Model.User (getUser) import Model.Message.Key import Model.SignIn (getSignIn, signInTokenToUsed) import Model.Json.Init (InitResult(..)) import Model.Init (getInit) import View.Page (page) getIndex :: Conf -> Maybe Text -> ActionM () getIndex conf mbToken = do initResult <- case mbToken of Just token -> do userOrError <- validateSignIn conf token case userOrError of Left errorKey -> return . InitError $ errorKey Right user -> liftIO . runDb . fmap InitSuccess . getInit $ user Nothing -> do mbLoggedUser <- getLoggedUser case mbLoggedUser of Nothing -> return InitEmpty Just user -> liftIO . runDb . fmap InitSuccess . getInit $ user html $ page (M.Conf { M.currency = currency conf }) initResult validateSignIn :: Conf -> Text -> ActionM (Either Key (Entity User)) validateSignIn conf textToken = do mbLoggedUser <- getLoggedUser case mbLoggedUser of Just loggedUser -> return . Right $ loggedUser Nothing -> do mbSignIn <- liftIO . runDb $ getSignIn textToken now <- liftIO getCurrentTime case mbSignIn of Nothing -> return . Left $ SignInInvalid Just signInValue -> if signInIsUsed . entityVal $ signInValue then return . Left $ SignInUsed else let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signInValue) in if diffTime > signInExpiration conf then return . Left $ SignInExpired else do LoginSession.put conf (signInToken . entityVal $ signInValue) mbUser <- liftIO . runDb $ do signInTokenToUsed . entityKey $ signInValue getUser . signInEmail . entityVal $ signInValue return $ case mbUser of Nothing -> Left UnauthorizedSignIn Just user -> Right user getLoggedUser :: ActionM (Maybe (Entity User)) getLoggedUser = do mbToken <- LoginSession.get case mbToken of Nothing -> return Nothing Just token -> do liftIO . runDb . getUserFromToken $ token signOut :: Conf -> ActionM () signOut conf = LoginSession.delete conf >> status ok200