zoriya/Aeris
1
0
Fork 0
mirror of https://github.com/zoriya/Aeris.git synced 2026-06-02 10:57:31 +00:00
Code Issues Packages Projects Releases Wiki Activity

feat: signin route

Browse Source
This commit is contained in:
GitBluub
2022-03-05 16:21:51 +01:00
parent 72c08038f6
commit 63f446d3ed
4 changed files with 65 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
api/src/Api/Auth.hs
+35 -13
View File
@@ -18,12 +18,16 @@ import Servant (
Post,
ReqBody,
err401,
err400,
err403,
throwError,
type (:<|>) (..),
type (:>),
type (:>), Capture, QueryParam
)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
import Core.OIDC ( getOauthTokens )
import Data.Aeson (FromJSON, ToJSON)
import Db.User (User', UserDB (UserDB), password, toUser)
import GHC.Generics (Generic)
@@ -34,10 +38,10 @@ import Servant.Server.Generic (AsServerT)
import Data.ByteString.Lazy.Char8 ( unpack )
import Api.OIDC (OauthAPI, oauth)
import App (AppM)
import Core.User (User, UserId (UserId))
import Core.User (User, UserId (UserId), Service)
import Data.Text (pack)
import Password (hashPassword'', toPassword, validatePassword')
import Repository (createUser, getUserByName')
import Repository (createUser, getUserByName', getUserByToken)
import Utils (UserAuth, AuthRes)
data LoginUser = LoginUser
@@ -57,15 +61,16 @@ newtype LoginResponse = LoginResponse
}
deriving (Eq, Show, Read, Generic)
instance ToJSON LoginResponse
instance FromJSON LoginResponse
instance ToJSON LoginUser
instance FromJSON LoginUser
instance ToJSON SignupUser
instance FromJSON SignupUser
instance ToJSON LoginResponse
instance FromJSON LoginResponse
type Protected =
"me" :> Get '[JSON] User
@@ -80,6 +85,10 @@ type Unprotected =
:<|> "signup"
:> ReqBody '[JSON] SignupUser
:> Post '[JSON] NoContent
:<|> Capture "service" Service :> "signin"
:> QueryParam "code" String
:> Post '[JSON] LoginResponse
loginHandler ::
CookieSettings ->
@@ -95,11 +104,23 @@ loginHandler cs jwts (LoginUser username p) = do
case etoken of
Left e -> throwError err401
Right v -> return $ LoginResponse $ unpack v
{--mApplyCookies <- liftIO $ acceptLogin cs jwts (toUser usr)
case mApplyCookies of
Nothing -> throwError err401
Just applyCookies -> return $ applyCookies NoContent
--}else throwError err401
else throwError err401
loginOauthHandler :: JWTSettings -> Service -> Maybe String -> AppM LoginResponse
loginOauthHandler jwts _ Nothing = throwError err400
loginOauthHandler jwts service (Just code) = do
tokens <- liftIO $ runMaybeT $ getOauthTokens service code
case tokens of
Nothing -> throwError err403
Just t -> do
user <- getUserByToken t
etoken <- liftIO $ makeJWT (toUser user) jwts Nothing
case etoken of
Left e -> throwError err401
Right v -> return $ LoginResponse $ unpack v
signupHandler ::
SignupUser ->
@@ -111,8 +132,9 @@ signupHandler (SignupUser name p) = do
unprotected :: CookieSettings -> JWTSettings -> ServerT Unprotected AppM
unprotected cs jwts =
loginHandler cs jwts
:<|> signupHandler
loginHandler cs jwts
:<|> signupHandler
:<|> loginOauthHandler jwts
data AuthAPI mode = AuthAPI
{ protectedApi :: mode :- UserAuth :> Protected
api/src/Api/OIDC.hs
+6 -5
View File
@@ -8,17 +8,18 @@ module Api.OIDC where
import App (AppM)
import Control.Monad.IO.Class (liftIO)
import Core.User (ExternalToken (ExternalToken, service), Service (Github, Spotify, Twitter, Google, Anilist, Discord), UserId (UserId), User (User))
import Data.Text (pack)
import Data.Text (pack, unpack)
import Core.OIDC ( getOauthTokens )
import Repository.User (updateTokens, getTokensByUserId, delTokens)
import Servant (Capture, Get, GetNoContent, JSON, NoContent (NoContent), QueryParam, ServerT, err400, throwError, type (:<|>) ((:<|>)), type (:>), err401, err403, ServerError (errHeaders), err302, Delete)
import Servant (Capture, Get, GetNoContent, JSON, NoContent (NoContent), QueryParam, ServerT, err400, throwError, type (:<|>) ((:<|>)), type (:>), err401, err403, ServerError (errHeaders), err302, Delete, Post)
import Servant.API.Generic (type (:-))
import Servant.Server.Generic (AsServerT)
import Utils (UserAuth, AuthRes)
import qualified Data.ByteString.Char8 as B8
import Servant.Auth.Server (AuthResult(Authenticated))
import Servant.Auth.Server (AuthResult(Authenticated), makeJWT)
import System.Environment.MrEnv (envAsString)
import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
import Db.User (toUser)
oauthHandler :: AuthRes -> Service -> Maybe String -> AppM NoContent
oauthHandler _ _ Nothing = throwError err400
@@ -89,10 +90,10 @@ type OauthAPI = UserAuth :> Capture "service" Service :> QueryParam "code" Strin
:<|> Capture "service" Service :> "url" :> QueryParam "redirect_uri" String :> Get '[JSON] NoContent
:<|> UserAuth :> "services" :> Get '[JSON] [String]
:<|> "redirect" :> QueryParam "code" String :> QueryParam "state" String :> Get '[JSON] NoContent
oauth :: ServerT OauthAPI AppM
oauth = oauthHandler
:<|> oauthDelHandler
:<|> urlHandler
:<|> servicesHandler
:<|> redirectHandler
:<|> redirectHandler
api/src/Repository/User.hs
+19 -2
View File
@@ -1,12 +1,14 @@
module Repository.User where
import App (AppM)
import Core.User (ExternalToken, UserId, Service)
import Core.User (ExternalToken (service, providerId), UserId, Service)
import Data.Text (Text)
import Db.User (User', getUserByName, getUserTokensById, insertUser, selectAllUser, updateUserTokens, getUserById, updateDelTokens)
import Db.User (User', getUserByName, getUserTokensById, insertUser, selectAllUser, updateUserTokens, getUserById, updateDelTokens, UserDB (externalTokens))
import Rel8 (insert, select, update, limit, lit)
import Repository.Utils (runQuery)
import Data.Int (Int64)
import Data.List (find)
import Servant (err401, throwError)
users :: AppM [User']
users = runQuery (select selectAllUser)
@@ -19,6 +21,21 @@ getUserById' uid = do
res <- runQuery (select $ limit 1 $ getUserById (lit uid))
return $ head res
getUserByToken :: ExternalToken -> AppM User'
getUserByToken t = do
users' <- users
case find findByToken users' of
Nothing -> throwError err401
Just x -> return x
where
findByToken :: User' -> Bool
findByToken usr = do
let userTokens = externalTokens usr
case find (\tok -> service tok == service t) userTokens of
Nothing -> False
Just tok -> providerId tok == providerId t
createUser :: User' -> AppM [UserId]
createUser user = runQuery (insert $ insertUser user)
api/src/Utils.hs
+5 -2
View File
@@ -3,6 +3,7 @@
{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
{-# LANGUAGE FlexibleInstances #-}
module Utils where
import Data.Aeson.Types (Value (String), Object)
@@ -18,9 +19,10 @@ import Db.Pipeline (Pipeline (Pipeline), PipelineId (PipelineId), pipelineLastTr
import Core.Pipeline (PipelineParams (PipelineParams))
import Data.Time (UTCTime (UTCTime), fromGregorian, secondsToDiffTime)
import Data.Default (Default, def)
import Data.Aeson (Value(Number, Object), decode)
import Data.Aeson (Value(Number, Object), decode, ToJSON, FromJSON)
import Data.Int (Int64)
import Data.Scientific ( toBoundedInteger )
import GHC.Generics (Generic)
mapInd :: (a -> Int -> b) -> [a] -> [b]
mapInd f l = zipWith f l [0 ..]
@@ -60,4 +62,5 @@ instance Default (Pipeline Identity) where
}
type UserAuth = Servant.Auth.Server.Auth '[JWT] User
type AuthRes = Servant.Auth.Server.AuthResult User
type AuthRes = Servant.Auth.Server.AuthResult User