summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-07-15 14:20:38 -0400
committerJoey Hess2017-07-15 17:20:17 -0400
commit5d7bdcde02d667d3f191470c23f8512dcb14f9fa (patch)
tree0d9b4b5f626bb7fe5fc5809c2115b6e68812c290
parent9a9fcc55fcdfd17b7e94e3bfd217c2526aceefcb (diff)
add Propellor.Property.Versioned
New module which allows different versions of a property or host to be written down in a propellor config file. Has many applications, including staged upgrades and rollbacks. Note that it currently only supports RevertableProperty that has the same metatypes for its setup and cleanup sides. And, each RevertableProperty in a version definition needs to have the same metatypes as the others too. I tried a couple of times to add support for differing metatypes, but it got beyond my avilities to do. This commit was sponsored by Jeff Goeke-Smith on Patreon.
-rw-r--r--debian/changelog3
-rw-r--r--doc/todo/differential_update_via_RevertableProperty.mdwn25
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property/Versioned.hs112
4 files changed, 124 insertions, 17 deletions
diff --git a/debian/changelog b/debian/changelog
index cce3338c..e7ec04bc 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,8 @@
propellor (4.3.4) UNRELEASED; urgency=medium
+ * Propellor.Property.Versioned: New module which allows different
+ versions of a property or host to be written down in a propellor config
+ file. Has many applications, including staged upgrades and rollbacks.
* LightDM.autoLogin: Use [Seat:*] rather than the old [SeatDefaults].
The new name has been supported since lightdm 1.15.
diff --git a/doc/todo/differential_update_via_RevertableProperty.mdwn b/doc/todo/differential_update_via_RevertableProperty.mdwn
index 6d65c916..3eb9bc7a 100644
--- a/doc/todo/differential_update_via_RevertableProperty.mdwn
+++ b/doc/todo/differential_update_via_RevertableProperty.mdwn
@@ -101,33 +101,23 @@ Is, perhaps:
data Version = A | B | C
deriving (Enum, Ord)
- foo :: Versioned Host
+ foo :: Versioned Hoso
foo = versionedHost "foo" $ do
ver A someprop
- <|> inVersion [B, C] otherprop
+ <|> othervers otherprop
ver A somerevertableprop
- ver [B, C] somethingelse
+ ver [B, C] newprop
That's ... pretty ok, would hit as least some of the use cases described
above. Seems to need a Reader+Writer monad to implement it,
without passing the Version around explicitly.
-Is it allowable for `somethingelse` to not be revertable?
+Is it allowable for `newprop` to not be revertable?
Once `foo` gets that property, it is never removed if we're moving only
-forwars. On the other hand, perhaps the user will want to roll back to
+forwards. On the other hand, perhaps the user will want to roll back to
version A. Allowing rollbacks seems good, so `inVersion` should only
accept `RevertableProperty`.
-Here's another situation where reversion is not needed:
-
- foo = versionedHost "foo" $ do
- ver A (someprop :: Property)
- <|> ver [B, C] (someprop :: Property)
-
-That feels like an edge case.. And the only way that propellor could tell
-reversion is not needed there is if it could compare the two sides of the
-`<|>`, and there's no Eq.
-
Another interesting case is this:
foo = versionedHost "foo" $ do
@@ -151,5 +141,6 @@ examples above. And that allows composition of properties with versioning:
someprop :: Versioned (Property DebianLike)
someprop = versionedProperty $ do
- ver A foo
- ver [B, C] bar
+ ver A foo <|> ver [B, C] bar
+
+> [[done]] in Propellor.Property.Versioned. --[[Joey]]
diff --git a/propellor.cabal b/propellor.cabal
index 3c2477b9..1bcc1618 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -154,6 +154,7 @@ Library
Propellor.Property.Unbound
Propellor.Property.User
Propellor.Property.Uwsgi
+ Propellor.Property.Versioned
Propellor.Property.XFCE
Propellor.Property.ZFS
Propellor.Property.ZFS.Process
diff --git a/src/Propellor/Property/Versioned.hs b/src/Propellor/Property/Versioned.hs
new file mode 100644
index 00000000..d6517ab9
--- /dev/null
+++ b/src/Propellor/Property/Versioned.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE RankNTypes, FlexibleContexts, TypeFamilies #-}
+
+-- | Versioned properties and hosts.
+--
+-- When importing and using this module, you will need to enable some
+-- language extensions:
+--
+-- > {-# LANGUAGE RankNTypes, FlexibleContexts, TypeFamilies #-}
+--
+-- This module takes advantage of `RevertableProperty` to let propellor
+-- switch cleanly between versions. The way it works is all revertable
+-- properties for other versions than the current version are first
+-- reverted, and then propellor ensures the property for the current
+-- version. This method should work for any combination of revertable
+-- properties.
+--
+-- For example:
+--
+-- > demo :: Versioned Int (RevertableProperty DebianLike DebianLike)
+-- > demo ver =
+-- > ver ( (== 1) --> Apache.modEnabled "foo"
+-- > `requires` Apache.modEnabled "foosupport"
+-- > <|> (== 2) --> Apache.modEnabled "bar"
+-- > <|> (> 2) --> Apache.modEnabled "baz"
+-- > )
+-- >
+-- > foo :: Host
+-- > foo = host "foo.example.com" $ props
+-- > & demo `version` (2 :: Int)
+--
+-- Similarly, a whole Host can be versioned. For example:
+--
+-- > bar :: Versioned Int Host
+-- > bar ver = host "bar.example.com" $ props
+-- > & osDebian Unstable X86_64
+-- > & ver ( (== 1) --> Apache.modEnabled "foo"
+-- > <|> (== 2) --> Apache.modEnabled "bar"
+-- > )
+-- > & ver ( (>= 2) --> Apt.unattendedUpgrades )
+--
+-- Note that some versioning of revertable properties may cause
+-- propellor to do a lot of unnecessary work each time it's run.
+-- Here's an example of such a problem:
+--
+-- > slow :: Versioned Int -> RevertableProperty DebianLike DebianLike
+-- > slow ver =
+-- > ver ( (== 1) --> (Apt.installed "foo" <!> Apt.removed "foo")
+-- > <|> (== 2) --> (Apt.installed "bar" <!> Apt.removed "bar")
+-- > )
+--
+-- Suppose that package bar depends on package foo. Then at version 2,
+-- propellor will remove package foo in order to revert version 1, only
+-- to re-install it since version 2 also needs it installed.
+
+module Propellor.Property.Versioned (Versioned, version, (-->), (<|>)) where
+
+import Propellor
+
+-- | Something that has multiple versions of type `v`.
+type Versioned v t = VersionedBy v -> t
+
+type VersionedBy v
+ = forall metatypes. Combines (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes)
+ => (CombinedType (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes) ~ RevertableProperty metatypes metatypes)
+ => (VerSpec v metatypes -> RevertableProperty metatypes metatypes)
+
+-- | Access a particular version of a Versioned value.
+version :: (Versioned v t) -> v -> t
+version f v = f (processVerSpec v)
+
+-- A specification of versions.
+--
+-- Why is this not a simple list like
+-- [(v -> Bool, RevertableProperty metatypes metatypes)] ?
+-- Using a list would mean the empty list would need to be dealt with,
+-- and processVerSpec does not have a Monoid instance for
+-- RevertableProperty metatypes metatypes in scope, and due to the way the
+-- Versioned type works, the compiler cannot find such an instance.
+--
+-- Also, using this data type allows a nice syntax for creating
+-- VerSpecs, via the `<&>` and `alt` functions.
+data VerSpec v metatypes
+ = Base (v -> Bool, RevertableProperty metatypes metatypes)
+ | More (v -> Bool, RevertableProperty metatypes metatypes) (VerSpec v metatypes)
+
+processVerSpec
+ :: Combines (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes)
+ => (CombinedType (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes) ~ RevertableProperty metatypes metatypes)
+ => v
+ -> VerSpec v metatypes
+ -> RevertableProperty metatypes metatypes
+processVerSpec v (Base (c, p))
+ | c v = p
+ | otherwise = revert p
+processVerSpec v (More (c, p) vs)
+ | c v = processVerSpec v vs `before` p
+ | otherwise = revert p `before` processVerSpec v vs
+
+-- | Specify a function that checks the version, and what
+-- `RevertableProperty` to use if the version matches.
+(-->) :: (v -> Bool) -> RevertableProperty metatypes metatypes -> VerSpec v metatypes
+c --> p = Base (c, p)
+
+-- | Add an alternate version.
+(<|>) :: VerSpec v metatypes -> VerSpec v metatypes -> VerSpec v metatypes
+Base a <|> Base b = More a (Base b)
+Base a <|> More b c = More a (More b c)
+More b c <|> Base a = More a (More b c)
+More a b <|> More c d = More a (More c (b <|> d))
+
+infixl 8 -->
+infixl 2 <|>