Compare commits
2 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
440c7fe2a8 | ||
|
|
c3fcf3703c |
@ -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 }
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user