如何使用 Yesod 正确处理 JWT 的到期日期？

Question

我目前正在为一个课程项目使用 Yesod 框架开发一个 Web 服务器。我是 Haskell 的新手，我着迷于它与我所知道的有关编程语言的所有其他事物的不同之处。然而，并不是所有的玫瑰。有时我会卡住几天，这个问题就是关于这样一个案例的。

这些是验证请求附带的不记名令牌的函数：

isDateExpired :: Maybe JWT.NumericDate -> Maybe JWT.NumericDate -> IO (Maybe Bool)
isDateExpired exptime currtime = return $ (<) <$> exptime <*> currtime

validateToken :: Handler AuthResult
validateToken = do
    bearerToken <- lookupBearerAuth
    master <- getYesod
    when (isNothing bearerToken) $ permissionDenied "Token not present in headers."
    let decodedAndVerified  = join $ JWT.decodeAndVerifySignature (JWT.secret (clientSecret master)) <$> bearerToken
        claimset            = JWT.claims <$> decodedAndVerified
        audience            = join $ JWT.aud <$> claimset
        iss = join $ JWT.iss <$> claimset
        expiration = join $ JWT.exp <$> claimset
    case audience of
        Just a -> do
            case a of
                Left uniqueAud -> do 
                    when (Just uniqueAud /= JWT.stringOrURI (clientId master)) $ permissionDenied "Invalid aud."
                Right _ -> permissionDenied "Tokens with multiple aud values not currently supported."
        _ -> permissionDenied "Audience not defined."
    when (iss /= JWT.stringOrURI (configIssuer master)) $
        permissionDenied "Invalid issuer."
    when (isNothing claimset) $
        permissionDenied "Claimset invalid."
    let mExpired = JWT.numericDate <$> getPOSIXTime >>= isDateExpired expiration
    --FIXME Currently, this next part has to be at the end of the function.
    liftIO $ mExpired >>= 
        \y -> if isNothing y then return $ Unauthorized "Expiration date missing." 
            else if y==Just True then return $ Unauthorized "Invalid expiration date."
                else return $ Authorized

好吧，这段代码确实有效。它正确地验证了令牌。但是，正如您在 FIXME 中看到的那样，validateToken 函数的最后一部分非常hacky。它必须是最后一行，这让我很恼火。

根据我收集到的信息，处理此问题的正确方法是使用when，就像在上面的案例中所做的那样。问题是，我希望这里有人可以阐明，在验证到期日期时，我最终在 mExpired 变量中得到了一个 IO (Maybe Bool)。而when 不接受。

我想做的是（在伪 Haskell 中）这样的事情：

when (isNothing mExpired || mExpired == Just True) $ permissionDenied "Invalid expiration date."

然后我可以在此之后检查其他内容，并在函数的末尾输入Authorized，一切都正确且美观。

这样的事情可能吗？

仅供参考：permissionDenied 的类型是 Failure ErrorResponse m => String -> m a

Answer 1

让我们再看看isDateExpired：

isDateExpired :: Maybe JWT.NumericDate -> Maybe JWT.NumericDate -> IO (Maybe Bool)
isDateExpired exptime currtime = return $ (<) <$> exptime <*> currtime

这实际上是一个纯函数：(<$>) 和 (<*>) 这里是 Maybe 函子，结果在 IO 中只是因为末尾有 return。所以让我们摆脱它：

isDateExpired :: Maybe JWT.NumericDate -> Maybe JWT.NumericDate -> Maybe Bool
isDateExpired exptime currtime = (<) <$> exptime <*> currtime

这让我们的观点清晰了很多；我们可以单独处理如何将其输入IO。

鉴于isDateExpired 现在是一个纯函数，我们不再需要mExpired 中的(>>=)：

    let mExpired = isDateExpired expiration . JWT.numericDate <$> getPOSIXTime

mExpired 仍然是IO (Maybe Bool)，感谢getPOSIXTime。我们可以通过使用<-（和liftIO）而不是let来改变它：

    mExpired <- liftIO $ isDateExpired expiration . JWT.numericDate <$> getPOSIXTime

（请注意，您做了几乎相同的事情。我将liftIO 与其余部分放在一起，这样我就不必为IO (Maybe Bool) 中间值想一个多余的名称，它是大部分是无趣的。）

决定下一步做什么的最直接的方法是在mExpired上进行模式匹配：

    case mExpired of
        Nothing -> permissionDenied "Expiration date missing."
        Just expired -> when expired $ permissionDenied "Invalid expiration date."

模式匹配往往比布尔测试更容易使用，除非您手中已经有了Bool。 （一个推论是，通常有一个更好的替代方法来使用 isJust 和 isNothing ——尽管我觉得你在 do-block 的其他地方使用 isNothing 和 when 很好。）

---

上面的重构假设您想要区分缺少日期的情况和无效的日期情况。尽管我怀疑这实际上是您想要/需要的，但让我们暂时假设您宁愿忽略差异（因此以相同的方式处理 Nothing 和 Just False）。来自Data.Maybe 的fromMaybe 允许您以非常方便的方式做到这一点：

fromMaybe :: a -> Maybe a -> a

    when (fromMaybe True mExpired) $ permissionDenied "Invalid expiration date."

这相当于您的“伪Haskell”行——实际上，我们提供True 作为mExpired 的默认值。如果您要沿着这条路线走，您甚至可以将fromMaybe True 移动到isExpired，这样一开始就会产生Bool。

另一个值得一提的函数是maybe，相当于Maybe打包成函数的案例分析：

maybe :: b -> (a -> b) -> Maybe a -> b

使用它，我上面写了几行的case-statement可以替换为：

    -- Line breaks added for clarity.
    maybe
        (permissionDenied "Expiration date missing.")
        (\expired -> when expired $ permissionDenied "Invalid expiration date.")
        mExpired

虽然在这种情况下，它的可读性可能不如 case 语句，但maybe 是一个您可以编写、部分应用等的函数；在其他情况下可以利用。

（一个小谜题：如果你用maybe来定义Maybe，(>>=) 会是什么样子？）