From e069bde130e3451e4906fb670a475e63c986aa6a Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Thu, 18 Jul 2019 16:09:59 +0200
Subject: [PATCH] add logout facility

---
 src/API.hs        |  2 ++
 src/Main.hs       | 17 ++++++++++++++++-
 src/Model/Auth.hs | 18 ++++++++++++++++++
 3 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/src/API.hs b/src/API.hs
index 6b9bd58..54cf47c 100644
--- a/src/API.hs
+++ b/src/API.hs
@@ -39,4 +39,6 @@ type UserAPI =
   :<|> "auth" :> 
     ( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo
     :<|> "send" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult
+    :<|> "logout" :> AuthProtect "header-auth" :> ReqBody '[JSON] Int
+      :> Post '[JSON] ()
     )
diff --git a/src/Main.hs b/src/Main.hs
index 235b970..8459501 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -162,7 +162,8 @@ beverages =
 
 auth =
   authGet :<|>
-  authSend
+  authSend :<|>
+  authLogout
   where
     authGet :: Int -> MateHandler AuthInfo
     authGet id =
@@ -170,3 +171,17 @@ auth =
 
     authSend :: AuthRequest -> MateHandler AuthResult
     authSend = processAuthRequest
+
+    authLogout :: Maybe Int -> Int -> MateHandler ()
+    authLogout (Just muid) luid = do
+      if muid == luid
+      then
+        processLogout luid
+      else
+        throwError $ err403
+          { errBody = "Forbidden"
+          }
+    authLogout Nothing _ = do
+      throwError $ err403
+        { errBody = "Forbidden"
+        }
diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs
index 4eba0cb..5425253 100644
--- a/src/Model/Auth.hs
+++ b/src/Model/Auth.hs
@@ -189,6 +189,17 @@ deleteToken tstr = Delete
   , dReturning = rCount
   }
 
+
+deleteTokenByUserId
+  :: Int
+  -> Opaleye.Delete Int64
+deleteTokenByUserId uid = Delete
+  { dTable     = tokenTable
+  , dWhere     = (\(_, rid, _) -> rid .== C.constant uid)
+  , dReturning = rCount
+  }
+
+
 newTicket :: Int -> MateHandler AuthTicket
 newTicket ident = do
   store <- rsTicketStore <$> ask
@@ -232,3 +243,10 @@ processAuthRequest (AuthRequest aticket hash) = do
 #else
       return Denied
 #endif
+
+processLogout
+  :: Int
+  -> MateHandler ()
+processLogout uid = do
+  conn <- rsConnection <$> ask
+  liftIO $ void $ runDelete_ conn (deleteTokenByUserId uid)