feat: usergroups & metrics usergroup

Fixes #538

messages/uniworx/de-de-formal.msg

@@ -386,6 +386,8 @@ UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig.
 UnauthorizedTokenInvalid: Ihr Authorisierungs-Token konnte nicht verarbeitet werden.
 UnauthorizedTokenInvalidRoute: Ihr Authorisierungs-Token ist auf dieser Unterseite nicht gültig.
 UnauthorizedTokenInvalidAuthority: Ihr Authorisierungs-Token basiert auf den Rechten eines Nutzers, der nicht mehr existiert.
+UnauthorizedTokenInvalidAuthorityGroup: Ihr Authorisierungs-Token basiert auf den Rechten einer Gruppe von Nutzern, die nicht mehr existiert.
+UnauthorizedTokenInvalidAuthorityValue: Ihr Authorisierungs-Token basiert auf Rechten, deren Spezifikation nicht interpretiert werden konnte.
 UnauthorizedToken404: Authorisierungs-Tokens können nicht auf Fehlerseiten ausgewertet werden.
 UnauthorizedSiteAdmin: Sie sind kein System-weiter Administrator.
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen.

models/users.model

@@ -83,3 +83,12 @@ StudyTermCandidate    -- No one at LMU is willing and able to tell us the meanin
     key           Int      -- a possible key for the studyTermName
     name          Text     -- studyTermName as plain text from LDAP
     deriving Show Eq Ord
+
+UserGroupMember
+    group         UserGroupName
+    user          UserId
+    primary       Checkmark nullable
+
+    UniquePrimaryUserGroupMember group primary !force
+    UniqueUserGroupMember group user
+    

package.yaml

@@ -240,7 +240,7 @@ executables:
     ghc-options:
       - -threaded
       - -rtsopts
-      - -with-rtsopts=-N
+      - -with-rtsopts="-N -T"
     dependencies:
       - uniworx
     when:

src/Foundation.hs

@@ -360,7 +360,15 @@ validateToken mAuthId' route' isWrite' token' = $runCachedMemoT $ for4 memo vali
     validateToken' mAuthId route isWrite BearerToken{..} = lift . exceptT return return $ do
       guardMExceptT (maybe True (HashSet.member route) tokenRoutes) (unauthorizedI MsgUnauthorizedTokenInvalidRoute)
 
-      User{userTokensIssuedAfter} <- maybeMExceptT (unauthorizedI MsgUnauthorizedTokenInvalidAuthority) $ get tokenAuthority
+      tokenAuthority' <- case tokenAuthority of
+        Left tVal
+          | JSON.Success groupName <- JSON.fromJSON tVal -> maybeT (throwError =<< unauthorizedI MsgUnauthorizedTokenInvalidAuthorityGroup) . hoist lift $ do
+              Entity _ UserGroupMember{..} <- MaybeT . getBy $ UniquePrimaryUserGroupMember groupName Active
+              return userGroupMemberUser
+          | otherwise -> throwError =<< unauthorizedI MsgUnauthorizedTokenInvalidAuthorityValue
+        Right uid -> return uid
+        
+      User{userTokensIssuedAfter} <- maybeMExceptT (unauthorizedI MsgUnauthorizedTokenInvalidAuthority) $ get tokenAuthority'
       guardMExceptT (Just tokenIssuedAt >= userTokensIssuedAfter) (unauthorizedI MsgUnauthorizedTokenExpired)
 
       let
@@ -370,7 +378,7 @@ validateToken mAuthId' route' isWrite' token' = $runCachedMemoT $ for4 memo vali
 
       authorityVal <- do
         dnf <- either throwM return $ routeAuthTags route
-        fmap fst . runWriterT $ evalAuthTags (AuthTagActive $ const True) (noTokenAuth dnf) (Just tokenAuthority) route isWrite
+        fmap fst . runWriterT $ evalAuthTags (AuthTagActive $ const True) (noTokenAuth dnf) (Just tokenAuthority') route isWrite
       guardExceptT (is _Authorized authorityVal) authorityVal
 
       whenIsJust tokenAddAuth $ \addDNF -> do

src/Handler/Course/LecturerInvite.hs

@@ -66,7 +66,7 @@ lecturerInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataLecturer mlType, _) _ = hoistAForm liftHandler $ toJunction <$> case mlType of

