From c97285a21ea0e392e8c63c1898ee2deeb34e99a0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 13 Apr 2014 02:28:40 -0400
Subject: propellor spin

---
 Propellor/Attr.hs | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'Propellor/Attr.hs')

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 4bc1c2c7..67ea8b8c 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -8,6 +8,7 @@ import Propellor.Types.Attr
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
 import qualified Data.Map as M
+import Control.Applicative
 
 pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty 
 pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc)
@@ -31,6 +32,13 @@ cnameFor domain mkp =
 addCName :: HostName -> Attr -> Attr
 addCName domain d = d { _cnames = S.insert domain (_cnames d) }
 
+sshPubKey :: String -> AttrProperty
+sshPubKey k = pureAttrProperty ("ssh pubkey known") $
+	\d -> d { _sshPubKey = Just k }
+
+getSshPubKey :: Propellor (Maybe String)
+getSshPubKey = asks _sshPubKey
+
 hostnameless :: Attr
 hostnameless = newAttr (error "hostname Attr not specified")
 
@@ -45,3 +53,12 @@ hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l
 
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
+
+-- | Lifts an action into a different host.
+--
+-- For example, `fromHost hosts "otherhost" getSshPubKey`
+fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
+fromHost l hn getter = case findHost l hn of
+	Nothing -> return Nothing
+	Just h -> liftIO $ Just <$>
+		runReaderT (runWithAttr getter) (hostAttr h)
-- 
cgit v1.3-2-g0d8e