add logout facility

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] ()
     )

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"
+        }

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)