From 5d7bdcde02d667d3f191470c23f8512dcb14f9fa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 15 Jul 2017 14:20:38 -0400 Subject: 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. --- src/Propellor/Property/Versioned.hs | 112 ++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) create mode 100644 src/Propellor/Property/Versioned.hs (limited to 'src/Propellor/Property/Versioned.hs') 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 <|> -- cgit v1.2.3