diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index ac34ebfd6..4c262a059 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/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. diff --git a/models/users.model b/models/users.model index 57ae421cf..55ee044db 100644 --- a/models/users.model +++ b/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 + \ No newline at end of file diff --git a/package.yaml b/package.yaml index 7350ec9de..9606e398f 100644 --- a/package.yaml +++ b/package.yaml @@ -240,7 +240,7 @@ executables: ghc-options: - -threaded - -rtsopts - - -with-rtsopts=-N + - -with-rtsopts="-N -T" dependencies: - uniworx when: diff --git a/src/Foundation.hs b/src/Foundation.hs index 4ac262136..688793330 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Course/LecturerInvite.hs b/src/Handler/Course/LecturerInvite.hs index 753bd7c10..44b27ce64 100644 --- a/src/Handler/Course/LecturerInvite.hs +++ b/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 diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 6e2baca9d..280a69d6f 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/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 diff --git a/src/Handler/Exam/CorrectorInvite.hs b/src/Handler/Exam/CorrectorInvite.hs index 8314a8ca1..d207ff9ef 100644 --- a/src/Handler/Exam/CorrectorInvite.hs +++ b/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, ()) diff --git a/src/Handler/Exam/RegistrationInvite.hs b/src/Handler/Exam/RegistrationInvite.hs index 8a157f72d..cfd109f94 100644 --- a/src/Handler/Exam/RegistrationInvite.hs +++ b/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 diff --git a/src/Handler/ExamOffice/Users.hs b/src/Handler/ExamOffice/Users.hs index 0a5d3b9bd..3e688c936 100644 --- a/src/Handler/ExamOffice/Users.hs +++ b/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 diff --git a/src/Handler/Metrics.hs b/src/Handler/Metrics.hs index 72ebd06a3..b51d8ebe9 100644 --- a/src/Handler/Metrics.hs +++ b/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") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index bfbbdccaa..bc5c308d4 100644 --- a/src/Handler/Sheet.hs +++ b/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, ()) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 0e7cbe547..9f3fe2788 100644 --- a/src/Handler/Submission.hs +++ b/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 diff --git a/src/Handler/Tutorial/TutorInvite.hs b/src/Handler/Tutorial/TutorInvite.hs index 1c1f119db..e78953b67 100644 --- a/src/Handler/Tutorial/TutorInvite.hs +++ b/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, ()) diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index e11f6a557..c2d944690 100644 --- a/src/Handler/Users.hs +++ b/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 diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs index 7780709a1..c4230890b 100644 --- a/src/Handler/Utils/Invitations.hs +++ b/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 diff --git a/src/Jobs/Handler/ChangeUserDisplayEmail.hs b/src/Jobs/Handler/ChangeUserDisplayEmail.hs index dd5e8f0d4..bbf62d0c1 100644 --- a/src/Jobs/Handler/ChangeUserDisplayEmail.hs +++ b/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 diff --git a/src/Jobs/Handler/SendNotification/Utils.hs b/src/Jobs/Handler/SendNotification/Utils.hs index 49671e02d..111b43382 100644 --- a/src/Jobs/Handler/SendNotification/Utils.hs +++ b/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)]) diff --git a/src/Jobs/Handler/SendPasswordReset.hs b/src/Jobs/Handler/SendPasswordReset.hs index d9acc739b..c589c3896 100644 --- a/src/Jobs/Handler/SendPasswordReset.hs +++ b/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 diff --git a/src/Model/Tokens.hs b/src/Model/Tokens.hs index 2b445eb99..5a2d6335e 100644 --- a/src/Model/Tokens.hs +++ b/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 <- decrypt tokenAuthority' + tokenAuthority' <- lift $ (Right <$> o .: "authority") <|> (Left <$> o .: "authority") :: ReaderT CryptoIDKey Parser (Either Value (CryptoUUID (AuthId site))) + tokenAuthority <- either (return . Left) (fmap Right . decrypt) tokenAuthority' tokenRoutes <- lift $ o .:? "routes" tokenAddAuth <- lift $ o .:? "add-auth" diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index 66a01cf6b..a1df33f56 100644 --- a/src/Model/Types/Security.hs +++ b/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 diff --git a/src/Model/Types/TH/PathPiece.hs b/src/Model/Types/TH/PathPiece.hs index 365ffb969..daf1dd789 100644 --- a/src/Model/Types/TH/PathPiece.hs +++ b/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 [wildP] (normalB [e|Left "PathPiece values must be converted from PersistText or PersistByteString"|]) [] + 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, PersistByteString, or PersistDbSpecific"|]) [] ] ] , instanceD sqlCxt ([t|PersistFieldSql|] `appT` t) [ funD 'sqlType - [ clause [wildP] (normalB [e|SqlString|]) [] + [ clause [wildP] (normalB [e|sType|]) [] ] ] ] diff --git a/src/Utils/Tokens.hs b/src/Utils/Tokens.hs index 64d4c0989..549ea81e6 100644 --- a/src/Utils/Tokens.hs +++ b/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 diff --git a/templates/metrics.hamlet b/templates/metrics.hamlet index 9f4a780a3..1881382bc 100644 --- a/templates/metrics.hamlet +++ b/templates/metrics.hamlet @@ -1,41 +1,46 @@ $newline never -
- $forall SampleGroup Info{..} _ mSamples <- samples -
-
#{metricName} -

- #{metricHelp} -

- $case mSamples - $of [] -

_{MsgMetricNoSamples} - $of _ - $maybe (lPairs, sValue) <- singleSample metricName mSamples -

- #{decodeUtf8 sValue} - $case lPairs - $of [] - $of _ -