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，就像它在上面的案例中所做的一样。这个问题，我希望这里有人可以说明一点，就是在验证到期日期时，我在IO (Maybe Bool)变量中得到mExpired。 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中，因为{{1} }} 在末尾。所以让我们摆脱它：

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通常有一个更好的选择 - 尽管我觉得你在{-1}}中使用了isNothing和其他地方的isNothing很好。）

上面的重构假定您想要将缺少的日期案例与无效的日期案例区分开来。虽然我怀疑这实际上是你想要/需要的，但我们暂时假设你宁愿忽视差异（从而以同样的方式处理when和Nothing）。来自Just False的{{1}}允许您以非常方便的方式执行此操作：

fromMaybe

Data.Maybe

这相当于您的“伪Haskell”行 - 实际上，我们提供fromMaybe :: a -> Maybe a -> a作为when (fromMaybe True mExpired) $ permissionDenied "Invalid expiration date."的默认值。如果你沿着这条路走下去，你甚至可以将True移到mExpired，这样就可以开始fromMaybe True。

值得一提的另一个功能是isExpired，相当于打包到函数中的Bool的案例分析：

maybe

使用它，我在上面写了几行的case语句可以替换为：

Maybe

虽然在这种情况下，可以说比案例陈述的可读性差，但maybe :: b -> (a -> b) -> Maybe a -> b是一个可以组成，部分应用等的函数;在其他情况下可以利用。

（一个很小的难题：-- Line breaks added for clarity. maybe (permissionDenied "Expiration date missing.") (\expired -> when expired $ permissionDenied "Invalid expiration date.") mExpired如果使用maybe来定义它，(>>=)会是什么样子？）

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

1 个答案: