auth process seems to work

This commit is contained in:
nek0 2019-05-10 14:10:11 +02:00
parent 3b439b8d32
commit 312047b4a5
2 changed files with 14 additions and 9 deletions

View file

@ -54,11 +54,10 @@ main = do
app :: ReadState -> Application app :: ReadState -> Application
-- app conn = serveWithContext userApi genAuthServerContext (users conn) -- app conn = serveWithContext userApi genAuthServerContext (users conn)
app initState = serve userApi $ app initState = serveWithContext userApi genAuthServerContext $
hoistServerWithContext hoistServerWithContext
userApi userApi
authProxy authProxy
-- genAuthServerContext
(`runReaderT` initState) (`runReaderT` initState)
users users
-- hoistServerWithContext -- hoistServerWithContext
@ -70,10 +69,10 @@ app initState = serve userApi $
userApi :: Proxy UserAPI userApi :: Proxy UserAPI
userApi = Proxy userApi = Proxy
authProxy :: Proxy (Context (AuthHandler Request Bool ': '[])) authProxy :: Proxy '[ AuthHandler Request Bool ]
authProxy = Proxy authProxy = Proxy
genAuthServerContext :: Context (AuthHandler Request Bool ': '[]) genAuthServerContext :: Context '[ AuthHandler Request Bool ]
genAuthServerContext = authHandler Servant.:. EmptyContext genAuthServerContext = authHandler Servant.:. EmptyContext
type instance AuthServerData (AuthProtect "header-auth") = Bool type instance AuthServerData (AuthProtect "header-auth") = Bool
@ -104,7 +103,7 @@ users =
userSelect conn ref sw userSelect conn ref sw
userNew :: UserSubmit -> MateHandler Int userNew :: UserSubmit -> MateHandler Int
userNew us = do userNew us = do
now <- liftIO $ getCurrentTime now <- liftIO $ getCurrentTime
randSalt <- liftIO $ random 8 randSalt <- liftIO $ random 8
conn <- rsConnection <$> ask conn <- rsConnection <$> ask
@ -121,4 +120,4 @@ users =
getUserAuthInfo id getUserAuthInfo id
authSend :: AuthRequest -> MateHandler AuthResult authSend :: AuthRequest -> MateHandler AuthResult
authSend _ = liftIO $ Granted <$> AuthToken <$> random 8 authSend = processAuthRequest

View file

@ -112,7 +112,7 @@ generateToken (Ticket _ ident exp) (AuthHash hash) = do
token <- liftIO $ Token token <- liftIO $ Token
<$> (random 23) <$> (random 23)
<*> (pure ident) <*> (pure ident)
<*> (addUTCTime 23 <$> getCurrentTime) <*> (addUTCTime (23*60) <$> getCurrentTime)
void $ liftIO $ runInsert_ conn (insertToken token) void $ liftIO $ runInsert_ conn (insertToken token)
return $ Granted (AuthToken $ tokenString token) return $ Granted (AuthToken $ tokenString token)
else else
@ -138,7 +138,7 @@ newTicket :: Int -> MateHandler AuthTicket
newTicket ident = do newTicket ident = do
store <- rsTicketStore <$> ask store <- rsTicketStore <$> ask
rand <- liftIO $ random 23 rand <- liftIO $ random 23
later <- liftIO $ (addUTCTime (23/60) <$> getCurrentTime) later <- liftIO $ (addUTCTime 23 <$> getCurrentTime)
let ticket = Ticket let ticket = Ticket
{ ticketId = AuthTicket rand { ticketId = AuthTicket rand
, ticketUser = ident , ticketUser = ident
@ -154,5 +154,11 @@ processAuthRequest (AuthRequest aticket hash) = do
store <- liftIO . readTVarIO =<< rsTicketStore <$> ask store <- liftIO . readTVarIO =<< rsTicketStore <$> ask
let mticket = S.filter (\st -> ticketId st == aticket) store let mticket = S.filter (\st -> ticketId st == aticket) store
case S.toList mticket of case S.toList mticket of
[ticket] -> generateToken ticket hash [ticket] -> do
now <- liftIO $ getCurrentTime
if now > ticketExpiry ticket
then
return Denied
else
generateToken ticket hash
_ -> return Denied _ -> return Denied