nek0/mateamt
1
0
Fork 0
Code Issues Pull requests Releases Activity

header suffices being raw, remove debug output

Browse source
This commit is contained in:
nek0 2019-10-14 06:40:07 +02:00
parent 22adf58f9b
commit f1518f4100
2 changed files with 7 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
app/Main.hs
View file

@ -8,8 +8,6 @@ module Main where
import Servant import Servant
import Servant.Server.Experimental.Auth import Servant.Server.Experimental.Auth
import Data.ByteString.Base16 (decode)
import Data.Set (empty) import Data.Set (empty)
import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple
@ -110,8 +108,8 @@ authHandler conn = mkAuthHandler handler
handler req = do handler req = do
let headers = requestHeaders req let headers = requestHeaders req
res <- case lookup "Authentication" headers of res <- case lookup "Authentication" headers of
Just hh -> Just hh -> do
validateToken (fst $ decode hh) conn validateToken hh conn
_ -> _ ->
return Nothing return Nothing
return res return res

11
src/Model/Auth.hs
View file

@ -250,7 +250,7 @@ generateToken
-> AuthResponse -> AuthResponse
-> PGS.Connection -> PGS.Connection
-> MateHandler AuthResult -> MateHandler AuthResult
generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse rawresponse) conn = do generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse response) conn = do
authData <- liftIO $ runSelect conn ( authData <- liftIO $ runSelect conn (
keepWhen (\(_, auid, amethod, _, _) -> keepWhen (\(_, auid, amethod, _, _) ->
auid .== C.constant tuid .&& amethod .== C.constant (fromEnum method)) auid .== C.constant tuid .&& amethod .== C.constant (fromEnum method))
@ -264,13 +264,12 @@ generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse rawresponse) conn = d
) )
] ]
let userPayloads = map (\(_, _, _, _, payload) -> let userPayloads = map (\(_, _, _, _, payload) ->
(decodeUtf8 $ fst $ B16.decode $ B.drop 2 payload)) authData (decodeUtf8 payload)) authData
response = rawresponse
authResult = case method of authResult = case method of
PrimaryPass -> validatePass response userPayloads PrimaryPass -> validatePass response userPayloads
SecondaryPass -> validatePass response userPayloads SecondaryPass -> validatePass response userPayloads
ChallengeResponse -> validateChallengeResponse response userPayloads ChallengeResponse -> validateChallengeResponse response userPayloads
liftIO $ print (response : userPayloads) -- liftIO $ print (response : userPayloads)
if authResult if authResult
then do then do
token <- liftIO $ Token token <- liftIO $ Token
@ -359,7 +358,7 @@ processAuthRequest (AuthRequest aticket hash) store conn = do
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] -> do [ticket] -> do
liftIO $ putStrLn "there is a ticket..." -- liftIO $ putStrLn "there is a ticket..."
now <- liftIO $ getCurrentTime now <- liftIO $ getCurrentTime
liftIO $ threadDelay delayTime liftIO $ threadDelay delayTime
if now > ticketExpiry ticket if now > ticketExpiry ticket
@ -376,7 +375,7 @@ processAuthRequest (AuthRequest aticket hash) store conn = do
return Denied return Denied
#endif #endif
else do else do
liftIO $ putStrLn "...and it is valid" -- liftIO $ putStrLn "...and it is valid"
generateToken ticket hash conn generateToken ticket hash conn
_ -> do _ -> do
liftIO $ threadDelay delayTime liftIO $ threadDelay delayTime