summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2016-03-27 19:59:20 -0400
committerJoey Hess2016-03-27 19:59:20 -0400
commit9d6dc29555b8499d8ae6c73c891b0b5dc19f83e5 (patch)
tree875311342f65bcdc380b31a14be8def60533b670 /src/Propellor/Property
parent3383d008c7df57e6b5dd066fa1dfa80ac39cdd8e (diff)
improve haddocks and move code around to make them more clear
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Chroot.hs3
-rw-r--r--src/Propellor/Property/Concurrent.hs2
-rw-r--r--src/Propellor/Property/Conductor.hs13
-rw-r--r--src/Propellor/Property/Dns.hs2
-rw-r--r--src/Propellor/Property/Docker.hs3
-rw-r--r--src/Propellor/Property/FreeBSD/Pkg.hs4
-rw-r--r--src/Propellor/Property/List.hs2
-rw-r--r--src/Propellor/Property/Partition.hs1
-rw-r--r--src/Propellor/Property/Scheduled.hs1
9 files changed, 20 insertions, 11 deletions
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 811b5baa..09047ce5 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -23,6 +23,7 @@ import Propellor.Container
import Propellor.Types.CmdLine
import Propellor.Types.Chroot
import Propellor.Types.Info
+import Propellor.Types.Core
import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Systemd.Core as Systemd
@@ -151,7 +152,7 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
- p `addInfoProperty` chrootInfo c
+ p `setInfoProperty` chrootInfo c
chrootInfo :: Chroot -> Info
chrootInfo (Chroot loc _ h) = mempty `addInfo`
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index ace85a3c..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
) where
import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
import Control.Concurrent
import qualified Control.Concurrent.Async as A
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ab747acc..8aa18d20 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,16 +83,17 @@ import qualified Propellor.Property.Ssh as Ssh
import qualified Data.Set as S
-- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
class Conductable c where
conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
instance Conductable Host where
- -- | Conduct the specified host.
conducts h = conductorFor h <!> notConductorFor h
--- | Each host in the list will be conducted in turn. Failure to conduct
--- one host does not prevent conducting subsequent hosts in the list, but
--- will be propagated as an overall failure of the property.
instance Conductable [Host] where
conducts hs =
propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
@@ -246,7 +247,7 @@ orchestrate' h (Conductor c l)
-- to have any effect.
conductorFor :: Host -> Property (HasInfo + UnixLike)
conductorFor h = go
- `addInfoProperty` (toInfo (ConductorFor [h]))
+ `setInfoProperty` (toInfo (ConductorFor [h]))
`requires` setupRevertableProperty (conductorKnownHost h)
`requires` Ssh.installed
where
@@ -270,7 +271,7 @@ conductorFor h = go
-- Reverts conductorFor.
notConductorFor :: Host -> Property (HasInfo + UnixLike)
notConductorFor h = (doNothing :: Property UnixLike)
- `addInfoProperty` (toInfo (NotConductorFor [h]))
+ `setInfoProperty` (toInfo (NotConductorFor [h]))
`describe` desc
`requires` undoRevertableProperty (conductorKnownHost h)
where
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 2b5596bd..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -81,7 +81,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
(partialzone, zonewarnings) = genZone indomain hostmap domain soa
baseprop = primaryprop
- `addInfoProperty` (toInfo (addNamedConf conf))
+ `setInfoProperty` (toInfo (addNamedConf conf))
primaryprop :: Property DebianLike
primaryprop = property ("dns primary for " ++ domain) $ do
sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ddefef15..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,6 +48,7 @@ module Propellor.Property.Docker (
import Propellor.Base hiding (init)
import Propellor.Types.Docker
import Propellor.Types.Container
+import Propellor.Types.Core
import Propellor.Types.CmdLine
import Propellor.Types.Info
import Propellor.Container
@@ -183,7 +184,7 @@ imagePulled ctr = pulled `describe` msg
propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
- p `addInfoProperty'` dockerinfo
+ p `addInfoProperty` dockerinfo
where
dockerinfo = dockerInfo $
mempty { _dockerContainers = M.singleton cn h }
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6c775b94..704c1db9 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -51,7 +51,7 @@ update =
go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
in
(property "pkg update has run" go :: Property FreeBSD)
- `addInfoProperty` (toInfo (PkgUpdate ""))
+ `setInfoProperty` (toInfo (PkgUpdate ""))
newtype PkgUpgrade = PkgUpgrade String
deriving (Typeable, Monoid, Show)
@@ -68,7 +68,7 @@ upgrade =
go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
in
(property "pkg upgrade has run" go :: Property FreeBSD)
- `addInfoProperty` (toInfo (PkgUpdate ""))
+ `setInfoProperty` (toInfo (PkgUpdate ""))
`requires` update
type Package = String
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index a8b8347a..0eec04c7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -13,6 +13,8 @@ module Propellor.Property.List (
) where
import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
import Propellor.PropAccum
import Propellor.Engine
import Propellor.Exception
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 291d4168..2bf5b927 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -3,6 +3,7 @@
module Propellor.Property.Partition where
import Propellor.Base
+import Propellor.Types.Core
import qualified Propellor.Property.Apt as Apt
import Utility.Applicative
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 95e4e362..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -10,6 +10,7 @@ module Propellor.Property.Scheduled
) where
import Propellor.Base
+import Propellor.Types.Core
import Utility.Scheduled
import Data.Time.Clock