src/Handler/Course/ParticipantInvite.hs

@@ -83,7 +83,7 @@ participantInvitationConfig = InvitationConfig{..}
     invitationHeading     (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseParticipantInviteHeading $ CI.original courseName
     invitationExplanation  _                    _ = return [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm (Entity _ Course{..}) _ uid = hoistAForm lift . wFormToAForm $ do

src/Handler/Exam/CorrectorInvite.hs

@@ -67,7 +67,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInviteHeading examName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionExamCorrector, ())

src/Handler/Exam/RegistrationInvite.hs

@@ -77,7 +77,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamRegistrationInviteHeading examName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
     invitationTokenConfig _ (InvDBDataExamRegistration{..}, _) = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       let itExpiresAt = Just $ Just invDBExamRegistrationDeadline
           itAddAuth
             | not invDBExamRegistrationCourseRegister

src/Handler/ExamOffice/Users.hs

@@ -67,7 +67,7 @@ examOfficeUserInvitationConfig = InvitationConfig{..}
       return . SomeMessage $ MsgExamOfficeUserInviteHeading userDisplayName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamOfficeUserInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       let itExpiresAt = Nothing
           itStartsAt = Nothing
           itAddAuth = Nothing

src/Handler/Metrics.hs

@@ -8,6 +8,7 @@ import Prometheus
 import qualified Network.Wai.Middleware.Prometheus as Prometheus
 
 import qualified Data.Text as Text
+import qualified Data.HashSet as HashSet
 
 
 getMetricsR :: Handler TypedContent
@@ -19,6 +20,13 @@ getMetricsR = selectRep $ do
     metricsHtml :: Handler Html
     metricsHtml = do
       samples <- collectMetrics
+
+      metricsToken <- runMaybeT . hoist runDB $ do
+        uid <- MaybeT maybeAuthId
+        guardM . lift . existsBy $ UniqueUserGroupMember UserGroupMetrics uid
+
+        encodeToken =<< bearerToken (Left $ toJSON UserGroupMetrics) (Just $ HashSet.singleton MetricsR) Nothing (Just Nothing) Nothing
+  
       defaultLayout $ do
         setTitleI MsgTitleMetrics
         $(widgetFile "metrics")

src/Handler/Sheet.hs

@@ -888,7 +888,7 @@ correctorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgSheetCorrInviteHeading sheetName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataSheetCorrector cLoad cState, _) _ = pure $ (JunctionSheetCorrector cLoad cState, ())

src/Handler/Submission.hs

@@ -107,7 +107,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
     invitationTokenConfig (Entity _ Submission{..}) _ = do
       Sheet{..} <- getJust submissionSheet
       Course{..} <- getJust sheetCourse
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       itAddAuth <- either throwM (return . Just) $ routeAuthTags (CSheetR courseTerm courseSchool courseShorthand sheetName SubmissionNewR)
       let itExpiresAt = Nothing
           itStartsAt = Nothing

src/Handler/Tutorial/TutorInvite.hs

@@ -64,7 +64,7 @@ tutorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgTutorInviteHeading tutorialName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionTutor, ())

src/Handler/Users.hs

@@ -572,7 +572,7 @@ functionInvitationConfig = InvitationConfig{..}
       MsgRenderer mr <- getMsgRenderer
       return [ihamlet|_{SomeMessage $ MsgSchoolFunctionInviteExplanation (mr $ SomeMessage invTokenUserFunctionFunction)}|]
     invitationTokenConfig _ (InvDBDataUserFunction{..}, _) = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       let itExpiresAt = Just $ Just invDBUserFunctionDeadline
           itAddAuth = Nothing
           itStartsAt = Nothing

src/Handler/Utils/Invitations.hs

@@ -144,7 +144,7 @@ data InvitationConfig junction = forall formCtx. InvitationConfig
 
 -- | Additional configuration needed for an invocation of `bearerToken`
 data InvitationTokenConfig = InvitationTokenConfig
