diff --git a/Snap/Snaplet/CustomAuth.hs b/Snap/Snaplet/CustomAuth.hs
--- a/Snap/Snaplet/CustomAuth.hs
+++ b/Snap/Snaplet/CustomAuth.hs
@@ -11,12 +11,14 @@
   , defAuthSettings
   , authName
   , authCookieLifetime
+  , authJWK
   , createAccount
   , loginUser
   , logoutUser
   , recoverSession
   , combinedLoginRecover
   , setUser
+  , setUser'
   , currentUser
   , getAuthFailData
   , resetAuthFailData
diff --git a/Snap/Snaplet/CustomAuth/AuthManager.hs b/Snap/Snaplet/CustomAuth/AuthManager.hs
--- a/Snap/Snaplet/CustomAuth/AuthManager.hs
+++ b/Snap/Snaplet/CustomAuth/AuthManager.hs
@@ -13,9 +13,10 @@
   , OAuth2Settings(..)
   ) where
 
+import Crypto.JOSE.JWK (JWK)
 import Data.Binary (Binary)
 import Data.ByteString (ByteString)
-import Data.HashMap.Lazy (HashMap)
+import Data.Map (Map)
 import Data.Text (Text)
 import Data.Time.Clock (NominalDiffTime)
 import Network.HTTP.Client (Manager)
@@ -51,18 +52,26 @@
   , stateStore' :: SnapletLens (Snaplet b) SessionManager
   , oauth2Provider :: Maybe Text
   , authFailData :: Maybe (AuthFailure e)
-  , providers :: HashMap Text Provider
+  , providers :: Map Text Provider
+
+  -- Parameters used by OAuth2
+  , httpManager :: Manager
+  -- | Used for RFC 7523 JWT Bearer tokens when required
+  , jwk :: Maybe JWK
   }
 
-data OAuth2Settings u i e b = IAuthBackend u i e b => OAuth2Settings {
-    oauth2Check :: Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe ByteString))
-  , oauth2Login :: Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe u))
+data OAuth2Settings p u i e b = IAuthBackend u i e b => OAuth2Settings
+  { oauth2Check :: p -> Text -> Handler b (AuthManager u e b) (Either e (Maybe ByteString))
+  , oauth2Login :: p -> Text -> Handler b (AuthManager u e b) (Either e (Maybe u))
   , oauth2Failure :: OAuth2Stage -> Handler b (AuthManager u e b) ()
-  , prepareOAuth2Create :: Text -> Text -> Handler b (AuthManager u e b) (Either e i)
+  , prepareOAuth2Create :: p -> Text -> Handler b (AuthManager u e b) (Either e i)
   , oauth2AccountCreated :: u -> Handler b (AuthManager u e b) ()
   , oauth2LoginDone :: Handler b (AuthManager u e b) ()
   , resumeAction :: Text -> Text -> ByteString -> Handler b (AuthManager u e b) ()
   , stateStore :: SnapletLens (Snaplet b) SessionManager
-  , httpManager :: Manager
   , bracket :: Handler b (AuthManager u e b) () -> Handler b (AuthManager u e b) ()
+  -- | Enabled provider names along with user defined associated data.
+  -- These are passed directly to routes and don't need to be
+  -- represented in AuthManager data.
+  , enabledProviders :: [(Text, p)]
   }
diff --git a/Snap/Snaplet/CustomAuth/Challenge.hs b/Snap/Snaplet/CustomAuth/Challenge.hs
new file mode 100644
--- /dev/null
+++ b/Snap/Snaplet/CustomAuth/Challenge.hs
@@ -0,0 +1,37 @@
+module Snap.Snaplet.CustomAuth.Challenge where
+
+import Control.Applicative
+import Data.Attoparsec.ByteString
+import Data.Attoparsec.ByteString.Char8 (char)
+import Data.ByteString (ByteString)
+import Data.CaseInsensitive (CI, mk)
+import Data.Char
+import Data.Word
+import Prelude hiding (takeWhile)
+
+data WWWAuthenticateChallenge = WWWAuthenticateChallenge
+  { challengeScheme :: CI ByteString
+  , challengeParams :: [(CI ByteString, ByteString)]
+  }
+  deriving (Show, Eq)
+
+parseWWWAuthenticateChallenge :: ByteString -> [WWWAuthenticateChallenge]
+parseWWWAuthenticateChallenge x = either (const []) id $ flip parseOnly x $
+  parseChallenge `sepBy` (char ',' *> spaces)
+  where
+    f :: (Enum a, Enum b) => a -> b
+    f = toEnum . fromEnum
+    spaces = skipWhile (isSpace . f)
+    parseChallenge =
+      WWWAuthenticateChallenge
+      <$> (mk <$> takeWhile1 (/= (f ' ')) <* spaces)
+      <*> authParam `sepBy1` (char ',' *> spaces)
+    authParam =
+      (,)
+      <$> (mk <$> takeWhile1 (/= f '='))
+      <* char '='
+      <*> (((char '"' *> takeWhile (/= f '"') <* char '"') <|>
+           (takeWhile (isAlphaNum . f))
+           ) <|>
+           (takeWhile (/= f ' ')))
+      <* spaces
diff --git a/Snap/Snaplet/CustomAuth/Handlers.hs b/Snap/Snaplet/CustomAuth/Handlers.hs
--- a/Snap/Snaplet/CustomAuth/Handlers.hs
+++ b/Snap/Snaplet/CustomAuth/Handlers.hs
@@ -10,23 +10,23 @@
 
 import Control.Error.Util hiding (err)
 import Control.Lens hiding (un)
+import Control.Monad
 import Control.Monad.Trans
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.State
 import qualified Data.Configurator as C
-import qualified Data.HashMap.Lazy as M
+import qualified Data.Map as M
 import Data.Maybe
-import Data.Monoid
 import qualified Data.Text as T
 import Data.Text.Encoding
-import Snap
 import Data.Map
+import Snap
 
 import Snap.Snaplet.CustomAuth.Types hiding (name)
 import Snap.Snaplet.CustomAuth.AuthManager
 import Snap.Snaplet.CustomAuth.OAuth2.Internal
