diff options
| author | Joris | 2017-11-08 23:47:26 +0100 | 
|---|---|---|
| committer | Joris | 2017-11-08 23:47:26 +0100 | 
| commit | 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 (patch) | |
| tree | 845f54d7fe876c9a3078036975ba85ec21d224a1 /src/server/Controller/Index.hs | |
| parent | a3601b5e6f5a3e41fa31752a2c704ccd3632790e (diff) | |
Use a better project structure
Diffstat (limited to 'src/server/Controller/Index.hs')
| -rw-r--r-- | src/server/Controller/Index.hs | 86 | 
1 files changed, 0 insertions, 86 deletions
| diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs deleted file mode 100644 index 8473c5c..0000000 --- a/src/server/Controller/Index.hs +++ /dev/null @@ -1,86 +0,0 @@ -module Controller.Index -  ( get -  , signOut -  ) where - -import Control.Monad.IO.Class (liftIO) -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime, diffUTCTime) -import Network.HTTP.Types.Status (ok200) -import Prelude hiding (error) -import Web.Scotty hiding (get) - -import qualified Common.Message as Message -import Common.Message.Key (Key) -import qualified Common.Message.Key as Key -import Common.Model (InitResult(..), User(..)) - -import Conf (Conf(..)) -import Model.Init (getInit) -import qualified LoginSession -import qualified Model.Query as Query -import qualified Model.SignIn as SignIn -import qualified Model.User as User -import Secure (getUserFromToken) -import View.Page (page) - -get :: Conf -> Maybe Text -> ActionM () -get conf mbToken = do -  initResult <- case mbToken of -    Just token -> do -      userOrError <- validateSignIn conf token -      case userOrError of -        Left errorKey -> -          return . InitEmpty . Left . Message.get $ errorKey -        Right user -> -          liftIO . Query.run . fmap InitSuccess $ getInit user conf -    Nothing -> do -      mbLoggedUser <- getLoggedUser -      case mbLoggedUser of -        Nothing -> -          return . InitEmpty . Right $ Nothing -        Just user -> -          liftIO . Query.run . fmap InitSuccess $ getInit user conf -  html $ page initResult - -validateSignIn :: Conf -> Text -> ActionM (Either Key User) -validateSignIn conf textToken = do -  mbLoggedUser <- getLoggedUser -  case mbLoggedUser of -    Just loggedUser -> -      return . Right $ loggedUser -    Nothing -> do -      mbSignIn <- liftIO . Query.run $ SignIn.getSignIn textToken -      now <- liftIO getCurrentTime -      case mbSignIn of -        Nothing -> -          return . Left $ Key.SignIn_LinkInvalid -        Just signIn -> -          if SignIn.isUsed signIn -            then -              return . Left $ Key.SignIn_LinkUsed -            else -              let diffTime = now `diffUTCTime` (SignIn.creation signIn) -              in  if diffTime > signInExpiration conf -                    then -                      return . Left $ Key.SignIn_LinkExpired -                    else do -                      LoginSession.put conf (SignIn.token signIn) -                      mbUser <- liftIO . Query.run $ do -                        SignIn.signInTokenToUsed . SignIn.id $ signIn -                        User.get . SignIn.email $ signIn -                      return $ case mbUser of -                        Nothing -> Left Key.Secure_Unauthorized -                        Just user -> Right user - -getLoggedUser :: ActionM (Maybe User) -getLoggedUser = do -  mbToken <- LoginSession.get -  case mbToken of -    Nothing -> -      return Nothing -    Just token -> do -      liftIO . Query.run . getUserFromToken $ token - -signOut :: Conf -> ActionM () -signOut conf = LoginSession.delete conf >> status ok200 | 
