@@ -97,6 +97,7 @@ server config dbPool jobTypesRef = Routes
9797 { rFilterResults = (\mFilter -> filterResults config dbPool jobTypesRef mFilter)
9898 , rStaticAssets = serveDirectoryFileServer "assets"
9999 , rEnqueue = enqueueJob config dbPool
100+ , rCancel = cancelJob config dbPool
100101 , rRunNow = runJobNow config dbPool
101102 , rRefreshJobTypes = refreshJobTypes config dbPool jobTypesRef
102103 }
@@ -110,6 +111,13 @@ refreshJobTypes cfg dbPool jobTypesRef = do
110111 atomicModifyIORef' jobTypesRef (\_ -> (allJobTypes, ()))
111112 throwError $ err301{errHeaders=[("Location", toS $ Links.rFilterResults Nothing)]}
112113
114+cancelJob :: Config
115+ -> Pool Connection
116+ -> JobId
117+ -> Handler NoContent
118+cancelJob cfg dbPool jid = do
119+ updateHelper cfg dbPool (Failed, jid, In [Queued, Retry])
120+
113121runJobNow :: Config
114122 -> Pool Connection
115123 -> JobId
@@ -364,7 +372,7 @@ actionsFuture Job{..} = do
364372
365373actionsWaiting :: Job -> Html ()
366374actionsWaiting Job{..} = do
367− form_ [ action_ "#", method_ "post" ] $ do
375+ form_ [ action_ (Links.rCancel jobId), method_ "post" ] $ do
368376 button_ [ class_ "btn btn-danger", type_ "submit" ] $ "Cancel"
369377
370378statusSuccess :: UTCTime -> Job -> Html ()
@@ -412,7 +420,7 @@ resultsPanel t filter@Filter{filterPage} js runningCount = do
412420 div_ [ class_ "card-header bg-secondary text-white" ] $ do
413421 "Currently running "
414422 span_ [ class_ "badge badge-primary badge-primary" ] $ toHtml (show runningCount)
415− div_ [ class_ "currently-running" ] $ div_ [ class_ "" ] $ table_ [ class_ "table table-responsive table-striped table-hover" ] $ do
423+ div_ [ class_ "currently-running" ] $ div_ [ class_ "" ] $ table_ [ class_ "table table-striped table-hover" ] $ do
416424 thead_ [ class_ "thead-dark"] $ do
417425 tr_ $ do
418426 th_ "Job status"