TsWeb.Routing.Auth

A generic authentication hook for TsWeb routing. The goal here is to be able to specify authentication requirements in a view's type, so that the routing statically guarantees that a view can only be entered when session preconditions are met. A full example of this is under the Example module of this source tree, but a synopsis follows. Given a session/user definition like so:

  data UserT f = User
    { _userId :: C f Int
    , _userLogin :: C f Text
    } deriving (Generic)
  ...
  data SessionDataT f = SessionData
    { _sdUser :: PrimaryKey UserT (Nullable f)
    , _sdRemember :: C f Bool
    } deriving (Generic)
  ...

  userP :: Proxy User
  userP = Proxy

then we can define a logged-in Authorize check as

instance Authorize SessionData User where
  checkAuth _ =
    _sdUser <$> readSession >>= case
      UserId Nothing -> pure Nothing
      UserId (Just uid) ->
        queryMaybe (select $ q uid) >>= case
          QSimply (Just user) -> pure $ Just user
          _ -> pure Nothing
    where
      q uid = do
        u <- all_ $ _dbUser db
        guard_ $ _userId u ==. val_ uid
        pure u

A view requiring an authenticated user would have a signature like

  authd :: ListContains n User xs => TsActionCtxT lts xs SessionData a
  authd = do
    user :: User <- getExtra
    ...

Finally, the route for only allowing logged-in users would look like

  runroute ro rw $ path #authd "authd" $ get $ auth userP authd

That view is statically defined to only be accessible to logged-in users; any anonymous session will either go to an alternate (non-auth) view, or get a 404.

Documentation

class Authorize sess perm where

A class for session data that needs to be statically verified against routes. This could be checks for optional session info, or to validate the value of that session information.

Methods

checkAuth :: ListContains n ReadOnlyPool xs => Proxy perm -> TsActionCtxT lts xs sess (Maybe perm)

Load a value out of the session or return Nothing. Used in the context of auth, the wrapped view will only be called when this returns Just; a Nothing value will cause the wrapped view to be skipped.

auth :: (Authorize sess perm, ListContains n ReadOnlyPool xs, Authorize sess perm) => Proxy perm -> TsActionCtxT lts (perm ': xs) sess () -> TsActionCtxT lts xs sess ()

Guarantee that the Spock session hold some verified piece of data. If the requisite data can be loaded, then the view is called with the data in its ctxExtras; otherwise jumpNext is called and the view is skipped.