server: fix map paths in api

1 files changed, 6 insertions, 3 deletions

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