diff --git a/.github/workflows/dashboard.yml b/.github/workflows/dashboard.yml new file mode 100644 index 000000000..d35b39545 --- /dev/null +++ b/.github/workflows/dashboard.yml @@ -0,0 +1,69 @@ +name: Deploy Dashboard + +on: + push: + branches: [master] + paths: ['dashboard/**'] + pull_request: + types: [opened, reopened, synchronize, closed] + paths: ['dashboard/**'] + +permissions: + contents: write + pull-requests: write + +concurrency: pages-${{ github.ref }} + +jobs: + deploy: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Setup Node + if: github.event.action != 'closed' + uses: actions/setup-node@v4 + with: + node-version: 22 + + - name: Install tools + if: github.event.action != 'closed' + run: npm install --no-save purescript@0.15.15 spago@1.0.3 esbuild + + # TODO: this is temporary until we fix a bug in spago for bundling single packages: + # there is a `purs graph` call that fails when doing that because it's trying to use + # all the dependencies of the package, which might not be there. So we build everything. + - name: Build whole repo + if: github.event.action != 'closed' + run: npx spago build + + - name: Build dashboard + if: github.event.action != 'closed' + run: npm run dashboard:build + + - name: Verify bundle + if: github.event.action != 'closed' + run: test -f dashboard/app.js + + - name: Prepare deploy directory + if: github.event.action != 'closed' + run: | + mkdir -p _site + cp dashboard/index.html _site/ + cp dashboard/app.js _site/ + cp -r dashboard/static _site/ + + - name: Deploy to Pages + if: github.ref == 'refs/heads/master' + uses: JamesIves/github-pages-deploy-action@v4 + with: + folder: _site + clean-exclude: pr-preview + + # On 'closed' events this removes the preview directory from gh-pages; + # on all other PR events it deploys the build to pr-preview/pr-/. + - name: Deploy PR preview + if: github.event_name == 'pull_request' + uses: rossjrw/pr-preview-action@v1 + with: + source-dir: ./_site/ diff --git a/.gitignore b/.gitignore index 9d091519f..30648d4da 100644 --- a/.gitignore +++ b/.gitignore @@ -4,6 +4,7 @@ /scratch /.vscode /scripts/analysis +/generated-docs result* @@ -20,5 +21,8 @@ result* TODO.md .spec-results +# Generated bundle +dashboard/app.js + # Keep it secret, keep it safe. .env diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 0259770f0..ef018a3fd 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -36,6 +36,10 @@ There are two additional PureScript directories focused on testing only: - `app-e2e` contains tests that exercise the server API, which requires that a server and associated wiremock services are running - `test-utils` contains utility code intended only for tests +There is one additional directory for the web dashboard: + +- `dashboard` contains the static HTML/CSS/JS dashboard for monitoring registry jobs. It is deployed independently to GitHub Pages and requires no build step. + There are three more directories containing code for the registry. - `db` contains schemas and migrations for the sqlite3 database used by the server. @@ -253,6 +257,36 @@ services.wiremock-github-api = { It is also possible to include specific files that should be returned to requests via the `files` key. Here's another short example of setting up an S3 mock, in which we copy files from the fixtures into the wiremock service's working directory given a particular file name, and then write request/response mappings that respond to requests by reading the file at path given by `bodyFileName`. +## Dashboard Development + +The `dashboard/` directory contains a Halogen (PureScript) application for monitoring registry jobs. It is deployed to GitHub Pages and calls the registry API cross-origin. + +### Building + +To produce a browser JS bundle: + +```sh +npm run dashboard:build +``` + +This outputs `dashboard/app.js`, which `dashboard/index.html` loads via ` + + diff --git a/dashboard/spago.yaml b/dashboard/spago.yaml new file mode 100644 index 000000000..cf2e3b22c --- /dev/null +++ b/dashboard/spago.yaml @@ -0,0 +1,35 @@ +package: + name: registry-dashboard + publish: + license: BSD-3-Clause + version: 0.0.1 + dependencies: + - aff + - arrays + - codec-json + - const + - control + - datetime + - effect + - either + - exceptions + - fetch + - foldable-traversable + - formatters + - halogen + - halogen-subscriptions + - integers + - json + - lists + - maybe + - newtype + - now + - parallel + - prelude + - registry-lib + - routing-duplex + - strings + - tailrec + - web-events + - web-html + - web-uievents diff --git a/dashboard/src/Dashboard/API.purs b/dashboard/src/Dashboard/API.purs new file mode 100644 index 000000000..88613ead7 --- /dev/null +++ b/dashboard/src/Dashboard/API.purs @@ -0,0 +1,128 @@ +-- | HTTP client for making requests to the registry server from the dashboard. +-- | Provides typed helpers for fetching job data from the Registry API. +module Dashboard.API + ( ApiConfig + , ApiError(..) + , defaultConfig + , fetchJobs + , fetchJob + , printApiError + ) where + +import Prelude + +import Codec.JSON.DecodeError as CJ.DecodeError +import Control.Alt ((<|>)) +import Control.Parallel (parallel, sequential) +import Data.Codec.JSON as CJ +import Data.DateTime (DateTime) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.String as String +import Effect.Aff (Aff, Milliseconds(..)) +import Effect.Aff as Aff +import Effect.Exception as Exception +import Fetch (Method(..)) +import Fetch as Fetch +import JSON as JSON +import Registry.API.V1 (Job, JobId, LogLevel, Route(..), SortOrder) +import Registry.API.V1 as V1 +import Routing.Duplex as Routing + +-- | Configuration for the API client. +type ApiConfig = + { baseUrl :: String + } + +-- | Default API configuration pointing to the production registry server. +defaultConfig :: ApiConfig +defaultConfig = + { baseUrl: "https://registry.purescript.org" + } + +-- | Errors that can occur when making API requests. +data ApiError + = HttpError { status :: Int, body :: String } + | ParseError { message :: String, raw :: String } + +-- | Render an ApiError as a human-readable string. +printApiError :: ApiError -> String +printApiError = case _ of + HttpError { status, body } -> + "HTTP " <> show status <> ": " <> body + ParseError { message, raw } -> + "Parse error: " <> message <> "\nResponse: " <> String.take 500 raw + +-- | Print a V1 Route to its URL path string. +printRoute :: Route -> String +printRoute = Routing.print V1.routes + +-- | Parse a JSON string using a codec, returning Either ApiError. +parseJson :: forall a. CJ.Codec a -> String -> Either ApiError a +parseJson codec str = case JSON.parse str of + Left jsonErr -> + Left $ ParseError { message: "JSON: " <> jsonErr, raw: str } + Right json -> case CJ.decode codec json of + Left decodeErr -> + Left $ ParseError { message: CJ.DecodeError.print decodeErr, raw: str } + Right a -> + Right a + +-- | Request timeout in milliseconds. +requestTimeout :: Milliseconds +requestTimeout = Milliseconds 10000.0 + +-- | Run an Aff action with a timeout. Returns Nothing if the action does not +-- | complete within the given duration, or Just the result if it does. +timeout :: forall a. Milliseconds -> Aff a -> Aff (Maybe a) +timeout ms action = sequential do + parallel (Just <$> action) <|> parallel (Nothing <$ Aff.delay ms) + +-- | Make a GET request to the given URL path and decode the response body. +get :: forall a. CJ.Codec a -> ApiConfig -> String -> Aff (Either ApiError a) +get codec config path = do + result <- Aff.try $ timeout requestTimeout do + response <- Fetch.fetch (config.baseUrl <> path) { method: GET } + body <- response.text + pure { status: response.status, body } + case result of + Left err -> + pure $ Left $ HttpError { status: 0, body: Exception.message err } + Right Nothing -> + pure $ Left $ HttpError { status: 0, body: "Request timed out" } + Right (Just { status, body }) + | status >= 200 && status < 300 -> + pure $ parseJson codec body + | otherwise -> + pure $ Left $ HttpError { status, body } + +-- | Fetch the list of jobs from the registry server. +-- | +-- | Parameters: +-- | - `since`: Only return jobs created after this time +-- | - `until`: Only return jobs created before this time +-- | - `order`: Sort order for results (ASC or DESC) +-- | - `includeCompleted`: When true, include finished jobs in the results +fetchJobs + :: ApiConfig + -> { since :: Maybe DateTime, until :: Maybe DateTime, order :: Maybe SortOrder, includeCompleted :: Maybe Boolean } + -> Aff (Either ApiError (Array Job)) +fetchJobs config params = do + let route = Jobs { since: params.since, until: params.until, order: params.order, include_completed: params.includeCompleted } + get (CJ.array V1.jobCodec) config (printRoute route) + +-- | Fetch a single job by its ID. +-- | +-- | Parameters: +-- | - `level`: Minimum log level to include in the response +-- | - `since`: Only return log lines after this time +-- | - `until`: Only return log lines before this time +-- | - `order`: Sort order for log lines (ASC or DESC) +fetchJob + :: ApiConfig + -> JobId + -> { level :: Maybe LogLevel, since :: Maybe DateTime, until :: Maybe DateTime, order :: Maybe SortOrder } + -> Aff (Either ApiError Job) +fetchJob config jobId params = do + let route = Job jobId { level: params.level, since: params.since, until: params.until, order: params.order } + get V1.jobCodec config (printRoute route) diff --git a/dashboard/src/Dashboard/Component/JobDetail.purs b/dashboard/src/Dashboard/Component/JobDetail.purs new file mode 100644 index 000000000..8478dc6b6 --- /dev/null +++ b/dashboard/src/Dashboard/Component/JobDetail.purs @@ -0,0 +1,589 @@ +-- | The Job Detail component displays detailed information about a single +-- | registry job, including its metadata, payload, and a log viewer with +-- | filtering, pagination, and auto-refresh. +module Dashboard.Component.JobDetail + ( Input + , Output(..) + , component + ) where + +import Prelude + +import Dashboard.API (ApiConfig, ApiError) +import Dashboard.API as API +import Dashboard.Job as Job +import Data.Array as Array +import Data.Codec.JSON as CJ +import Data.DateTime (DateTime) +import Data.Either (Either(..)) +import Data.Foldable (for_) +import Data.Maybe (Maybe(..), fromMaybe, isJust) +import Data.Newtype (unwrap) +import Effect.Aff (Milliseconds(..)) +import Effect.Aff.Class (class MonadAff) +import Effect.Class (liftEffect) +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import JSON as JSON +import Registry.API.V1 (Job(..), JobId(..), LogLevel(..), LogLine, SortOrder(..)) +import Registry.API.V1 as V1 +import Registry.Internal.Codec as Internal.Codec +import Registry.Operation as Operation +import Registry.PackageName as PackageName +import Registry.Version (Version) +import Registry.Version as Version +import Web.Event.Event as Event +import Web.UIEvent.MouseEvent (MouseEvent) +import Web.UIEvent.MouseEvent as MouseEvent + +-- -------------------------------------------------------------------------- +-- Public types +-- -------------------------------------------------------------------------- + +-- | The component input: the job ID to display and the API configuration. +type Input = { jobId :: String, apiConfig :: ApiConfig } + +-- | The component output signals navigation back to the jobs list. +data Output = NavigateBack + +-- -------------------------------------------------------------------------- +-- Internal types +-- -------------------------------------------------------------------------- + +type State = + { apiConfig :: ApiConfig + , jobId :: String + , job :: Maybe Job + , loading :: Boolean + , error :: Maybe String + , logLevel :: LogLevel + , allLogs :: Array LogLine + , lastLogTimestamp :: Maybe DateTime + , logSortOrder :: SortOrder + , logAutoRefresh :: Boolean + , logRefreshSubId :: Maybe H.SubscriptionId + , payloadCollapsed :: Boolean + , logUntil :: Maybe DateTime + , logPage :: Int + } + +data Action + = Initialize + | FetchJob + | HandleFetchResult (Either ApiError Job) + | SetLogLevel String + | HandleLogLevelResult (Either ApiError Job) + | ToggleLogAutoRefresh Boolean + | ToggleLogSortOrder + | LogRefreshTick + | HandleLogRefreshResult (Either ApiError Job) + | TogglePayload + | LogPrevPage + | LogNextPage + | GoBack MouseEvent + | Receive Input + +-- -------------------------------------------------------------------------- +-- Component +-- -------------------------------------------------------------------------- + +component :: forall query m. MonadAff m => H.Component query Input Output m +component = + H.mkComponent + { initialState + , render + , eval: H.mkEval $ H.defaultEval + { handleAction = handleAction + , initialize = Just Initialize + , receive = Just <<< Receive + } + } + +initialState :: Input -> State +initialState input = + { apiConfig: input.apiConfig + , jobId: input.jobId + , job: Nothing + , loading: true + , error: Nothing + , logLevel: Info + , allLogs: [] + , lastLogTimestamp: Nothing + , logSortOrder: DESC + , logAutoRefresh: true + , logRefreshSubId: Nothing + , payloadCollapsed: false + , logUntil: Nothing + , logPage: 0 + } + +-- -------------------------------------------------------------------------- +-- Rendering +-- -------------------------------------------------------------------------- + +render :: forall m. State -> H.ComponentHTML Action () m +render state = + HH.div_ + [ renderBreadcrumb state + , renderPageTitle state + , renderContent state + ] + +renderBreadcrumb :: forall m. State -> H.ComponentHTML Action () m +renderBreadcrumb state = + HH.nav [ HP.class_ (HH.ClassName "breadcrumb-bar") ] + [ HH.div [ HP.class_ (HH.ClassName "breadcrumb-bar__inner") ] + [ HH.a + [ HP.class_ (HH.ClassName "breadcrumb-bar__link") + , HP.href "#/" + , HE.onClick GoBack + ] + [ HH.text "Jobs" ] + , HH.span [ HP.class_ (HH.ClassName "breadcrumb-bar__sep") ] [ HH.text "/" ] + , HH.span [ HP.class_ (HH.ClassName "breadcrumb-bar__current") ] + [ HH.text state.jobId ] + ] + ] + +renderPageTitle :: forall m. State -> H.ComponentHTML Action () m +renderPageTitle state = case state.job of + Nothing -> + HH.div [ HP.class_ (HH.ClassName "page-title clearfix") ] + [ HH.h1 [ HP.class_ (HH.ClassName "page-title__title") ] + [ HH.text (if state.loading then "Loading..." else "Job") ] + ] + Just job -> do + let jobTypeName = V1.printJobType (Job.getJobType job) + let + titleText = case Job.getPackageName job of + Just name -> PackageName.print name <> fromMaybe "" (map (\v -> "@" <> Version.print v) (Job.getPackageVersion job)) + Nothing -> "Package Set Update" + HH.div [ HP.class_ (HH.ClassName "page-title clearfix") ] + [ HH.h1 [ HP.class_ (HH.ClassName "page-title__title") ] + [ HH.span [ HP.class_ (HH.ClassName ("job-type-badge job-type-badge--" <> jobTypeName)) ] + [ HH.text jobTypeName ] + , HH.text (" " <> titleText) + ] + ] + +renderContent :: forall m. State -> H.ComponentHTML Action () m +renderContent state + | state.loading = + HH.div [ HP.class_ (HH.ClassName "loading-state") ] + [ HH.div [ HP.class_ (HH.ClassName "spinner") ] [] + , HH.p_ [ HH.text "Loading job..." ] + ] + | Just err <- state.error = + HH.div [ HP.class_ (HH.ClassName "error-state") ] + [ HH.p [ HP.class_ (HH.ClassName "error-message") ] [ HH.text err ] ] + | Just job <- state.job = + renderJobDetail state job + | otherwise = + HH.div [ HP.class_ (HH.ClassName "error-state") ] + [ HH.p [ HP.class_ (HH.ClassName "error-message") ] [ HH.text "Job not found." ] ] + +renderJobDetail :: forall m. State -> Job -> H.ComponentHTML Action () m +renderJobDetail state job = do + let info = V1.jobInfo job + let statusName = Job.printStatus (Job.deriveStatus info) + HH.div [ HP.class_ (HH.ClassName "job-detail") ] + [ renderInfoBlock info statusName (Job.getCompilerVersion job) + , renderPayloadSection state job + , renderLogsSection state + ] + +renderInfoBlock :: forall m. V1.JobInfo () -> String -> Maybe Version -> H.ComponentHTML Action () m +renderInfoBlock info statusName compiler = do + let waitDuration = computeDurationBetween info.createdAt info.startedAt + let runDuration = map (\s -> computeDurationBetween s info.finishedAt) info.startedAt + HH.div [ HP.class_ (HH.ClassName "job-detail__timestamps") ] + ( Array.catMaybes + [ Just $ renderInfoRow "Job ID" + (HH.code [ HP.class_ (HH.ClassName "job-detail__ts-value") ] [ HH.text (unwrap info.jobId) ]) + , Just $ renderInfoRow "Status" + ( HH.span [ HP.class_ (HH.ClassName ("job-status job-status--" <> statusName)) ] + [ HH.text statusName ] + ) + , map (\c -> renderInfoRow "Compiler" (tsValue (Version.print c))) compiler + , Just $ renderInfoRow "Created" (tsValue (Job.formatTimestamp info.createdAt)) + , Just $ renderInfoRow "Started" (tsValue (fromMaybe "\x2014" (map Job.formatTimestamp info.startedAt))) + , Just $ renderInfoRow "Finished" (tsValue (fromMaybe "\x2014" (map Job.formatTimestamp info.finishedAt))) + , if isJust info.startedAt then Just $ renderInfoRow "Wait time" (tsValue waitDuration) + else Nothing + , map (\dur -> renderInfoRow "Duration" (tsValue dur)) runDuration + ] + ) + +renderInfoRow :: forall m. String -> H.ComponentHTML Action () m -> H.ComponentHTML Action () m +renderInfoRow label value = + HH.div [ HP.class_ (HH.ClassName "job-detail__ts-row") ] + [ HH.span [ HP.class_ (HH.ClassName "job-detail__ts-label") ] [ HH.text label ] + , value + ] + +tsValue :: forall m. String -> H.ComponentHTML Action () m +tsValue text = HH.span [ HP.class_ (HH.ClassName "job-detail__ts-value") ] [ HH.text text ] + +renderPayloadSection :: forall m. State -> Job -> H.ComponentHTML Action () m +renderPayloadSection state job = + HH.div [ HP.class_ (HH.ClassName "job-detail__section") ] + [ HH.div [ HP.class_ (HH.ClassName "job-detail__section-header") ] + [ HH.h2 [ HP.class_ (HH.ClassName "job-detail__section-title") ] + [ HH.text "Payload" ] + , HH.button + [ HP.class_ (HH.ClassName "toolbar-btn toolbar-btn--small") + , HE.onClick \_ -> TogglePayload + ] + [ HH.text (if state.payloadCollapsed then "Show" else "Hide") ] + ] + , if state.payloadCollapsed then + HH.text "" + else + HH.pre [ HP.class_ (HH.ClassName "json-viewer") ] + [ HH.text (getPayloadJson job) ] + ] + +renderLogsSection :: forall m. State -> H.ComponentHTML Action () m +renderLogsSection state = + HH.div [ HP.class_ (HH.ClassName "job-detail__section") ] + [ HH.div [ HP.class_ (HH.ClassName "job-detail__section-header") ] + [ HH.h2 [ HP.class_ (HH.ClassName "job-detail__section-title") ] + [ HH.text "Logs" ] + , HH.div [ HP.class_ (HH.ClassName "log-controls") ] + [ renderLogLevelSelect state.logLevel + , HH.button + [ HP.class_ (HH.ClassName "toolbar-btn toolbar-btn--small") + , HE.onClick \_ -> ToggleLogSortOrder + ] + [ HH.text (if state.logSortOrder == ASC then "Oldest first \x25B2" else "Newest first \x25BC") ] + , HH.label [ HP.class_ (HH.ClassName "toolbar-label") ] + [ HH.input + [ HP.type_ HP.InputCheckbox + , HP.checked state.logAutoRefresh + , HE.onChecked ToggleLogAutoRefresh + ] + , HH.text " Auto-refresh " + , HH.span + [ HP.class_ + ( HH.ClassName + ( "refresh-indicator" + <> if state.logAutoRefresh then "" else " refresh-indicator--inactive" + ) + ) + ] + [] + ] + ] + ] + , renderLogEntries state + ] + +renderLogLevelSelect :: forall m. LogLevel -> H.ComponentHTML Action () m +renderLogLevelSelect current = + HH.select + [ HP.class_ (HH.ClassName "toolbar-select toolbar-select--small") + , HE.onValueChange SetLogLevel + ] + [ HH.option [ HP.value "DEBUG", HP.selected (current == Debug) ] [ HH.text "Debug" ] + , HH.option [ HP.value "INFO", HP.selected (current == Info) ] [ HH.text "Info" ] + , HH.option [ HP.value "WARN", HP.selected (current == Warn) ] [ HH.text "Warn" ] + , HH.option [ HP.value "NOTICE", HP.selected (current == Notice) ] [ HH.text "Notice" ] + , HH.option [ HP.value "ERROR", HP.selected (current == Error) ] [ HH.text "Error" ] + ] + +renderLogEntries :: forall m. State -> H.ComponentHTML Action () m +renderLogEntries state + | Array.null state.allLogs = + HH.div [ HP.class_ (HH.ClassName "empty-state") ] + [ HH.p_ [ HH.text "No logs at this level." ] ] + | otherwise = do + -- Logs are stored in ASC order; reverse at render time for DESC. + let displayLogs = case state.logSortOrder of + ASC -> state.allLogs + DESC -> Array.reverse state.allLogs + let totalLogs = Array.length displayLogs + let totalPages = logTotalPages totalLogs + let page = min state.logPage (totalPages - 1) + let pageStart = page * logPageSize + let pageLogs = Array.slice pageStart (pageStart + logPageSize) displayLogs + HH.div_ + [ HH.table [ HP.class_ (HH.ClassName "log-table") ] + [ HH.thead_ + [ HH.tr_ + [ HH.th [ HP.class_ (HH.ClassName "log-table__th log-table__th--rownum") ] [ HH.text "#" ] + , HH.th [ HP.class_ (HH.ClassName "log-table__th log-table__th--time") ] [ HH.text "Time" ] + , HH.th [ HP.class_ (HH.ClassName "log-table__th log-table__th--level") ] [ HH.text "Level" ] + , HH.th [ HP.class_ (HH.ClassName "log-table__th") ] [ HH.text "Message" ] + ] + ] + , HH.tbody_ (Array.mapWithIndex (renderLogEntry pageStart) pageLogs) + ] + , renderLogPagination page totalPages totalLogs + ] + +renderLogEntry :: forall m. Int -> Int -> LogLine -> H.ComponentHTML Action () m +renderLogEntry offset index logLine = do + let level = V1.printLogLevel logLine.level + HH.tr [ HP.class_ (HH.ClassName ("log-entry log-entry--" <> level)) ] + [ HH.td [ HP.class_ (HH.ClassName "log-entry__rownum") ] + [ HH.text (show (offset + index + 1)) ] + , HH.td [ HP.class_ (HH.ClassName "log-entry__time") ] + [ HH.text (Job.formatTimestamp logLine.timestamp) ] + , HH.td [ HP.class_ (HH.ClassName "log-entry__level") ] + [ HH.span [ HP.class_ (HH.ClassName ("log-level log-level--" <> level)) ] + [ HH.text level ] + ] + , HH.td [ HP.class_ (HH.ClassName "log-entry__message") ] + [ HH.pre [ HP.class_ (HH.ClassName "log-entry__text") ] + [ HH.text logLine.message ] + ] + ] + +-- | Render pagination controls for the log table, reusing the jobs-nav CSS. +renderLogPagination :: forall m. Int -> Int -> Int -> H.ComponentHTML Action () m +renderLogPagination page totalPages totalLogs + | totalPages <= 1 = HH.text "" + | otherwise = + HH.div [ HP.class_ (HH.ClassName "jobs-nav") ] + [ HH.button + [ HP.class_ (HH.ClassName "jobs-nav__btn") + , HP.disabled (page <= 0) + , HE.onClick \_ -> LogPrevPage + ] + [ HH.text "\x25C0" ] + , HH.span [ HP.class_ (HH.ClassName "jobs-nav__info") ] + [ HH.text ("Page " <> show (page + 1) <> " of " <> show totalPages <> " (" <> show totalLogs <> " entries)") ] + , HH.button + [ HP.class_ (HH.ClassName "jobs-nav__btn") + , HP.disabled (page >= totalPages - 1) + , HE.onClick \_ -> LogNextPage + ] + [ HH.text "\x25B6" ] + ] + +-- -------------------------------------------------------------------------- +-- Action handling +-- -------------------------------------------------------------------------- + +handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit +handleAction = case _ of + Initialize -> do + handleAction FetchJob + state <- H.get + let finished = case state.job of + Just job -> isJust (V1.jobInfo job).finishedAt + Nothing -> false + unless finished do + subId <- H.subscribe =<< Job.timerEmitter logRefreshInterval LogRefreshTick + H.modify_ _ { logRefreshSubId = Just subId } + + Receive input -> do + state <- H.get + when (state.jobId /= input.jobId || state.apiConfig /= input.apiConfig) do + H.modify_ _ { jobId = input.jobId, apiConfig = input.apiConfig } + handleAction FetchJob + + FetchJob -> do + H.modify_ _ { loading = true, error = Nothing } + state <- H.get + result <- H.liftAff $ API.fetchJob state.apiConfig (JobId state.jobId) + { level: Just state.logLevel, since: Nothing, until: Nothing, order: Just ASC } + handleAction (HandleFetchResult result) + + HandleFetchResult result -> case result of + Left err -> do + let msg = API.printApiError err + H.modify_ _ { loading = false, error = Just msg, job = Nothing } + Right job -> do + let info = V1.jobInfo job + let logs = info.logs + let lastTs = map _.timestamp (Array.last logs) + H.modify_ _ + { loading = false + , error = Nothing + , job = Just job + , allLogs = logs + , lastLogTimestamp = lastTs + , logUntil = info.finishedAt + , logPage = 0 + } + fetchAllRemainingLogs + stopAutoRefreshIfFinished info + + SetLogLevel val -> do + let level = parseLogLevel val + H.modify_ _ { logLevel = level, allLogs = [], lastLogTimestamp = Nothing, logPage = 0 } + state <- H.get + result <- H.liftAff $ API.fetchJob state.apiConfig (JobId state.jobId) + { level: Just level, since: Nothing, until: state.logUntil, order: Just ASC } + handleAction (HandleLogLevelResult result) + + HandleLogLevelResult result -> case result of + Left _ -> + H.modify_ _ { allLogs = [], lastLogTimestamp = Nothing } + Right job -> do + let logs = (V1.jobInfo job).logs + let lastTs = map _.timestamp (Array.last logs) + H.modify_ _ { allLogs = logs, lastLogTimestamp = lastTs } + fetchAllRemainingLogs + + ToggleLogAutoRefresh enabled -> do + state <- H.get + for_ state.logRefreshSubId H.unsubscribe + if enabled then do + subId <- H.subscribe =<< Job.timerEmitter logRefreshInterval LogRefreshTick + H.modify_ _ { logAutoRefresh = true, logRefreshSubId = Just subId } + else + H.modify_ _ { logAutoRefresh = false, logRefreshSubId = Nothing } + + ToggleLogSortOrder -> do + H.modify_ \s -> s + { logSortOrder = if s.logSortOrder == ASC then DESC else ASC + , logPage = 0 + } + + LogRefreshTick -> do + state <- H.get + -- No-op if the job is already finished: all logs have been fetched. + let finished = case state.job of + Just job -> isJust (V1.jobInfo job).finishedAt + Nothing -> false + unless finished do + result <- H.liftAff $ API.fetchJob state.apiConfig (JobId state.jobId) + { level: Just state.logLevel, since: state.lastLogTimestamp, until: Nothing, order: Just ASC } + handleAction (HandleLogRefreshResult result) + + HandleLogRefreshResult result -> case result of + -- Intentional silent retry: transient API errors are ignored and the + -- next tick will attempt another fetch automatically. + Left _ -> pure unit + Right job -> do + state <- H.get + let info = V1.jobInfo job + let newLogs = Array.filter (isNewerThan state.lastLogTimestamp) info.logs + when (not (Array.null newLogs)) do + let lastTs = map _.timestamp (Array.last newLogs) + -- Logs are always stored in ASC order; new logs are appended at the end. + let combined = capLogs state.logSortOrder (state.allLogs <> newLogs) + H.modify_ _ { allLogs = combined, lastLogTimestamp = lastTs } + -- Update job status and logUntil from the refreshed data + H.modify_ _ { job = Just job, logUntil = info.finishedAt } + stopAutoRefreshIfFinished info + + TogglePayload -> + H.modify_ \s -> s { payloadCollapsed = not s.payloadCollapsed } + + LogPrevPage -> + H.modify_ \s -> s { logPage = max 0 (s.logPage - 1) } + + LogNextPage -> do + state <- H.get + let totalPages = logTotalPages (Array.length state.allLogs) + H.modify_ \s -> s { logPage = min (totalPages - 1) (s.logPage + 1) } + + GoBack ev -> do + liftEffect $ Event.preventDefault (MouseEvent.toEvent ev) + H.raise NavigateBack + +-- -------------------------------------------------------------------------- +-- Helpers +-- -------------------------------------------------------------------------- + +-- | Stop the auto-refresh timer if the job has finished. +stopAutoRefreshIfFinished :: forall m. V1.JobInfo () -> H.HalogenM State Action () Output m Unit +stopAutoRefreshIfFinished info = + when (isJust info.finishedAt) do + state <- H.get + for_ state.logRefreshSubId H.unsubscribe + H.modify_ _ { logAutoRefresh = false, logRefreshSubId = Nothing } + +-- | Maximum number of log entries to keep in memory. +maxLogEntries :: Int +maxLogEntries = 2000 + +-- | Number of log entries to display per page in the log table. +logPageSize :: Int +logPageSize = 200 + +-- | Compute total pages for log pagination, always returning at least 1. +logTotalPages :: Int -> Int +logTotalPages total = max 1 (((total - 1) / logPageSize) + 1) + +-- | Cap an array of logs (stored in ASC order) to `maxLogEntries`, trimming +-- | from the end furthest from the user's current view. +capLogs :: SortOrder -> Array LogLine -> Array LogLine +capLogs sortOrder logs = + if Array.length logs <= maxLogEntries then logs + else case sortOrder of + ASC -> Array.take maxLogEntries logs + DESC -> Array.drop (Array.length logs - maxLogEntries) logs + +-- | Maximum number of pagination requests when fetching all remaining logs. +maxPaginationIterations :: Int +maxPaginationIterations = 20 + +logRefreshInterval :: Milliseconds +logRefreshInterval = Milliseconds 3000.0 + +-- | Parse a log level string from the select element. +parseLogLevel :: String -> LogLevel +parseLogLevel = case _ of + "DEBUG" -> Debug + "WARN" -> Warn + "NOTICE" -> Notice + "ERROR" -> Error + _ -> Info + +-- | Check if a log line is newer than the given timestamp. +isNewerThan :: Maybe DateTime -> LogLine -> Boolean +isNewerThan mTs logLine = case mTs of + Nothing -> true + Just ts -> logLine.timestamp > ts + +-- | Encode the job's payload to a pretty-printed JSON string. +getPayloadJson :: Job -> String +getPayloadJson = case _ of + PublishJob j -> JSON.printIndented (CJ.encode Operation.publishCodec j.payload) + UnpublishJob j -> JSON.printIndented (CJ.encode Operation.authenticatedCodec j.payload) + TransferJob j -> JSON.printIndented (CJ.encode Operation.authenticatedCodec j.payload) + MatrixJob j -> JSON.printIndented (CJ.encode (Internal.Codec.packageMap Version.codec) j.payload) + PackageSetJob j -> JSON.printIndented (CJ.encode Operation.packageSetOperationCodec j.payload) + +-- | Compute a human-readable duration between a start time and an optional +-- | end time. If the end time is absent, shows "ongoing". +computeDurationBetween :: DateTime -> Maybe DateTime -> String +computeDurationBetween start = case _ of + Nothing -> "ongoing" + Just end -> Job.formatDurationBetween start end + +-- | Fetch all remaining log pages after the initial fetch by looping until +-- | either an empty batch is returned or the maximum number of iterations +-- | is reached. +fetchAllRemainingLogs :: forall m. MonadAff m => H.HalogenM State Action () Output m Unit +fetchAllRemainingLogs = go 0 + where + go :: Int -> H.HalogenM State Action () Output m Unit + go iteration = + when (iteration < maxPaginationIterations) do + state <- H.get + -- Stop fetching if we've already reached the log cap + when (Array.length state.allLogs < maxLogEntries) do + case state.lastLogTimestamp of + Nothing -> pure unit + Just since -> do + result <- H.liftAff $ API.fetchJob state.apiConfig (JobId state.jobId) + { level: Just state.logLevel, since: Just since, until: Nothing, order: Just ASC } + case result of + Left _ -> pure unit + Right job -> do + let newLogs = Array.filter (isNewerThan (Just since)) (V1.jobInfo job).logs + if Array.null newLogs then + pure unit + else do + currentState <- H.get + let combined = capLogs currentState.logSortOrder (currentState.allLogs <> newLogs) + let lastTs = map _.timestamp (Array.last combined) + H.modify_ _ { allLogs = combined, lastLogTimestamp = lastTs } + go (iteration + 1) diff --git a/dashboard/src/Dashboard/Component/JobsList.purs b/dashboard/src/Dashboard/Component/JobsList.purs new file mode 100644 index 000000000..b26a73236 --- /dev/null +++ b/dashboard/src/Dashboard/Component/JobsList.purs @@ -0,0 +1,873 @@ +-- | The Jobs List component displays a filterable list of registry jobs with +-- | page-based pagination. +module Dashboard.Component.JobsList + ( Input + , Output(..) + , Filters + , TimeRange + , StatusFilter + , component + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Dashboard.API (ApiConfig, ApiError) +import Dashboard.API as API +import Dashboard.Job (JobStatus(..), JobSummary) +import Dashboard.Job as Job +import Dashboard.Route (JobsListParams) +import Data.Array as Array +import Data.DateTime (DateTime) +import Data.DateTime as DateTime +import Data.Either (Either(..)) +import Data.Foldable (for_) +import Data.Maybe (Maybe(..), fromMaybe, isJust, isNothing) +import Data.Newtype (unwrap) +import Data.String as String +import Data.Time.Duration (Seconds(..)) +import Effect.Aff (Milliseconds(..)) +import Effect.Aff.Class (class MonadAff) +import Effect.Class (liftEffect) +import Effect.Now as Now +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Registry.API.V1 (Job, JobType(..), SortOrder(..)) +import Registry.API.V1 as V1 +import Registry.PackageName as PackageName +import Registry.Version as Version + +-- | The number of jobs to display per page. +pageSize :: Int +pageSize = 100 + +-- | The component input is the API configuration plus optional filter +-- | parameters parsed from the URL hash. +type Input = + { apiConfig :: ApiConfig + , params :: JobsListParams + } + +-- | The component output signals navigation to a job detail view or notifies +-- | the parent that filter state has changed (so the URL hash can be updated). +data Output + = NavigateToJob String + | FiltersChanged JobsListParams + +-- | Time range options for the server-side `since`/`until` query parameters. +-- | `UntilNow` sends only `until = now` with no `since` bound, returning all +-- | jobs up to the current time. +data TimeRange + = UntilNow + | LastHour + | Last24Hours + | LastWeek + | Custom + +derive instance Eq TimeRange + +-- | Return the window size in hours for preset time ranges. +timeRangeHours :: TimeRange -> Number +timeRangeHours = case _ of + UntilNow -> 24.0 + LastHour -> 1.0 + Last24Hours -> 24.0 + LastWeek -> 168.0 + Custom -> 24.0 + +-- | Which column the jobs list is sorted by. Currently only Created is +-- | supported server-side; Started is display-only. +data SortField = SortByCreated + +derive instance Eq SortField + +-- | The default sort order is newest-first. +defaultSortOrder :: SortOrder +defaultSortOrder = DESC + +-- | The status filter merges the old "include completed" checkbox with the +-- | status dropdown into a single control. +data StatusFilter + = ActiveOnly + | AllStatuses + | OnlyPending + | OnlyRunning + | OnlySucceeded + | OnlyFailed + +derive instance Eq StatusFilter + +-- | Client-side filter state. +type Filters = + { jobType :: Maybe JobType + , packageName :: String + , packageVersion :: String + , compilerVersion :: String + , statusFilter :: StatusFilter + } + +emptyFilters :: Filters +emptyFilters = + { jobType: Nothing + , packageName: "" + , packageVersion: "" + , compilerVersion: "" + , statusFilter: AllStatuses + } + +type State = + { apiConfig :: ApiConfig + , jobs :: Array JobSummary + , loading :: Boolean + , error :: Maybe String + , timeRange :: TimeRange + , autoRefresh :: Boolean + , refreshSubId :: Maybe H.SubscriptionId + , filters :: Filters + , since :: Maybe DateTime + , until :: Maybe DateTime + , sortField :: SortField + , sortOrder :: SortOrder + -- | Raw input values for the Custom time range datetime-local inputs. + , sinceStr :: String + , untilStr :: String + -- | The current page number (1-indexed). + , currentPage :: Int + -- | Whether there are more results beyond the current page. + , hasNextPage :: Boolean + -- | Boundary timestamps for pages we have visited. `pageCursors !! 0` is + -- | the cursor that takes us from page 1 to page 2, etc. + , pageCursors :: Array DateTime + } + +data Action + = Initialize + | FetchJobs + | FetchJobsSilent + | HandleFetchResult (Either ApiError (Array Job)) + | SetTimeRange TimeRange + | SetCustomSince String + | SetCustomUntil String + | ToggleAutoRefresh Boolean + | SetFilterJobType String + | SetFilterPackageName String + | SetFilterPackageVersion String + | SetFilterCompilerVersion String + | SetFilterStatus String + | ClearFilters + | SetSort SortField + | NavigateToJobDetail String + | NextPage + | PrevPage + | Tick + | Receive Input + +component :: forall query m. MonadAff m => H.Component query Input Output m +component = + H.mkComponent + { initialState + , render + , eval: H.mkEval $ H.defaultEval + { handleAction = handleAction + , initialize = Just Initialize + , receive = Just <<< Receive + } + } + +initialState :: Input -> State +initialState input = do + let p = input.params + { apiConfig: input.apiConfig + , jobs: [] + , loading: true + , error: Nothing + , timeRange: parseTimeRange (fromMaybe "" p.range) + , autoRefresh: fromMaybe false p.autoRefresh + , refreshSubId: Nothing + , filters: + { jobType: p.jobType >>= parseJobType + , packageName: fromMaybe "" p.package + , packageVersion: fromMaybe "" p.version + , compilerVersion: fromMaybe "" p.compiler + , statusFilter: parseStatusFilter (fromMaybe "" p.status) + } + , sortField: SortByCreated + , sortOrder: case p.order of + Just "asc" -> ASC + _ -> defaultSortOrder + , since: Nothing + , until: Nothing + , sinceStr: fromMaybe "" p.since + , untilStr: fromMaybe "" p.until + , currentPage: fromMaybe 1 p.page + , hasNextPage: true + , pageCursors: [] + } + +-- -------------------------------------------------------------------------- +-- Converting between URL params and component state +-- -------------------------------------------------------------------------- + +-- | Build URL parameters from the current component state, omitting defaults. +stateToParams :: State -> JobsListParams +stateToParams s = + { range: case s.timeRange of + Last24Hours -> Nothing + _ -> Just (printTimeRange s.timeRange) + , status: case s.filters.statusFilter of + AllStatuses -> Nothing + sf -> Just (printStatusFilter sf) + , jobType: map printJobType s.filters.jobType + , package: case String.trim s.filters.packageName of + "" -> Nothing + v -> Just v + , version: case String.trim s.filters.packageVersion of + "" -> Nothing + v -> Just v + , compiler: case String.trim s.filters.compilerVersion of + "" -> Nothing + v -> Just v + , autoRefresh: case s.autoRefresh of + false -> Nothing + true -> Just true + , since: case s.timeRange of + Custom | s.sinceStr /= "" -> Just s.sinceStr + _ -> Nothing + , until: case s.timeRange of + Custom | s.untilStr /= "" -> Just s.untilStr + _ -> Nothing + , order: + if s.sortOrder == defaultSortOrder then Nothing + else Just (if s.sortOrder == ASC then "asc" else "desc") + , page: + if s.currentPage <= 1 then Nothing + else Just s.currentPage + } + +-- -------------------------------------------------------------------------- +-- TimeRange serialization +-- -------------------------------------------------------------------------- + +printTimeRange :: TimeRange -> String +printTimeRange = case _ of + UntilNow -> "all" + LastHour -> "1h" + Last24Hours -> "24h" + LastWeek -> "1w" + Custom -> "custom" + +parseTimeRange :: String -> TimeRange +parseTimeRange = case _ of + "all" -> UntilNow + "1h" -> LastHour + "24h" -> Last24Hours + "1w" -> LastWeek + "custom" -> Custom + _ -> Last24Hours + +-- -------------------------------------------------------------------------- +-- StatusFilter serialization +-- -------------------------------------------------------------------------- + +printStatusFilter :: StatusFilter -> String +printStatusFilter = case _ of + ActiveOnly -> "active" + AllStatuses -> "all" + OnlyPending -> "pending" + OnlyRunning -> "running" + OnlySucceeded -> "succeeded" + OnlyFailed -> "failed" + +-- -------------------------------------------------------------------------- +-- JobType serialization +-- -------------------------------------------------------------------------- + +printJobType :: JobType -> String +printJobType = case _ of + PublishJobType -> "publish" + UnpublishJobType -> "unpublish" + TransferJobType -> "transfer" + MatrixJobType -> "matrix" + PackageSetJobType -> "packageset" + +-- -------------------------------------------------------------------------- +-- Rendering +-- -------------------------------------------------------------------------- + +render :: forall m. State -> H.ComponentHTML Action () m +render state = do + let filteredJobs = applyFilters state.filters state.jobs + HH.div_ + [ renderPageTitle + , renderToolbar state + , renderContent state filteredJobs + , renderPagination state + ] + +renderPageTitle :: forall w i. HH.HTML w i +renderPageTitle = + HH.div [ HP.class_ (HH.ClassName "page-title") ] + [ HH.h1 [ HP.class_ (HH.ClassName "page-title__title") ] [ HH.text "Jobs" ] + ] + +-- | The toolbar is a single bar with three logical zones separated by +-- | vertical dividers: Query (time range) | Filters (client-side) | Actions +-- | (refresh controls). +renderToolbar :: forall m. State -> H.ComponentHTML Action () m +renderToolbar state = + HH.div [ HP.class_ (HH.ClassName "jobs-toolbar") ] + ( [ HH.div [ HP.class_ (HH.ClassName "jobs-toolbar__zone jobs-toolbar__zone--query") ] + [ renderField "TIME RANGE" $ renderTimeRangeSelect state ] + , HH.div [ HP.class_ (HH.ClassName "jobs-toolbar__divider") ] [] + , HH.div [ HP.class_ (HH.ClassName "jobs-toolbar__zone jobs-toolbar__zone--filters") ] + ( [ renderField "STATUS" $ renderStatusSelect state.filters.statusFilter + , renderField "TYPE" $ renderTypeSelect state.filters.jobType + , renderField "PACKAGE" $ renderTextFilter "Package name" state.filters.packageName SetFilterPackageName + , renderField "VERSION" $ renderTextFilter "Version" state.filters.packageVersion SetFilterPackageVersion + , renderField "COMPILER" $ renderTextFilter "Compiler" state.filters.compilerVersion SetFilterCompilerVersion + ] + <> clearLink + ) + , HH.div [ HP.class_ (HH.ClassName "jobs-toolbar__divider") ] [] + , HH.div [ HP.class_ (HH.ClassName "jobs-toolbar__zone jobs-toolbar__zone--actions") ] + [ renderField "REFRESH" $ + HH.label [ HP.class_ (HH.ClassName "toolbar-toggle") ] + [ HH.input + [ HP.type_ HP.InputCheckbox + , HP.checked state.autoRefresh + , HE.onChecked ToggleAutoRefresh + ] + , HH.text " Auto " + , HH.span + [ HP.class_ + ( HH.ClassName + ( "refresh-indicator" + <> if state.autoRefresh then "" else " refresh-indicator--inactive" + ) + ) + ] + [] + ] + ] + ] + <> customRangeRow + ) + where + clearLink + | hasActiveFilters state.filters = + [ HH.button + [ HP.class_ (HH.ClassName "jobs-toolbar__clear") + , HE.onClick \_ -> ClearFilters + ] + [ HH.text "Clear" ] + ] + | otherwise = [] + + customRangeRow + | state.timeRange == Custom = + [ HH.div [ HP.class_ (HH.ClassName "jobs-toolbar__custom-range") ] + [ HH.label [ HP.class_ (HH.ClassName "toolbar-field__label") ] [ HH.text "FROM" ] + , HH.input + [ HP.type_ HP.InputDatetimeLocal + , HP.class_ (HH.ClassName "toolbar-input") + , HP.value state.sinceStr + , HE.onValueInput SetCustomSince + ] + , HH.label [ HP.class_ (HH.ClassName "toolbar-field__label") ] [ HH.text "TO" ] + , HH.input + [ HP.type_ HP.InputDatetimeLocal + , HP.class_ (HH.ClassName "toolbar-input") + , HP.value state.untilStr + , HE.onValueInput SetCustomUntil + ] + ] + ] + | otherwise = [] + +-- | A labeled field: small uppercase label above the control. +renderField :: forall m. String -> H.ComponentHTML Action () m -> H.ComponentHTML Action () m +renderField label control = + HH.div [ HP.class_ (HH.ClassName "toolbar-field") ] + [ HH.span [ HP.class_ (HH.ClassName "toolbar-field__label") ] [ HH.text label ] + , control + ] + +-- | A sortable column header. Shows the sort indicator only when this column +-- | is the active sort field. +sortableHeader :: forall m. State -> SortField -> String -> H.ComponentHTML Action () m +sortableHeader state field label = + HH.th + [ HP.class_ (HH.ClassName "jobs-table__th jobs-table__th--sortable") + , HE.onClick \_ -> SetSort field + ] + ( [ HH.text (label <> " ") ] + <> + if state.sortField == field then + [ HH.span [ HP.class_ (HH.ClassName "sort-indicator") ] + [ HH.text (if state.sortOrder == DESC then "\x25BC" else "\x25B2") ] + ] + else [] + ) + +renderTimeRangeSelect :: forall m. State -> H.ComponentHTML Action () m +renderTimeRangeSelect state = + HH.select + [ HP.class_ (HH.ClassName "toolbar-select") + , HE.onValueChange handleChange + ] + [ HH.option [ HP.value "all", HP.selected (state.timeRange == UntilNow) ] [ HH.text "Until now" ] + , HH.option [ HP.value "1", HP.selected (state.timeRange == LastHour) ] [ HH.text "Last hour" ] + , HH.option [ HP.value "24", HP.selected (state.timeRange == Last24Hours) ] [ HH.text "Last 24 hours" ] + , HH.option [ HP.value "168", HP.selected (state.timeRange == LastWeek) ] [ HH.text "Last week" ] + , HH.option [ HP.value "custom", HP.selected (state.timeRange == Custom) ] [ HH.text "Custom" ] + ] + where + handleChange val = SetTimeRange case val of + "1" -> LastHour + "24" -> Last24Hours + "168" -> LastWeek + "custom" -> Custom + _ -> UntilNow + +renderStatusSelect :: forall m. StatusFilter -> H.ComponentHTML Action () m +renderStatusSelect current = + HH.select + [ HP.class_ (HH.ClassName "toolbar-select") + , HE.onValueChange SetFilterStatus + ] + [ HH.option [ HP.value "active", HP.selected (current == ActiveOnly) ] [ HH.text "Active" ] + , HH.option [ HP.value "all", HP.selected (current == AllStatuses) ] [ HH.text "All" ] + , HH.option [ HP.value "pending", HP.selected (current == OnlyPending) ] [ HH.text "Pending" ] + , HH.option [ HP.value "running", HP.selected (current == OnlyRunning) ] [ HH.text "Running" ] + , HH.option [ HP.value "succeeded", HP.selected (current == OnlySucceeded) ] [ HH.text "Succeeded" ] + , HH.option [ HP.value "failed", HP.selected (current == OnlyFailed) ] [ HH.text "Failed" ] + ] + +renderTypeSelect :: forall m. Maybe JobType -> H.ComponentHTML Action () m +renderTypeSelect current = + HH.select + [ HP.class_ (HH.ClassName "toolbar-select") + , HE.onValueChange SetFilterJobType + ] + [ HH.option [ HP.value "", HP.selected (isNothing current) ] [ HH.text "All" ] + , HH.option [ HP.value "publish", HP.selected (current == Just PublishJobType) ] [ HH.text "Publish" ] + , HH.option [ HP.value "unpublish", HP.selected (current == Just UnpublishJobType) ] [ HH.text "Unpublish" ] + , HH.option [ HP.value "transfer", HP.selected (current == Just TransferJobType) ] [ HH.text "Transfer" ] + , HH.option [ HP.value "matrix", HP.selected (current == Just MatrixJobType) ] [ HH.text "Matrix" ] + , HH.option [ HP.value "packageset", HP.selected (current == Just PackageSetJobType) ] [ HH.text "Package Set" ] + ] + +renderTextFilter :: forall m. String -> String -> (String -> Action) -> H.ComponentHTML Action () m +renderTextFilter placeholder current action = + HH.input + [ HP.class_ (HH.ClassName "toolbar-input") + , HP.placeholder placeholder + , HP.value current + , HE.onValueInput action + ] + +renderContent :: forall m. State -> Array JobSummary -> H.ComponentHTML Action () m +renderContent state filteredJobs + | state.loading = + HH.div [ HP.class_ (HH.ClassName "loading-state") ] + [ HH.div [ HP.class_ (HH.ClassName "spinner") ] [] + , HH.p_ [ HH.text "Loading jobs..." ] + ] + | Just err <- state.error = + HH.div [ HP.class_ (HH.ClassName "error-state") ] + [ HH.p [ HP.class_ (HH.ClassName "error-message") ] [ HH.text err ] + , HH.button + [ HP.class_ (HH.ClassName "toolbar-btn") + , HE.onClick \_ -> FetchJobs + ] + [ HH.text "Retry" ] + ] + | Array.null state.jobs = + HH.div [ HP.class_ (HH.ClassName "empty-state") ] + [ HH.p_ [ HH.text "No jobs found for the selected time range." ] ] + | Array.null filteredJobs = + HH.div [ HP.class_ (HH.ClassName "empty-state") ] + [ HH.p_ + [ HH.text "No jobs match the current filters. " + , HH.button + [ HP.class_ (HH.ClassName "jobs-toolbar__clear") + , HE.onClick \_ -> ClearFilters + ] + [ HH.text "Clear filters" ] + ] + ] + | otherwise = + HH.div_ + [ renderPagination state + , HH.table [ HP.class_ (HH.ClassName "jobs-table") ] + [ HH.thead_ + [ HH.tr_ + [ HH.th [ HP.class_ (HH.ClassName "jobs-table__th jobs-table__th--rownum") ] [ HH.text "#" ] + , HH.th [ HP.class_ (HH.ClassName "jobs-table__th") ] [ HH.text "Type" ] + , HH.th [ HP.class_ (HH.ClassName "jobs-table__th") ] [ HH.text "Package" ] + , HH.th [ HP.class_ (HH.ClassName "jobs-table__th") ] [ HH.text "Status" ] + , sortableHeader state SortByCreated "Created" + , HH.th [ HP.class_ (HH.ClassName "jobs-table__th") ] [ HH.text "Started" ] + , HH.th [ HP.class_ (HH.ClassName "jobs-table__th") ] [ HH.text "Compiler" ] + , HH.th [ HP.class_ (HH.ClassName "jobs-table__th") ] [ HH.text "Duration" ] + ] + ] + , HH.tbody_ (Array.mapWithIndex renderJobRow filteredJobs) + ] + ] + +renderJobRow :: forall m. Int -> JobSummary -> H.ComponentHTML Action () m +renderJobRow index summary = do + let jobIdStr = unwrap summary.jobId + let jobTypeName = V1.printJobType summary.jobType + let statusName = Job.printStatus (Job.deriveStatus summary) + HH.tr + [ HP.class_ (HH.ClassName "jobs-table__row") + , HE.onClick \_ -> NavigateToJobDetail jobIdStr + ] + [ HH.td [ HP.class_ (HH.ClassName "jobs-table__td jobs-table__td--rownum") ] + [ HH.text (show (index + 1)) ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.span [ HP.class_ (HH.ClassName ("job-type-badge job-type-badge--" <> jobTypeName)) ] + [ HH.text jobTypeName ] + ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.span [ HP.class_ (HH.ClassName "job-package") ] + [ HH.text (fromMaybe "\x2014" (map PackageName.print summary.packageName)) ] + , case summary.packageVersion of + Just v -> HH.span [ HP.class_ (HH.ClassName "job-version") ] [ HH.text ("@" <> Version.print v) ] + Nothing -> HH.text "" + ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.span [ HP.class_ (HH.ClassName ("job-status job-status--" <> statusName)) ] + [ HH.text statusName ] + ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.text (Job.formatTimestamp summary.createdAt) ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.text (fromMaybe "\x2014" (map Job.formatTimestamp summary.startedAt)) ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.text (fromMaybe "\x2014" (map Version.print summary.compilerVersion)) ] + , HH.td [ HP.class_ (HH.ClassName "jobs-table__td") ] + [ HH.text (computeDuration summary) ] + ] + +-- | Render pagination controls showing the current page and prev/next buttons. +renderPagination :: forall m. State -> H.ComponentHTML Action () m +renderPagination state + | state.loading || Array.null state.jobs = HH.text "" + | otherwise = + HH.div [ HP.class_ (HH.ClassName "jobs-nav") ] + [ HH.button + [ HP.class_ (HH.ClassName "jobs-nav__btn") + , HP.disabled (state.currentPage <= 1) + , HE.onClick \_ -> PrevPage + ] + [ HH.text "\x25C0" ] + , HH.span [ HP.class_ (HH.ClassName "jobs-nav__info") ] + [ HH.text ("Page " <> show state.currentPage) ] + , HH.button + [ HP.class_ (HH.ClassName "jobs-nav__btn") + , HP.disabled (not state.hasNextPage) + , HE.onClick \_ -> NextPage + ] + [ HH.text "\x25B6" ] + ] + +-- -------------------------------------------------------------------------- +-- Action handling +-- -------------------------------------------------------------------------- + +handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit +handleAction = case _ of + Initialize -> + handleAction FetchJobs + + -- The component owns its filter/sort state after initialization; URL params + -- are only used once in initialState. Re-renders from the parent only + -- update the apiConfig. + Receive input -> + H.modify_ _ { apiConfig = input.apiConfig } + + FetchJobs -> do + H.modify_ _ { loading = true, error = Nothing } + result <- doFetchJobs + handleAction (HandleFetchResult result) + + FetchJobsSilent -> do + result <- doFetchJobs + handleAction (HandleFetchResult result) + + HandleFetchResult result -> case result of + Left err -> do + let msg = API.printApiError err + let + displayMsg = + if String.contains (String.Pattern "Failed to fetch") msg then + "Unable to reach the registry API. This may be a CORS configuration issue." + else + msg + H.modify_ _ { loading = false, error = Just displayMsg, jobs = [] } + Right jobs -> do + state <- H.get + let summaries = map Job.toJobSummary jobs + let newFingerprints = map jobFingerprint summaries + let oldFingerprints = map jobFingerprint state.jobs + -- Skip the state update when the set of jobs hasn't changed. This + -- avoids VDOM diffing on every auto-refresh tick when nothing new + -- has arrived. + unless (not state.loading && newFingerprints == oldFingerprints) do + let hasNext = Array.length jobs >= pageSize + H.modify_ _ { loading = false, error = Nothing, jobs = summaries, hasNextPage = hasNext } + + SetTimeRange range -> do + when (range == Custom) do + now <- liftEffect Now.nowDateTime + let sinceDefault = subtractHours 24.0 now + H.modify_ _ { sinceStr = Job.formatDateTimeLocal sinceDefault, untilStr = Job.formatDateTimeLocal now } + H.modify_ _ { timeRange = range, since = Nothing, until = Nothing, currentPage = 1, pageCursors = [], hasNextPage = true } + handleAction FetchJobs + notifyFiltersChanged + + SetCustomSince val -> do + H.modify_ _ { sinceStr = val, since = Nothing, until = Nothing, currentPage = 1, pageCursors = [], hasNextPage = true } + state <- H.get + -- Fetch when both inputs have been provided. + case Job.parseDateTimeLocal val, Job.parseDateTimeLocal state.untilStr of + Just _, Just _ -> handleAction FetchJobs + _, _ -> pure unit + notifyFiltersChanged + + SetCustomUntil val -> do + H.modify_ _ { untilStr = val, since = Nothing, until = Nothing, currentPage = 1, pageCursors = [], hasNextPage = true } + state <- H.get + case Job.parseDateTimeLocal state.sinceStr, Job.parseDateTimeLocal val of + Just _, Just _ -> handleAction FetchJobs + _, _ -> pure unit + notifyFiltersChanged + + ToggleAutoRefresh enabled -> do + state <- H.get + for_ state.refreshSubId H.unsubscribe + if enabled then do + subId <- H.subscribe =<< Job.timerEmitter refreshInterval Tick + H.modify_ _ { autoRefresh = true, refreshSubId = Just subId } + else + H.modify_ _ { autoRefresh = false, refreshSubId = Nothing } + notifyFiltersChanged + + SetFilterJobType val -> updateFilter _ { jobType = parseJobType val } + SetFilterPackageName val -> updateFilter _ { packageName = val } + SetFilterPackageVersion val -> updateFilter _ { packageVersion = val } + SetFilterCompilerVersion val -> updateFilter _ { compilerVersion = val } + + SetFilterStatus val -> do + let sf = parseStatusFilter val + let needsRefetch s = statusFilterNeedsRefetch s.filters.statusFilter sf + state <- H.get + updateFilter _ { statusFilter = sf } + -- Re-fetch when switching between Active and other modes, because + -- Active excludes completed jobs server-side. + when (needsRefetch state) do + H.modify_ _ { currentPage = 1, pageCursors = [], hasNextPage = true } + handleAction FetchJobs + + ClearFilters -> do + H.modify_ _ { filters = emptyFilters, sortOrder = defaultSortOrder, currentPage = 1, pageCursors = [], hasNextPage = true } + notifyFiltersChanged + + SetSort field -> do + H.modify_ \s -> do + let newOrder = if s.sortField == field then (if s.sortOrder == DESC then ASC else DESC) else DESC + s { sortField = field, sortOrder = newOrder, currentPage = 1, pageCursors = [], hasNextPage = true } + handleAction FetchJobs + notifyFiltersChanged + + NavigateToJobDetail jobId -> + H.raise (NavigateToJob jobId) + + NextPage -> do + state <- H.get + when (state.hasNextPage && not state.loading) do + let + cursor = case state.sortOrder of + DESC -> extremeCreatedAt min state.jobs + ASC -> extremeCreatedAt max state.jobs + case cursor of + Nothing -> pure unit + Just ts -> do + let newCursors = state.pageCursors <> [ ts ] + H.modify_ _ { currentPage = state.currentPage + 1, pageCursors = newCursors } + handleAction FetchJobs + notifyFiltersChanged + + PrevPage -> do + state <- H.get + when (state.currentPage > 1) do + let newCursors = fromMaybe [] (Array.init state.pageCursors) + H.modify_ _ { currentPage = state.currentPage - 1, pageCursors = newCursors, hasNextPage = true } + handleAction FetchJobs + notifyFiltersChanged + + Tick -> + handleAction FetchJobsSilent + +-- -------------------------------------------------------------------------- +-- Helpers +-- -------------------------------------------------------------------------- + +-- | Update one filter field, and notify the parent. +updateFilter :: forall m. MonadAff m => (Filters -> Filters) -> H.HalogenM State Action () Output m Unit +updateFilter f = do + H.modify_ \s -> s { filters = f s.filters } + notifyFiltersChanged + +-- | Lightweight fingerprint of a job for equality checking. +jobFingerprint :: JobSummary -> { jobId :: String, finishedAt :: Maybe DateTime, success :: Boolean } +jobFingerprint job = + { jobId: unwrap job.jobId + , finishedAt: job.finishedAt + , success: job.success + } + +-- | Build query parameters from the current state and fetch jobs from the API. +doFetchJobs :: forall m. MonadAff m => H.HalogenM State Action () Output m (Either ApiError (Array Job)) +doFetchJobs = do + state <- H.get + now <- liftEffect Now.nowDateTime + let + customSince = Job.parseDateTimeLocal state.sinceStr + customUntil = Job.parseDateTimeLocal state.untilStr + baseSince = state.since <|> case state.timeRange of + Custom -> customSince + UntilNow -> Nothing + _ -> Just (subtractHours (timeRangeHours state.timeRange) now) + baseUntil = state.until <|> case state.timeRange of + Custom -> customUntil + UntilNow -> Just now + _ -> Nothing + pageCursor = Array.index state.pageCursors (state.currentPage - 2) + since = case state.sortOrder of + DESC -> baseSince + ASC -> + if state.currentPage > 1 then pageCursor + else baseSince + until = case state.sortOrder of + DESC -> + if state.currentPage > 1 then pageCursor + else baseUntil + ASC -> baseUntil + includeCompleted = Just (state.filters.statusFilter /= ActiveOnly) + H.liftAff $ API.fetchJobs state.apiConfig { since, until, order: Just state.sortOrder, includeCompleted } + +-- | Notify the parent component that filter state has changed so the URL can +-- | be updated. +notifyFiltersChanged :: forall m. MonadAff m => H.HalogenM State Action () Output m Unit +notifyFiltersChanged = do + state <- H.get + H.raise (FiltersChanged (stateToParams state)) + +refreshInterval :: Milliseconds +refreshInterval = Milliseconds 5000.0 + +-- | Find the extreme (min or max) `createdAt` timestamp among job summaries. +extremeCreatedAt :: (DateTime -> DateTime -> DateTime) -> Array JobSummary -> Maybe DateTime +extremeCreatedAt pick = Array.foldl (\acc s -> Just (maybe s.createdAt (pick s.createdAt) acc)) Nothing + where + maybe fallback f = case _ of + Nothing -> fallback + Just x -> f x + +-- | Apply client-side filters to an array of job summaries. +applyFilters :: Filters -> Array JobSummary -> Array JobSummary +applyFilters filters = Array.filter matchesAll + where + matchesAll summary = + matchesType summary + && matchesPackageName summary + && matchesPackageVersion summary + && matchesCompilerVersion summary + && matchesStatusFilter summary + + matchesType summary = case filters.jobType of + Nothing -> true + Just jt -> summary.jobType == jt + + matchesPackageName summary = case String.trim filters.packageName of + "" -> true + needle -> case summary.packageName of + Nothing -> false + Just name -> String.contains (String.Pattern (String.toLower needle)) (String.toLower (PackageName.print name)) + + matchesPackageVersion summary = case String.trim filters.packageVersion of + "" -> true + needle -> case summary.packageVersion of + Nothing -> false + Just ver -> String.contains (String.Pattern (String.toLower needle)) (String.toLower (Version.print ver)) + + matchesCompilerVersion summary = case String.trim filters.compilerVersion of + "" -> true + needle -> case summary.compilerVersion of + Nothing -> false + Just ver -> String.contains (String.Pattern (String.toLower needle)) (String.toLower (Version.print ver)) + + matchesStatusFilter summary = do + let s = Job.deriveStatus summary + case filters.statusFilter of + ActiveOnly -> s == Pending || s == Running + AllStatuses -> true + OnlyPending -> s == Pending + OnlyRunning -> s == Running + OnlySucceeded -> s == Succeeded + OnlyFailed -> s == Failed + +-- | Returns true when at least one client-side filter deviates from defaults. +hasActiveFilters :: Filters -> Boolean +hasActiveFilters f = + f.statusFilter /= AllStatuses + || isJust f.jobType + || String.trim f.packageName /= "" + || String.trim f.packageVersion /= "" + || String.trim f.compilerVersion /= "" + +-- | Parse a job type filter value from a select element. +parseJobType :: String -> Maybe JobType +parseJobType = case _ of + "publish" -> Just PublishJobType + "unpublish" -> Just UnpublishJobType + "transfer" -> Just TransferJobType + "matrix" -> Just MatrixJobType + "packageset" -> Just PackageSetJobType + _ -> Nothing + +-- | Parse a status filter value from a select element. +parseStatusFilter :: String -> StatusFilter +parseStatusFilter = case _ of + "all" -> AllStatuses + "pending" -> OnlyPending + "running" -> OnlyRunning + "succeeded" -> OnlySucceeded + "failed" -> OnlyFailed + "active" -> ActiveOnly + _ -> AllStatuses + +-- | Determine whether changing the status filter requires a server re-fetch. +statusFilterNeedsRefetch :: StatusFilter -> StatusFilter -> Boolean +statusFilterNeedsRefetch old new = (old == ActiveOnly) /= (new == ActiveOnly) + +-- | Subtract a number of hours from a DateTime. +subtractHours :: Number -> DateTime -> DateTime +subtractHours hours dt = do + let totalSeconds = hours * 3600.0 + let duration = Seconds (negate totalSeconds) + fromMaybe dt (DateTime.adjust duration dt) + +-- | Compute the duration string for a job. +computeDuration :: forall r. { startedAt :: Maybe DateTime, finishedAt :: Maybe DateTime | r } -> String +computeDuration job = case job.startedAt of + Nothing -> "\x2014" + Just started -> case job.finishedAt of + Nothing -> "running..." + Just finished -> Job.formatDurationBetween started finished diff --git a/dashboard/src/Dashboard/Job.purs b/dashboard/src/Dashboard/Job.purs new file mode 100644 index 000000000..1e07acfd7 --- /dev/null +++ b/dashboard/src/Dashboard/Job.purs @@ -0,0 +1,183 @@ +-- | Shared helpers for working with registry jobs. These are used by both +-- | the JobsList and JobDetail components to avoid duplicating logic for +-- | deriving job status, extracting job fields, and formatting durations. +module Dashboard.Job + ( JobStatus(..) + , JobSummary + , deriveStatus + , printStatus + , toJobSummary + , getJobType + , getPackageName + , getPackageVersion + , getCompilerVersion + , formatTimestamp + , formatDateTimeLocal + , parseDateTimeLocal + , formatDurationSecs + , formatDurationBetween + , timerEmitter + ) where + +import Prelude + +import Control.Monad.Rec.Class (forever) +import Data.DateTime (DateTime) +import Data.DateTime as DateTime +import Data.Formatter.DateTime (FormatterCommand(..)) +import Data.Formatter.DateTime as Formatter.DateTime +import Data.Int as Int +import Data.List (List) +import Data.List as List +import Data.Either (hush) +import Data.Maybe (Maybe(..), isJust, isNothing) +import Data.Newtype (unwrap) +import Data.Time.Duration (Seconds) +import Effect.Aff (Milliseconds) +import Effect.Aff as Aff +import Effect.Class (liftEffect) +import Halogen.Subscription (Emitter) +import Halogen.Subscription as HS +import Registry.API.V1 (Job(..), JobId, JobType(..)) +import Registry.API.V1 as V1 +import Registry.PackageName (PackageName) +import Registry.Version (Version) + +-- | Client-side job status derived from the job's timestamps and success flag. +data JobStatus + = Pending + | Running + | Succeeded + | Failed + +derive instance Eq JobStatus + +-- | Print a job status as a lowercase string suitable for CSS class names. +printStatus :: JobStatus -> String +printStatus = case _ of + Pending -> "pending" + Running -> "running" + Succeeded -> "succeeded" + Failed -> "failed" + +-- | Derive the status of a job from its fields. +deriveStatus :: forall r. { startedAt :: Maybe DateTime, finishedAt :: Maybe DateTime, success :: Boolean | r } -> JobStatus +deriveStatus job + | isJust job.finishedAt && job.success = Succeeded + | isJust job.finishedAt && not job.success = Failed + | isJust job.startedAt && isNothing job.finishedAt = Running + | otherwise = Pending + +-- | A lightweight summary of a Job containing only the fields needed for +-- | list display. Stripping the payload (which can be large, e.g. a full +-- | resolution map for matrix jobs) and logs avoids holding unnecessary data +-- | in component state. +type JobSummary = + { jobId :: JobId + , jobType :: JobType + , createdAt :: DateTime + , startedAt :: Maybe DateTime + , finishedAt :: Maybe DateTime + , success :: Boolean + , packageName :: Maybe PackageName + , packageVersion :: Maybe Version + , compilerVersion :: Maybe Version + } + +-- | Project a full Job into a lightweight JobSummary, discarding the payload +-- | and logs. +toJobSummary :: Job -> JobSummary +toJobSummary job = do + let info = V1.jobInfo job + { jobId: info.jobId + , jobType: getJobType job + , createdAt: info.createdAt + , startedAt: info.startedAt + , finishedAt: info.finishedAt + , success: info.success + , packageName: getPackageName job + , packageVersion: getPackageVersion job + , compilerVersion: getCompilerVersion job + } + +-- | Extract the job type from a Job. +getJobType :: Job -> JobType +getJobType = case _ of + PublishJob _ -> PublishJobType + UnpublishJob _ -> UnpublishJobType + TransferJob _ -> TransferJobType + MatrixJob _ -> MatrixJobType + PackageSetJob _ -> PackageSetJobType + +-- | Extract the package name from a Job, if present. +getPackageName :: Job -> Maybe PackageName +getPackageName = case _ of + PublishJob r -> Just r.packageName + UnpublishJob r -> Just r.packageName + TransferJob r -> Just r.packageName + MatrixJob r -> Just r.packageName + PackageSetJob _ -> Nothing + +-- | Extract the package version from a Job, if present. +getPackageVersion :: Job -> Maybe Version +getPackageVersion = case _ of + PublishJob r -> Just r.packageVersion + UnpublishJob r -> Just r.packageVersion + TransferJob _ -> Nothing + MatrixJob r -> Just r.packageVersion + PackageSetJob _ -> Nothing + +-- | Extract the compiler version from a Job, if present (matrix jobs only). +getCompilerVersion :: Job -> Maybe Version +getCompilerVersion = case _ of + MatrixJob r -> Just r.compilerVersion + _ -> Nothing + +-- | Format a DateTime as "YYYY-MM-DD HH:MM:SS". +formatTimestamp :: DateTime -> String +formatTimestamp = Formatter.DateTime.format timestampFormat + +-- "YYYY-MM-DD HH:MM:SS" +timestampFormat :: List FormatterCommand +timestampFormat = List.fromFoldable + [ YearFull, Placeholder "-", MonthTwoDigits, Placeholder "-", DayOfMonthTwoDigits + , Placeholder " ", Hours24, Placeholder ":", MinutesTwoDigits, Placeholder ":", SecondsTwoDigits + ] + +-- | Format a DateTime as an HTML datetime-local input value "YYYY-MM-DDTHH:MM". +formatDateTimeLocal :: DateTime -> String +formatDateTimeLocal = Formatter.DateTime.format dateTimeLocalFormat + +-- | Parse an HTML datetime-local input value ("YYYY-MM-DDTHH:MM") into a DateTime. +parseDateTimeLocal :: String -> Maybe DateTime +parseDateTimeLocal = hush <<< Formatter.DateTime.unformat dateTimeLocalFormat + +-- "YYYY-MM-DDTHH:MM" +dateTimeLocalFormat :: List FormatterCommand +dateTimeLocalFormat = List.fromFoldable + [ YearFull, Placeholder "-", MonthTwoDigits, Placeholder "-", DayOfMonthTwoDigits + , Placeholder "T", Hours24, Placeholder ":", MinutesTwoDigits + ] + +-- | Format a duration in seconds as a human-readable string. +formatDurationSecs :: Int -> String +formatDurationSecs totalSecs + | totalSecs < 60 = show totalSecs <> "s" + | otherwise = do + let mins = totalSecs / 60 + let remSecs = totalSecs `mod` 60 + show mins <> "m " <> show remSecs <> "s" + +-- | Format the duration between two DateTimes as a human-readable string. +formatDurationBetween :: DateTime -> DateTime -> String +formatDurationBetween start end = do + let diff = DateTime.diff end start :: Seconds + formatDurationSecs (Int.floor (unwrap diff)) + +-- | Create a Halogen Emitter that fires the given action at a fixed interval. +timerEmitter :: forall action m. Applicative m => Milliseconds -> action -> m (Emitter action) +timerEmitter interval action = pure $ HS.makeEmitter \push -> do + fiber <- Aff.launchAff $ forever do + Aff.delay interval + liftEffect (push action) + pure (Aff.launchAff_ (Aff.killFiber (Aff.error "unsubscribe") fiber)) diff --git a/dashboard/src/Dashboard/Route.purs b/dashboard/src/Dashboard/Route.purs new file mode 100644 index 000000000..af4fff4b4 --- /dev/null +++ b/dashboard/src/Dashboard/Route.purs @@ -0,0 +1,94 @@ +module Dashboard.Route + ( Route(..) + , JobsListParams + , defaultParams + , routes + ) where + +import Prelude hiding ((/)) + +import Control.Alt ((<|>)) +import Data.Maybe (Maybe(..)) +import Routing.Duplex (RouteDuplex(..), RouteDuplex') +import Routing.Duplex as RD +import Routing.Duplex.Parser (RouteParser) +import Routing.Duplex.Printer (RoutePrinter) + +-- | Optional filter parameters carried on the JobsList route. +-- | Only non-default values are encoded in the URL hash. +type JobsListParams = + { range :: Maybe String + , status :: Maybe String + , jobType :: Maybe String + , package :: Maybe String + , version :: Maybe String + , compiler :: Maybe String + , autoRefresh :: Maybe Boolean + , since :: Maybe String + , until :: Maybe String + , order :: Maybe String + , page :: Maybe Int + } + +-- | All-Nothing params representing defaults (no filters active). +defaultParams :: JobsListParams +defaultParams = + { range: Nothing + , status: Nothing + , jobType: Nothing + , package: Nothing + , version: Nothing + , compiler: Nothing + , autoRefresh: Nothing + , since: Nothing + , until: Nothing + , order: Nothing + , page: Nothing + } + +data Route + = JobsList JobsListParams + | JobDetail String + +derive instance Eq Route + +-- | The routing codec. Handles: +-- | / -> JobsList with optional query params +-- | /?range=1h&... -> JobsList with filter params +-- | /jobs/:id -> JobDetail +routes :: RouteDuplex' Route +routes = RD.root routeChoice + where + routeChoice :: RouteDuplex' Route + routeChoice = RouteDuplex enc dec + + enc :: Route -> RoutePrinter + enc = case _ of + JobsList params -> do + let RD.RouteDuplex encParams _ = jobsListParams + encParams params + JobDetail jobId -> do + let RD.RouteDuplex encDetail _ = RD.path "jobs" RD.segment + encDetail jobId + + dec :: RouteParser Route + dec = do + let RD.RouteDuplex _ decDetail = RD.end (RD.path "jobs" RD.segment) + let RD.RouteDuplex _ decParams = RD.end jobsListParams + (JobDetail <$> decDetail) <|> (JobsList <$> decParams) + + -- | Parse/print optional query parameters for the jobs list view. + jobsListParams :: RouteDuplex' JobsListParams + jobsListParams = RD.params + { range: RD.optional <<< RD.string + , status: RD.optional <<< RD.string + , jobType: RD.optional <<< RD.string + , package: RD.optional <<< RD.string + , version: RD.optional <<< RD.string + , compiler: RD.optional <<< RD.string + , autoRefresh: RD.optional <<< RD.boolean + , since: RD.optional <<< RD.string + , until: RD.optional <<< RD.string + , order: RD.optional <<< RD.string + , page: RD.optional <<< RD.int <<< RD.string + } diff --git a/dashboard/src/Dashboard/Router.purs b/dashboard/src/Dashboard/Router.purs new file mode 100644 index 000000000..0b7359757 --- /dev/null +++ b/dashboard/src/Dashboard/Router.purs @@ -0,0 +1,234 @@ +module Dashboard.Router + ( component + ) where + +import Prelude + +import Dashboard.API as API +import Dashboard.Component.JobDetail as JobDetail +import Dashboard.Component.JobsList as JobsList +import Dashboard.Route (Route(..)) +import Dashboard.Route as Route +import Data.Const (Const) +import Data.Either (hush) +import Data.Array as Array +import Data.Maybe (Maybe(..), fromMaybe) +import Data.String (Pattern(..)) +import Data.String as String +import Effect (Effect) +import Effect.Aff.Class (class MonadAff) +import Effect.Class (liftEffect) +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Halogen.Subscription as HS +import Routing.Duplex as RD +import Type.Proxy (Proxy(..)) +import Web.Event.Event as Event +import Web.Event.EventTarget as EventTarget +import Web.HTML as HTML +import Web.HTML.Event.HashChangeEvent.EventTypes as HashChangeEvent +import Web.HTML.Location as Location +import Web.HTML.Window as Window +import Web.UIEvent.MouseEvent (MouseEvent) +import Web.UIEvent.MouseEvent as MouseEvent + +type Slots = + ( jobsList :: H.Slot (Const Void) JobsList.Output Unit + , jobDetail :: H.Slot (Const Void) JobDetail.Output String + ) + +_jobsList :: Proxy "jobsList" +_jobsList = Proxy + +_jobDetail :: Proxy "jobDetail" +_jobDetail = Proxy + +type State = + { route :: Route + , lastJobsListParams :: Route.JobsListParams + } + +data Action + = Initialize + | HandleRouteChange Route + | HandleJobsListOutput JobsList.Output + | HandleJobDetailOutput JobDetail.Output + | GoHome MouseEvent + | GoTab Route MouseEvent + +component :: forall query output m. MonadAff m => H.Component query Unit output m +component = + H.mkComponent + { initialState + , render + , eval: H.mkEval $ H.defaultEval + { handleAction = handleAction + , initialize = Just Initialize + } + } + +initialState :: Unit -> State +initialState _ = + { route: JobsList Route.defaultParams + , lastJobsListParams: Route.defaultParams + } + +render :: forall m. MonadAff m => State -> H.ComponentHTML Action Slots m +render state = + HH.div [ HP.style "height: 100%" ] + [ HH.div [ HP.class_ (HH.ClassName "everything-except-footer") ] + [ HH.div [ HP.class_ (HH.ClassName "top-banner") ] + [ HH.div [ HP.class_ (HH.ClassName "container clearfix") ] + [ HH.a + [ HP.class_ (HH.ClassName "top-banner__logo") + , HP.href "#/" + , HE.onClick GoHome + ] + [ HH.text "PureScript Registry" ] + ] + ] + , if Array.length tabs > 1 then + HH.div [ HP.class_ (HH.ClassName "tab-bar") ] + [ HH.div [ HP.class_ (HH.ClassName "container") ] + [ HH.nav [ HP.class_ (HH.ClassName "tab-bar__nav") ] + tabs + ] + ] + else + HH.text "" + , HH.div [ HP.class_ (HH.ClassName "container") ] + [ content ] + ] + , HH.div [ HP.class_ (HH.ClassName "footer") ] + [ HH.div [ HP.classes [ HH.ClassName "footer__inner", HH.ClassName "container" ] ] + [ HH.span [ HP.class_ (HH.ClassName "footer__label") ] + [ HH.text "PureScript Registry Dashboard" ] + , HH.ul [ HP.class_ (HH.ClassName "footer__links") ] + [ HH.li_ [ HH.a [ HP.href "https://github.com/purescript/registry" ] [ HH.text "Registry" ] ] + , HH.li_ [ HH.a [ HP.href "https://github.com/purescript/registry-dev" ] [ HH.text "GitHub" ] ] + , HH.li_ [ HH.a [ HP.href "https://registry.purescript.org/api/v1/status" ] [ HH.text "API" ] ] + , HH.li_ [ HH.a [ HP.href "https://www.purescript.org" ] [ HH.text "purescript.org" ] ] + ] + ] + ] + ] + where + tabs = + [ HH.a + [ HP.classes [ HH.ClassName "tab-bar__tab", HH.ClassName "tab-bar__tab--active" ] + , HP.href "#/" + , HE.onClick (GoTab (JobsList state.lastJobsListParams)) + ] + [ HH.text "Jobs" ] + ] + + content = case state.route of + JobsList params -> + HH.slot _jobsList unit JobsList.component { apiConfig: API.defaultConfig, params } HandleJobsListOutput + JobDetail jobId -> + HH.slot _jobDetail jobId JobDetail.component { jobId, apiConfig: API.defaultConfig } HandleJobDetailOutput + +handleAction :: forall output m. MonadAff m => Action -> H.HalogenM State Action Slots output m Unit +handleAction = case _ of + Initialize -> do + route <- liftEffect getRouteFromHash + applyRoute route + emitter <- liftEffect hashChangeEmitter + void $ H.subscribe (map HandleRouteChange emitter) + + HandleRouteChange route -> + applyRoute route + + HandleJobsListOutput (JobsList.NavigateToJob jobId) -> + liftEffect $ setHash ("#/jobs/" <> jobId) + + HandleJobsListOutput (JobsList.FiltersChanged params) -> do + H.modify_ _ { lastJobsListParams = params } + liftEffect $ replaceHash (routeToHash (JobsList params)) + + HandleJobDetailOutput JobDetail.NavigateBack -> do + state <- H.get + liftEffect $ setHash (routeToHash (JobsList state.lastJobsListParams)) + + GoHome ev -> do + liftEffect $ Event.preventDefault (MouseEvent.toEvent ev) + state <- H.get + liftEffect $ setHash (routeToHash (JobsList state.lastJobsListParams)) + + GoTab route ev -> do + liftEffect $ Event.preventDefault (MouseEvent.toEvent ev) + liftEffect $ setHash (routeToHash route) + +applyRoute :: forall output m. Applicative m => Route -> H.HalogenM State Action Slots output m Unit +applyRoute route = case route of + JobsList params -> H.modify_ _ { route = route, lastJobsListParams = params } + _ -> H.modify_ _ { route = route } + +-- | Read the current URL hash and parse it into a Route, falling back to +-- | JobsList with default params if parsing fails. +getRouteFromHash :: Effect Route +getRouteFromHash = do + hash <- getHash + pure $ fromMaybe (JobsList Route.defaultParams) (parseHash hash) + +-- | Get the current hash from window.location. +getHash :: Effect String +getHash = do + window <- HTML.window + location <- Window.location window + Location.hash location + +-- | Set the hash on window.location. This creates a new history entry and +-- | fires the hashchange event. +setHash :: String -> Effect Unit +setHash hash = do + window <- HTML.window + location <- Window.location window + Location.setHash hash location + +-- | Replace the current hash without creating a new history entry and without +-- | firing the hashchange event. This is used for filter updates so that each +-- | keystroke doesn't pollute the browser history. +replaceHash :: String -> Effect Unit +replaceHash hash = do + window <- HTML.window + location <- Window.location window + Location.replace hash location + +-- | Convert a Route to a hash string (e.g. "#/?range=1h&status=running"). +routeToHash :: Route -> String +routeToHash route = "#" <> RD.print Route.routes route + +-- | Parse a hash string (which may include a leading '#') into a Route. +parseHash :: String -> Maybe Route +parseHash h = do + let path = hashToPath h + hush (RD.parse Route.routes path) + +-- | Convert a hash string like "#/jobs/abc" to a path like "/jobs/abc". +-- | An empty or absent hash maps to "/". +hashToPath :: String -> String +hashToPath h = case String.stripPrefix (Pattern "#") h of + Just rest + | rest == "" -> "/" + | otherwise -> rest + Nothing + | h == "" -> "/" + | otherwise -> h + +-- | Create a Halogen Emitter that fires the parsed Route whenever the URL +-- | hash changes. +hashChangeEmitter :: Effect (HS.Emitter Route) +hashChangeEmitter = do + window <- HTML.window + pure $ HS.makeEmitter \push -> do + let target = Window.toEventTarget window + let eventType = HashChangeEvent.hashchange + listener <- EventTarget.eventListener \_ -> do + route <- getRouteFromHash + push route + EventTarget.addEventListener eventType listener false target + pure do + EventTarget.removeEventListener eventType listener false target diff --git a/dashboard/src/Main.purs b/dashboard/src/Main.purs new file mode 100644 index 000000000..91696cfc7 --- /dev/null +++ b/dashboard/src/Main.purs @@ -0,0 +1,13 @@ +module Dashboard.Main where + +import Prelude + +import Dashboard.Router as Router +import Effect (Effect) +import Halogen.Aff as HA +import Halogen.VDom.Driver (runUI) + +main :: Effect Unit +main = HA.runHalogenAff do + body <- HA.awaitBody + runUI Router.component unit body diff --git a/dashboard/static/style.css b/dashboard/static/style.css new file mode 100644 index 000000000..0f983643f --- /dev/null +++ b/dashboard/static/style.css @@ -0,0 +1,784 @@ +/* -- Custom Properties ------------------------------------------------ */ +:root { + --font-size-sm: 87.5%; +} + +/* -- Reset / Base ---------------------------------------------------- */ +*, *::before, *::after { box-sizing: border-box; } +html, body { height: 100%; margin: 0; padding: 0; } +body { + font-family: "Roboto", sans-serif; + font-size: var(--font-size-sm); + line-height: 1.563; + background-color: #ffffff; + color: #000000; +} +@media (min-width: 38em) { + body { font-size: 100%; } +} +@media (prefers-color-scheme: dark) { + body { background-color: #141417; color: #dedede; } +} + +a { color: #c4953a; font-weight: bold; text-decoration: none; } +a:visited { color: #c4953a; } +a:hover { color: #7b5904; } +@media (prefers-color-scheme: dark) { + a, a:visited { color: #d8ac55; } + a:hover { color: #f0dcab; } +} + +code, pre { + background-color: #f1f5f9; + border-radius: 3px; + color: #194a5b; + font-family: "Roboto Mono", monospace; + font-size: var(--font-size-sm); +} +@media (prefers-color-scheme: dark) { + code, pre { background-color: #232327; color: #c1d3da; } +} + +/* -- Layout ---------------------------------------------------------- */ +.container { + display: block; + max-width: 66em; + margin-left: auto; + margin-right: auto; + padding-left: 20px; + padding-right: 20px; +} +@media (min-width: 52em) { + .container { padding-left: 30px; padding-right: 30px; } +} +.clearfix::after { + content: ""; + display: table; + clear: both; +} + +/* -- Sticky Footer --------------------------------------------------- */ +.everything-except-footer { + min-height: 100%; + padding-bottom: 3.5em; +} +.footer { + position: relative; + height: 3.5em; + margin-top: -3.5em; + width: 100%; + background-color: #1d222d; + color: #f0f0f0; +} +.footer__inner { + display: flex; + align-items: center; + justify-content: space-between; + height: 3.5em; +} +.footer__label { + font-size: var(--font-size-sm); + font-weight: 300; + white-space: nowrap; +} +.footer__links { + list-style: none; + margin: 0; + padding: 0; + display: flex; + align-items: center; +} +.footer__links li { + display: inline-flex; + align-items: center; +} +.footer__links li + li::before { + content: "\00B7"; + color: #6b7280; + margin: 0 0.5em; +} +.footer__links a { + color: #f0f0f0; + font-weight: 400; + text-decoration: none; +} +.footer__links a:visited { + color: #f0f0f0; +} +.footer__links a:hover { + color: #d8ac55; +} +@media (max-width: 38em) { + .footer__inner { + flex-direction: column; + justify-content: center; + gap: 0.15em; + height: 3.5em; + } + .footer__label, .footer__links { + text-align: center; + } +} + +/* -- Top Banner ------------------------------------------------------- */ +.top-banner { + background-color: #1d222d; + color: #f0f0f0; + font-weight: normal; +} +.top-banner a { color: #f0f0f0; } +.top-banner a:hover { color: #d8ac55; } +.top-banner__logo { + float: left; + font-size: 2.44em; + font-weight: 300; + line-height: 90px; +} +@media (max-width: 38em) { + .top-banner__logo { font-size: 1.5em; line-height: 60px; } +} + +/* -- Tab Bar ---------------------------------------------------------- */ +.tab-bar { + background-color: #f8f9fa; + border-bottom: 1px solid #e0e0e0; +} +@media (prefers-color-scheme: dark) { + .tab-bar { background-color: #1a1a1f; border-bottom-color: #2a2a2f; } +} +.tab-bar__nav { + display: flex; + gap: 0; +} +.tab-bar__tab { + display: inline-block; + padding: 0.6em 1.25em; + font-size: var(--font-size-sm); + font-weight: 700; + color: #777; + text-decoration: none; + border-bottom: 2px solid transparent; + transition: color 0.15s ease, border-color 0.15s ease; +} +.tab-bar__tab:visited { color: #777; } +.tab-bar__tab:hover { + color: #c4953a; + border-bottom-color: #c4953a; +} +.tab-bar__tab--active { + color: #c4953a; + border-bottom-color: #c4953a; +} +.tab-bar__tab--active:visited { color: #c4953a; } +@media (prefers-color-scheme: dark) { + .tab-bar__tab { color: #a0a0a0; } + .tab-bar__tab:visited { color: #a0a0a0; } + .tab-bar__tab:hover { color: #d8ac55; border-bottom-color: #d8ac55; } + .tab-bar__tab--active { color: #d8ac55; border-bottom-color: #d8ac55; } + .tab-bar__tab--active:visited { color: #d8ac55; } +} + +/* -- Page Title ------------------------------------------------------- */ +.page-title { margin: 1.5em 0 1em; } +.page-title__title { + margin: 0; + font-size: 2em; + font-weight: 700; +} + +/* -- Toolbar ---------------------------------------------------------- */ +.jobs-toolbar { + display: flex; + flex-wrap: wrap; + align-items: flex-start; + gap: 0; + margin-bottom: 1.5em; + padding: 0.75em 1em; + background-color: #f1f5f9; + border-radius: 3px; +} +@media (prefers-color-scheme: dark) { + .jobs-toolbar { background-color: #232327; } +} + +/* -- Toolbar zones ---------------------------------------------------- */ +.jobs-toolbar__zone { + display: flex; + flex-wrap: wrap; + align-items: flex-end; + gap: 0.75em; +} +.jobs-toolbar__zone--query { flex: 0 0 auto; align-items: flex-start; } +.jobs-toolbar__zone--filters { flex: 1 1 0%; } +.jobs-toolbar__zone--actions { + flex: 0 0 auto; + align-items: flex-start; + gap: 0.5em; +} + +/* -- Zone dividers ---------------------------------------------------- */ +.jobs-toolbar__divider { + width: 1px; + align-self: stretch; + margin: 4px 12px; + background-color: #d0d5dd; +} +@media (prefers-color-scheme: dark) { + .jobs-toolbar__divider { background-color: #3a3a42; } +} + +/* -- Labeled field (label above control) ------------------------------ */ +.toolbar-field { + display: flex; + flex-direction: column; + gap: 2px; +} +.toolbar-field__label { + font-size: 10px; + font-weight: 700; + text-transform: uppercase; + letter-spacing: 0.5px; + color: #888; + white-space: nowrap; +} +@media (prefers-color-scheme: dark) { + .toolbar-field__label { color: #777; } +} + +/* -- Clear button ----------------------------------------------------- */ +.jobs-toolbar__clear { + font-family: "Roboto", sans-serif; + font-size: 75%; + font-weight: bold; + white-space: nowrap; + align-self: flex-end; + padding: 0 0 0.2em; + border: none; + background: none; + color: #c4953a; + cursor: pointer; +} +.jobs-toolbar__clear:hover { color: #7b5904; } +@media (prefers-color-scheme: dark) { + .jobs-toolbar__clear { color: #d8ac55; } + .jobs-toolbar__clear:hover { color: #f0dcab; } +} + +/* -- Toggle label (Auto-refresh) -------------------------------------- */ +.toolbar-toggle { + font-size: var(--font-size-sm); + font-weight: 700; + white-space: nowrap; + cursor: pointer; +} + +/* -- Custom range row (full width below toolbar) ---------------------- */ +.jobs-toolbar__custom-range { + display: flex; + flex-wrap: wrap; + gap: 0.5em; + align-items: center; + width: 100%; + padding-top: 0.5em; +} + +/* -- Form Controls ---------------------------------------------------- */ +.toolbar-select, .toolbar-input { + font-family: "Roboto", sans-serif; + font-size: var(--font-size-sm); + padding: 0.25em 0.5em; + border: 1px solid #ccc; + border-radius: 3px; + background-color: #ffffff; + color: #000000; + max-width: 130px; +} +.toolbar-select { max-width: none; } +@media (prefers-color-scheme: dark) { + .toolbar-select, .toolbar-input { + background-color: #141417; + color: #dedede; + border-color: #43434e; + } +} +.toolbar-btn { + font-family: "Roboto", sans-serif; + font-size: var(--font-size-sm); + padding: 0.25em 0.75em; + border: 1px solid #c4953a; + border-radius: 3px; + background-color: transparent; + color: #c4953a; + font-weight: 700; + cursor: pointer; +} +.toolbar-btn:hover { background-color: #c4953a; color: #ffffff; } +@media (prefers-color-scheme: dark) { + .toolbar-btn { border-color: #d8ac55; color: #d8ac55; } + .toolbar-btn:hover { background-color: #d8ac55; color: #141417; } +} +.toolbar-btn:disabled { opacity: 0.4; cursor: default; } +.toolbar-btn:disabled:hover { background-color: transparent; color: #c4953a; } +@media (prefers-color-scheme: dark) { + .toolbar-btn:disabled:hover { color: #d8ac55; } +} +.toolbar-btn--small { font-size: 75%; padding: 0.15em 0.5em; } + +/* -- Jobs Table -------------------------------------------------------- */ +.jobs-table { + width: 100%; + border-collapse: collapse; +} +.jobs-table__th { + text-align: left; + font-size: 75%; + text-transform: uppercase; + letter-spacing: 0.05em; + color: #777; + padding: 0.5em 0.75em; + border-bottom: 2px solid #ddd; +} +@media (prefers-color-scheme: dark) { + .jobs-table__th { color: #a0a0a0; border-bottom-color: #43434e; } +} +.jobs-table__row { cursor: pointer; } +.jobs-table__row:hover { background-color: #f1f5f9; } +@media (prefers-color-scheme: dark) { + .jobs-table__row:hover { background-color: #232327; } +} +.jobs-table__td { + padding: 0.6em 0.75em; + border-bottom: 1px solid #eee; + vertical-align: middle; +} +@media (prefers-color-scheme: dark) { + .jobs-table__td { border-bottom-color: #2a2a2f; } +} + +/* -- Row Number Column ------------------------------------------------ */ +.jobs-table__th--rownum, +.jobs-table__td--rownum { + width: 3em; + text-align: right; + font-variant-numeric: tabular-nums; + color: #999; +} +@media (prefers-color-scheme: dark) { + .jobs-table__td--rownum { color: #666; } +} + +/* -- Sortable Column Header ------------------------------------------- */ +.jobs-table__th--sortable { + cursor: pointer; + user-select: none; +} +.jobs-table__th--sortable:hover { + color: #c4953a; +} +@media (prefers-color-scheme: dark) { + .jobs-table__th--sortable:hover { color: #d8ac55; } +} +.sort-indicator { + font-size: 75%; + margin-left: 0.15em; +} + +/* -- Job Type Badges -------------------------------------------------- */ +.job-type-badge { + display: inline-block; + font-family: "Roboto Mono", monospace; + font-size: 75%; + font-weight: 700; + padding: 0.15em 0.5em; + border-radius: 3px; + text-transform: uppercase; + letter-spacing: 0.03em; +} +.page-title .job-type-badge { + font-size: 40%; + padding: 0.15em 0.45em; + vertical-align: middle; + position: relative; + top: -0.1em; +} +.job-type-badge--publish { background-color: #e8f5e9; color: #2e7d32; } +.job-type-badge--unpublish { background-color: #fff3e0; color: #e65100; } +.job-type-badge--transfer { background-color: #e3f2fd; color: #1565c0; } +.job-type-badge--matrix { background-color: #f3e5f5; color: #7b1fa2; } +.job-type-badge--packageset { background-color: #fce4ec; color: #c62828; } +@media (prefers-color-scheme: dark) { + .job-type-badge--publish { background-color: #1b3a1e; color: #81c784; } + .job-type-badge--unpublish { background-color: #3e2100; color: #ffb74d; } + .job-type-badge--transfer { background-color: #0d2744; color: #64b5f6; } + .job-type-badge--matrix { background-color: #2a1233; color: #ce93d8; } + .job-type-badge--packageset { background-color: #3b1117; color: #ef9a9a; } +} + +/* -- Status Indicators ------------------------------------------------ */ +.job-status { + font-family: "Roboto Mono", monospace; + font-size: var(--font-size-sm); + font-weight: 700; +} +.job-status--pending { color: #777; } +.job-status--running { color: #1565c0; } +.job-status--succeeded { color: #2e7d32; } +.job-status--failed { color: #c62828; } +@media (prefers-color-scheme: dark) { + .job-status--pending { color: #a0a0a0; } + .job-status--running { color: #64b5f6; } + .job-status--succeeded { color: #81c784; } + .job-status--failed { color: #ef9a9a; } +} + +/* -- Running Status Pulse --------------------------------------------- */ +.job-status--running::before { + content: ""; + display: inline-block; + width: 8px; + height: 8px; + border-radius: 50%; + background-color: #1565c0; + margin-right: 0.4em; + animation: pulse 1.5s ease-in-out infinite; +} +@media (prefers-color-scheme: dark) { + .job-status--running::before { background-color: #64b5f6; } +} + +/* -- Job Package / Version -------------------------------------------- */ +.job-package { font-weight: 700; } +.job-version { + font-family: "Roboto Mono", monospace; + font-size: var(--font-size-sm); + color: #777; + margin-left: 0.25em; +} +@media (prefers-color-scheme: dark) { + .job-version { color: #a0a0a0; } +} + +/* -- Breadcrumb Bar --------------------------------------------------- */ +.breadcrumb-bar { + margin-top: 1em; + padding: 0.5em 0.85em; + background-color: #f1f5f9; + border-radius: 3px; + border: 1px solid #e2e8f0; +} +@media (prefers-color-scheme: dark) { + .breadcrumb-bar { + background-color: #1a1a1f; + border-color: #2a2a2f; + } +} +.breadcrumb-bar__inner { + display: flex; + align-items: center; + gap: 0.5em; + font-size: var(--font-size-sm); +} +.breadcrumb-bar__link { + font-weight: 700; +} +.breadcrumb-bar__sep { + color: #999; + font-weight: 300; + user-select: none; +} +@media (prefers-color-scheme: dark) { + .breadcrumb-bar__sep { color: #555; } +} +.breadcrumb-bar__current { + color: #555; + font-weight: 400; +} +@media (prefers-color-scheme: dark) { + .breadcrumb-bar__current { color: #a0a0a0; } +} +.breadcrumb-bar__current .job-type-badge { + font-size: 70%; + padding: 0.1em 0.4em; + vertical-align: middle; + position: relative; + top: -0.05em; +} + +/* -- Job Detail ------------------------------------------------------- */ +.job-detail__timestamps { + display: flex; + flex-direction: column; + gap: 0.35em; + margin-bottom: 1em; +} +.job-detail__ts-row { + display: flex; + align-items: baseline; + gap: 0.75em; +} +.job-detail__ts-label { + flex: 0 0 6.5em; + font-size: 75%; + text-transform: uppercase; + letter-spacing: 0.05em; + color: #777; + font-weight: 700; + text-align: left; +} +@media (prefers-color-scheme: dark) { + .job-detail__ts-label { color: #a0a0a0; } +} +.job-detail__ts-value { + font-family: "Roboto Mono", monospace; + font-size: var(--font-size-sm); +} +.job-detail__section { + margin-bottom: 2em; +} +.job-detail__section-header { + display: flex; + align-items: center; + justify-content: space-between; + margin-bottom: 0.75em; +} +.job-detail__section-title { + margin: 0; + font-size: 1.25em; + font-weight: 700; +} + +/* -- Log Controls ----------------------------------------------------- */ +.log-controls { + display: flex; + align-items: center; + gap: 0.75em; +} + +/* -- Log Viewer ------------------------------------------------------- */ +.log-table { width: 100%; border-collapse: collapse; table-layout: fixed; } +.log-table__th { + text-align: left; + font-size: 75%; + text-transform: uppercase; + letter-spacing: 0.05em; + color: #777; + padding: 0.35em 0.75em 0.35em 0; + border-bottom: 2px solid #ddd; +} +@media (prefers-color-scheme: dark) { + .log-table__th { color: #a0a0a0; border-bottom-color: #43434e; } +} +.log-table__th--rownum { + width: 3em; + text-align: right; + padding-right: 0.75em; +} +.log-table__th--time { width: 13em; } +.log-table__th--level { width: 5em; } +.log-entry__rownum { + font-family: "Roboto Mono", monospace; + font-size: 75%; + color: #999; + text-align: right; + white-space: nowrap; + padding: 0.25em 0.75em 0.25em 0; + vertical-align: baseline; + width: 3em; + font-variant-numeric: tabular-nums; +} +@media (prefers-color-scheme: dark) { + .log-entry__rownum { color: #666; } +} +.log-entry__time { + font-family: "Roboto Mono", monospace; + font-size: 75%; + color: #777; + white-space: nowrap; + padding: 0.25em 0.75em 0.25em 0; + vertical-align: baseline; + width: 13em; +} +@media (prefers-color-scheme: dark) { + .log-entry__time { color: #a0a0a0; } +} +.log-entry__level { + font-family: "Roboto Mono", monospace; + font-size: 75%; + font-weight: 700; + white-space: nowrap; + padding: 0.25em 0.75em 0.25em 0; + vertical-align: baseline; + width: 5em; +} +.log-entry__message { + vertical-align: baseline; +} +.log-level--DEBUG { color: #777; } +.log-level--INFO { color: #1565c0; } +.log-level--WARN { color: #e65100; } +.log-level--NOTICE { color: #c4953a; } +.log-level--ERROR { color: #c62828; } +@media (prefers-color-scheme: dark) { + .log-level--DEBUG { color: #a0a0a0; } + .log-level--INFO { color: #64b5f6; } + .log-level--WARN { color: #ffb74d; } + .log-level--NOTICE { color: #d8ac55; } + .log-level--ERROR { color: #ef9a9a; } +} +.log-entry__text { + font-family: "Roboto Mono", monospace; + font-size: var(--font-size-sm); + margin: 0; + padding: 0; + white-space: pre-wrap; + word-wrap: break-word; + overflow-wrap: break-word; + background: transparent; + color: inherit; +} + +/* -- JSON Viewer ------------------------------------------------------ */ +.json-viewer { + background-color: #f1f5f9; + border-radius: 3px; + padding: 1em; + font-family: "Roboto Mono", monospace; + font-size: var(--font-size-sm); + color: #194a5b; + overflow-x: auto; +} +@media (prefers-color-scheme: dark) { + .json-viewer { background-color: #232327; color: #c1d3da; } +} + +/* -- Utility States --------------------------------------------------- */ +.loading-state, .empty-state, .error-state { + text-align: center; + padding: 3em 1em; + color: #777; +} +@media (prefers-color-scheme: dark) { + .loading-state, .empty-state, .error-state { color: #a0a0a0; } +} +.error-message { color: #c62828; } +@media (prefers-color-scheme: dark) { + .error-message { color: #ef9a9a; } +} + +/* -- Spinner ---------------------------------------------------------- */ +.spinner { + width: 24px; + height: 24px; + border: 3px solid #ddd; + border-top-color: #c4953a; + border-radius: 50%; + animation: spin 0.8s linear infinite; + margin: 0 auto 1em; +} +@media (prefers-color-scheme: dark) { + .spinner { border-color: #43434e; border-top-color: #d8ac55; } +} +.spinner--small { width: 16px; height: 16px; border-width: 2px; } + +/* -- Refresh Indicator ------------------------------------------------ */ +.refresh-indicator { + display: inline-block; + width: 8px; + height: 8px; + border-radius: 50%; + background-color: #2e7d32; + animation: pulse 1.5s ease-in-out infinite; +} +.refresh-indicator--inactive { + background-color: #ccc; + animation: none; +} +@media (prefers-color-scheme: dark) { + .refresh-indicator { background-color: #81c784; } + .refresh-indicator--inactive { background-color: #555; } +} + +/* -- Pagination Nav --------------------------------------------------- */ +.jobs-nav { + display: flex; + align-items: center; + justify-content: center; + gap: 1em; + margin-top: 1em; + padding-top: 1em; +} +.jobs-nav__info { + font-size: var(--font-size-sm); + color: #777; +} +@media (prefers-color-scheme: dark) { + .jobs-nav__info { color: #a0a0a0; } +} +.jobs-nav__btn { + font-family: "Roboto", sans-serif; + font-size: var(--font-size-sm); + padding: 0.25em 0.75em; + border: 1px solid #ccc; + border-radius: 3px; + background-color: transparent; + color: #555; + cursor: pointer; +} +.jobs-nav__btn:hover:not(:disabled) { + background-color: #f1f5f9; + color: #000; +} +.jobs-nav__btn:disabled { + opacity: 0.3; + cursor: default; +} +@media (prefers-color-scheme: dark) { + .jobs-nav__btn { + border-color: #43434e; + color: #a0a0a0; + } + .jobs-nav__btn:hover:not(:disabled) { + background-color: #232327; + color: #dedede; + } +} + +/* -- Animations ------------------------------------------------------- */ +@keyframes pulse { + 0%, 100% { opacity: 1; } + 50% { opacity: 0.3; } +} +@keyframes spin { + to { transform: rotate(360deg); } +} + +/* -- Reduced Motion --------------------------------------------------- */ +@media (prefers-reduced-motion: reduce) { + .spinner, + .job-status--running::before, + .refresh-indicator { + animation: none; + } +} + +/* -- Responsive ------------------------------------------------------- */ +@media (max-width: 64em) { + .jobs-toolbar { + flex-direction: column; + align-items: stretch; + } + .jobs-toolbar__divider { + width: auto; + height: 1px; + align-self: auto; + margin: 8px 0; + } + .jobs-toolbar__zone--filters { flex-direction: row; } + .jobs-toolbar__zone--actions { justify-content: flex-end; } +} +@media (max-width: 38em) { + .jobs-toolbar__zone--filters { flex-direction: column; align-items: stretch; } + .jobs-table__th:nth-child(6), + .jobs-table__td:nth-child(6) { display: none; } + .job-detail__ts-label { flex: 0 0 5.5em; } +} diff --git a/lib/src/Operation.purs b/lib/src/Operation.purs index 83debc9cf..ed005826e 100644 --- a/lib/src/Operation.purs +++ b/lib/src/Operation.purs @@ -52,7 +52,7 @@ import Registry.Location (Location) import Registry.Location as Location import Registry.PackageName (PackageName) import Registry.PackageName as PackageName -import Registry.SSH (Signature(..)) +import Registry.SSH.Signature (Signature(..)) import Registry.Version (Version) import Registry.Version as Version diff --git a/lib/src/SSH.purs b/lib/src/SSH.purs index 9a922f4f1..0e2c6ec6b 100644 --- a/lib/src/SSH.purs +++ b/lib/src/SSH.purs @@ -3,7 +3,7 @@ module Registry.SSH , PrivateKey , PrivateKeyParseError(..) , printPrivateKeyParseError - , Signature(..) + , module Registry.SSH.Signature , parsePublicKey , parsePrivateKey , publicKeyToOwner @@ -17,11 +17,11 @@ import Data.Bifunctor (bimap) import Data.Either (Either(..)) import Data.Function.Uncurried (Fn1, Fn2, Fn3, Fn4, runFn1, runFn2, runFn3, runFn4) import Data.Maybe (Maybe) -import Data.Newtype (class Newtype) import Data.Nullable (Nullable, null) import Data.Nullable as Nullable import Effect.Exception as Exception import Registry.Owner (Owner(..)) +import Registry.SSH.Signature (Signature(..)) -- | A parsed SSH public key which can be used to verify payloads. newtype PublicKey = PublicKey ParsedKey @@ -67,12 +67,6 @@ parsePublicKey key = case parse key of Right parsed | isPrivateKey parsed -> Left $ "Expected public key, but this is a private key of type " <> keyType parsed result -> map PublicKey result --- | A hex-encoded SSH signature -newtype Signature = Signature String - -derive instance Newtype Signature _ -derive newtype instance Eq Signature - foreign import signImpl :: Fn2 ParsedKey String Signature -- | Sign a payload using a parsed SSH key. Returns the signature. diff --git a/lib/src/SSH/Signature.purs b/lib/src/SSH/Signature.purs new file mode 100644 index 000000000..310e5d33c --- /dev/null +++ b/lib/src/SSH/Signature.purs @@ -0,0 +1,20 @@ +-- | The Signature type used for SSH-signed payloads. +-- | +-- | This type is separated from Registry.SSH so that modules needing only +-- | the Signature newtype (such as Registry.Operation) do not transitively +-- | depend on the ssh2 FFI, which is Node.js-only. Browser consumers such +-- | as the dashboard depend on this module, so it must stay free of +-- | Node.js-only FFI. +module Registry.SSH.Signature + ( Signature(..) + ) where + +import Prelude + +import Data.Newtype (class Newtype) + +-- | A hex-encoded SSH signature +newtype Signature = Signature String + +derive instance Newtype Signature _ +derive newtype instance Eq Signature diff --git a/package.json b/package.json index 76bc4e96e..f6a45ea9a 100644 --- a/package.json +++ b/package.json @@ -6,5 +6,9 @@ "app", "foreign", "lib" - ] + ], + "scripts": { + "dashboard:dev": "spago bundle -p registry-dashboard --module Dashboard.Main --platform browser --bundle-type app --outfile ../dashboard/app.js --bundler-args '--watch=forever' --bundler-args '--servedir=./dashboard'", + "dashboard:build": "spago bundle -p registry-dashboard --module Dashboard.Main --platform browser --bundle-type app --outfile ../dashboard/app.js" + } } diff --git a/scripts/spago.yaml b/scripts/spago.yaml index 4d9a26b0e..a3bdb19f1 100644 --- a/scripts/spago.yaml +++ b/scripts/spago.yaml @@ -11,28 +11,17 @@ package: - console - datetime - either - - exceptions - - exists - - filterable + - fetch - foldable-traversable - formatters - json - - lists - - newtype - node-fs - node-path - node-process - - now - - numbers - ordered-collections - - parsing - prelude - - profunctor - - refs - registry-app - registry-foreign - registry-lib - run - strings - - tuples - - variant diff --git a/spago.lock b/spago.lock index f77ac2576..d3b93a367 100644 --- a/spago.lock +++ b/spago.lock @@ -20,6 +20,7 @@ "dotenv", "effect", "either", + "enums", "exceptions", "exists", "fetch", @@ -32,7 +33,6 @@ "httpurple", "identity", "integers", - "js-date", "js-fetch", "js-promise-aff", "js-uri", @@ -50,7 +50,6 @@ "nullable", "numbers", "ordered-collections", - "orders", "parallel", "parsing", "partial", @@ -63,14 +62,12 @@ "run", "safe-coerce", "strings", - "these", "transformers", "tuples", "typelevel-prelude", "unicode", "unsafe-coerce", - "uuidv4", - "variant" + "uuidv4" ] }, "test": { @@ -117,6 +114,45 @@ "dependencies": [] } }, + "registry-dashboard": { + "path": "dashboard", + "core": { + "dependencies": [ + "aff", + "arrays", + "codec-json", + "const", + "control", + "datetime", + "effect", + "either", + "exceptions", + "fetch", + "foldable-traversable", + "formatters", + "halogen", + "halogen-subscriptions", + "integers", + "json", + "lists", + "maybe", + "newtype", + "now", + "parallel", + "prelude", + "registry-lib", + "routing-duplex", + "strings", + "tailrec", + "web-events", + "web-html", + "web-uievents" + ] + }, + "test": { + "dependencies": [] + } + }, "registry-foreign": { "path": "foreign", "core": { @@ -238,31 +274,20 @@ "console", "datetime", "either", - "exceptions", - "exists", - "filterable", + "fetch", "foldable-traversable", "formatters", "json", - "lists", - "newtype", "node-fs", "node-path", "node-process", - "now", - "numbers", "ordered-collections", - "parsing", "prelude", - "profunctor", - "refs", "registry-app", "registry-foreign", "registry-lib", "run", - "strings", - "tuples", - "variant" + "strings" ] }, "test": { @@ -1265,6 +1290,23 @@ "tuples" ] }, + "dom-indexed": { + "type": "registry", + "version": "13.0.0", + "integrity": "sha256-Tr9uDQdmKN4TUGMg1/4KzsVu5zPa8OqKB4N6/S2a8vU=", + "dependencies": [ + "datetime", + "media-types", + "prelude", + "strings", + "web-clipboard", + "web-events", + "web-html", + "web-pointerevents", + "web-touchevents", + "web-uievents" + ] + }, "dotenv": { "type": "registry", "version": "4.0.3", @@ -1529,6 +1571,23 @@ "unsafe-coerce" ] }, + "freeap": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-e7SiV9rg+rVARsU9cxA/02sps7ubogvVgYwj8nWosX4=", + "dependencies": [ + "const", + "either", + "gen", + "lists", + "newtype", + "nonempty", + "prelude", + "tailrec", + "tuples", + "unsafe-coerce" + ] + }, "functions": { "type": "registry", "version": "6.0.0", @@ -1589,6 +1648,92 @@ "tuples" ] }, + "halogen": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-YrUm27QEiE1DyGaGJ5MNLVg4H/P3gnX/NVv1gRtWjB4=", + "dependencies": [ + "aff", + "bifunctors", + "console", + "control", + "dom-indexed", + "effect", + "either", + "exceptions", + "foldable-traversable", + "foreign", + "fork", + "free", + "freeap", + "functions", + "halogen-subscriptions", + "halogen-vdom", + "lazy", + "lists", + "maybe", + "media-types", + "newtype", + "ordered-collections", + "parallel", + "prelude", + "profunctor", + "refs", + "strings", + "tailrec", + "transformers", + "tuples", + "unfoldable", + "unsafe-coerce", + "unsafe-reference", + "web-clipboard", + "web-dom", + "web-events", + "web-file", + "web-html", + "web-touchevents", + "web-uievents" + ] + }, + "halogen-subscriptions": { + "type": "registry", + "version": "2.0.0", + "integrity": "sha256-1eBtVZENgGtKuOY9H0iuYD3dO1CSqmOIyhYe4OhypOU=", + "dependencies": [ + "arrays", + "contravariant", + "control", + "effect", + "foldable-traversable", + "maybe", + "prelude", + "refs", + "safe-coerce", + "unsafe-reference" + ] + }, + "halogen-vdom": { + "type": "registry", + "version": "8.0.0", + "integrity": "sha256-jk6aj/tH630skFVk6mB5Q+0g2zb897KX72T63fJhJ2Y=", + "dependencies": [ + "arrays", + "bifunctors", + "effect", + "foreign", + "foreign-object", + "functions", + "maybe", + "newtype", + "nullable", + "prelude", + "refs", + "tuples", + "unsafe-coerce", + "web-dom", + "web-events" + ] + }, "heterogeneous": { "type": "registry", "version": "0.7.0", @@ -1856,20 +2001,6 @@ "prelude" ] }, - "lcg": { - "type": "registry", - "version": "4.0.0", - "integrity": "sha256-bUYyfXYmjTn7zSpj2hTiePywzsuD80fCjkonsrpdGOw=", - "dependencies": [ - "effect", - "integers", - "maybe", - "numbers", - "partial", - "prelude", - "random" - ] - }, "lists": { "type": "registry", "version": "7.0.0", @@ -2494,56 +2625,6 @@ "tuples" ] }, - "quickcheck": { - "type": "registry", - "version": "8.0.1", - "integrity": "sha256-SfW+maesCt0jnnFhfrgJZGPcWLj8oFcGbcDIVklmdzc=", - "dependencies": [ - "arrays", - "console", - "control", - "effect", - "either", - "enums", - "exceptions", - "foldable-traversable", - "gen", - "identity", - "integers", - "lazy", - "lcg", - "lists", - "maybe", - "newtype", - "nonempty", - "numbers", - "partial", - "prelude", - "record", - "st", - "strings", - "tailrec", - "transformers", - "tuples" - ] - }, - "quickcheck-laws": { - "type": "registry", - "version": "7.0.0", - "integrity": "sha256-hDd4Q99TNlEz9sU0Cssm7n6+BswAq69HL8KqNP5UKOU=", - "dependencies": [ - "arrays", - "console", - "control", - "effect", - "enums", - "foldable-traversable", - "maybe", - "newtype", - "prelude", - "quickcheck" - ] - }, "random": { "type": "registry", "version": "6.0.0", @@ -2753,29 +2834,6 @@ "refs" ] }, - "these": { - "type": "registry", - "version": "6.0.0", - "integrity": "sha256-I2QW4ZpaCf51oV6DeGiT3yeP4/k6G8vUHHXshK4NYc0=", - "dependencies": [ - "arrays", - "bifunctors", - "console", - "control", - "effect", - "foldable-traversable", - "gen", - "invariant", - "lists", - "maybe", - "newtype", - "prelude", - "quickcheck", - "quickcheck-laws", - "tailrec", - "tuples" - ] - }, "transformers": { "type": "registry", "version": "6.1.0", @@ -2913,6 +2971,37 @@ "unsafe-coerce" ] }, + "web-clipboard": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-3CV0txwKddLoj8qBrRjUWbiX0M8+rnOpi1iApr5PEb0=", + "dependencies": [ + "effect", + "functions", + "js-promise", + "maybe", + "nullable", + "prelude", + "unsafe-coerce", + "web-events", + "web-html" + ] + }, + "web-dom": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-rVeqkxChkjqisDvOujy9BMEgGqJkwX3t6g21bXfiG5o=", + "dependencies": [ + "effect", + "enums", + "maybe", + "newtype", + "nullable", + "prelude", + "unsafe-coerce", + "web-events" + ] + }, "web-events": { "type": "registry", "version": "4.0.0", @@ -2952,6 +3041,56 @@ "web-events" ] }, + "web-html": { + "type": "registry", + "version": "4.1.1", + "integrity": "sha256-yOuZJGUxFrivHKpo/jKuKzFZaq6PPPE64ftSysXFssk=", + "dependencies": [ + "effect", + "enums", + "foreign", + "functions", + "js-date", + "maybe", + "media-types", + "newtype", + "nullable", + "prelude", + "unsafe-coerce", + "web-dom", + "web-events", + "web-file", + "web-storage" + ] + }, + "web-pointerevents": { + "type": "registry", + "version": "2.0.0", + "integrity": "sha256-mQbm1V36u3It2WdYMAXtzLBJl3uRAhN4BjeZTw3LWN8=", + "dependencies": [ + "effect", + "maybe", + "prelude", + "unsafe-coerce", + "web-dom", + "web-events", + "web-html", + "web-uievents" + ] + }, + "web-storage": { + "type": "registry", + "version": "5.0.0", + "integrity": "sha256-YJfos55oeKtBStNfoWfeflSy8j+4IDym5eaZtIY7YM4=", + "dependencies": [ + "effect", + "maybe", + "nullable", + "prelude", + "unsafe-coerce", + "web-events" + ] + }, "web-streams": { "type": "registry", "version": "4.0.0", @@ -2966,6 +3105,35 @@ "prelude", "tuples" ] + }, + "web-touchevents": { + "type": "registry", + "version": "4.0.0", + "integrity": "sha256-H02c53BJlHDlAgogj/x8bM7PagJjhMMrMPYy9I7Rf0s=", + "dependencies": [ + "functions", + "maybe", + "nullable", + "prelude", + "unsafe-coerce", + "web-events", + "web-uievents" + ] + }, + "web-uievents": { + "type": "registry", + "version": "5.0.0", + "integrity": "sha256-yh9uVLIGu8wE1+jwLehtfsRfR1eyiShhIMMhBPqKybE=", + "dependencies": [ + "effect", + "enums", + "maybe", + "nullable", + "prelude", + "unsafe-coerce", + "web-events", + "web-html" + ] } } }