aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Server/Frontend/Routes.hs1
-rw-r--r--lib/Server/Frontend/Tracker.hs22
-rw-r--r--lib/Yesod/Auth/Uffd.hs2
3 files changed, 23 insertions, 2 deletions
diff --git a/lib/Server/Frontend/Routes.hs b/lib/Server/Frontend/Routes.hs
index fa3a9ce..cf6e342 100644
--- a/lib/Server/Frontend/Routes.hs
+++ b/lib/Server/Frontend/Routes.hs
@@ -45,6 +45,7 @@ mkYesodData "Frontend" [parseRoutes|
/ticket/announce/#UUID AnnounceR POST
/ticket/del-announce/#UUID DelAnnounceR GET
+/trackers TrackersR GET
/tracker/#Text TrackerViewR GET
/ticker/announce TickerAnnounceR POST
diff --git a/lib/Server/Frontend/Tracker.hs b/lib/Server/Frontend/Tracker.hs
index 23bbdb9..e3d88ba 100644
--- a/lib/Server/Frontend/Tracker.hs
+++ b/lib/Server/Frontend/Tracker.hs
@@ -1,9 +1,11 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QuasiQuotes #-}
-module Server.Frontend.Tracker (getTrackerViewR) where
+module Server.Frontend.Tracker (getTrackerViewR, getTrackersR) where
import Data.Coerce (coerce)
+import Data.Function ((&))
import Data.Functor ((<&>))
+import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (getCurrentTime)
@@ -16,6 +18,24 @@ import Yesod hiding (update, (=.), (==.))
import OwnTracks.Status
+
+getTrackersR :: Handler Html
+getTrackersR = do
+ trackers <- runDB $ select do
+ (t :& p) <- from $
+ (table @Tracker) `LeftOuterJoin` (table @Ping)
+ `on` \(t :& p) -> just (t ^. TrackerId) ==. p ?. PingTrackerId
+ pure (t, p)
+ & fmap associateJoin
+
+ defaultLayout [whamlet|
+ <h1> Trackers
+ <section>
+ <ul>
+ $forall (trackerId, (Tracker{..}, status)) <- M.toList trackers
+ <li><a href="@{TrackerViewR trackerName}">#{trackerName}</a>
+ |]
+
getTrackerViewR :: Text -> Handler Html
getTrackerViewR name =
runDB (selectOne do
diff --git a/lib/Yesod/Auth/Uffd.hs b/lib/Yesod/Auth/Uffd.hs
index 4d5e5af..8dd0548 100644
--- a/lib/Yesod/Auth/Uffd.hs
+++ b/lib/Yesod/Auth/Uffd.hs
@@ -64,7 +64,7 @@ uffdClient url clientId clientSecret =
}
where oauth2 = OAuth2
{ oauth2ClientId = clientId
- , oauth2ClientSecret = Just clientSecret
+ , oauth2ClientSecret = {- Just -} clientSecret
, oauth2AuthorizeEndpoint =
url { uriPath = "/oauth2/authorize" }
, oauth2TokenEndpoint =