add debug print of codeExpiration

This commit is contained in:
Sarah Vaupel 2024-03-05 17:12:47 +01:00
parent c17f8f1ae2
commit c3fcf3703c

View File

@ -3,7 +3,7 @@
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE OverloadedRecordDot, OverloadedStrings, ScopedTypeVariables, TypeApplications, LambdaCase #-} {-# LANGUAGE OverloadedRecordDot, OverloadedStrings, ScopedTypeVariables, TypeApplications, LambdaCase, RecordWildCards #-}
module AuthCode module AuthCode
( State(..) ( State(..)
@ -93,6 +93,8 @@ data AuthRequest user = AuthRequest
, scopes :: [Scope user] , scopes :: [Scope user]
} }
instance Show user => Show (AuthRequest user) where
show AuthRequest{..} = "AuthRequest{ codeExpiration = " ++ show codeExpiration ++ ", .. }"
data State user = State 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 :: Text -> Maybe String -> AuthState user -> IO (Maybe (user, [Scope user]))
verify code mClientID state = do verify code mClientID state = do
now <- getCurrentTime now <- getCurrentTime
atomically $ do
codes <- (readTVar >>= activeCodes) state
print $ "activeCodes: " ++ tshow codes
tokens <- (readTVar >>= activeTokens) state
print $ "activeTokens: " ++ tshow tokens
mData <- atomically $ do mData <- atomically $ do
result <- (readTVar >=> return . M.lookup code . activeCodes) state result <- (readTVar >=> return . M.lookup code . activeCodes) state
modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes } modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes }