1 files changed, 47 insertions, 0 deletions
diff --git a/server/src/Secure.hs b/server/src/Secure.hs
new file mode 100644
index 0000000..f427304
--- /dev/null
+++ b/server/src/Secure.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Secure
+  ( loggedAction
+  , getUserFromToken
+  ) where
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Text (Text)
+import Data.Text.Lazy (fromStrict)
+import Network.HTTP.Types.Status (forbidden403)
+import Web.Scotty
+
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (User)
+
+import Model.Query (Query)
+import qualified LoginSession
+import qualified Model.Query as Query
+import qualified Model.SignIn as SignIn
+import qualified Model.User as User
+
+loggedAction :: (User -> ActionM ()) -> ActionM ()
+loggedAction action = do
+  maybeToken <- LoginSession.get
+  case maybeToken of
+    Just token -> do
+      maybeUser <- liftIO . Query.run . getUserFromToken $ token
+      case maybeUser of
+        Just user ->
+          action user
+        Nothing -> do
+          status forbidden403
+          html . fromStrict . Message.get $ Key.Secure_Unauthorized
+    Nothing -> do
+      status forbidden403
+      html . fromStrict . Message.get $ Key.Secure_Forbidden
+
+getUserFromToken :: Text -> Query (Maybe User)
+getUserFromToken token = do
+  mbSignIn <- SignIn.getSignIn token
+  case mbSignIn of
+    Just signIn ->
+      User.get (SignIn.email signIn)
+    Nothing ->
+      return Nothing