From 8d8b4e04531e1fbfd9b39da35e4062d6a5748f6f Mon Sep 17 00:00:00 2001
From: Mats Rauhala <mats.rauhala@iki.fi>
Date: Tue, 28 Aug 2018 22:24:54 +0300
Subject: [PATCH] wip

---
 src/API/Books.hs   | 2 +-
 src/Server/Auth.hs | 4 ++++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/API/Books.hs b/src/API/Books.hs
index 3cb0369..73df85d 100644
--- a/src/API/Books.hs
+++ b/src/API/Books.hs
@@ -55,7 +55,7 @@ instance FromJSON JsonBook
 instance ToJSON PostBook
 instance FromJSON PostBook
 
-type API = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI
+type API = Auth '[TokenCheck, SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI
 
 type BaseAPI = "books" :> Get '[JSON] [JsonBook]
        :<|> "books" :> ReqBody '[JSON] PostBook :> Post '[JSON] JsonBook
diff --git a/src/Server/Auth.hs b/src/Server/Auth.hs
index d6ef079..04e777f 100644
--- a/src/Server/Auth.hs
+++ b/src/Server/Auth.hs
@@ -6,10 +6,12 @@
 {-# Language DuplicateRecordFields #-}
 {-# Language TypeApplications #-}
 {-# Language TemplateHaskell #-}
+{-# Language FlexibleContexts #-}
 module Server.Auth
   ( SafeUser(..)
   , authCheck
   , AuthResult(..)
+  , TokenCheck
   , requireLoggedIn)
   where
 
@@ -56,3 +58,5 @@ authCheck app (BasicAuthData username password) = flip runReaderT app $
 requireLoggedIn :: (MonadLogger m, MonadThrow m, Monad m) => (SafeUser -> m a) -> AuthResult SafeUser -> m a
 requireLoggedIn f (Authenticated user) = f user
 requireLoggedIn _ u = $logError (pack (show u)) >> throwM err401
+
+data TokenCheck