tinker tinker

src/API.hs

@@ -23,10 +23,11 @@ import Types
 
 type UserAPI =
   "user" :>
-    ( "list" :> QueryParam "refine" Refine
+    ( "list" :> AuthProtect "header-auth"
-      :> AuthProtect "header-auth" :> Get '[JSON] [User]
+      :> QueryParam "refine" Refine :> Get '[JSON] [User]
     :<|> "new" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
-    :<|> "update" :> ReqBody '[JSON] (Int, UserSubmit) :> Post '[JSON] ()
+    :<|> "update" :> AuthProtect "header-auth"
+      :> ReqBody '[JSON] (Int, UserSubmit) :> Post '[JSON] ()
     )
   :<|> "auth" :> 
     ( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo

src/Main.hs

@@ -98,8 +98,8 @@ users =
   userNew :<|>
   userUpdate
   where
-    userList :: Maybe Refine -> Maybe Int -> MateHandler [User]
+    userList :: Maybe Int -> Maybe Refine -> MateHandler [User]
-    userList ref muid = do
+    userList muid ref = do
       conn <- rsConnection <$> ask
       userSelect conn ref (isJust muid)
 
@@ -110,11 +110,20 @@ users =
       conn <- rsConnection <$> ask
       head <$> (liftIO $ runInsert_ conn (insertUser us (utctDay now) randSalt))
 
-    userUpdate :: (Int, UserSubmit) -> MateHandler ()
+    userUpdate :: Maybe Int -> (Int, UserSubmit) -> MateHandler ()
-    userUpdate (id, us) = do
+    userUpdate Nothing _ =
-      now <- liftIO $ getCurrentTime
+      throwError $ err403
-      conn <- rsConnection <$> ask
+        { errBody = "No Authorization present"
-      void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now))
+        }
+    userUpdate (Just aid) (id, us) = if aid == id
+      then do
+        now <- liftIO $ getCurrentTime
+        conn <- rsConnection <$> ask
+        void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now))
+      else
+      throwError $ err401
+        { errBody = "Wrong Authorization present"
+        }
 
 auth =
   authGet :<|>

src/Model/Auth.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Model.Auth where
 
-import Servant (Handler)
+import Servant
 
 import GHC.Generics
 
@@ -106,9 +106,13 @@ validateToken conn header = do
       now <- liftIO $ getCurrentTime
       if diffUTCTime stamp now > 0
       then return $ Just uid
-      else return $ Nothing
+      else throwError $ err401
+        { errBody = "Your token expired!"
+        }
     _ ->
-      return Nothing
+      throwError $ err401
+        { errBody = "No valid token found!"
+        }
 
 generateToken
   :: Ticket