ms2k/nuthatch
SHA256
Watch
0
Code Releases Activity

Replace raw HTTP dispatch with typed Servant API

Browse source
This commit is contained in:
ms2k 2026-07-18 13:17:40 +09:00
commit 435d4fea4c
1 changed files with 1625 additions and 445 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/Nuthatch/Session.hs
View file

@ -24,7 +24,7 @@ import Nuthatch.Paths (encodeUserId)
import Nuthatch.Types
import System.Entropy (getEntropy)
mintSession :: Config -> Text -> Text -> Maybe Text -> IO (Either Text Text)
mintSession :: Config -> Text -> Text -> Maybe Text -> IO (Either Text SessionToken)
mintSession cfg iss sub display = do
now <- floor <$> getPOSIXTime
let expAt = now + cfgSessionHours cfg * 3600
@ -43,10 +43,10 @@ mintSession cfg iss sub display = do
, "oidc_subject" A..= sub
] <> maybe [] (\d -> ["display" A..= d]) display
token = signJwt (TE.encodeUtf8 (cfgJwtSecret cfg)) header payload
pure (Right token)
pure (validateSessionToken token)
verifySession :: Config -> Text -> IO (Either Text SessionUser)
verifySession cfg token = do
verifySession :: Config -> SessionToken -> IO (Either Text SessionUser)
verifySession cfg (SessionToken token) = do
now <- floor <$> getPOSIXTime
pure $ do
claims <- verifyJwt (TE.encodeUtf8 (cfgJwtSecret cfg)) token
@ -120,13 +120,13 @@ claimInt obj key =
_ -> Left ("invalid integer claim " <> key)
_ -> Left ("missing claim " <> key)
newCsrfToken :: IO Text
newCsrfToken :: IO CsrfToken
newCsrfToken = do
bytes <- getEntropy 32
pure (TE.decodeUtf8 (B64.encodeUnpadded bytes))
pure (CsrfToken (TE.decodeUtf8 (B64.encodeUnpadded bytes)))
constantTimeEq :: Text -> Text -> Bool
constantTimeEq a b =
constantTimeEq :: CsrfToken -> CsrfToken -> Bool
constantTimeEq (CsrfToken a) (CsrfToken b) =
let ba = TE.encodeUtf8 a
bb = TE.encodeUtf8 b
in BS.length ba == BS.length bb