-import Snap.Snaplet.CustomAuth.User (setUser, recoverSession, currentUser, isSessionDefined)
+import Snap.Snaplet.CustomAuth.User (setUser, setUser', recoverSession, currentUser, isSessionDefined)
 import Snap.Snaplet.CustomAuth.Util (getParamText)
 
 setFailure'
@@ -62,7 +62,7 @@
   runMaybeT $ do
     ses <- MaybeT $ getCookie sesName
     lift $ expireCookie ses >> logout (decodeUtf8 $ cookieValue ses)
-  modify $ \mgr -> mgr { activeUser = Nothing }
+  setUser' Nothing
 
 -- Recover if session token is present.  Login if login+password are
 -- present.
@@ -120,7 +120,7 @@
 
 authInit
   :: IAuthBackend u i e b
-  => Maybe (OAuth2Settings u i e b)
+  => Maybe (OAuth2Settings p u i e b)
   -> AuthSettings
   -> SnapletInit b (AuthManager u e b)
 authInit oa s = makeSnaplet (view authName s) "Custom auth" Nothing $ do
@@ -128,7 +128,7 @@
   un <- liftIO $ C.lookupDefault "_login" cfg "userField"
   pn <- liftIO $ C.lookupDefault "_password" cfg "passwordField"
   scn <- liftIO $ C.lookupDefault "_session" cfg "sessionCookieName"
-  ps <- maybe (return M.empty) oauth2Init oa
+  ps <- maybe (return M.empty) (oauth2Init s) oa
   return $ AuthManager
     { activeUser = Nothing
     , cookieLifetime = s ^. authCookieLifetime
@@ -139,6 +139,8 @@
     , oauth2Provider = Nothing
     , authFailData = Nothing
     , providers = ps
+    , httpManager = s ^. authHTTPManager
+    , jwk = s ^. authJWK
     }
 
 isLoggedIn :: UserData u => Handler b (AuthManager u e b) Bool
diff --git a/Snap/Snaplet/CustomAuth/OAuth2/Internal.hs b/Snap/Snaplet/CustomAuth/OAuth2/Internal.hs
--- a/Snap/Snaplet/CustomAuth/OAuth2/Internal.hs
+++ b/Snap/Snaplet/CustomAuth/OAuth2/Internal.hs
@@ -1,8 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Snap.Snaplet.CustomAuth.OAuth2.Internal
   ( oauth2Init
@@ -12,55 +10,68 @@
 
 import Control.Error.Util hiding (err)
 import Control.Lens
-import Control.Monad.Except
+import Control.Monad
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.State
+import qualified Crypto.Hash
+import Crypto.Random (getRandomBytes)
 import Data.Aeson
 import qualified Data.Binary
 import Data.Binary (Binary)
-import Data.Binary.Instances ()
+import qualified Data.ByteArray as ByteArray
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64
+import qualified Data.ByteString.Base64.URL as URL
 import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
-import Data.Char (chr)
 import qualified Data.Configurator as C
-import Data.HashMap.Lazy (HashMap)
-import qualified Data.HashMap.Lazy as M
-import Data.Maybe (isJust, isNothing, catMaybes)
-import Data.Monoid
+import Data.List (find, lookup)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (isJust, isNothing, catMaybes, fromMaybe, fromJust, maybeToList)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, decodeUtf8', encodeUtf8)
-import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
+import Data.Time.Clock (UTCTime(utctDayTime), getCurrentTime, diffUTCTime)
 import Network.HTTP.Client (Manager)
-import Network.OAuth.OAuth2
+import qualified Network.HTTP.Client as HTTP
+import qualified Network.URI
+import Network.OAuth.OAuth2 hiding (fetchAccessToken, error)
+import Network.OAuth.OAuth2.AuthorizationRequest
+import Network.OAuth.OAuth2.TokenRequest
 import Prelude hiding (lookup)
 import Snap hiding (path)
 import Snap.Snaplet.Session
-import System.Random
 import URI.ByteString
 
 import Snap.Snaplet.CustomAuth.AuthManager
+import Snap.Snaplet.CustomAuth.OAuth2.Internal.DPoP
+import Snap.Snaplet.CustomAuth.OAuth2.Internal.PAR
+import Snap.Snaplet.CustomAuth.OAuth2.Internal.UserInfo
 import Snap.Snaplet.CustomAuth.Types hiding (name)
 import Snap.Snaplet.CustomAuth.User (setUser, currentUser, recoverSession)
-import Snap.Snaplet.CustomAuth.Util (getStateName, getParamText, setFailure)
+import Snap.Snaplet.CustomAuth.Util (getStateName, getParamText, setFailure, getTruncatedCurrentTime, fromURIByteString )
 
 oauth2Init
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
-  -> Initializer b (AuthManager u e b) (HashMap Text Provider)
-oauth2Init s = do
+  => AuthSettings
+  -> OAuth2Settings p u i e b
+  -> Initializer b (AuthManager u e b) (Map Text Provider)
+oauth2Init auths s = do
   cfg <- getSnapletUserConfig
   root <- getSnapletRootURL
   hostname <- liftIO $ C.require cfg "hostname"
   scheme <- liftIO $ C.lookupDefault "https" cfg "protocol"
-  names <- liftIO $ C.lookupDefault [] cfg "oauth2.providers"
+  let names = map fst $ enabledProviders s
   -- TODO: use discovery
   let makeProvider name = let
         name' = "oauth2." <> name
         lk = MaybeT . C.lookup cfg . (name' <>)
         lku n = lk n >>=
           MaybeT . return . hush . parseURI strictURIParserOptions . encodeUtf8
+        lkMaybe n = lift $
+          (hush . parseURI strictURIParserOptions . encodeUtf8 =<<) <$>
+          C.lookup cfg (name' <> n)
         callback = URI (Scheme scheme)
                    (Just $ Authority Nothing (Host hostname) Nothing)
                    ("/" <> root <> "/oauth2callback/" <> (encodeUtf8 name))
@@ -71,19 +82,26 @@
            <*> lk ".scope"
            <*> lku ".endpoint.identity"
            <*> lk ".identityField"
+           <*> lkMaybe ".endpoint.par"
+           <*> lkMaybe ".issuer"
+           <*> (lift $ C.lookupDefault False cfg $ name' <> ".dpop")
+           <*> lkMaybe ".endpoint.jwks"
            <*> (OAuth2
                 <$> lk ".clientId"
-                <*> (lift $ runMaybeT $ lk ".clientSecret")
+                <*> (lift . fmap (fromMaybe "") . runMaybeT $ lk ".clientSecret")
                 <*> lku ".endpoint.auth"
                 <*> lku ".endpoint.access"
-                <*> (pure $ Just callback))
+                <*> (pure callback))
+  providers <- liftIO $ catMaybes <$> mapM (runMaybeT . makeProvider) names
   addRoutes $ mapped._2 %~ (bracket s) $
     [ ("oauth2createaccount", oauth2CreateAccount s)
     , ("oauth2callback/:provider", oauth2Callback s)
     , ("oauth2login/:provider", redirectLogin)
     ]
-  liftIO $ M.fromList . map (\x -> (providerName x, x)) . catMaybes <$>
-    (mapM (runMaybeT . makeProvider) names)
+  maybe (pure ()) (\p -> error $ "JWK not provided while provider " <>
+                         T.unpack (providerName p) <> " uses PAR") $
+    guard (isNothing (auths ^. authJWK)) *> find (isJust . parEndpoint) providers
+  return . M.fromList $ map ((,) <$> providerName <*> id) providers
 
 redirectLogin
   :: Handler b (AuthManager u e b) ()
@@ -94,62 +112,82 @@
   where
     toProvider p = do
       success <- redirectToProvider $ providerName p
-      if success then return () else pass
+      when (isNothing success) pass
 
+userProvider
+  :: OAuth2Settings p u i e b
+  -> Provider
+  -> p
+userProvider s provider =
+  fromJust $ lookup (providerName provider) $ enabledProviders s
+
 getRedirUrl
   :: Provider
-  -> Text
+  -> B.ByteString
+  -> B.ByteString
   -> URI
-getRedirUrl p token =
-  appendQueryParams [("state", encodeUtf8 token)
+getRedirUrl p token pkceChallenge =
+  appendQueryParams [("state", token)
+                    ,("code_challenge", pkceChallenge)
                     ,("scope", encodeUtf8 $ scope p)] $ authorizationUrl $ oauth p
 
 redirectToProvider
   :: Text
-  -> Handler b (AuthManager u e b) Bool
+  -> Handler b (AuthManager u e b) (Maybe RedirectError)
 redirectToProvider pName = do
-  maybe (return False) redirectToProvider' =<< M.lookup pName <$> gets providers
+  maybe (return $ Just UnknownProvider) redirectToProvider' =<< M.lookup pName <$> gets providers
 
 redirectToProvider'
   :: Provider
-  -> Handler b (AuthManager u e b) Bool
-redirectToProvider' provider = do
+  -> Handler b (AuthManager u e b) (Maybe RedirectError)
+redirectToProvider' provider = fmap (either Just (const Nothing)) $ runExceptT $ do
+  let oa = oauth provider
   -- Generate a state token and store it in SessionManager
-  store <- gets stateStore'
-  stamp <- liftIO $ (T.pack . show) <$> getCurrentTime
-  name <- getStateName
-  let randomChar i
-        | i < 10 = chr (i+48)
-        | i < 36 = chr (i+55)
-        | otherwise = chr (i+61)
-      randomText n = T.pack <$> replicateM n (randomChar <$> randomRIO (0,61))
-  token <- liftIO $ randomText 20
-  withTop' store $ do
-    setInSession name token
-    setInSession (name <> "_stamp") stamp
-    commitSession
-  let redirUrl = serializeURIRef' $ getRedirUrl provider token
-  redirect' redirUrl 303
+  store <- lift $ gets stateStore'
+  -- Some implementations may mind fractional iat/exp claims
+  curr <- liftIO getTruncatedCurrentTime
+  name <- (<> providerName provider) <$> lift getStateName
+  -- PKCE verifier, used in access token fetch
+  (token, pkceVerifier) <- liftIO genParams
+  -- PKCE challenge, sent in the initial redirect/PAR request
+  let pkceChallenge =
+        decodeLatin1 . URL.encodeUnpadded . B.pack .
+        ByteArray.unpack @(Crypto.Hash.Digest Crypto.Hash.SHA256) $
+        Crypto.Hash.hash pkceVerifier
+      baseParams =
+        [ ("response_type", "code")
+        , ("client_id", encodeUtf8 $ oauth2ClientId oa)
+        , ("redirect_uri", serializeURIRef' $ oauth2RedirectUri oa)
+        ]
+      stateParams =
+        [ ("state", token)
+        , ("code_challenge", encodeUtf8 pkceChallenge)
+        , ("code_challenge_method", "S256")
+        , ("scope", encodeUtf8 $ scope provider)
+        ]
 
-getUserInfo
-  :: MonadIO m
-  => Manager
-  -> Provider
-  -> AccessToken
-  -> ExceptT (Maybe ByteString) m Text
-getUserInfo mgr provider token = do
-  let endpoint = identityEndpoint provider
-  (withExceptT Just $ ExceptT $ liftIO $ authGetJSON mgr token endpoint) >>=
-    (maybe (throwE Nothing) pure . lookupProviderInfo)
+  lift $ withTop' store $ do
+    setInSession name $ decodeLatin1 token
+    setInSession (name <> "_stamp") . T.pack $ show curr
+    setInSession (name <> "_pkce_verifier") (decodeLatin1 $ pkceVerifier)
+    commitSession
+  lift . flip redirect' 303 =<< serializeURIRef' <$> maybe
+    -- Known statically
+    (lift . pure . appendQueryParams stateParams $ authorizationUrl oa)
+    -- PAR. Need to fetch parameter with POST
+    (parRequest provider curr (baseParams <> stateParams))
+    (parEndpoint provider)
   where
-    lookup' a b = maybeText =<< M.lookup a b
-    maybeText (String x) = Just x
-    maybeText _ = Nothing
-    lookupProviderInfo = lookup' (identityField provider)
+    genParams =
+      (,)
+      -- State token
+      <$> (URL.encodeUnpadded <$> getRandomBytes 20)
+      -- PKCE verifier
+      <*> (URL.encodeUnpadded <$> getRandomBytes 32)
 
 oauth2Callback
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Handler b (AuthManager u e b) ()
 oauth2Callback s = do
   provs <- gets providers
@@ -158,13 +196,13 @@
 
 oauth2Callback'
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Provider
   -> Handler b (AuthManager u e b) ()
 oauth2Callback' s provider = do
-  name <- getStateName
+  name <- (<> providerName provider) <$> getStateName
+  mgr <- gets httpManager
   let ss = stateStore s
-      mgr = httpManager s
   res <- runExceptT $ do
     let param = oauth provider
     expiredStamp <- lift $ withTop' ss $
@@ -173,6 +211,8 @@
     when expiredStamp $ throwE ExpiredState
     hostState <- maybe (throwE StateNotStored) return =<<
       (lift $ withTop' ss $ getFromSession name)
+    pkceVerifier <- maybe (throwE StateNotStored) (pure . encodeUtf8) =<<
+      (lift $ withTop' ss $ getFromSession $ name <> "_pkce_verifier")
     providerState <- maybe (throwE StateNotReceived) return =<<
       (lift $ getParamText "state")
     when (hostState /= providerState) $ throwE BadState
@@ -183,21 +223,39 @@
     (maybe (throwE (IdExtractionFailed Nothing)) pure =<<
       (fmap ExchangeToken) <$> (lift $ getParamText "code")) >>=
     -- TODO: catch?
-      (liftIO . fetchAccessToken mgr param >=>
-       either (const $ throwE AccessTokenFetchError) pure >=>
-      -- TODO: get user id (sub) from idToken in token, if
-      -- available. Requires JWT handling.
-       withExceptT (IdExtractionFailed . ((hush . decodeUtf8' . toStrict) =<<)) .
-        getUserInfo (httpManager s) provider . accessToken)
+      (fetchAccessToken mgr param pkceVerifier >=>
+       withExceptT IdExtractionFailed .
+        getUserInfo mgr provider . accessToken)
   either (setFailure ((oauth2Failure s) SCallback) (Just $ providerName provider) .
           Right . Create . OAuth2Failure)
     (oauth2Success s provider) res
+  where
+    -- Add PKCE challenge to access token
+    fetchAccessToken :: Manager -> OAuth2 -> B.ByteString -> ExchangeToken -> ExceptT OAuth2Failure (Handler b (AuthManager u e b)) OAuth2Token
+    fetchAccessToken mgr oa pkceVerifier code
+      | dpopBoundAccessTokens provider = do
+        let (uri, body) = accessTokenUrl oa code
+        req <- liftIO (HTTP.requestFromURI $ fromURIByteString uri)
+        curr <- liftIO getTruncatedCurrentTime
+        clientAssertion <- withExceptT (DPoPRequestError . JOSEError) $ getClientAssertion provider curr
+        resp <- withExceptT DPoPRequestError $ dpopReq provider id HTTP.httpLbs $ req
+          & HTTP.urlEncodedBody
+          ([("code_verifier", pkceVerifier)
+           ,("client_assertion", clientAssertion)
+           ,("client_assertion_type", "urn:ietf:params:oauth:client-assertion-type:jwt-bearer")
+           , ("client_id", encodeUtf8 $ oauth2ClientId oa)
+           ] <> body)
+        withExceptT AccessTokenFetchError $ except $ parseResponseFlexible $ HTTP.responseBody resp
+      | otherwise = withExceptT AccessTokenFetchError $
+        let (uri, body) = accessTokenUrl oa code
+        in doSimplePostRequest mgr oa uri (("code_verifier", pkceVerifier):body) >>=
+           except . parseResponseFlexible
 
 -- User has successfully completed OAuth2 login.  Get the stored
 -- intended action and perform it.
 oauth2Success
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Provider
   -> Text
   -> Handler b (AuthManager u e b) ()
@@ -219,7 +277,7 @@
 
 doOauth2Login
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Provider
   -> Text
   -> Handler b (AuthManager u e b) ()
@@ -233,7 +291,7 @@
   where
     proceed = do
       res <- runExceptT $ do
-        usr <- ExceptT $ (oauth2Login s) (providerName provider) token
+        usr <- ExceptT $ (oauth2Login s) (userProvider s provider) token
         maybe (return ()) (lift . setUser) usr
         return usr
       either (setFailure ((oauth2Failure s) SLogin)
@@ -250,12 +308,12 @@
 
 prepareOAuth2Create'
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Provider
   -> Text
   -> Handler b (AuthManager u e b) (Either (Either e CreateFailure) i)
 prepareOAuth2Create' s provider token =
-  (prepareOAuth2Create s) (providerName provider) token >>=
+  ((prepareOAuth2Create s) (userProvider s provider) token) >>=
   either checkDuplicate (return . Right)
   where
     checkDuplicate e = do
@@ -265,7 +323,7 @@
 -- Check that stored action is not too old and that user matches
 doResume
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Provider
   -> Text
   -> Text
@@ -280,7 +338,7 @@
       (hush $ Data.ByteString.Base64.decode $ encodeUtf8 d)
     when (requireUser d' && isNothing user) $ throwE (Right AttachNotLoggedIn)
     u <- ExceptT $ return . either (Left . Left) Right =<<
-      (oauth2Check s) (providerName provider) token
+      (oauth2Check s) (userProvider s provider) token
     -- Compare current user with action's stored user
     when (userId /= actionUser d') $
      throwE (Right ActionUserMismatch)
@@ -302,7 +360,7 @@
 -- requesting account creation afterwards.
 oauth2CreateAccount
   :: IAuthBackend u i e b
-  => OAuth2Settings u i e b
+  => OAuth2Settings p u i e b
   -> Handler b (AuthManager u e b) ()
 oauth2CreateAccount s = do
   store <- gets stateStore'
diff --git a/Snap/Snaplet/CustomAuth/OAuth2/Internal/DPoP.hs b/Snap/Snaplet/CustomAuth/OAuth2/Internal/DPoP.hs
new file mode 100644
--- /dev/null
+++ b/Snap/Snaplet/CustomAuth/OAuth2/Internal/DPoP.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Snap.Snaplet.CustomAuth.OAuth2.Internal.DPoP where
+
+import Control.Lens
+import Control.Monad
+import Control.Monad.Error.Class
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.Trans.Except
+import Crypto.JOSE.Header
+import Crypto.JOSE.JWK
+import Crypto.JOSE.JWA.JWS (Alg(ES256))
+import Crypto.JWT
+import Data.Aeson
+import qualified Data.Aeson.KeyMap as M
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import Data.List (find)
+import Data.Maybe
+import Data.Text (Text)
+import Data.Text.Encoding (decodeLatin1, decodeUtf8, encodeUtf8)
+import Data.Text.Strict.Lens
+import Data.Time
+import qualified Network.HTTP.Client as HTTP
+import Network.HTTP.Types
+import Network.HTTP.Types.Method
+import Network.OAuth.OAuth2
+import URI.ByteString
+import Snap hiding (Method)
+import Snap.Snaplet.Session
+
+import Snap.Snaplet.CustomAuth.AuthManager hiding (jwk)
+import Snap.Snaplet.CustomAuth.Challenge
+import Snap.Snaplet.CustomAuth.Types
+import Snap.Snaplet.CustomAuth.Util
+
+data DPoPJWT = DPoPJWT
+  { jwtClaims :: ClaimsSet
+  , claimHtm :: Text
+  , claimHtu :: Text
+  , claimNonce :: Maybe Text
+  -- | PDS endpoints only
+  , claimAth :: Maybe Text
+  }
+
+instance HasClaimsSet DPoPJWT where
+  claimsSet f s = fmap (\a' -> s { jwtClaims = a'}) (f (jwtClaims s))
+
+instance FromJSON DPoPJWT where
+  parseJSON = withObject "DPoP" $ \o ->
+    DPoPJWT
+    <$> parseJSON (Object o)
+    <*> o .: "htm"
+    <*> o .: "htu"
+    <*> o .:? "nonce"
+    <*> o .:? "ath"
+
+instance ToJSON DPoPJWT where
+  toJSON s =
+    Object $ M.union
+    (M.fromList $ (maybe id (\x -> (("nonce",String x):)) $ claimNonce s)
+     [ ("htm", String $ claimHtm s)
+     , ("htu", String $ claimHtu s)
+     ])
+    ((\(Object o) -> o) $ toJSON $ jwtClaims s)
+
+dpopKeys :: MonadRandom m => m JWK
+dpopKeys = do
+  jwk <- genJWK (ECGenParam P_256)
+  let h = view thumbprint jwk :: Digest SHA256
+      kid = view (re (base64url . digest) . utf8) h
+  pure $ set jwkKid (Just kid) jwk
+
+dpopClaims :: MonadRandom m => UTCTime -> Method -> URI -> Maybe Text -> m DPoPJWT
+dpopClaims t method uri nonce = do
+  jti <- decodeLatin1 . Base64.encode <$> getRandomBytes 12
+  pure $ DPoPJWT
+    { jwtClaims = emptyClaimsSet
+                  & claimJti ?~ jti
+                  & claimIat ?~ NumericDate t
+    , claimHtm = decodeLatin1 method
+    , claimHtu = decodeUtf8 $ normalizeURIRef' httpNormalization uri
+    , claimNonce = nonce
+    , claimAth = Nothing
+    }
+
+dpopJWTSign :: (MonadRandom m, MonadError e m, AsError e) => JWK -> DPoPJWT -> m SignedJWT
+dpopJWTSign key dpop = do
+  let hdr = newJWSHeader ((), ES256)
+        & typ ?~ HeaderParam () "dpop+jwt"
+        & jwk ?~ (HeaderParam () $ fromJust $ view asPublicKey key)
+  signJWT key hdr dpop
+
+-- | Generate DPoP JWK
+newDPoP
+  :: Provider
+  -> Handler b (AuthManager u e b) ()
+newDPoP provider = do
+  ss <- gets stateStore'
+  let oa = oauth provider
+  --name <- (("_" <> providerName provider) <>) <$> getStateName
+  name <- getStateName
+  k <- liftIO dpopKeys
+  withTop' ss $ setInSession (name <> "_dpop_jwk") $ decodeLatin1 $ BL.toStrict $ encode k
+
+recoverDPoPKey
+  :: Provider
+  -> Handler b (AuthManager u e b) (Maybe JWK)
+recoverDPoPKey provider = do
+  ss <- gets stateStore'
+  name <- getStateName
+  raw <- withTop' ss (getFromSession (name <> "_dpop_jwk"))
+  pure $ maybe Nothing (decode . BL.fromStrict . encodeUtf8) raw
+
+newtype ResponseBodyError = ResponseBodyError { respError :: Text }
+  deriving (Show, Eq)
+
+instance FromJSON ResponseBodyError where
+  parseJSON = withObject "Response" $ \v -> ResponseBodyError <$> v .: "error"
+
+dpopReq
+  :: Provider
+  -> (a -> BL.ByteString)
+  -> (HTTP.Request -> HTTP.Manager -> IO (HTTP.Response a))
+  -> HTTP.Request
+  -> ExceptT RedirectError (Handler b (AuthManager u e b)) (HTTP.Response a)
+dpopReq provider toLBS reqf req = do
+  (ss, mgr) <- lift $ gets ((,) <$> stateStore' <*> httpManager)
+  name <- lift getStateName
+  let nonceName = name <> "_dpop_nonce"
+  t <- liftIO getTruncatedCurrentTime
+  storedNonce <- lift $ withTop' ss $ getFromSession nonceName
+  key <- maybe (throwE DPoPKeyMissing) pure =<< lift (recoverDPoPKey provider)
+  let htu = URI
+        (Scheme $ if HTTP.secure req then "https" else "http")
+        (Just $ Authority Nothing (Host $ HTTP.host req) (Just $ Port $ HTTP.port req))
+        (HTTP.path req)
+        (Query []) Nothing
+      dpopReq' maybeNonce = do
+        -- dpopClaims t (HTTP.method req) htu maybeNonce
+        let createClaims = runJOSE $
+              dpopClaims t (HTTP.method req) htu maybeNonce
+        claims <- liftIO createClaims >>= either
+          (throwE . JOSEError) pure
+        let createJWT = runJOSE $
+              dpopJWTSign key claims
+        jwt <- liftIO createJWT >>= either
+          (throwE . JOSEError) pure
+        let req' = req
+              { HTTP.requestHeaders =
+                ("dpop", BL.toStrict $ encodeCompact jwt):
+                (filter ((/= "dpop") . fst) (HTTP.requestHeaders req))
+              }
+        liftIO (reqf req' mgr) >>=
+          (\case
+              r | Just dpopNonce <- getHeaderValue "dpop-nonce" r -> do
+                let n = decodeUtf8 dpopNonce
+                lift $ withTop' ss $ do
+                  setInSession nonceName n
+                  commitSession
+                pure (r, Just n)
+              r -> pure (r, Nothing)
+          ) >>= \case
+          (r, n@(Just _)) | nonceRequired r -> do
+            dpopReq' n
+          (r, x) -> do
+            let maybeChallenge =
+                  find ((== "dpop") . challengeScheme) .
+                  parseWWWAuthenticateChallenge =<<
+                  getHeaderValue "www-authenticate" r
+            pure r
+
+  dpopReq' storedNonce
+  where
+    getHeaderValue n = lookup n . HTTP.responseHeaders
+
+    nonceRequired r =
+      let s = HTTP.responseStatus r
+      in or
+         [ isJust $ do
+             challenge <-
+               find ((== "dpop") . challengeScheme) . parseWWWAuthenticateChallenge =<<
+               getHeaderValue "www-authenticate" r
+             authError <- lookup "error" $ challengeParams challenge
+             guard $
+               statusCode s == 401 &&
+               challengeScheme challenge == "DPoP" &&
+               authError == "use_dpop_nonce"
+         , isJust $ do
+             contentType <- getHeaderValue "content-type" r
+             (ResponseBodyError authError) <-
+               guard (contentType == "application/json") *> (decode $ toLBS $ HTTP.responseBody r)
+             guard $
+               statusCode s == 400 &&
+               authError == "use_dpop_nonce"
+         ]
diff --git a/Snap/Snaplet/CustomAuth/OAuth2/Internal/PAR.hs b/Snap/Snaplet/CustomAuth/OAuth2/Internal/PAR.hs
new file mode 100644
--- /dev/null
+++ b/Snap/Snaplet/CustomAuth/OAuth2/Internal/PAR.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+-- | Support for making requests to resource servers, including
+-- handling of DPoP.
+
+module Snap.Snaplet.CustomAuth.OAuth2.Internal.PAR where
+
+import Control.Lens
+import Control.Monad.Trans
+import Control.Monad.Trans.Except
+import Control.Monad.State
+import Crypto.JWT hiding (jwk)
+import Data.Aeson
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Base64 as Base64
+import Data.ByteString.Lazy (toStrict)
+import Data.Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1, decodeUtf8', encodeUtf8)
+import Data.Time
+import qualified Network.HTTP.Client as HTTP
+import Network.OAuth.OAuth2
+import qualified Network.URI
+import Snap
+import Unsafe.Coerce
+import URI.ByteString
+
+import Snap.Snaplet.CustomAuth.AuthManager
+import Snap.Snaplet.CustomAuth.Types
+import Snap.Snaplet.CustomAuth.OAuth2.Internal.DPoP
+import Snap.Snaplet.CustomAuth.Util
+
+newtype RequestURI = RequestURI { reqURI :: Text }
+  deriving (Show)
+
+instance FromJSON RequestURI where
+  parseJSON = withObject "RequestURI" $ \o -> RequestURI <$> o .: "request_uri"
+
+getClientAssertion
+  :: Provider
+  -> UTCTime
+  -> ExceptT JWTError (Handler b (AuthManager u e b)) ByteString
+getClientAssertion provider curr = do
+  maybeJWK <- lift $ gets jwk
+
+  -- Tailored for bsky, may need generalisation for others
+  let createClaims = do
+        jti <- decodeLatin1 . Base64.encode <$> getRandomBytes 12
+        let claims =
+              emptyClaimsSet
+              & claimAud ?~ Audience [aud]
+              & claimIss ?~ sub
+              & claimSub ?~ sub
+              & claimJti ?~ jti
+              & claimIat ?~ NumericDate curr
+              & claimExp ?~ NumericDate (addUTCTime 90 curr)
+        pure claims
+      oa = oauth provider
+      accessURI = oauth2AuthorizeEndpoint oa
+      sub = fromJust $ preview stringOrUri $ oauth2ClientId oa
+      aud = fromJust $ preview stringOrUri $ decodeLatin1 $
+            schemeBS (uriScheme accessURI) <> "://" <>
+            fromMaybe "" (hostBS . authorityHost <$> uriAuthority accessURI)
+
+  claims <- liftIO createClaims
+
+  let createAssertion = runJOSE $ do
+        let j = fromJust maybeJWK
+        hdr <- makeJWSHeader j
+        encodeCompact <$> signClaims j hdr claims
+
+  fmap toStrict $ ExceptT $ liftIO createAssertion
+
+parRequest
+  :: Provider
+  -> UTCTime
+  -> [(ByteString, ByteString)]
+  -> URI
+  -> ExceptT RedirectError (Handler b (AuthManager u e b)) (URIRef Absolute)
+parRequest provider curr params parUrl = do
+  let oa = oauth provider
+
+  f <-
+    if dpopBoundAccessTokens provider
+    then do
+      _ <- lift $ newDPoP provider
+      pure $ dpopReq provider id
+    else do
+      mgr <- lift $ gets httpManager
+      pure $ \f -> liftIO . flip f mgr
+
+  clientAssertion <- withExceptT JOSEError $ getClientAssertion provider curr
+  let parQuery =
+        params <>
+        [ ("client_assertion", clientAssertion)
+        , ("client_assertion_type", "urn:ietf:params:oauth:client-assertion-type:jwt-bearer")
+        ]
+
+  req <- HTTP.urlEncodedBody parQuery <$> liftIO (HTTP.requestFromURI $ fromURIByteString parUrl)
+
+  requestURI <-
+    liftIO (HTTP.requestFromURI $ fromURIByteString parUrl) >>=
+    f HTTP.httpLbs . HTTP.urlEncodedBody parQuery >>=
+    maybe (throwE PARRequestURIParseError) (pure . reqURI) .
+    decode . HTTP.responseBody
+
+  let q = [ ("client_id", encodeUtf8 $ oauth2ClientId oa)
+          , ("request_uri", encodeUtf8 requestURI)
+          ]
+  pure $ over (queryL . queryPairsL) (<> q) (oauth2AuthorizeEndpoint oa)
diff --git a/Snap/Snaplet/CustomAuth/OAuth2/Internal/UserInfo.hs b/Snap/Snaplet/CustomAuth/OAuth2/Internal/UserInfo.hs
new file mode 100644
--- /dev/null
+++ b/Snap/Snaplet/CustomAuth/OAuth2/Internal/UserInfo.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Snap.Snaplet.CustomAuth.OAuth2.Internal.UserInfo where
+
+import Control.Applicative
+import Control.Lens
+import Control.Monad.Time
+import Control.Monad.Trans
+import Control.Monad.Trans.Except
+import Crypto.JOSE
+import Crypto.JWT
+import Data.Aeson (Value(..), eitherDecode)
+import qualified Data.ByteString.Lazy as BL
+import Data.Bifunctor
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8Lenient, encodeUtf8)
+import Network.HTTP.Client (Manager)
+import qualified Network.HTTP.Client as HTTP
+import Network.OAuth.OAuth2
+
+import Snap.Snaplet.CustomAuth.Types
+import Snap.Snaplet.CustomAuth.OAuth2.Internal.DPoP
+import Snap.Snaplet.CustomAuth.Util
+
+getUserInfo
+  :: MonadIO m
+  => Manager
+  -> Provider
+  -> AccessToken
+  -> ExceptT (Maybe Text) m Text
+getUserInfo mgr provider token
+  | Just jwksURI <- jwksEndpoint provider = do
+      jwks <- withExceptT (Just . T.pack) $ ExceptT $ do
+        liftIO $ eitherDecode . HTTP.responseBody <$>
+          (HTTP.requestFromURI (fromURIByteString jwksURI) >>=
+           flip HTTP.httpLbs mgr)
+      claims <- withExceptT (Just . T.pack . show @JWTError) $ mapExceptT liftIO $
+        ExceptT $ runJOSE $ do
+        jwt <- (decodeCompact . BL.fromStrict . encodeUtf8 . atoken) token
+        verifyClaims (defaultJWTValidationSettings (const True))
+          (jwks :: JWKSet)
+          (jwt :: SignedJWT)
+      sub <- maybe (throwE $ Just "sub not found") pure $ claims ^. claimSub
+      pure $ fromJust $ sub ^? string <|> (T.pack . show <$> sub ^? uri)
+  | otherwise = do
+      -- TODO PAR if needed
+      let endpoint = identityEndpoint provider
+      mapExceptT (fmap (first (Just . decodeUtf8Lenient . BL.toStrict)) . liftIO)
+        (authGetJSON mgr token endpoint) >>=
+        (maybe (throwE Nothing) pure . lookupProviderInfo)
+  where
+    lookup' a b = maybeText =<< M.lookup a b
+    maybeText (String x) = Just x
+    maybeText _ = Nothing
+    lookupProviderInfo = lookup' (identityField provider)
+
diff --git a/Snap/Snaplet/CustomAuth/OAuth2/Splices.hs b/Snap/Snaplet/CustomAuth/OAuth2/Splices.hs
--- a/Snap/Snaplet/CustomAuth/OAuth2/Splices.hs
+++ b/Snap/Snaplet/CustomAuth/OAuth2/Splices.hs
@@ -7,7 +7,6 @@
 import Control.Monad.State
 import Data.Map.Syntax
 import Data.Maybe
-import Data.Monoid
 import Heist
 import Heist.Compiled
 import Snap
diff --git a/Snap/Snaplet/CustomAuth/Types.hs b/Snap/Snaplet/CustomAuth/Types.hs
--- a/Snap/Snaplet/CustomAuth/Types.hs
+++ b/Snap/Snaplet/CustomAuth/Types.hs
@@ -5,13 +5,16 @@
 module Snap.Snaplet.CustomAuth.Types where
 
 import Control.Lens.TH
+import Crypto.JWT (JWTError)
+import Crypto.JOSE.JWK (JWK)
 import Data.Binary
 import Data.Binary.Instances ()
 import Data.ByteString
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime, NominalDiffTime)
 import GHC.Generics (Generic)
-import Network.OAuth.OAuth2 (OAuth2)
+import Network.HTTP.Client (Manager)
+import Network.OAuth.OAuth2 (OAuth2, TokenResponseError)
 import URI.ByteString (URI)
 
 import Snap.Core (Cookie(..))
@@ -32,7 +35,7 @@
   | DuplicateName
   | PasswordFailure PasswordFailure
   | OAuth2Failure OAuth2Failure
-  deriving (Eq, Show, Read)
+  deriving (Eq, Show)
 
 data OAuth2Failure =
     StateNotStored | StateNotReceived | ExpiredState | BadState
@@ -40,8 +43,9 @@
   | AlreadyUser | AlreadyLoggedIn
   | IdentityInUse
   | ProviderError (Maybe Text)
-  | AccessTokenFetchError
-  deriving (Show, Read, Eq)
+  | DPoPRequestError RedirectError
+  | AccessTokenFetchError TokenResponseError
+  deriving (Show, Eq)
 
 data OAuth2ActionFailure =
   ActionTimeout | ActionDecodeError | ActionUserMismatch
@@ -60,6 +64,10 @@
   , scope :: Text
   , identityEndpoint :: URI
   , identityField :: Text
+  , parEndpoint :: Maybe URI
+  , issuer :: Maybe URI
+  , dpopBoundAccessTokens :: Bool
+  , jwksEndpoint :: Maybe URI
   , oauth :: OAuth2
   }
   deriving (Show)
@@ -85,9 +93,21 @@
 data AuthSettings = AuthSettings
   { _authName :: Text
   , _authCookieLifetime :: Maybe NominalDiffTime
+  -- | Needed by OAuth2 if using PAR
+  , _authJWK :: Maybe JWK
+  -- | Needed by OAuth2 if using PAR
+  , _authHTTPManager :: Manager
   }
 
+data RedirectError
+  = UnknownProvider
+  | JWKMissing
+  | DPoPKeyMissing
+  | PARRequestURIParseError
+  | JOSEError JWTError
+  deriving (Show, Eq)
+
 makeLenses ''AuthSettings
 
-defAuthSettings :: AuthSettings
-defAuthSettings = AuthSettings "auth" Nothing
+defAuthSettings :: Manager -> AuthSettings
+defAuthSettings = AuthSettings "auth" Nothing Nothing
diff --git a/Snap/Snaplet/CustomAuth/User.hs b/Snap/Snaplet/CustomAuth/User.hs
--- a/Snap/Snaplet/CustomAuth/User.hs
+++ b/Snap/Snaplet/CustomAuth/User.hs
@@ -1,23 +1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Snap.Snaplet.CustomAuth.User where
 
 import Control.Error.Util
+import Control.Monad
 import Control.Monad.State
 import Control.Monad.Trans.Maybe
 import Data.ByteString (ByteString)
-import Data.ByteString.Lazy (toStrict)
+import Data.ByteString.Char8 (pack)
 import qualified Data.Configurator as C
 import Data.Maybe
 import Data.Text.Encoding
 import Data.Time.Clock (addUTCTime, getCurrentTime)
 import Snap
-import qualified Text.Show.ByteString
 
 import Snap.Snaplet.CustomAuth.Types (AuthUser(..))
 import Snap.Snaplet.CustomAuth.AuthManager
 
+-- | Set user and set response headers to store it in a session
+-- cookie.
 setUser
   :: UserData u
   => u
@@ -29,12 +32,19 @@
   (name, lifetime) <- gets ((,) <$> sessionCookieName <*> cookieLifetime)
   modifyResponse $ addHeader "Set-Cookie" $
     name <> "=" <> session udata <>
-    (maybe "" (("; Max-Age=" <>) . toStrict . Text.Show.ByteString.show @Int . floor) lifetime) <>
+    (maybe "" (("; Max-Age=" <>) . pack . show @Int . floor) lifetime) <>
     "; Path=/" <>
     (if secure then "; Secure; SameSite=None" else "") <>
     "; HttpOnly"
-  modify $ \mgr -> mgr { activeUser = Just usr }
+  setUser' $ Just usr
 
+-- | Only set user in AuthManager internal state.
+setUser'
+  :: Maybe u
+  -> Handler b (AuthManager u e b) ()
+setUser' usr =
+  modify $ \mgr -> mgr { activeUser = usr }
+
 currentUser :: UserData u => Handler b (AuthManager u e b) (Maybe u)
 currentUser = do
   u <- get
@@ -47,7 +57,7 @@
 
 recoverSession
   :: IAuthBackend u i e b
-  => Handler b (AuthManager u e b) ()
+  => Handler b (AuthManager  u e b) ()
 recoverSession = do
   sesName <- gets sessionCookieName
   let quit e = do
@@ -57,7 +67,7 @@
   usr <- runMaybeT $ do
     val <- MaybeT $ ((hush . decodeUtf8' . cookieValue =<<) <$> getCookie sesName)
     lift $ recover val
-  modify $ \mgr -> mgr { activeUser = join $ hush <$> usr }
+  setUser' $ join $ hush <$> usr
   maybe (return ()) (either quit (const $ return ())) usr
 
 -- Just check if the session cookie is defined
diff --git a/Snap/Snaplet/CustomAuth/Util.hs b/Snap/Snaplet/CustomAuth/Util.hs
--- a/Snap/Snaplet/CustomAuth/Util.hs
+++ b/Snap/Snaplet/CustomAuth/Util.hs
@@ -7,10 +7,16 @@
 import Control.Error.Util
 import Control.Monad.State
 import Data.ByteString (ByteString)
-import Data.Monoid
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as C8
+import Data.Char
+import Data.Kind (Type)
 import Data.Text (Text)
 import Data.Text.Encoding
+import Data.Time
+import qualified Network.URI
 import Snap hiding (path)
+import qualified URI.ByteString
 
 import Snap.Snaplet.CustomAuth.AuthManager
 
@@ -22,7 +28,7 @@
   return $ "__" <> name <> "_" <> path <> "_state"
 
 getParamText
-  :: forall (f :: * -> *).
+  :: forall (f :: Type -> Type).
      MonadSnap f
   => ByteString
   -> f (Maybe Text)
@@ -39,3 +45,31 @@
                    , authFailData = Just failure'
                    }
   action
+
+getTruncatedCurrentTime
+  :: IO UTCTime
+getTruncatedCurrentTime =
+  (\t -> t { utctDayTime = fromInteger . floor . realToFrac $ utctDayTime t }) <$> getCurrentTime
+
+fromURIByteString
+  :: URI.ByteString.URI -> Network.URI.URI
+fromURIByteString uri =
+  Network.URI.URI
+  { Network.URI.uriScheme = C8.unpack (URI.ByteString.schemeBS $ URI.ByteString.uriScheme uri)
+                            <> ":"
+  , Network.URI.uriAuthority =
+      (\a -> Network.URI.URIAuth
+             { Network.URI.uriUserInfo = "" -- TODO?
+             , Network.URI.uriRegName = C8.unpack $ URI.ByteString.hostBS $
+                                        URI.ByteString.authorityHost a
+             , Network.URI.uriPort = "" -- TODO?
+             }
+      )
+      <$> URI.ByteString.uriAuthority uri
+  , Network.URI.uriPath = C8.unpack $ URI.ByteString.uriPath uri
+  , Network.URI.uriQuery = C8.unpack $ URI.ByteString.serializeQuery'
+                           URI.ByteString.httpNormalization $
+                           URI.ByteString.uriQuery uri
+  , Network.URI.uriFragment = C8.unpack . URI.ByteString.serializeFragment' $
+                          URI.ByteString.uriFragment uri
+  }
diff --git a/snaplet-customauth.cabal b/snaplet-customauth.cabal
--- a/snaplet-customauth.cabal
+++ b/snaplet-customauth.cabal
@@ -1,5 +1,5 @@
 Name:                snaplet-customauth
-Version:             0.2.1
+Version:             0.3.0
 Synopsis:            Alternate authentication snaplet
 Description:         More customizable authentication snaplet with OAuth2 support
 License:             BSD3
@@ -23,38 +23,48 @@
 
   other-modules:
     Snap.Snaplet.CustomAuth.AuthManager,
+    Snap.Snaplet.CustomAuth.Challenge,
     Snap.Snaplet.CustomAuth.Handlers,
     Snap.Snaplet.CustomAuth.Heist,
     Snap.Snaplet.CustomAuth.Types,
     Snap.Snaplet.CustomAuth.User,
     Snap.Snaplet.CustomAuth.Util,
     Snap.Snaplet.CustomAuth.OAuth2.Internal,
+    Snap.Snaplet.CustomAuth.OAuth2.Internal.DPoP,
+    Snap.Snaplet.CustomAuth.OAuth2.Internal.PAR,
+    Snap.Snaplet.CustomAuth.OAuth2.Internal.UserInfo,
     Snap.Snaplet.CustomAuth.OAuth2.Splices
 
   Build-depends:
     base                      >= 4.4     && < 5,
-    lens                      >= 3.7.6   && < 4.20,
-    bytestring                >= 0.9.1   && < 0.11,
-    base64-bytestring         >= 1.0.0.1 && < 1.1,
-    bytestring-show           >= 0.3.5.6 && < 0.4,
+    lens                      >= 3.7.6   && < 6,
+    bytestring                >= 0.9.1   && < 0.13,
+    base64-bytestring         >= 1.0.0.1 && < 1.3,
+    crypton                   >= 1.0     && < 2,
+    memory                    >= 0.18    && < 1,
+    jose                      >= 0.11    && < 0.12,
+    monad-time                >= 0.4     && < 0.5,
     heist                     >= 1.0.1   && < 1.2,
     mtl                       >= 2       && < 3,
-    transformers              >= 0.4     && < 0.6,
+    transformers              >= 0.4     && < 0.7,
     errors                    >= 2.3     && < 2.4,
     snap                      >= 1.1     && < 1.2,
     snap-core                 >= 1.0     && < 1.1,
     configurator              >= 0.3     && < 0.4,
-    text                      >= 0.11    && < 1.3,
-    time                      >= 1.1     && < 1.12,
+    text                      >= 0.11    && < 2.3,
+    time                      >= 1.1     && < 1.13,
     xmlhtml                   >= 0.1     && < 0.3,
     binary                    >= 0.8.5   && < 0.9,
     binary-instances          >= 1       && < 2,
-    hoauth2                   >= 1.11.0  && < 1.17.0,
-    http-client               >= 0.5.7   && < 0.7,
+    hoauth2                   >= 2.9     && < 3,
+    attoparsec                >= 0.13    && < 0.15,
+    case-insensitive          >= 1       && < 2,
+    http-client               >= 0.5.7   && < 0.8,
     http-client-tls           >= 0.3.5   && < 0.4,
-    containers                >= 0.5.6   && < 0.6,
+    http-types                >= 0.12    && < 0.13,
+    containers                >= 0.5.6   && < 0.7,
     unordered-containers      >= 0.2.7.1 && < 0.3,
-    aeson                     >= 1.2     && < 1.6,
+    aeson                     >= 2.0.1.0 && < 3,
     uri-bytestring            >= 0.2.3   && < 0.4,
-    map-syntax                >= 0.2     && < 0.4,
-    random                    >= 1.1     && < 1.2
+    network-uri               >= 2.6.1   && < 3,
+    map-syntax                >= 0.2     && < 0.4