Compare commits

...

2 Commits
main ... debug

Author SHA1 Message Date
Sarah Vaupel
440c7fe2a8 fix debug prints 2024-03-06 01:50:22 +01:00
Sarah Vaupel
c3fcf3703c add debug print of codeExpiration 2024-03-05 17:12:47 +01:00

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(..)
@ -23,7 +23,7 @@ import User
import Data.Aeson import Data.Aeson
import Data.ByteString (ByteString (..), fromStrict, toStrict) import Data.ByteString (ByteString (..), fromStrict, toStrict)
import Data.Either (fromRight) import Data.Either (fromRight)
import Data.Map.Strict (Map) import Data.Map.Strict (Map, assocs)
import Data.Maybe (isJust, fromMaybe, fromJust) import Data.Maybe (isJust, fromMaybe, fromJust)
import Data.Time.Clock import Data.Time.Clock
import Data.Text (pack, replace, Text, stripPrefix) import Data.Text (pack, replace, Text, stripPrefix)
@ -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
@ -127,9 +129,15 @@ genUnencryptedCode req url state = do
atomically . modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes } 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 verify code mClientID state = do
now <- getCurrentTime now <- getCurrentTime
(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 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 }