add logout capability

src/API.hs

@@ -55,6 +55,9 @@ type UserAPI =
   :<|> "auth" :> QueryParam "destination" T.Text
     :> ReqBody '[FormUrlEncoded] AuthReturn
     :> Post '[HTML] UserSelectPage
+  :<|> "auth" :> "logout"
+    -- :> ReqBody '[FormUrlEncoded] ()
+    :> Post '[HTML] UserOverviewPage
   )
 
 ( userSelectLink :<|>
@@ -66,5 +69,6 @@ type UserAPI =
   userManageAuthCreateLink :<|>
   userManageAuthDeleteLink :<|>
   authLink :<|>
-  authPostLink
+  authPostLink :<|>
+  authLogoutLink
   ) = allLinks (Proxy :: Proxy UserAPI)

src/Control/Auth.hs

@@ -7,6 +7,7 @@ module Control.Auth where
 
 import Servant
 import Servant.Client
+import Servant.Client.Core.Auth (mkAuthenticatedRequest)
 
 import qualified Data.Text as T
 
@@ -30,6 +31,7 @@ import Types
 import View
 import Util
 import Client
+import ClientAuth
 import API
 import Hash
 
@@ -174,3 +176,20 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
 authPostControl Nothing _ _ = throwError $ err400
   { errBody = "No ticket cookie present."
   }
+
+authLogoutControl
+  :: Maybe T.Text
+  -> UserHandler UserOverviewPage
+authLogoutControl mcookie = do
+  (ReadState _ backend _) <- ask
+  let mParsedCookie = fmap parseCookieText mcookie
+      token = T.unpack $ fromMaybe "secret" $
+        ((lookup "x-token") =<< mParsedCookie)
+  eReturn <- liftIO $ runClientM
+    (authLogout (mkAuthenticatedRequest token authenticateReq))
+    backend
+  case eReturn of
+    Right _ -> throwError $ redirect303 userSelectLink
+    Left err -> throwError $ err500
+      { errBody = fromString (show err)
+      }

src/Main.hs

@@ -53,6 +53,7 @@ userApp initState = serveWithContext userApi (EmptyContext) $
     :<|> userManageAuthDeleteControl mcookie
     :<|> authControl mcookie
     :<|> authPostControl mcookie
+    :<|> authLogoutControl mcookie
     )
 
 userApi :: Proxy UserAPI

src/View/User.hs

@@ -66,6 +66,15 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
       ": " <>
       (formatMoney $ MT.userDetailsBalance ud)
       -- TODO: Add currency symbol
+    H.p $ H.form
+      H.! HA.method "post"
+      H.! HA.action ("/" <> (fromString $ show $ linkURI $ authLogoutLink))
+      H.! HA.enctype "application/x-www-form-urlencoded" $ do
+        H.div H.! HA.class_ "form-group optional" $ do
+          H.button
+            H.! HA.class_ "btn btn-default"
+            H.! HA.type_ "submit"
+            $ H.toHtml $ translate "Logout"
     case method of
       MT.PrimaryPass ->
         userSettingsPointer