From f1518f41000084c7eea2f5761853e0767da576e4 Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 14 Oct 2019 06:40:07 +0200 Subject: [PATCH] header suffices being raw, remove debug output --- app/Main.hs | 6 ++---- src/Model/Auth.hs | 11 +++++------ 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 91fefdf..fdf15a2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,8 +8,6 @@ module Main where import Servant import Servant.Server.Experimental.Auth -import Data.ByteString.Base16 (decode) - import Data.Set (empty) import Database.PostgreSQL.Simple @@ -110,8 +108,8 @@ authHandler conn = mkAuthHandler handler handler req = do let headers = requestHeaders req res <- case lookup "Authentication" headers of - Just hh -> - validateToken (fst $ decode hh) conn + Just hh -> do + validateToken hh conn _ -> return Nothing return res diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index a4981aa..c924f71 100644 --- a/src/Model/Auth.hs +++ b/src/Model/Auth.hs @@ -250,7 +250,7 @@ generateToken -> AuthResponse -> PGS.Connection -> MateHandler AuthResult -generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse rawresponse) conn = do +generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse response) conn = do authData <- liftIO $ runSelect conn ( keepWhen (\(_, auid, amethod, _, _) -> 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) -> - (decodeUtf8 $ fst $ B16.decode $ B.drop 2 payload)) authData - response = rawresponse + (decodeUtf8 payload)) authData authResult = case method of PrimaryPass -> validatePass response userPayloads SecondaryPass -> validatePass response userPayloads ChallengeResponse -> validateChallengeResponse response userPayloads - liftIO $ print (response : userPayloads) + -- liftIO $ print (response : userPayloads) if authResult then do token <- liftIO $ Token @@ -359,7 +358,7 @@ processAuthRequest (AuthRequest aticket hash) store conn = do let mticket = S.filter (\st -> ticketId st == aticket) store case S.toList mticket of [ticket] -> do - liftIO $ putStrLn "there is a ticket..." + -- liftIO $ putStrLn "there is a ticket..." now <- liftIO $ getCurrentTime liftIO $ threadDelay delayTime if now > ticketExpiry ticket @@ -376,7 +375,7 @@ processAuthRequest (AuthRequest aticket hash) store conn = do return Denied #endif else do - liftIO $ putStrLn "...and it is valid" + -- liftIO $ putStrLn "...and it is valid" generateToken ticket hash conn _ -> do liftIO $ threadDelay delayTime