diff options
| -rw-r--r-- | debian/changelog | 3 | ||||
| -rw-r--r-- | doc/todo/differential_update_via_RevertableProperty.mdwn | 25 | ||||
| -rw-r--r-- | propellor.cabal | 1 | ||||
| -rw-r--r-- | src/Propellor/Property/Versioned.hs | 112 |
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 <|> |