Merge branch 'with-ghcjs' into 'master'

Use Haskell on the frontend

See merge request guyonvarch/shared-cost!2

1 files changed, 31 insertions, 0 deletions

diff --git a/server/src/Secure.hs b/server/src/Secure.hs
new file mode 100644
index 0000000..a30941f
--- /dev/null
+++ b/server/src/Secure.hs
@@ -0,0 +1,31 @@
+module Secure
+  ( loggedAction
+  ) where
+
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.Text.Lazy            as TL
+import qualified Network.HTTP.Types.Status as HTTP
+import           Web.Scotty
+
+import           Common.Model              (User)
+import qualified Common.Msg                as Msg
+
+import qualified LoginSession
+import qualified Model.Query               as Query
+import qualified Persistence.User          as UserPersistence
+
+loggedAction :: (User -> ActionM ()) -> ActionM ()
+loggedAction action = do
+  maybeToken <- LoginSession.get
+  case maybeToken of
+    Just token -> do
+      maybeUser <- liftIO . Query.run . UserPersistence.get $ token
+      case maybeUser of
+        Just user ->
+          action user
+        Nothing -> do
+          status HTTP.forbidden403
+          html . TL.fromStrict . Msg.get $ Msg.Secure_Unauthorized
+    Nothing -> do
+      status HTTP.forbidden403
+      html . TL.fromStrict . Msg.get $ Msg.Secure_Forbidden