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 conn = serveWithContext userApi genAuthServerContext (users conn)
app initState = serve userApi $
app initState = serveWithContext userApi genAuthServerContext $
hoistServerWithContext
userApi
authProxy
-- genAuthServerContext
(`runReaderT` initState)
users
-- hoistServerWithContext
@ -70,10 +69,10 @@ app initState = serve userApi $
userApi :: Proxy UserAPI
userApi = Proxy
authProxy :: Proxy (Context (AuthHandler Request Bool ': '[]))
authProxy :: Proxy '[ AuthHandler Request Bool ]
authProxy = Proxy
genAuthServerContext :: Context (AuthHandler Request Bool ': '[])
genAuthServerContext :: Context '[ AuthHandler Request Bool ]
genAuthServerContext = authHandler Servant.:. EmptyContext
type instance AuthServerData (AuthProtect "header-auth") = Bool
@ -104,7 +103,7 @@ users =
userSelect conn ref sw
userNew :: UserSubmit -> MateHandler Int
userNew us = do
userNew us = do
now <- liftIO $ getCurrentTime
randSalt <- liftIO $ random 8
conn <- rsConnection <$> ask
@ -121,4 +120,4 @@ users =
getUserAuthInfo id
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
<$> (random 23)
<*> (pure ident)
<*> (addUTCTime 23 <$> getCurrentTime)
<*> (addUTCTime (23*60) <$> getCurrentTime)
void $ liftIO $ runInsert_ conn (insertToken token)
return $ Granted (AuthToken $ tokenString token)
else
@ -138,7 +138,7 @@ newTicket :: Int -> MateHandler AuthTicket
newTicket ident = do
store <- rsTicketStore <$> ask
rand <- liftIO $ random 23
later <- liftIO $ (addUTCTime (23/60) <$> getCurrentTime)
later <- liftIO $ (addUTCTime 23 <$> getCurrentTime)
let ticket = Ticket
{ ticketId = AuthTicket rand
, ticketUser = ident
@ -154,5 +154,11 @@ processAuthRequest (AuthRequest aticket hash) = do
store <- liftIO . readTVarIO =<< rsTicketStore <$> ask
let mticket = S.filter (\st -> ticketId st == aticket) store
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