From 312047b4a54d8254d818655b26d8b46987dc29e9 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 10 May 2019 14:10:11 +0200 Subject: [PATCH] auth process seems to work --- src/Main.hs | 11 +++++------ src/Model/Auth.hs | 12 +++++++++--- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 332efac..712160e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index 5834617..c7975ee 100644 --- a/src/Model/Auth.hs +++ b/src/Model/Auth.hs @@ -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