Reformatting

src/API/Users.hs

@@ -15,10 +15,9 @@ import Web.FormUrlEncoded
 import Database (runDB)
 import Database.User
 import Database.Schema
-import Control.Lens (view)
-import Data.Generics.Product
-import Servant.Auth as SA
+import Server.Auth
 import Servant.Auth.Server as SAS
+import Servant.Auth as SA
 
 
 data RegisterForm = RegisterForm { username :: Username
@@ -41,33 +40,6 @@ instance FromJSON RegisterStatus
 instance FromForm RegisterForm
 instance ToForm RegisterForm
 
--- generic-lens can convert similar types to this
--- I'm trying out servant-auth-server which uses a jwt style login. IIRC anyone
--- can open the jwt token and view what's inside, you just can't modify it.
---
--- Is it a problem that a human readable username and email are visible?
-data SafeUser = SafeUser { email :: Email
-                         , username :: Username
-                         , role :: Role }
-              deriving (Show, Generic)
-
-instance ToJSON SafeUser where
-instance FromJSON SafeUser where
-instance ToJWT SafeUser where
-instance FromJWT SafeUser where
-
-authCheck :: App -> BasicAuthData -> IO (AuthResult SafeUser)
-authCheck app (BasicAuthData username password) = flip runReaderT app $
-  maybe SAS.Indefinite authenticated <$> runDB (validateUser username' password')
-  where
-    username' = Username $ decodeUtf8 username
-    password' = PlainPassword $ decodeUtf8 password
-    authenticated = SAS.Authenticated . view (super @SafeUser)
-
-type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult SafeUser)
-
-instance FromBasicAuthData SafeUser where
-  fromBasicAuthData authData authCheckFunction = authCheckFunction authData
 
 type API = Auth '[SA.BasicAuth] SafeUser :> "login" :> Get '[JSON] LoginStatus
       :<|> "register" :> ReqBody '[JSON, FormUrlEncoded] RegisterForm :> Post '[JSON] RegisterStatus

src/Server.hs

@@ -13,7 +13,7 @@
 module Server where
 
 import qualified API as API
-import qualified API.Users as Users
+import Server.Auth (authCheck)
 import Servant
 import Types
 import ClassyPrelude hiding (Handler)
@@ -31,7 +31,7 @@ server app = serveWithContext api cfg (enter server' API.handler :<|> serveDirec
   where
     myKey = view (field @"jwk") app
     jwtCfg = defaultJWTSettings myKey
-    authCfg = Users.authCheck app
+    authCfg = authCheck app
     cfg = jwtCfg :. defaultCookieSettings :. authCfg :. EmptyContext
     server' :: AppM :~> Servant.Handler
     server' = NT (Handler . ExceptT . try . (`runReaderT` app) . (runFileLoggingT "logs/server.log"))

src/Server/Auth.hs

@@ -0,0 +1,46 @@
+{-# Language DataKinds #-}
+{-# Language TypeFamilies #-}
+{-# Language OverloadedStrings #-}
+{-# Language NoImplicitPrelude #-}
+{-# Language TypeOperators #-}
+{-# Language DuplicateRecordFields #-}
+{-# Language TypeApplications #-}
+module Server.Auth where
+
+import ClassyPrelude
+import Servant.Auth.Server as SAS
+import Data.Aeson
+import Database.Schema
+import Database.User
+import Database
+import Types
+import Control.Lens (view)
+import Data.Generics.Product
+
+-- generic-lens can convert similar types to this
+-- I'm trying out servant-auth-server which uses a jwt style login. IIRC anyone
+-- can open the jwt token and view what's inside, you just can't modify it.
+--
+-- Is it a problem that a human readable username and email are visible?
+data SafeUser = SafeUser { email :: Email
+                         , username :: Username
+                         , role :: Role }
+              deriving (Show, Generic)
+
+instance ToJSON SafeUser where
+instance FromJSON SafeUser where
+instance ToJWT SafeUser where
+instance FromJWT SafeUser where
+
+type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult SafeUser)
+
+instance FromBasicAuthData SafeUser where
+  fromBasicAuthData authData authCheckFunction = authCheckFunction authData
+
+authCheck :: App -> BasicAuthData -> IO (AuthResult SafeUser)
+authCheck app (BasicAuthData username password) = flip runReaderT app $
+  maybe SAS.Indefinite authenticated <$> runDB (validateUser username' password')
+  where
+    username' = Username $ decodeUtf8 username
+    password' = PlainPassword $ decodeUtf8 password
+    authenticated = SAS.Authenticated . view (super @SafeUser)