module Servant.Auth.Server.Internal.Cookie where
import Blaze.ByteString.Builder (toByteString)
import Control.Monad.Except
import Control.Monad.Reader
import qualified Crypto.JOSE as Jose
import qualified Crypto.JWT as Jose
import Crypto.Util (constTimeEq)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.CaseInsensitive (mk)
import Network.Wai (requestHeaders)
import Web.Cookie
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.JWT (FromJWT (decodeJWT), ToJWT,
makeJWT)
import Servant.Auth.Server.Internal.Types
cookieAuthCheck :: FromJWT usr => CookieSettings -> JWTSettings -> AuthCheck usr
cookieAuthCheck ccfg jwtCfg = do
req <- ask
jwtCookie <- maybe mempty return $ do
cookies' <- lookup "Cookie" $ requestHeaders req
let cookies = parseCookies cookies'
xsrfCookie <- lookup (xsrfCookieName ccfg) cookies
xsrfHeader <- lookup (mk $ xsrfHeaderName ccfg) $ requestHeaders req
guard $ xsrfCookie `constTimeEq` xsrfHeader
lookup "JWT-Cookie" cookies
verifiedJWT <- liftIO $ runExceptT $ do
unverifiedJWT <- Jose.decodeCompact $ BSL.fromStrict jwtCookie
Jose.validateJWSJWT (jwtSettingsToJwtValidationSettings jwtCfg)
(key jwtCfg)
unverifiedJWT
return unverifiedJWT
case verifiedJWT of
Left (_ :: Jose.JWTError) -> mzero
Right v -> case decodeJWT v of
Left _ -> mzero
Right v' -> return v'
makeCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie)
makeCookie cookieSettings jwtSettings v = do
ejwt <- makeJWT v jwtSettings Nothing
case ejwt of
Left _ -> return Nothing
Right jwt -> return $ Just $ def
{ setCookieName = "JWT-Cookie"
, setCookieValue = BSL.toStrict jwt
, setCookieHttpOnly = True
, setCookieMaxAge = cookieMaxAge cookieSettings
, setCookieExpires = cookieExpires cookieSettings
, setCookieSecure = case cookieIsSecure cookieSettings of
Secure -> True
NotSecure -> False
}
makeCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe BS.ByteString)
makeCookieBS a b c = fmap (toByteString . renderSetCookie) <$> makeCookie a b c