uniworx/oauth2-mock-server
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix debug prints

Browse Source
This commit is contained in:
Sarah Vaupel 2024-03-06 01:50:22 +01:00
parent c3fcf3703c
commit 440c7fe2a8
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/AuthCode.hs
View File

@ -23,7 +23,7 @@ import User
import Data.Aeson
import Data.ByteString (ByteString (..), fromStrict, toStrict)
import Data.Either (fromRight)
import Data.Map.Strict (Map)
import Data.Map.Strict (Map, assocs)
import Data.Maybe (isJust, fromMaybe, fromJust)
import Data.Time.Clock
import Data.Text (pack, replace, Text, stripPrefix)
@ -129,14 +129,15 @@ genUnencryptedCode req url state = do
atomically . modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes }
verify :: Text -> Maybe String -> AuthState user -> IO (Maybe (user, [Scope user]))
verify :: (Show user) => 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
(codes, tokens) <- atomically $ do
codes <- readTVar state >>= return . activeCodes
tokens <- readTVar state >>= return . activeTokens
return (codes, tokens)
print $ "activeCodes: " ++ show codes
-- print $ "activeTokens: " ++ show ((\(uuid,(usr,scps)) -> (uuid,(usr,showScope <$> scps))) <$> assocs tokens)
mData <- atomically $ do
result <- (readTVar >=> return . M.lookup code . activeCodes) state
modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes }