server: fix map paths in api

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