summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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 <|>