override deploy url with PropellorRepo.hasOriginUrl info

* Made the PropellorRepo.hasOriginUrl property override the repository
  url that --spin passes to a host.
* PropellorRepo.hasOriginUrl type changed to include HasInfo. (API change)

This commit was sponsored by Jake Vosloo on Patreon.

1 files changed, 8 insertions, 3 deletions

diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 88d2b473..4a945e82 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -29,6 +29,7 @@ import Propellor.Gpg
 import Propellor.Bootstrap
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
+import Propellor.Property.PropellorRepo (OriginUrl(..))
 import qualified Propellor.Shim as Shim
 import Utility.FileMode
 import Utility.SafeCommand
@@ -220,7 +221,7 @@ updateServer target relay hst connect haveprecompiled privdata = do
 		v <- maybe Nothing readish <$> getMarked fromh statusMarker
 		case v of
 			(Just NeedRepoUrl) -> do
-				sendRepoUrl toh
+				sendRepoUrl hst toh
 				loop
 			(Just NeedPrivData) -> do
 				sendPrivData hn toh privdata
@@ -242,8 +243,12 @@ updateServer target relay hst connect haveprecompiled privdata = do
 				done
 			Nothing -> done
 
-sendRepoUrl :: Handle -> IO ()
-sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
+sendRepoUrl :: Host -> Handle -> IO ()
+sendRepoUrl hst toh = sendMarked toh repoUrlMarker =<< geturl
+  where
+	geturl = case fromInfoVal (fromInfo (hostInfo hst)) of
+		Nothing -> fromMaybe "" <$> getRepoUrl
+		Just (OriginUrl u) -> return u
 
 sendPrivData :: HostName -> Handle -> PrivMap -> IO ()
 sendPrivData hn toh privdata = void $ actionMessage msg $ do