add debug print of codeExpiration
This commit is contained in:
parent
c17f8f1ae2
commit
c3fcf3703c
@ -3,7 +3,7 @@
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# LANGUAGE OverloadedRecordDot, OverloadedStrings, ScopedTypeVariables, TypeApplications, LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedRecordDot, OverloadedStrings, ScopedTypeVariables, TypeApplications, LambdaCase, RecordWildCards #-}
|
||||
|
||||
module AuthCode
|
||||
( State(..)
|
||||
@ -93,6 +93,8 @@ data AuthRequest user = AuthRequest
|
||||
, scopes :: [Scope user]
|
||||
}
|
||||
|
||||
instance Show user => Show (AuthRequest user) where
|
||||
show AuthRequest{..} = "AuthRequest{ codeExpiration = " ++ show codeExpiration ++ ", .. }"
|
||||
|
||||
|
||||
data State user = State
|
||||
@ -130,6 +132,11 @@ genUnencryptedCode req url state = do
|
||||
verify :: Text -> Maybe String -> AuthState user -> IO (Maybe (user, [Scope user]))
|
||||
verify code mClientID state = do
|
||||
now <- getCurrentTime
|
||||
atomically $ do
|
||||
codes <- (readTVar >>= activeCodes) state
|
||||
print $ "activeCodes: " ++ tshow codes
|
||||
tokens <- (readTVar >>= activeTokens) state
|
||||
print $ "activeTokens: " ++ tshow tokens
|
||||
mData <- atomically $ do
|
||||
result <- (readTVar >=> return . M.lookup code . activeCodes) state
|
||||
modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user