diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,13 @@ +propellor (4.3.4) unstable; 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. + + -- Joey Hess Sat, 15 Jul 2017 17:22:53 -0400 + propellor (4.3.3) unstable; urgency=medium * Hosts can be configured to build propellor using stack, by adding diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,13 @@ +propellor (4.3.4) unstable; 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. + + -- Joey Hess Sat, 15 Jul 2017 17:22:53 -0400 + propellor (4.3.3) unstable; urgency=medium * Hosts can be configured to build propellor using stack, by adding diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 4.3.3 +Version: 4.3.4 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess @@ -154,6 +154,7 @@ 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/LightDM.hs b/src/Propellor/Property/LightDM.hs --- a/src/Propellor/Property/LightDM.hs +++ b/src/Propellor/Property/LightDM.hs @@ -12,6 +12,6 @@ -- | Configures LightDM to skip the login screen and autologin as a user. autoLogin :: User -> Property DebianLike autoLogin (User u) = "/etc/lightdm/lightdm.conf" `ConfFile.containsIniSetting` - ("SeatDefaults", "autologin-user", u) + ("Seat:*", "autologin-user", u) `describe` "lightdm autologin" `requires` installed diff --git a/src/Propellor/Property/Versioned.hs b/src/Propellor/Property/Versioned.hs new file mode 100644 --- /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 <|>