summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--config-joey.hs4
-rw-r--r--debian/changelog18
-rw-r--r--doc/todo/RevertableProperty_with_NoInfo.mdwn30
-rw-r--r--src/Propellor/PropAccum.hs4
-rw-r--r--src/Propellor/Property.hs2
-rw-r--r--src/Propellor/Property/Apache.hs6
-rw-r--r--src/Propellor/Property/Apt.hs4
-rw-r--r--src/Propellor/Property/Chroot.hs4
-rw-r--r--src/Propellor/Property/Conductor.hs6
-rw-r--r--src/Propellor/Property/Debootstrap.hs2
-rw-r--r--src/Propellor/Property/DiskImage.hs8
-rw-r--r--src/Propellor/Property/Dns.hs8
-rw-r--r--src/Propellor/Property/DnsSec.hs4
-rw-r--r--src/Propellor/Property/Docker.hs2
-rw-r--r--src/Propellor/Property/Git.hs2
-rw-r--r--src/Propellor/Property/Nginx.hs2
-rw-r--r--src/Propellor/Property/Prosody.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs4
-rw-r--r--src/Propellor/Property/Ssh.hs2
-rw-r--r--src/Propellor/Property/Systemd.hs22
-rw-r--r--src/Propellor/Property/Uwsgi.hs2
-rw-r--r--src/Propellor/Types.hs130
22 files changed, 181 insertions, 87 deletions
diff --git a/config-joey.hs b/config-joey.hs
index 8de259b3..34b48027 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -515,13 +515,13 @@ myDnsSecondary = propertyList "dns secondary for all my domains" $ props
& Dns.secondary hosts "ikiwiki.info"
& Dns.secondary hosts "olduse.net"
-branchableSecondary :: RevertableProperty
+branchableSecondary :: RevertableProperty HasInfo
branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
-- Currently using kite (ns4) as primary with secondaries
-- elephant (ns3) and gandi.
-- kite handles all mail.
-myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty
+myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty HasInfo
myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain
(Dns.mkSOA "ns4.kitenet.net" 100) $
[ (RootDomain, NS $ AbsDomain "ns4.kitenet.net")
diff --git a/debian/changelog b/debian/changelog
index ba94f6bf..6b3f6940 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,14 +1,24 @@
propellor (2.13.0) UNRELEASED; urgency=medium
- * Added Propellor.Property.Concurrent for concurrent properties.
- (Note that no output multiplexing is currently done.)
+ * RevertableProperty used to be assumed to contain info, but this is
+ now made explicit, with RevertableProperty HasInfo or
+ RevertableProperty NoInfo. (API change)
+ Transition guide:
+ - If you define a RevertableProperty, expect some type check
+ failures like: "Expecting one more argument to ‘RevertableProperty’".
+ - Change it to "RevertableProperty NoInfo"
+ - The compiler will then tell you if it needs "HasInfo" instead.
+ - If you have code that uses the RevertableProperty constructor
+ that fails to type check, use the more powerful <!> operator
+ instead to create the RevertableProperty.
* Various property combinators that combined a RevertableProperty
with a non-revertable property used to yield a RevertableProperty.
This was a bug, because the combined property could not be fully
- reverted in many cases. Fixed by making the combined property
- instead be a Property HasInfo.
+ reverted in many cases, and the result is now a non-revertable property.
* combineWith now takes an additional parameter to control how revert
actions are combined (API change).
+ * Added Propellor.Property.Concurrent for concurrent properties.
+ (Note that no output multiplexing is currently done.)
* Add File.isCopyOf. Thanks, Per Olofsson.
-- Joey Hess <id@joeyh.name> Sat, 24 Oct 2015 15:16:45 -0400
diff --git a/doc/todo/RevertableProperty_with_NoInfo.mdwn b/doc/todo/RevertableProperty_with_NoInfo.mdwn
index 3b4a61a9..1aea0a04 100644
--- a/doc/todo/RevertableProperty_with_NoInfo.mdwn
+++ b/doc/todo/RevertableProperty_with_NoInfo.mdwn
@@ -16,3 +16,33 @@ a mouthful!
Since only 2 places in the propellor source code currently need to deal
with this, it doesn't currently seem worth making the change, unless a less
intrusive way can be found.
+
+> Hmm.. I'm not sure what I meant by that last paragraph, but I'm sure
+> this wart is annoying in more than 2 places by now. --[[Joey]]
+
+> Would be nice to instead have `RevertableProperty i`, where the i was inherited
+> from the currently active property. This would be less of a mouthful,
+> and models the info transfer correctly. Ie, if I have a
+> RevertableProperty that includes dns settings on its setup side,
+> reverting it means dropping those dns settings, so the result is NoInfo.
+
+> Unfortunately, when I tried to implement this, the types prevented it.
+> In particular, anything to do with the second property in a
+> `RevertableProperty i` is a problem because we don't know what
+> type of Property it is. For example:
+
+ data RevertableProperty i where
+ RIProperty :: Property HasInfo -> Property i -> RevertableProperty HasInfo
+ RSProperty :: Property NoInfo -> Property i -> RevertableProperty NoInfo
+
+ activeProperty :: RevertableProperty i -> Property i
+ activeProperty (RIProperty p _) = p
+ activeProperty (RSProperty p _) = p
+
+ inactiveProperty :: RevertableProperty i -> Property x
+
+> The x is unknown and cannot be deduced from the available types.
+>
+> What could be done, instead, is to make a `RevertableProperty i` specify
+> the info of both its sides. While this doesn't perfectly model
+> the info propigation, the types work. [[done]] --[[Joey]]
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 3c50cf32..85a30af5 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports, FlexibleContexts #-}
module Propellor.PropAccum
( host
@@ -46,7 +46,7 @@ class PropAccum h where
(&^) = addPropFront
-- | Adds a property in reverted form.
-(!) :: PropAccum h => h -> RevertableProperty -> h
+(!) :: IsProp (RevertableProperty i) => PropAccum h => h -> RevertableProperty i -> h
h ! p = h & revert p
infixl 1 &
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index d80d9c1f..e967cac9 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -201,7 +201,7 @@ withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
-- | Undoes the effect of a RevertableProperty.
-revert :: RevertableProperty -> RevertableProperty
+revert :: RevertableProperty i -> RevertableProperty i
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
makeChange :: IO () -> Propellor Result
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index 91b2e6a2..c2f49cff 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -16,7 +16,7 @@ reloaded = Service.reloaded "apache2"
-- | A basic virtual host, publishing a directory, and logging to
-- the combined apache log file.
-virtualHost :: HostName -> Port -> FilePath -> RevertableProperty
+virtualHost :: HostName -> Port -> FilePath -> RevertableProperty NoInfo
virtualHost hn (Port p) docroot = siteEnabled hn
[ "<VirtualHost *:"++show p++">"
, "ServerName "++hn++":"++show p
@@ -30,7 +30,7 @@ virtualHost hn (Port p) docroot = siteEnabled hn
type ConfigFile = [String]
-siteEnabled :: HostName -> ConfigFile -> RevertableProperty
+siteEnabled :: HostName -> ConfigFile -> RevertableProperty NoInfo
siteEnabled hn cf = enable <!> disable
where
enable = combineProperties ("apache site enabled " ++ hn)
@@ -59,7 +59,7 @@ siteAvailable hn cf = combineProperties ("apache site available " ++ hn) $
where
comment = "# deployed with propellor, do not modify"
-modEnabled :: String -> RevertableProperty
+modEnabled :: String -> RevertableProperty NoInfo
modEnabled modname = enable <!> disable
where
enable = check (not <$> isenabled) $
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 14f170af..fd6230e8 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -212,7 +212,7 @@ autoRemove = runApt ["-y", "autoremove"]
`describe` "apt autoremove"
-- | Enables unattended upgrades. Revert to disable.
-unattendedUpgrades :: RevertableProperty
+unattendedUpgrades :: RevertableProperty NoInfo
unattendedUpgrades = enable <!> disable
where
enable = setup True
@@ -272,7 +272,7 @@ data AptKey = AptKey
, pubkey :: String
}
-trustsKey :: AptKey -> RevertableProperty
+trustsKey :: AptKey -> RevertableProperty NoInfo
trustsKey k = trustsKey' k <!> untrustKey k
trustsKey' :: AptKey -> Property NoInfo
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 771c4b99..20871a12 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -116,10 +116,10 @@ bootstrapped bootstrapper location = Chroot location bootstrapper h
-- Reverting this property removes the chroot. Anything mounted inside it
-- is first unmounted. Note that it does not ensure that any processes
-- that might be running inside the chroot are stopped.
-provisioned :: Chroot -> RevertableProperty
+provisioned :: Chroot -> RevertableProperty HasInfo
provisioned c = provisioned' (propagateChrootInfo c) c False
-provisioned' :: (Property HasInfo -> Property HasInfo) -> Chroot -> Bool -> RevertableProperty
+provisioned' :: (Property HasInfo -> Property HasInfo) -> Chroot -> Bool -> RevertableProperty HasInfo
provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
(propigator $ propertyList (chrootDesc c "exists") [setup])
<!>
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ed46601d..0d275b91 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,7 +83,7 @@ import qualified Data.Set as S
-- | Class of things that can be conducted.
class Conductable c where
- conducts :: c -> RevertableProperty
+ conducts :: c -> RevertableProperty HasInfo
instance Conductable Host where
-- | Conduct the specified host.
@@ -268,7 +268,7 @@ notConductorFor h = infoProperty desc (return NoChange) (addInfo mempty (NotCond
where
desc = "not " ++ cdesc (hostName h)
-conductorKnownHost :: Host -> RevertableProperty
+conductorKnownHost :: Host -> RevertableProperty NoInfo
conductorKnownHost h =
mk Ssh.knownHost
<!>
@@ -290,7 +290,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h')
-- Use this property to let the specified conductor ssh in and run propellor.
-conductedBy :: Host -> RevertableProperty
+conductedBy :: Host -> RevertableProperty NoInfo
conductedBy h = (setup <!> teardown)
`describe` ("conducted by " ++ hostName h)
where
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index f8981591..61912b32 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -98,7 +98,7 @@ extractSuite (System (Ubuntu r) _) = Just r
-- When necessary, falls back to installing debootstrap from source.
-- Note that installation from source is done by downloading the tarball
-- from a Debian mirror, with no cryptographic verification.
-installed :: RevertableProperty
+installed :: RevertableProperty NoInfo
installed = install <!> remove
where
install = withOS "debootstrap installed" $ \o ->
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 90d0bcc6..5b8619ba 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -69,16 +69,16 @@ type DiskImage = FilePath
-- Note that the disk image file is reused if it already exists,
-- to avoid expensive IO to generate a new one. And, it's updated in-place,
-- so its contents are undefined during the build process.
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
imageBuilt = imageBuilt' False
-- | Like 'built', but the chroot is deleted and rebuilt from scratch each
-- time. This is more expensive, but useful to ensure reproducible results
-- when the properties of the chroot have been changed.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
imageRebuilt = imageBuilt' True
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
imageBuilt' rebuild img mkchroot tabletype final partspec =
imageBuiltFrom img chrootdir tabletype final partspec
`requires` Chroot.provisioned chroot
@@ -99,7 +99,7 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
& Apt.cacheCleaned
-- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty NoInfo
imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
where
desc = img ++ " built from " ++ chrootdir
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 4c2f787f..adc12930 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -60,7 +60,7 @@ import Data.List
--
-- In either case, the secondary dns server Host should have an ipv4 and/or
-- ipv6 property defined.
-primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
+primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty HasInfo
primary hosts domain soa rs = setup <!> cleanup
where
setup = setupPrimary zonefile id hosts domain soa rs
@@ -152,7 +152,7 @@ cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
-- This is different from the serial number used by 'primary', so if you
-- want to later disable DNSSEC you will need to adjust the serial number
-- passed to mkSOA to ensure it is larger.
-signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
+signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty HasInfo
signedPrimary recurrance hosts domain soa rs = setup <!> cleanup
where
setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
@@ -184,12 +184,12 @@ signedPrimary recurrance hosts domain soa rs = setup <!> cleanup
--
-- Note that if a host is declared to be a primary and a secondary dns
-- server for the same domain, the primary server config always wins.
-secondary :: [Host] -> Domain -> RevertableProperty
+secondary :: [Host] -> Domain -> RevertableProperty HasInfo
secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
-- | This variant is useful if the primary server does not have its DNS
-- configured via propellor.
-secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty
+secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty HasInfo
secondaryFor masters hosts domain = setup <!> cleanup
where
setup = pureInfoProperty desc (addNamedConf conf)
diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs
index c0aa1302..1ba459e6 100644
--- a/src/Propellor/Property/DnsSec.hs
+++ b/src/Propellor/Property/DnsSec.hs
@@ -7,7 +7,7 @@ import qualified Propellor.Property.File as File
--
-- signedPrimary uses this, so this property does not normally need to be
-- used directly.
-keysInstalled :: Domain -> RevertableProperty
+keysInstalled :: Domain -> RevertableProperty HasInfo
keysInstalled domain = setup <!> cleanup
where
setup = propertyList "DNSSEC keys installed" $
@@ -37,7 +37,7 @@ keysInstalled domain = setup <!> cleanup
--
-- signedPrimary uses this, so this property does not normally need to be
-- used directly.
-zoneSigned :: Domain -> FilePath -> RevertableProperty
+zoneSigned :: Domain -> FilePath -> RevertableProperty HasInfo
zoneSigned domain zonefile = setup <!> cleanup
where
setup = check needupdate (forceZoneSigned domain zonefile)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 394c4271..2b0e7e7e 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -123,7 +123,7 @@ container cn image = Container image (Host cn [] info)
--
-- Reverting this property ensures that the container is stopped and
-- removed.
-docked :: Container -> RevertableProperty
+docked :: Container -> RevertableProperty HasInfo
docked ctr@(Container _ h) =
(propagateContainerInfo ctr (go "docked" setup))
<!>
diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs
index d69fe250..8937d21a 100644
--- a/src/Propellor/Property/Git.hs
+++ b/src/Propellor/Property/Git.hs
@@ -11,7 +11,7 @@ import Data.List
-- using git-daemon, run from inetd.
--
-- Note that reverting this property does not remove or stop inetd.
-daemonRunning :: FilePath -> RevertableProperty
+daemonRunning :: FilePath -> RevertableProperty NoInfo
daemonRunning exportdir = setup <!> unsetup
where
setup = containsLine conf (mkl "tcp4")
diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs
index c9b4d8fd..c28dcc01 100644
--- a/src/Propellor/Property/Nginx.hs
+++ b/src/Propellor/Property/Nginx.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.Service as Service
type ConfigFile = [String]
-siteEnabled :: HostName -> ConfigFile -> RevertableProperty
+siteEnabled :: HostName -> ConfigFile -> RevertableProperty NoInfo
siteEnabled hn cf = enable <!> disable
where
enable = siteVal hn `File.isSymlinkedTo` siteValRelativeCfg hn
diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs
index 0e379e63..f2d80ae4 100644
--- a/src/Propellor/Property/Prosody.hs
+++ b/src/Propellor/Property/Prosody.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
type Conf = String
-confEnabled :: Conf -> ConfigFile -> RevertableProperty
+confEnabled :: Conf -> ConfigFile -> RevertableProperty NoInfo
confEnabled conf cf = enable <!> disable
where
enable = dir `File.isSymlinkedTo` target
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 92903e9a..d6db6813 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -298,7 +298,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
, " </Directory>"
]
-apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty
+apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty NoInfo
apacheSite hn withssl middle = Apache.siteEnabled hn $ apachecfg hn withssl middle
apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
@@ -921,7 +921,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
, "rewriterule (.*) http://joeyh.name$1 [r]"
]
-userDirHtml :: Property HasInfo
+userDirHtml :: Property NoInfo
userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
`onChange` Apache.reloaded
`requires` Apache.modEnabled "userdir"
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 60121336..304ed5cc 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -115,7 +115,7 @@ dotFile f user = do
-- ports it is configured to listen on.
--
-- Revert to prevent it listening on a particular port.
-listenPort :: Int -> RevertableProperty
+listenPort :: Int -> RevertableProperty NoInfo
listenPort port = enable <!> disable
where
portline = "Port " ++ show port
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 8761d842..42ff8e57 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -93,7 +93,7 @@ disabled n = trivial $ cmdProperty "systemctl" ["disable", n]
`describe` ("service " ++ n ++ " disabled")
-- | Masks a systemd service.
-masked :: ServiceName -> RevertableProperty
+masked :: ServiceName -> RevertableProperty NoInfo
masked n = systemdMask <!> systemdUnmask
where
systemdMask = trivial $ cmdProperty "systemctl" ["mask", n]
@@ -206,7 +206,7 @@ container name system mkchroot = Container name c h
--
-- Reverting this property stops the container, removes the systemd unit,
-- and deletes the chroot and all its contents.
-nspawned :: Container -> RevertableProperty
+nspawned :: Container -> RevertableProperty HasInfo
nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
p `describe` ("nspawned " ++ name)
where
@@ -231,7 +231,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
-- | Sets up the service file for the container, and then starts
-- it running.
-nspawnService :: Container -> ChrootCfg -> RevertableProperty
+nspawnService :: Container -> ChrootCfg -> RevertableProperty NoInfo
nspawnService (Container name _ _) cfg = setup <!> teardown
where
service = nspawnServiceName name
@@ -282,7 +282,7 @@ nspawnServiceParams (SystemdNspawnCfg ps) =
--
-- This uses nsenter to enter the container, by looking up the pid of the
-- container's init process and using its namespace.
-enterScript :: Container -> RevertableProperty
+enterScript :: Container -> RevertableProperty NoInfo
enterScript c@(Container name _ _) = setup <!> teardown
where
setup = combineProperties ("generated " ++ enterScriptFile c)
@@ -328,7 +328,7 @@ mungename = replace "/" "_"
-- When there is no leading dash, "--" is prepended to the parameter.
--
-- Reverting the property will remove a parameter, if it's present.
-containerCfg :: String -> RevertableProperty
+containerCfg :: String -> RevertableProperty HasInfo
containerCfg p = RevertableProperty (mk True) (mk False)
where
mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
@@ -340,18 +340,18 @@ containerCfg p = RevertableProperty (mk True) (mk False)
-- | Bind mounts </etc/resolv.conf> from the host into the container.
--
-- This property is enabled by default. Revert it to disable it.
-resolvConfed :: RevertableProperty
+resolvConfed :: RevertableProperty HasInfo
resolvConfed = containerCfg "bind=/etc/resolv.conf"
-- | Link the container's journal to the host's if possible.
-- (Only works if the host has persistent journal enabled.)
--
-- This property is enabled by default. Revert it to disable it.
-linkJournal :: RevertableProperty
+linkJournal :: RevertableProperty HasInfo
linkJournal = containerCfg "link-journal=try-guest"
-- | Disconnect networking of the container from the host.
-privateNetwork :: RevertableProperty
+privateNetwork :: RevertableProperty HasInfo
privateNetwork = containerCfg "private-network"
class Publishable a where
@@ -389,7 +389,7 @@ instance Publishable (Proto, Bound Port) where
-- > & Systemd.running Systemd.networkd
-- > & Systemd.publish (Port 80 ->- Port 8080)
-- > & Apt.installedRunning "apache2"
-publish :: Publishable p => p -> RevertableProperty
+publish :: Publishable p => p -> RevertableProperty HasInfo
publish p = containerCfg $ "--port=" ++ toPublish p
class Bindable a where
@@ -402,9 +402,9 @@ instance Bindable (Bound FilePath) where
toBind v = hostSide v ++ ":" ++ containerSide v
-- | Bind mount a file or directory from the host into the container.
-bind :: Bindable p => p -> RevertableProperty
+bind :: Bindable p => p -> RevertableProperty HasInfo
bind p = containerCfg $ "--bind=" ++ toBind p
-- | Read-only mind mount.
-bindRo :: Bindable p => p -> RevertableProperty
+bindRo :: Bindable p => p -> RevertableProperty HasInfo
bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
diff --git a/src/Propellor/Property/Uwsgi.hs b/src/Propellor/Property/Uwsgi.hs
index 7de1a85a..9748f16d 100644
--- a/src/Propellor/Property/Uwsgi.hs
+++ b/src/Propellor/Property/Uwsgi.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
type AppName = String
-appEnabled :: AppName -> ConfigFile -> RevertableProperty
+appEnabled :: AppName -> ConfigFile -> RevertableProperty NoInfo
appEnabled an cf = enable <!> disable
where
enable = appVal an `File.isSymlinkedTo` appValRelativeCfg an
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 06f0935d..fa24786c 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -156,12 +156,6 @@ propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a
-instance Show (Property i) where
- show p = "property " ++ show (propertyDesc p)
-
-instance Show RevertableProperty where
- show (RevertableProperty p _) = "property " ++ show (propertyDesc p)
-
-- | Changes the action that is performed to satisfy a property.
adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
@@ -175,6 +169,9 @@ propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d
+instance Show (Property i) where
+ show p = "property " ++ show (propertyDesc p)
+
-- | A Property can include a list of child properties that it also
-- satisfies. This allows them to be introspected to collect their info, etc.
propertyChildren :: Property i -> [Property i]
@@ -183,11 +180,23 @@ propertyChildren (SProperty _ _ cs) = cs
-- | A property that can be reverted. The first Property is run
-- normally and the second is run when it's reverted.
-data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
+data RevertableProperty i = RevertableProperty (Property i) (Property i)
+
+instance Show (RevertableProperty i) where
+ show (RevertableProperty p _) = show p
--- | Shorthand to construct a revertable property.
-(<!>) :: Property i1 -> Property i2 -> RevertableProperty
-p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
+class MkRevertableProperty i1 i2 where
+ -- | Shorthand to construct a revertable property.
+ (<!>) :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2)
+
+instance MkRevertableProperty HasInfo HasInfo where
+ x <!> y = RevertableProperty x y
+instance MkRevertableProperty NoInfo NoInfo where
+ x <!> y = RevertableProperty x y
+instance MkRevertableProperty NoInfo HasInfo where
+ x <!> y = RevertableProperty (toProp x) y
+instance MkRevertableProperty HasInfo NoInfo where
+ x <!> y = RevertableProperty x (toProp y)
-- | Class of types that can be used as properties of a host.
class IsProp p where
@@ -210,35 +219,43 @@ instance IsProp (Property NoInfo) where
getDesc = propertyDesc
getInfoRecursive _ = mempty
-instance IsProp RevertableProperty where
- -- | Sets the description of both sides.
- setDesc (RevertableProperty p1 p2) d =
- RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
+instance IsProp (RevertableProperty HasInfo) where
+ setDesc = setDescR
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
-- | Return the Info of the currently active side.
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
+instance IsProp (RevertableProperty NoInfo) where
+ setDesc = setDescR
+ getDesc (RevertableProperty p1 _) = getDesc p1
+ toProp (RevertableProperty p1 _) = toProp p1
+ getInfoRecursive (RevertableProperty _ _) = mempty
+
+-- | Sets the description of both sides.
+setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i
+setDescR (RevertableProperty p1 p2) d =
+ RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
-- | Type level calculation of the type that results from combining two
-- types of properties.
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
-type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
+type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y)
-- When only one of the properties is revertable, the combined property is
-- not fully revertable, so is not a RevertableProperty.
-type instance CombinedType RevertableProperty (Property NoInfo) = Property HasInfo
-type instance CombinedType RevertableProperty (Property HasInfo) = Property HasInfo
-type instance CombinedType (Property NoInfo) RevertableProperty = Property HasInfo
-type instance CombinedType (Property HasInfo) RevertableProperty = Property HasInfo
+type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y)
+type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y)
+
+type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result
class Combines x y where
-- | Combines together two properties, yielding a property that
-- has the description and info of the first, and that has the second
-- property as a child.
combineWith
- :: (Propellor Result -> Propellor Result -> Propellor Result)
+ :: ResultCombiner
-- ^ How to combine the actions to satisfy the properties.
- -> (Propellor Result -> Propellor Result -> Propellor Result)
+ -> ResultCombiner
-- ^ Used when combining revertable properties, to combine
-- their reversion actions.
-> x
@@ -261,20 +278,57 @@ instance Combines (Property NoInfo) (Property NoInfo) where
combineWith f _ (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
SProperty d1 (f a1 a2) (y : cs1)
-instance Combines RevertableProperty RevertableProperty where
- combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
- RevertableProperty
- (combineWith sf tf s1 s2)
- (combineWith tf sf t1 t2)
-
-instance Combines RevertableProperty (Property HasInfo) where
- combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
-
-instance Combines RevertableProperty (Property NoInfo) where
- combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
-
-instance Combines (Property HasInfo) RevertableProperty where
- combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
-
-instance Combines (Property NoInfo) RevertableProperty where
- combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
+instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty NoInfo) (Property HasInfo) where
+ combineWith = combineWithRP
+instance Combines (RevertableProperty NoInfo) (Property NoInfo) where
+ combineWith = combineWithRP
+instance Combines (RevertableProperty HasInfo) (Property HasInfo) where
+ combineWith = combineWithRP
+instance Combines (RevertableProperty HasInfo) (Property NoInfo) where
+ combineWith = combineWithRP
+instance Combines (Property HasInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithPR
+instance Combines (Property NoInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithPR
+instance Combines (Property HasInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithPR
+instance Combines (Property NoInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithPR
+
+combineWithRR
+ :: Combines (Property x) (Property y)
+ => ResultCombiner
+ -> ResultCombiner
+ -> RevertableProperty x
+ -> RevertableProperty y
+ -> RevertableProperty (CInfo x y)
+combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
+ RevertableProperty
+ (combineWith sf tf s1 s2)
+ (combineWith tf sf t1 t2)
+
+combineWithRP
+ :: Combines (Property i) y
+ => (Propellor Result -> Propellor Result -> Propellor Result)
+ -> (Propellor Result -> Propellor Result -> Propellor Result)
+ -> RevertableProperty i
+ -> y
+ -> CombinedType (Property i) y
+combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y
+
+combineWithPR
+ :: Combines x (Property i)
+ => (Propellor Result -> Propellor Result -> Propellor Result)
+ -> (Propellor Result -> Propellor Result -> Propellor Result)
+ -> x
+ -> RevertableProperty i
+ -> CombinedType x (Property i)
+combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y