-  { itAuthority :: UserId
+  { itAuthority :: Either Value UserId
   , itAddAuth   :: Maybe AuthDNF
   , itExpiresAt :: Maybe (Maybe UTCTime)
   , itStartsAt  :: Maybe UTCTime

src/Jobs/Handler/ChangeUserDisplayEmail.hs

@@ -12,7 +12,7 @@ import Text.Hamlet
 
 dispatchJobChangeUserDisplayEmail :: UserId -> UserEmail -> Handler ()
 dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do
-  token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken jUser (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing
+  token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken (Right jUser) (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing
   jwt <- encodeToken token
   let
     setDisplayEmailUrl :: SomeRoute UniWorX

src/Jobs/Handler/SendNotification/Utils.hs

@@ -16,7 +16,7 @@ ihamletSomeMessage f trans = f $ trans . SomeMessage
 mkEditNotifications :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (HtmlUrlI18n UniWorXMessage (Route UniWorX))
 mkEditNotifications uid = liftHandler $ do
   cID <- encrypt uid
-  jwt <- encodeToken =<< bearerToken uid (Just . HashSet.singleton $ UserNotificationR cID) Nothing Nothing Nothing
+  jwt <- encodeToken =<< bearerToken (Right uid) (Just . HashSet.singleton $ UserNotificationR cID) Nothing Nothing Nothing
   let
     editNotificationsUrl :: SomeRoute UniWorX
     editNotificationsUrl = SomeRoute (UserNotificationR cID, [(toPathPiece GetBearer, toPathPiece jwt)])

src/Jobs/Handler/SendPasswordReset.hs

@@ -29,7 +29,7 @@ dispatchJobSendPasswordReset jRecipient = userMailT jRecipient $ do
       LTUUnique utc' _ -> utc'
       _other           -> UTCTime (addDays 2 $ utctDay now) 0
 
-  resetToken' <- bearerToken jRecipient (Just . HashSet.singleton $ UserPasswordR cID) Nothing (Just $ Just tomorrowEndOfDay) Nothing
+  resetToken' <- bearerToken (Right jRecipient) (Just . HashSet.singleton $ UserPasswordR cID) Nothing (Just $ Just tomorrowEndOfDay) Nothing
   let resetToken = resetToken'
         & tokenRestrict (UserPasswordR cID) (decodeUtf8 . Base64.encode . BA.convert $ computeUserAuthenticationDigest userAuthentication)
   encodedToken <- encodeToken resetToken

src/Model/Tokens.hs

@@ -46,7 +46,7 @@ import Data.Binary (Binary)
 data BearerToken site = BearerToken
   { tokenIdentifier   :: TokenId
     -- ^ Unique identifier for each token; maybe useful for tracing usage of tokens
-  , tokenAuthority    :: AuthId site
+  , tokenAuthority    :: Either Value (AuthId site)
     -- ^ Tokens only grant rights the `tokenAuthority` has (i.e. `AuthTag`s are evaluated with the user set to `tokenAuthority`)
   , tokenRoutes       :: Maybe (HashSet (Route site))
     -- ^ Tokens can optionally be restricted to only be usable on a subset of routes
@@ -97,7 +97,7 @@ tokenToJSON :: forall m.
 --
 -- Monadic context is needed because `AuthId`s are encrypted during encoding
 tokenToJSON BearerToken{..} = do
-  cID <- encrypt tokenAuthority :: m (CryptoUUID (AuthId (HandlerSite m)))
+  cID <- either (return . Left) (fmap Right . encrypt) tokenAuthority :: m (Either Value (CryptoUUID (AuthId (HandlerSite m))))
   let stdPayload = Jose.JwtClaims
         { jwtIss = Just $ toPathPiece tokenIssuedBy
         , jwtSub = Nothing
@@ -108,7 +108,7 @@ tokenToJSON BearerToken{..} = do
         , jwtJti = Just $ toPathPiece tokenIdentifier
         }
   return . JSON.object $
-    catMaybes [ Just $ "authority" .= cID
+    catMaybes [ Just $ "authority" .= either id toJSON cID
               , ("routes" .=) <$> tokenRoutes
               , ("add-auth" .=) <$> tokenAddAuth
               , ("restrictions" .=) <$> assertM' (not . HashMap.null) tokenRestrictions
@@ -128,8 +128,8 @@ tokenParseJSON :: forall site.
 --
 -- It's usually easier to use `Utils.Tokens.tokenParseJSON'`
 tokenParseJSON v@(Object o) = do
-  tokenAuthority' <- lift (o .: "authority") :: ReaderT CryptoIDKey Parser (CryptoUUID (AuthId site))
+  tokenAuthority' <- lift $ (Right <$> o .: "authority") <|> (Left <$> o .: "authority") :: ReaderT CryptoIDKey Parser (Either Value (CryptoUUID (AuthId site)))
-  tokenAuthority <- decrypt tokenAuthority'
+  tokenAuthority <- either (return . Left) (fmap Right . decrypt) tokenAuthority'
 
   tokenRoutes        <- lift $ o .:? "routes"
   tokenAddAuth       <- lift $ o .:? "add-auth"

src/Model/Types/Security.hs

@@ -21,6 +21,11 @@ import qualified Data.Aeson.Types as Aeson
 
 import qualified Data.Binary as Binary
 
+import qualified Data.CaseInsensitive as CI
+
+import Model.Types.TH.PathPiece
+import Database.Persist.Sql
+
 
 data AuthenticationMode = AuthLDAP
                         | AuthPWHash { authPWHash :: Text }
@@ -152,3 +157,21 @@ instance (Ord a, Binary a) => Binary (PredDNF a) where
 type AuthLiteral = PredLiteral AuthTag
 
 type AuthDNF = PredDNF AuthTag
+
+
+data UserGroupName
+  = UserGroupMetrics
+  | UserGroupCustom { userGroupCustomName :: CI Text }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance PathPiece UserGroupName where
+  toPathPiece UserGroupMetrics = "metrics"
+  toPathPiece (UserGroupCustom t) = CI.original t
+  fromPathPiece t = Just $ if
+    | "metrics" `ciEq` t -> UserGroupMetrics
+    | otherwise          -> UserGroupCustom $ CI.mk t
+    where
+      ciEq = (==) `on` CI.mk
+
+pathPieceJSON ''UserGroupName
+derivePersistFieldPathPiece' (sqlType (Proxy @(CI Text))) ''UserGroupName

src/Model/Types/TH/PathPiece.hs

@@ -1,5 +1,6 @@
 module Model.Types.TH.PathPiece
   ( derivePersistFieldPathPiece
+  , derivePersistFieldPathPiece'
   ) where
 
 import ClassyPrelude.Yesod
@@ -13,7 +14,10 @@ import Language.Haskell.TH.Datatype
 
 
 derivePersistFieldPathPiece :: Name -> DecsQ
-derivePersistFieldPathPiece tName = do
+derivePersistFieldPathPiece = derivePersistFieldPathPiece' SqlString
+
+derivePersistFieldPathPiece' :: SqlType -> Name -> DecsQ
+derivePersistFieldPathPiece' sType tName = do
   DatatypeInfo{..} <- reifyDatatype tName
   vars <- forM datatypeVars (const $ newName "a")
   let t = foldl (\t' n' -> t' `appT` varT n') (conT tName) vars
@@ -32,15 +36,18 @@ derivePersistFieldPathPiece tName = do
         [ do
             bs <- newName "bs"
             clause [[p|PersistByteString $(varP bs)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistByteString") Right $ fromPathPiece =<< either (const Nothing) Just (Text.decodeUtf8' $(varE bs))|]) []
+        , do
+            bs <- newName "bs"
+            clause [[p|PersistDbSpecific $(varP bs)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistDbSpecific") Right $ fromPathPiece =<< either (const Nothing) Just (Text.decodeUtf8' $(varE bs))|]) []
         , do
             text <- newName "text"
-            clause [[p|PersistText $(varP text)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistTetx") Right $ fromPathPiece $(varE text)|]) []
+            clause [[p|PersistText $(varP text)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistText") Right $ fromPathPiece $(varE text)|]) []
-        , clause [wildP] (normalB [e|Left "PathPiece values must be converted from PersistText or PersistByteString"|]) []
+        , clause [wildP] (normalB [e|Left "PathPiece values must be converted from PersistText, PersistByteString, or PersistDbSpecific"|]) []
         ]
       ]
     , instanceD sqlCxt ([t|PersistFieldSql|] `appT` t)
       [ funD 'sqlType
-        [ clause [wildP] (normalB [e|SqlString|]) []
+        [ clause [wildP] (normalB [e|sType|]) []
         ]
       ]
     ]

src/Utils/Tokens.hs

@@ -58,7 +58,7 @@ bearerToken :: forall m.
                , HasInstanceID (HandlerSite m) InstanceId
                , HasAppSettings (HandlerSite m)
                )
-            => AuthId (HandlerSite m)
+            => Either Value (AuthId (HandlerSite m))
             -> Maybe (HashSet (Route (HandlerSite m)))
             -> Maybe AuthDNF
             -> Maybe (Maybe UTCTime) -- ^ @Nothing@ determines default expiry time automatically

templates/metrics.hamlet

@@ -1,41 +1,46 @@
 $newline never
-<dl .deflist>
+$maybe t <- metricsToken
-  $forall SampleGroup Info{..} _ mSamples <- samples
+  <section>
-    <dt .deflist__dt>
+    <pre style="font-family: monospace; white-space: pre-wrap; word-break: break-all;">
-      <div>#{metricName}
+      #{toPathPiece t}
-      <p style="font-weight: 600; color: var(--color-fontsec); font-size: 0.9rem; margin-top: 7px">
+<section>
-        #{metricHelp}
+  <dl .deflist>
-    <dd .deflist__dd style="overflow: auto; max-height: 50vh">
+    $forall SampleGroup Info{..} _ mSamples <- samples
-      $case mSamples
+      <dt .deflist__dt>
-        $of []
+        <div>#{metricName}
-          <p style="font-style: italic">_{MsgMetricNoSamples}
+        <p style="font-weight: 600; color: var(--color-fontsec); font-size: 0.9rem; margin-top: 7px">
-        $of _
+          #{metricHelp}
-          $maybe (lPairs, sValue) <- singleSample metricName mSamples
+      <dd .deflist__dd style="overflow: auto; max-height: 50vh">
-            <p>
+        $case mSamples
-              #{decodeUtf8 sValue}
+          $of []
-            $case lPairs
+            <p style="font-style: italic">_{MsgMetricNoSamples}
-              $of []
+          $of _
-              $of _
+            $maybe (lPairs, sValue) <- singleSample metricName mSamples
-                <ul .list-inline .list--comma-separated>
+              <p>
-                  $forall (lName, lValue) <- lPairs
+                #{decodeUtf8 sValue}
-                    <li>#{lName}=#{lValue}
+              $case lPairs
-          $nothing
+                $of []
-            $with allLabels <- getLabels mSamples
+                $of _
-              <table .table .table--striped .table--hover>
+                  <ul .list-inline .list--comma-separated>
-                <thead>
+                    $forall (lName, lValue) <- lPairs
-                  <tr .table__row .table__row--head>
+                      <li>#{lName}=#{lValue}
-                    <th .table__th>_{MsgMetricName}
+            $nothing
-                    $forall l <- allLabels
+              $with allLabels <- getLabels mSamples
-                      <th .table__th style="font-family: monospace">#{l}
+                <table .table .table--striped .table--hover>
-                    <th .table__th>_{MsgMetricValue}
+                  <thead>
-                <tbody>
+                    <tr .table__row .table__row--head>
-                  $forall Sample sName lPairs sValue <- mSamples
+                      <th .table__th>_{MsgMetricName}
-                    <tr .table__row>
-                      <td .table__td title=#{sName}>
-                        #{metricBasename metricName sName}
                       $forall l <- allLabels
+                        <th .table__th style="font-family: monospace">#{l}
+                      <th .table__th>_{MsgMetricValue}
+                  <tbody>
+                    $forall Sample sName lPairs sValue <- mSamples
+                      <tr .table__row>
+                        <td .table__td title=#{sName}>
+                          #{metricBasename metricName sName}
+                        $forall l <- allLabels
+                          <td .table__td>
+                            $maybe lValue <- lookup l lPairs
+                              #{lValue}
                         <td .table__td>
-                          $maybe lValue <- lookup l lPairs
+                          #{decodeUtf8 sValue}
-                            #{lValue}
-                      <td .table__td>
-                        #{decodeUtf8 sValue}