In the last article we talked about you and me being able to update openings. As you are the admin of your project and me only sometimes a guest in your space, I should not have any rights to change BlogPosts or other significant. But, before we dive deeper into the topic: have you found a solution for a dropdownmenu as we said in, I think it was the last post?

To compare let's have a look:

data MenuTypes
    = NavbarLeft MenuItem
    | NavbarLeftDrop MenuItem
    | NavbarRight MenuItem

what is adding a new MenuType 'NavbarLeftDrop' and apply ($) MenuItem to it. Each MenuItem might be declared like so...

, NavbarLeftDrop $
  MenuItem
      { menuItemLabel = ""YourHandler"
      , menuItemRoute = "YourHandlerR"
      , menuItemAccessCallback = True
      }

and than composed together,

let navbarLeftDropMenuItems = [x | NavbarLeftDrop x <- menuItems]

followed by:

let navbarLeftDropFilteredMenuItems =
     [x | x <- navbarLeftDropMenuItems, menuItemAccessCallback x]

Straight forward construction where 'menuItemAccessCallback' is found as of type Bool in the declaration for:

data MenuItem = MenuItem
    { menuItemLabel :: Text
    , menuItemRoute :: Route App
    , menuItemAccessCallback :: Bool
    }

That was quite only adding one MenuType and as easy as like so, probably intended by the authors of the framework. In templates/default-layout.hamlet we may also add

<li class=" dropdown">
    <a href="#" class="dropdown-toggle " data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">More<span class="caret"></span></a>
        <ul class="dropdown-menu">
            $forall MenuItem label route _ <- navbarLeftDropFilteredMenuItems
                <li :Just route == mcurrentRoute:.active>
                    <a href="@{route}">#{label}

<li class=" dropdown">
     <a href="#" class="dropdown-toggle " data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false"></a>

Let's digest this slowly somewhere in the hidden seas of our growing Haskell brain.

But back to our topic: https://www.yesodweb.com/book/authentication-and-authorization

We said we have one admin and one (or more) folks that can change only some parts of our application. This may cover quite a lot of scenarios. Let's go to config/models... where we entry

isAdmin Bool default=false

into the User section. Back in src/ Foundation.hs. You may note our first impression looking at the file has changed. We feel more orientated and seem to have more of an oversight. Yeah, we are still not able to understand all of its parts and instances but, come on, we are not bad at all in gaining new confidence by practise and declare the 'isAdmin' type like so:

isAdmin ::
    ( AuthEntity (HandlerSite m) ~ User
    , AuthId (HandlerSite m) ~ Key User
    , MonadHandler m
    , YesodAuthPersist (HandlerSite m)
    )
    => m AuthResult

Zosh! Not from this planet? Ok, than let us say we synonymical declare isAdmin like so:

isAdmin :: a => b

and hide all the unknown. As already running against some walls with the complexity of Yesod, we use a simple technique going from outside in, to get a better understanding of the inner workings of Yesod and in this case Yesod.Auth.

So 'isAdmin' is of type (allthestuffbetweentheouterbrackets) and returns a type m AuthResult. https://hackage.haskell.org/package/yesod-auth-1.6.10.3/docs/Yesod-Auth.html#t:AuthEntity puts some light on it. Each of the components which we use here with all the respect to its complexity, should be only studied as far as we by the time understand it - but they should be - studied.

Don't overdo for now. Keep a Hoogle Search Tab open in your browser, or install Hoogle local and use it directly with an alias in your Terminal. You may also have a look at https://awesomeopensource.com/project/lazamar/haskell-docs-cli, which I find very useful. Check all the Types without fear. Of 'HandlerSite m' for example we might think as something as a representation of our application. We won't get it all now and in one go - we get it from time to time better.

After we have added

isAdmin = do
    mauth <- maybeAuth
    case mauth of
        Nothing -> return AuthenticationRequired
        Just (Entity _ user)
            | userIsAdmin user -> return Authorized
            | otherwise -> return $ Unauthorized ""only admin permitted"

we may see that the return type of isAdmin (m AuthResult, which we find in the Yesod.Core package) has the constructors AuthenticationRequired, Authorized and Unauthorized which will be used in a case match on maybeAuth. Hoogle helps us as

maybeAuth :: (YesodAuthPersist master, val ~ AuthEntity master, Key val ~ AuthId master, PersistEntity val, Typeable val, MonadHandler m, HandlerSite m ~ master) => m (Maybe (Entity val))

what is, at least for us, very close to the type of isAdmin. Ok, we understand that maybeAuth is in some way the guiding element here. isAdmin is constructed following the needs of maybeAuth.

Further down in scr/Foundation.hs we use isAdmin instead of isAuthenticated.

-- Routes requiring authentication.
isAuthorized ProfileR _ = isAdmin

And for our other authorized user

isLimitedAuthorized ::
       ( AuthEntity (HandlerSite m) ~ User
       , AuthId (HandlerSite m) ~ Key User
       , MonadHandler m
       , YesodAuthPersist (HandlerSite m)
       )
    => m AuthResult

isLimitedAuthorized = do
    mauth <- maybeAuth
    case mauth of
        Nothing -> return AuthenticationRequired
        Just (Entity _ user)
            | isLimited user -> return Authorized
            | otherwise -> return $ Unauthorized "you have only some rights to edit here"

isLimited :: User -> Bool
isLimited user =
    case userName user of
        "Usernameofyourchoice2" -> True
        "" -> True
        _ -> True

where we adapt the route according

isAuthorized _ _ = isLimitedAuthorized

if we want all excluded routes from the isAuthorized list to be access able. Or restricted (better) like so:

isAuthorized CreateOpeningsR _ = isLimitedAuthorized

Multi User Auth requires us to think about or database as well. As you may have already anticipated we have to do something like

INSERT INTO "user" (name, password, is_admin) VALUES ('usernameofyourchoice', 'sha256|19|5n4WQefN5UpdxV6+G07vRw==|ClhWvqz+YA7AVFbv11odI38U+FSwWfjCqAd6fgh2KXQ=','true');

for our admin user, respectivly for others 'false' as last row value.

As usual you may find the extended 'Blogandmore' code in the mulitauth-branch of https://git.onepigayear.de/ye/blogandmore

Note also that the branch is updated to lts-18.12 and that I have added FlexibleContexts to the language pragmas of src/Foundation.hs.

Thanks for reading.