diff options
Diffstat (limited to '')
| -rw-r--r-- | server/Handlers.hs | 6 | ||||
| -rw-r--r-- | 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 |