From 1db21885df2bd99d65a5aac43bd7fc35ea0ff767 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Sun, 3 Apr 2022 02:33:37 +0200
Subject: [PATCH] server: fix map paths in api
---
server/Handlers.hs | 6 +++---
server/Server.hs | 9 ++++++---
2 files changed, 9 insertions(+), 6 deletions(-)
diff --git a/server/Handlers.hs b/server/Handlers.hs
index d42e74d..39995dc 100644
--- a/server/Handlers.hs
+++ b/server/Handlers.hs
@@ -31,8 +31,8 @@ import Network.WebSockets (PendingConnection, acceptRequest,
import Servant (Handler, err404, throwError)
import Server (JobStatus (..), Org (orgUrl),
RemoteRef (reponame), ServerState,
- Sha1, adjustedPath, getJobStatus,
- unState)
+ Sha1, getJobStatus,
+ unState, adjustedWebPath)
import Worker (Job (Job))
@@ -60,7 +60,7 @@ instance ToJSON MapService where
mapInfo rev mappath MapResult { .. } = A.object
[ "badges" .= mapresultBadges
-- TODO: type-safe url library for adding the slash?
- , "url" .= (orgUrl org <> adjustedPath rev org <> "/" <> toText mappath) ]
+ , "url" .= (orgUrl org <> adjustedWebPath rev org <> "/" <> toText mappath) ]
diff --git a/server/Server.hs b/server/Server.hs
index 0c09314..b07cb58 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -30,7 +30,7 @@ module Server ( loadConfig
, ServerState, emptyState, unState
, JobStatus(..)
, prettySha,getJobStatus,overJobStatus
- , adjustedPath,RealtimeMsg(..),newRealtimeChannel) where
+ , adjustedPath,RealtimeMsg(..),newRealtimeChannel,adjustedWebPath) where
import Universum
@@ -269,9 +269,12 @@ getJobStatus mvar orgslug sha = withMVar mvar $ \state -> pure $ do
-- | the path (relative to a baseurl / webdir) where an adjusted
-- map should go
adjustedPath :: Text -> Org True -> Text -- TODO: filepath library using Text?
-adjustedPath rev Org {..} =
- orgWebdir <> "/" <> (rev <> show orgGeneration)
+adjustedPath rev org@Org {..} =
+ orgWebdir <> "/" <> adjustedWebPath rev org
+adjustedWebPath :: Text -> Org True -> Text
+adjustedWebPath rev Org {..} =
+ rev <> show orgGeneration
newRealtimeChannel :: IO RealtimeChannel
newRealtimeChannel = atomically newBroadcastTChan
--
GitLab