tarpitting and deleting found expired tokens
This commit is contained in:
parent
d806b8c3ff
commit
4599e2a7e9
3 changed files with 45 additions and 23 deletions
|
@ -14,12 +14,16 @@ import Control.Monad.IO.Class (liftIO)
|
||||||
|
|
||||||
import Control.Monad.Reader (ask)
|
import Control.Monad.Reader (ask)
|
||||||
|
|
||||||
|
import Control.Concurrent (threadDelay, forkIO)
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
import Data.Profunctor.Product (p3)
|
import Data.Profunctor.Product (p3)
|
||||||
|
|
||||||
import qualified Database.PostgreSQL.Simple as PGS
|
import qualified Database.PostgreSQL.Simple as PGS
|
||||||
|
|
||||||
|
import Data.Int (Int64)
|
||||||
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
@ -67,10 +71,12 @@ getUserAuthInfo
|
||||||
-> MateHandler AuthInfo
|
-> MateHandler AuthInfo
|
||||||
getUserAuthInfo ident = do
|
getUserAuthInfo ident = do
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
users <- liftIO $ runSelect conn (
|
users <- liftIO $ do
|
||||||
|
void $ threadDelay $ 1 * 10 ^ 6
|
||||||
|
runSelect conn (
|
||||||
keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
|
keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
|
||||||
uid .== C.constant ident) <<< queryTable userTable
|
uid .== C.constant ident) <<< queryTable userTable
|
||||||
) :: MateHandler
|
) :: IO
|
||||||
[ ( Int
|
[ ( Int
|
||||||
, Text
|
, Text
|
||||||
, Int
|
, Int
|
||||||
|
@ -106,10 +112,15 @@ validateToken conn header = do
|
||||||
now <- liftIO $ getCurrentTime
|
now <- liftIO $ getCurrentTime
|
||||||
if diffUTCTime stamp now > 0
|
if diffUTCTime stamp now > 0
|
||||||
then return $ Just uid
|
then return $ Just uid
|
||||||
else throwError $ err401
|
else do
|
||||||
|
liftIO $ do
|
||||||
|
void $ forkIO $ void $ runDelete_ conn (deleteToken header)
|
||||||
|
threadDelay $ 1 * 10 ^ 6
|
||||||
|
throwError $ err401
|
||||||
{ errBody = "Your token expired!"
|
{ errBody = "Your token expired!"
|
||||||
}
|
}
|
||||||
_ ->
|
_ -> do
|
||||||
|
liftIO $ threadDelay $ 1 * 10 ^ 6
|
||||||
throwError $ err401
|
throwError $ err401
|
||||||
{ errBody = "No valid token found!"
|
{ errBody = "No valid token found!"
|
||||||
}
|
}
|
||||||
|
@ -163,6 +174,15 @@ insertToken (Token tString tUser tExpiry) = Insert
|
||||||
, iOnConflict = Nothing
|
, iOnConflict = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
deleteToken
|
||||||
|
:: ByteString
|
||||||
|
-> Opaleye.Delete Int64
|
||||||
|
deleteToken tstr = Delete
|
||||||
|
{ dTable = tokenTable
|
||||||
|
, dWhere = (\(rtstr, _, _) -> rtstr .== C.constant tstr)
|
||||||
|
, dReturning = rCount
|
||||||
|
}
|
||||||
|
|
||||||
newTicket :: Int -> MateHandler AuthTicket
|
newTicket :: Int -> MateHandler AuthTicket
|
||||||
newTicket ident = do
|
newTicket ident = do
|
||||||
store <- rsTicketStore <$> ask
|
store <- rsTicketStore <$> ask
|
||||||
|
@ -185,9 +205,12 @@ processAuthRequest (AuthRequest aticket hash) = do
|
||||||
case S.toList mticket of
|
case S.toList mticket of
|
||||||
[ticket] -> do
|
[ticket] -> do
|
||||||
now <- liftIO $ getCurrentTime
|
now <- liftIO $ getCurrentTime
|
||||||
|
liftIO $ threadDelay $ 1 * 10 ^ 6
|
||||||
if now > ticketExpiry ticket
|
if now > ticketExpiry ticket
|
||||||
then
|
then
|
||||||
return Denied
|
return Denied
|
||||||
else
|
else
|
||||||
generateToken ticket hash
|
generateToken ticket hash
|
||||||
_ -> return Denied
|
_ -> do
|
||||||
|
liftIO $ threadDelay $ 1 * 10 ^ 6
|
||||||
|
return Denied
|
||||||
|
|
|
@ -155,10 +155,10 @@ insertUser us now randSalt = Insert
|
||||||
updateUserDetails :: Int -> UserDetailsSubmit -> Day -> Update Int64
|
updateUserDetails :: Int -> UserDetailsSubmit -> Day -> Update Int64
|
||||||
updateUserDetails id uds now = Update
|
updateUserDetails id uds now = Update
|
||||||
{ uTable = userTable
|
{ uTable = userTable
|
||||||
, uUpdateWith = updateEasy (\(id_, _, _, _, _, _, i7, i8, _) ->
|
, uUpdateWith = updateEasy (\(id_, _, i3, _, _, _, i7, i8, _) ->
|
||||||
( id_
|
( id_
|
||||||
, C.constant (userDetailsSubmitIdent uds)
|
, C.constant (userDetailsSubmitIdent uds)
|
||||||
, C.constant (userDetailsSubmitBalance uds)
|
, i3
|
||||||
, C.constant now
|
, C.constant now
|
||||||
, C.constant (userDetailsSubmitEmail uds)
|
, C.constant (userDetailsSubmitEmail uds)
|
||||||
, C.constant (userDetailsSubmitAvatar uds)
|
, C.constant (userDetailsSubmitAvatar uds)
|
||||||
|
|
|
@ -70,7 +70,6 @@ instance FromJSON UserDetails
|
||||||
|
|
||||||
data UserDetailsSubmit = UserDetailsSubmit
|
data UserDetailsSubmit = UserDetailsSubmit
|
||||||
{ userDetailsSubmitIdent :: T.Text
|
{ userDetailsSubmitIdent :: T.Text
|
||||||
, userDetailsSubmitBalance :: Int
|
|
||||||
, userDetailsSubmitEmail :: Maybe T.Text
|
, userDetailsSubmitEmail :: Maybe T.Text
|
||||||
, userDetailsSubmitAvatar :: Maybe Int
|
, userDetailsSubmitAvatar :: Maybe Int
|
||||||
, userDetailsSubmitHash :: Maybe AuthHash
|
, userDetailsSubmitHash :: Maybe AuthHash
|
||||||
|
|
Loading…
Reference in a new issue