From 9e87165bd8d9b0c80e4efa5ebae22e913ecb18a1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 15:08:43 -0400 Subject: initial type-level OS list --- src/Propellor/Types/OS/Typelevel.hs | 92 +++++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 src/Propellor/Types/OS/Typelevel.hs diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs new file mode 100644 index 00000000..70d82e43 --- /dev/null +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances #-} + +module Propellor.Types.OS.TypeLevel ( + SupportedOS(..), + OSList(..), + debian, + buntish, + freeBSD, + unixlike, + combineSupportedOS, + intersectSupportedOS, +) where + +import Network.BSD (HostName) +import Data.Typeable +import Data.String +import Data.Type.Bool +import Data.Type.Equality + +-- | A supported operating system. +data SupportedOS = OSDebian | OSBuntish | OSFreeBSD + deriving (Show, Eq) + +-- | A type-level and value-level list of supported operating systems. +-- +-- If the list is empty, no operating system is supported. +data OSList (os :: [SupportedOS]) = OSList [SupportedOS] + deriving (Show, Eq) + +-- | Any unix-like OS. +unixlike :: OSList '[OSDebian, OSBuntish, OSFreeBSD] +unixlike = OSList [OSDebian, OSBuntish, OSFreeBSD] + +debian :: OSList '[OSDebian] +debian = typeOS OSDebian + +buntish :: OSList '[OSBuntish] +buntish = typeOS OSBuntish + +freeBSD :: OSList '[OSFreeBSD] +freeBSD = typeOS OSFreeBSD + +typeOS :: SupportedOS -> OSList os +typeOS o = OSList [o] + +-- FIXME, should type check +-- foo :: OSList '[OSDebian, OSFreeBSD] +-- foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike + +-- | Combines two lists of supported OS's, yielding a list with the +-- contents of both. +combineSupportedOS + :: (r ~ ConcatOSList l1 l2) + => OSList l1 + -> OSList l2 + -> OSList r +combineSupportedOS (OSList l1) (OSList l2) = OSList (l1 ++ l2) + +-- | Type level concat for OSList. +type family ConcatOSList (list1 :: [a]) (list2 :: [a]) :: [a] +type instance ConcatOSList '[] list2 = list2 +type instance ConcatOSList (a ': rest) list2 = a ': ConcatOSList rest list2 + +-- | The intersection between two lists of supported OS's. +intersectSupportedOS + :: (r ~ IntersectOSList '[] l1 l2) + => OSList l1 + -> OSList l2 + -> OSList r +intersectSupportedOS (OSList l1) (OSList l2) = OSList (filter (`elem` l2) l1) + +-- | Type level intersection for OSList +type family IntersectOSList (coll :: [a]) (list1 :: [a]) (list2 :: [a]) :: [a] +type instance IntersectOSList coll '[] list2 = coll +type instance IntersectOSList coll (a ': rest) list2 = + If (ElemOSList a list2) + (IntersectOSList (a ': coll) rest list2) + (IntersectOSList coll rest list2) + +-- | Type level elem for OSList +type family ElemOSList a (list :: [b]) :: Bool +type instance ElemOSList a '[] = False +type instance ElemOSList a (b ': bs) = + If (a == b) + True + (ElemOSList a bs) + +-- | Type level equality for SupportedOS +type family EqOS (a :: SupportedOS) (b :: SupportedOS) where + EqOS a a = True + EqOS a b = False +type instance a == b = EqOS a b -- cgit v1.2.3 From 6d52245a574e65275f818d90839737f0074b045f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 15:08:58 -0400 Subject: document status --- ...ent_2_5a1c0c54db25b039eda28e213e1e6263._comment | 43 ++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment diff --git a/doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment b/doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment new file mode 100644 index 00000000..27aaf0cd --- /dev/null +++ b/doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment @@ -0,0 +1,43 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2016-03-08T18:44:25Z" + content=""" +I've made a typed-os-requirements branch that has type-level +OS lists implemented. + +For example: + + *Propellor.Types.OS.TypeLevel> let l = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike + *Propellor.Types.OS.TypeLevel> l + OSList [OSDebian,OSFreeBSD] + *Propellor.Types.OS.TypeLevel> :t l + l :: OSList + (IntersectOSList + '[] '['OSDebian, 'OSFreeBSD] '['OSDebian, 'OSBuntish, 'OSFreeBSD]) + +What this is lacking is type-level equality for OSList. +The complicated type above should be equivilant to `OSList '[OSDebian, OSFreeBSD]` + +So, this doesn't type check yet: + + foo :: OSList '[OSDebian, OSFreeBSD] + foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike + + src/Propellor/Types/OS/Typelevel.hs:47:46: + Couldn't match expected type ‘IntersectOSList + '[] + '['OSDebian, 'OSFreeBSD] + '['OSDebian, 'OSBuntish, 'OSFreeBSD]’ + with actual type ‘'['OSDebian, 'OSFreeBSD]’ + In the expression: + (debian `combineSupportedOS` freeBSD) + `intersectSupportedOS` unixlike + In an equation for ‘foo’: + foo + = (debian `combineSupportedOS` freeBSD) + `intersectSupportedOS` unixlike + +Also, `intersectSupportedOS` should have an additional constraint, +to prevent it from generating an empty type-level list. +"""]] -- cgit v1.2.3 From 1b84e20fa8715ba8e0881bbd9660de84f8f70feb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 16:15:40 -0400 Subject: simplfy --- src/Propellor/Types/OS/Typelevel.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs index 70d82e43..2b17d87b 100644 --- a/src/Propellor/Types/OS/Typelevel.hs +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -63,19 +63,19 @@ type instance ConcatOSList (a ': rest) list2 = a ': ConcatOSList rest list2 -- | The intersection between two lists of supported OS's. intersectSupportedOS - :: (r ~ IntersectOSList '[] l1 l2) + :: (r ~ IntersectOSList l1 l2) => OSList l1 -> OSList l2 -> OSList r intersectSupportedOS (OSList l1) (OSList l2) = OSList (filter (`elem` l2) l1) -- | Type level intersection for OSList -type family IntersectOSList (coll :: [a]) (list1 :: [a]) (list2 :: [a]) :: [a] -type instance IntersectOSList coll '[] list2 = coll -type instance IntersectOSList coll (a ': rest) list2 = +type family IntersectOSList (list1 :: [a]) (list2 :: [a]) :: [a] +type instance IntersectOSList '[] list2 = list2 +type instance IntersectOSList (a ': rest) list2 = If (ElemOSList a list2) - (IntersectOSList (a ': coll) rest list2) - (IntersectOSList coll rest list2) + (a ': IntersectOSList rest list2) + (IntersectOSList rest list2) -- | Type level elem for OSList type family ElemOSList a (list :: [b]) :: Bool -- cgit v1.2.3 From 4dab5fd328fc04ed006f32014330dac2621f0385 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 17:18:25 -0400 Subject: fixed it! --- src/Propellor/Types/OS/Typelevel.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs index 2b17d87b..82f3a426 100644 --- a/src/Propellor/Types/OS/Typelevel.hs +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -71,14 +71,14 @@ intersectSupportedOS (OSList l1) (OSList l2) = OSList (filter (`elem` l2) l1) -- | Type level intersection for OSList type family IntersectOSList (list1 :: [a]) (list2 :: [a]) :: [a] -type instance IntersectOSList '[] list2 = list2 +type instance IntersectOSList '[] list2 = '[] type instance IntersectOSList (a ': rest) list2 = If (ElemOSList a list2) (a ': IntersectOSList rest list2) (IntersectOSList rest list2) -- | Type level elem for OSList -type family ElemOSList a (list :: [b]) :: Bool +type family ElemOSList (a :: SupportedOS) (list :: [SupportedOS]) :: Bool type instance ElemOSList a '[] = False type instance ElemOSList a (b ': bs) = If (a == b) -- cgit v1.2.3 From 61a1ba8ff1fa496af24d22986057a7607ae55ff1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 17:54:49 -0400 Subject: make it a type error to intersect two OS lists if the result is empty --- doc/todo/type_level_OS_requirements.mdwn | 4 +++- src/Propellor/Types/OS/Typelevel.hs | 15 +++++++++++---- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/doc/todo/type_level_OS_requirements.mdwn b/doc/todo/type_level_OS_requirements.mdwn index 65e6099f..6d5d7aaf 100644 --- a/doc/todo/type_level_OS_requirements.mdwn +++ b/doc/todo/type_level_OS_requirements.mdwn @@ -11,7 +11,9 @@ For example, `Property i '[Debian, FreeBSD]` combined with `Property i '[Debian, yields a `Property i '[Debian]` -- the intersection of the OS's supported by the combined properties. -And, combining two properties that demand different OS's would need to be a +Combining two properties that demand different OS's would yield a +`Property i '[]` -- since the type level OS list is empty, + type error. Can a type level function combine two types successfully, and fail to combine two others somehow? Don't know. Maybe combine to an IncoherentOS and don't allow a `Property i IncoherentOS` to be used in a diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs index 82f3a426..879259df 100644 --- a/src/Propellor/Types/OS/Typelevel.hs +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -43,9 +43,8 @@ freeBSD = typeOS OSFreeBSD typeOS :: SupportedOS -> OSList os typeOS o = OSList [o] --- FIXME, should type check --- foo :: OSList '[OSDebian, OSFreeBSD] --- foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike +foo :: OSList '[OSDebian, OSFreeBSD] +foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike -- | Combines two lists of supported OS's, yielding a list with the -- contents of both. @@ -63,12 +62,20 @@ type instance ConcatOSList (a ': rest) list2 = a ': ConcatOSList rest list2 -- | The intersection between two lists of supported OS's. intersectSupportedOS - :: (r ~ IntersectOSList l1 l2) + :: (r ~ IntersectOSList l1 l2, CannotCombineOS l1 l2 r ~ CanCombineOS) => OSList l1 -> OSList l2 -> OSList r intersectSupportedOS (OSList l1) (OSList l2) = OSList (filter (`elem` l2) l1) +-- | Detect intersection of two lists that don't have any common OS. +-- +-- The name of this was chosen to make type errors a more understandable. +type family CannotCombineOS (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckIntersection +type instance CannotCombineOS l1 l2 '[] = 'CannotCombineOS +type instance CannotCombineOS l1 l2 (a ': rest) = 'CanCombineOS +data CheckIntersection = CannotCombineOS | CanCombineOS + -- | Type level intersection for OSList type family IntersectOSList (list1 :: [a]) (list2 :: [a]) :: [a] type instance IntersectOSList '[] list2 = '[] -- cgit v1.2.3 From 30008bc643eeb8128f42734fe96d4f9010078558 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 18:13:06 -0400 Subject: simplify --- src/Propellor/Types/OS/Typelevel.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs index 879259df..4803e4ac 100644 --- a/src/Propellor/Types/OS/Typelevel.hs +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -87,10 +87,7 @@ type instance IntersectOSList (a ': rest) list2 = -- | Type level elem for OSList type family ElemOSList (a :: SupportedOS) (list :: [SupportedOS]) :: Bool type instance ElemOSList a '[] = False -type instance ElemOSList a (b ': bs) = - If (a == b) - True - (ElemOSList a bs) +type instance ElemOSList a (b ': bs) = a == b || ElemOSList a bs -- | Type level equality for SupportedOS type family EqOS (a :: SupportedOS) (b :: SupportedOS) where -- cgit v1.2.3 From a08ec3412b45a49d3668a6d6439d1c81b05612ab Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Mar 2016 23:33:12 -0400 Subject: backported to ghc 7.6.3 Works on debian stable! --- src/Propellor/Types/OS/Typelevel.hs | 38 +++++++++++++++++++++++++++++-------- 1 file changed, 30 insertions(+), 8 deletions(-) diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs index 4803e4ac..0c2e76bf 100644 --- a/src/Propellor/Types/OS/Typelevel.hs +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -14,8 +14,6 @@ module Propellor.Types.OS.TypeLevel ( import Network.BSD (HostName) import Data.Typeable import Data.String -import Data.Type.Bool -import Data.Type.Equality -- | A supported operating system. data SupportedOS = OSDebian | OSBuntish | OSFreeBSD @@ -86,11 +84,35 @@ type instance IntersectOSList (a ': rest) list2 = -- | Type level elem for OSList type family ElemOSList (a :: SupportedOS) (list :: [SupportedOS]) :: Bool -type instance ElemOSList a '[] = False -type instance ElemOSList a (b ': bs) = a == b || ElemOSList a bs +type instance ElemOSList a '[] = 'False +type instance ElemOSList a (b ': bs) = EqOS a b || ElemOSList a bs -- | Type level equality for SupportedOS -type family EqOS (a :: SupportedOS) (b :: SupportedOS) where - EqOS a a = True - EqOS a b = False -type instance a == b = EqOS a b +-- +-- This is a very clumsy implmentation, but it works back to ghc 7.6. +type family EqOS (a :: SupportedOS) (b :: SupportedOS) :: Bool +type instance EqOS OSDebian OSDebian = 'True +type instance EqOS OSBuntish OSBuntish = 'True +type instance EqOS OSFreeBSD OSFreeBSD = 'True +type instance EqOS OSDebian OSBuntish = 'False +type instance EqOS OSDebian OSFreeBSD = 'False +type instance EqOS OSBuntish OSDebian = 'False +type instance EqOS OSBuntish OSFreeBSD = 'False +type instance EqOS OSFreeBSD OSDebian = 'False +type instance EqOS OSFreeBSD OSBuntish = 'False +-- More modern version if the combinatiorial explosion gets too bad later: +-- +-- type family EqOS (a :: SupportedOS) (b :: SupportedOS) where +-- EqOS a a = True +-- EqOS a b = False + +-- | This is in Data.Type.Bool with modern versions of ghc, but is included +-- here to support ghc 7.6. +type family If (cond :: Bool) (tru :: a) (fls :: a) :: a +type instance If 'True tru fls = tru +type instance If 'False tru fls = fls +type family (a :: Bool) || (b :: Bool) :: Bool +type instance 'False || 'False = 'False +type instance 'True || 'True = 'True +type instance 'True || 'False = 'True +type instance 'False || 'True = 'True -- cgit v1.2.3 From 892462ce5be7b37d2a24c1eee662f7d36dbaec82 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Mar 2016 11:00:21 -0400 Subject: added protype of ensureProperty that prevents running properties in the wrong OS --- src/Propellor/Types/OS/Typelevel.hs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs index 0c2e76bf..3d4eeb8f 100644 --- a/src/Propellor/Types/OS/Typelevel.hs +++ b/src/Propellor/Types/OS/Typelevel.hs @@ -7,7 +7,7 @@ module Propellor.Types.OS.TypeLevel ( buntish, freeBSD, unixlike, - combineSupportedOS, + includeSupportedOS, intersectSupportedOS, ) where @@ -41,17 +41,35 @@ freeBSD = typeOS OSFreeBSD typeOS :: SupportedOS -> OSList os typeOS o = OSList [o] -foo :: OSList '[OSDebian, OSFreeBSD] -foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike +data Property os = Property os (IO ()) --- | Combines two lists of supported OS's, yielding a list with the --- contents of both. -combineSupportedOS +mkProperty :: os -> IO () -> Property os +mkProperty os a = Property os a + +-- Intentionally a type error! :) +--foo :: Property (OSList '[OSDebian, OSFreeBSD]) +--foo = mkProperty supportedos $ do +-- ensureProperty supportedos jail +-- where supportedos = includeSupportedOS debian + +jail :: Property (OSList '[OSFreeBSD]) +jail = Property freeBSD $ do + return () + +ensureProperty + :: (CannotCombineOS outeros inneros (IntersectOSList outeros inneros) ~ CanCombineOS) + => OSList outeros + -> Property (OSList inneros) + -> IO () +ensureProperty outeros (Property inneros a) = a + +-- | Adds to a list of supported OS's. +includeSupportedOS :: (r ~ ConcatOSList l1 l2) => OSList l1 -> OSList l2 -> OSList r -combineSupportedOS (OSList l1) (OSList l2) = OSList (l1 ++ l2) +includeSupportedOS (OSList l1) (OSList l2) = OSList (l1 ++ l2) -- | Type level concat for OSList. type family ConcatOSList (list1 :: [a]) (list2 :: [a]) :: [a] -- cgit v1.2.3 From bf318157142194e5dfdab732212b11d0a2068365 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Mar 2016 11:44:22 -0400 Subject: rename to Target --- src/Propellor/Types/OS/Typelevel.hs | 136 ------------------------------------ src/Propellor/Types/Target.hs | 136 ++++++++++++++++++++++++++++++++++++ 2 files changed, 136 insertions(+), 136 deletions(-) delete mode 100644 src/Propellor/Types/OS/Typelevel.hs create mode 100644 src/Propellor/Types/Target.hs diff --git a/src/Propellor/Types/OS/Typelevel.hs b/src/Propellor/Types/OS/Typelevel.hs deleted file mode 100644 index 3d4eeb8f..00000000 --- a/src/Propellor/Types/OS/Typelevel.hs +++ /dev/null @@ -1,136 +0,0 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances #-} - -module Propellor.Types.OS.TypeLevel ( - SupportedOS(..), - OSList(..), - debian, - buntish, - freeBSD, - unixlike, - includeSupportedOS, - intersectSupportedOS, -) where - -import Network.BSD (HostName) -import Data.Typeable -import Data.String - --- | A supported operating system. -data SupportedOS = OSDebian | OSBuntish | OSFreeBSD - deriving (Show, Eq) - --- | A type-level and value-level list of supported operating systems. --- --- If the list is empty, no operating system is supported. -data OSList (os :: [SupportedOS]) = OSList [SupportedOS] - deriving (Show, Eq) - --- | Any unix-like OS. -unixlike :: OSList '[OSDebian, OSBuntish, OSFreeBSD] -unixlike = OSList [OSDebian, OSBuntish, OSFreeBSD] - -debian :: OSList '[OSDebian] -debian = typeOS OSDebian - -buntish :: OSList '[OSBuntish] -buntish = typeOS OSBuntish - -freeBSD :: OSList '[OSFreeBSD] -freeBSD = typeOS OSFreeBSD - -typeOS :: SupportedOS -> OSList os -typeOS o = OSList [o] - -data Property os = Property os (IO ()) - -mkProperty :: os -> IO () -> Property os -mkProperty os a = Property os a - --- Intentionally a type error! :) ---foo :: Property (OSList '[OSDebian, OSFreeBSD]) ---foo = mkProperty supportedos $ do --- ensureProperty supportedos jail --- where supportedos = includeSupportedOS debian - -jail :: Property (OSList '[OSFreeBSD]) -jail = Property freeBSD $ do - return () - -ensureProperty - :: (CannotCombineOS outeros inneros (IntersectOSList outeros inneros) ~ CanCombineOS) - => OSList outeros - -> Property (OSList inneros) - -> IO () -ensureProperty outeros (Property inneros a) = a - --- | Adds to a list of supported OS's. -includeSupportedOS - :: (r ~ ConcatOSList l1 l2) - => OSList l1 - -> OSList l2 - -> OSList r -includeSupportedOS (OSList l1) (OSList l2) = OSList (l1 ++ l2) - --- | Type level concat for OSList. -type family ConcatOSList (list1 :: [a]) (list2 :: [a]) :: [a] -type instance ConcatOSList '[] list2 = list2 -type instance ConcatOSList (a ': rest) list2 = a ': ConcatOSList rest list2 - --- | The intersection between two lists of supported OS's. -intersectSupportedOS - :: (r ~ IntersectOSList l1 l2, CannotCombineOS l1 l2 r ~ CanCombineOS) - => OSList l1 - -> OSList l2 - -> OSList r -intersectSupportedOS (OSList l1) (OSList l2) = OSList (filter (`elem` l2) l1) - --- | Detect intersection of two lists that don't have any common OS. --- --- The name of this was chosen to make type errors a more understandable. -type family CannotCombineOS (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckIntersection -type instance CannotCombineOS l1 l2 '[] = 'CannotCombineOS -type instance CannotCombineOS l1 l2 (a ': rest) = 'CanCombineOS -data CheckIntersection = CannotCombineOS | CanCombineOS - --- | Type level intersection for OSList -type family IntersectOSList (list1 :: [a]) (list2 :: [a]) :: [a] -type instance IntersectOSList '[] list2 = '[] -type instance IntersectOSList (a ': rest) list2 = - If (ElemOSList a list2) - (a ': IntersectOSList rest list2) - (IntersectOSList rest list2) - --- | Type level elem for OSList -type family ElemOSList (a :: SupportedOS) (list :: [SupportedOS]) :: Bool -type instance ElemOSList a '[] = 'False -type instance ElemOSList a (b ': bs) = EqOS a b || ElemOSList a bs - --- | Type level equality for SupportedOS --- --- This is a very clumsy implmentation, but it works back to ghc 7.6. -type family EqOS (a :: SupportedOS) (b :: SupportedOS) :: Bool -type instance EqOS OSDebian OSDebian = 'True -type instance EqOS OSBuntish OSBuntish = 'True -type instance EqOS OSFreeBSD OSFreeBSD = 'True -type instance EqOS OSDebian OSBuntish = 'False -type instance EqOS OSDebian OSFreeBSD = 'False -type instance EqOS OSBuntish OSDebian = 'False -type instance EqOS OSBuntish OSFreeBSD = 'False -type instance EqOS OSFreeBSD OSDebian = 'False -type instance EqOS OSFreeBSD OSBuntish = 'False --- More modern version if the combinatiorial explosion gets too bad later: --- --- type family EqOS (a :: SupportedOS) (b :: SupportedOS) where --- EqOS a a = True --- EqOS a b = False - --- | This is in Data.Type.Bool with modern versions of ghc, but is included --- here to support ghc 7.6. -type family If (cond :: Bool) (tru :: a) (fls :: a) :: a -type instance If 'True tru fls = tru -type instance If 'False tru fls = fls -type family (a :: Bool) || (b :: Bool) :: Bool -type instance 'False || 'False = 'False -type instance 'True || 'True = 'True -type instance 'True || 'False = 'True -type instance 'False || 'True = 'True diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs new file mode 100644 index 00000000..c9739ad4 --- /dev/null +++ b/src/Propellor/Types/Target.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances #-} + +module Propellor.Types.Target ( + Target(..), + Targeting(..), + debian, + buntish, + freeBSD, + unixlike, + includeTarget, + intersectTarget, +) where + +import Network.BSD (HostName) +import Data.Typeable +import Data.String + +----- DEMO ---------- +data Property os = Property os (IO ()) + +mkProperty :: os -> IO () -> Property os +mkProperty os a = Property os a + +-- Intentionally a type error! :) +--foo :: Property (Targeting '[OSDebian, OSFreeBSD]) +--foo = mkProperty supportedos $ do +-- ensureProperty supportedos jail +-- where supportedos = includeTarget debian + +jail :: Property (Targeting '[OSFreeBSD]) +jail = Property freeBSD $ do + return () +----- END DEMO ---------- + +-- | A Target system, where a Property is indended to be used. +data Target = OSDebian | OSBuntish | OSFreeBSD + deriving (Show, Eq) + +-- | A type-level and value-level list of targets. +data Targeting (os :: [Target]) = Targeting [Target] + deriving (Show, Eq) + +-- | Any unix-like OS. +unixlike :: Targeting '[OSDebian, OSBuntish, OSFreeBSD] +unixlike = Targeting [OSDebian, OSBuntish, OSFreeBSD] + +debian :: Targeting '[OSDebian] +debian = typeOS OSDebian + +buntish :: Targeting '[OSBuntish] +buntish = typeOS OSBuntish + +freeBSD :: Targeting '[OSFreeBSD] +freeBSD = typeOS OSFreeBSD + +typeOS :: Target -> Targeting os +typeOS o = Targeting [o] + +ensureProperty + :: (CannotCombineTargets outertarget innertarget (IntersectTargeting outertarget innertarget) ~ CanCombineTargets) + => Targeting outertarget + -> Property (Targeting innertarget) + -> IO () +ensureProperty outeros (Property inneros a) = a + +-- | Adds to a list of targets. +includeTarget + :: (r ~ ConcatTargeting l1 l2) + => Targeting l1 + -> Targeting l2 + -> Targeting r +includeTarget (Targeting l1) (Targeting l2) = Targeting (l1 ++ l2) + +-- | Type level concat for Targeting. +type family ConcatTargeting (list1 :: [a]) (list2 :: [a]) :: [a] +type instance ConcatTargeting '[] list2 = list2 +type instance ConcatTargeting (a ': rest) list2 = a ': ConcatTargeting rest list2 + +-- | The intersection between two lists of Targets. +intersectTarget + :: (r ~ IntersectTargeting l1 l2, CannotCombineTargets l1 l2 r ~ CanCombineTargets) + => Targeting l1 + -> Targeting l2 + -> Targeting r +intersectTarget (Targeting l1) (Targeting l2) = Targeting (filter (`elem` l2) l1) + +-- | Detect intersection of two lists that don't have any common OS. +-- +-- The name of this was chosen to make type errors a more understandable. +type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckIntersection +type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets +type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets +data CheckIntersection = CannotCombineTargets | CanCombineTargets + +-- | Type level intersection for Targeting +type family IntersectTargeting (list1 :: [a]) (list2 :: [a]) :: [a] +type instance IntersectTargeting '[] list2 = '[] +type instance IntersectTargeting (a ': rest) list2 = + If (ElemTargeting a list2) + (a ': IntersectTargeting rest list2) + (IntersectTargeting rest list2) + +-- | Type level elem for Targeting +type family ElemTargeting (a :: Target) (list :: [Target]) :: Bool +type instance ElemTargeting a '[] = 'False +type instance ElemTargeting a (b ': bs) = EqTarget a b || ElemTargeting a bs + +-- | Type level equality for Target +-- +-- This is a very clumsy implmentation, but it works back to ghc 7.6. +type family EqTarget (a :: Target) (b :: Target) :: Bool +type instance EqTarget OSDebian OSDebian = 'True +type instance EqTarget OSBuntish OSBuntish = 'True +type instance EqTarget OSFreeBSD OSFreeBSD = 'True +type instance EqTarget OSDebian OSBuntish = 'False +type instance EqTarget OSDebian OSFreeBSD = 'False +type instance EqTarget OSBuntish OSDebian = 'False +type instance EqTarget OSBuntish OSFreeBSD = 'False +type instance EqTarget OSFreeBSD OSDebian = 'False +type instance EqTarget OSFreeBSD OSBuntish = 'False +-- More modern version if the combinatiorial explosion gets too bad later: +-- +-- type family EqTarget (a :: Target) (b :: Target) where +-- EqTarget a a = True +-- EqTarget a b = False + +-- | This is in Data.Type.Bool with modern versions of ghc, but is included +-- here to support ghc 7.6. +type family If (cond :: Bool) (tru :: a) (fls :: a) :: a +type instance If 'True tru fls = tru +type instance If 'False tru fls = fls +type family (a :: Bool) || (b :: Bool) :: Bool +type instance 'False || 'False = 'False +type instance 'True || 'True = 'True +type instance 'True || 'False = 'True +type instance 'False || 'True = 'True -- cgit v1.2.3 From bbac72a724314cc00b17cfa3cdab149b2dad8166 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Mar 2016 12:08:28 -0400 Subject: improve --- src/Propellor/Types/Target.hs | 76 +++++++++++++++++++++++++++---------------- 1 file changed, 48 insertions(+), 28 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index c9739ad4..a7d33412 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -3,10 +3,15 @@ module Propellor.Types.Target ( Target(..), Targeting(..), + target, + UnixLike, + unixLike, + DebianOnly, debian, + BuntishOnly, buntish, + FreeBSDOnly, freeBSD, - unixlike, includeTarget, intersectTarget, ) where @@ -15,20 +20,28 @@ import Network.BSD (HostName) import Data.Typeable import Data.String ------ DEMO ---------- -data Property os = Property os (IO ()) +data Property target = Property target (IO ()) + +mkProperty :: IO () -> Property UnixLike +mkProperty a = Property unixLike a -mkProperty :: os -> IO () -> Property os -mkProperty os a = Property os a +-- | Changes the target of a property. +-- +-- This can only tighten the target list to contain fewer targets. +target + :: (newtarget' ~ IntersectTarget oldtarget newtarget, CannotCombineTargets oldtarget newtarget newtarget' ~ CanCombineTargets) + => Targeting newtarget -> Property (Targeting oldtarget) -> Property (Targeting newtarget') +target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget newtarget) a +----- DEMO ---------- -- Intentionally a type error! :) ---foo :: Property (Targeting '[OSDebian, OSFreeBSD]) ---foo = mkProperty supportedos $ do --- ensureProperty supportedos jail --- where supportedos = includeTarget debian +foo :: Property (Targeting '[OSDebian, OSFreeBSD]) +foo = Property supportedos $ do + ensureProperty supportedos jail + where supportedos = includeTarget debian freeBSD jail :: Property (Targeting '[OSFreeBSD]) -jail = Property freeBSD $ do +jail = target freeBSD $ mkProperty $ do return () ----- END DEMO ---------- @@ -40,24 +53,31 @@ data Target = OSDebian | OSBuntish | OSFreeBSD data Targeting (os :: [Target]) = Targeting [Target] deriving (Show, Eq) --- | Any unix-like OS. -unixlike :: Targeting '[OSDebian, OSBuntish, OSFreeBSD] -unixlike = Targeting [OSDebian, OSBuntish, OSFreeBSD] +type UnixLike = Targeting '[OSDebian, OSBuntish, OSFreeBSD] + +unixLike :: UnixLike +unixLike = Targeting [OSDebian, OSBuntish, OSFreeBSD] + +type DebianOnly = Targeting '[OSDebian] + +debian :: DebianOnly +debian = targeting OSDebian + +type BuntishOnly = Targeting '[OSBuntish] -debian :: Targeting '[OSDebian] -debian = typeOS OSDebian +buntish :: BuntishOnly +buntish = targeting OSBuntish -buntish :: Targeting '[OSBuntish] -buntish = typeOS OSBuntish +type FreeBSDOnly = Targeting '[OSFreeBSD] -freeBSD :: Targeting '[OSFreeBSD] -freeBSD = typeOS OSFreeBSD +freeBSD :: FreeBSDOnly +freeBSD = targeting OSFreeBSD -typeOS :: Target -> Targeting os -typeOS o = Targeting [o] +targeting :: Target -> Targeting os +targeting o = Targeting [o] ensureProperty - :: (CannotCombineTargets outertarget innertarget (IntersectTargeting outertarget innertarget) ~ CanCombineTargets) + :: (CannotCombineTargets outertarget innertarget (IntersectTarget outertarget innertarget) ~ CanCombineTargets) => Targeting outertarget -> Property (Targeting innertarget) -> IO () @@ -78,7 +98,7 @@ type instance ConcatTargeting (a ': rest) list2 = a ': ConcatTargeting rest list -- | The intersection between two lists of Targets. intersectTarget - :: (r ~ IntersectTargeting l1 l2, CannotCombineTargets l1 l2 r ~ CanCombineTargets) + :: (r ~ IntersectTarget l1 l2, CannotCombineTargets l1 l2 r ~ CanCombineTargets) => Targeting l1 -> Targeting l2 -> Targeting r @@ -93,12 +113,12 @@ type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets data CheckIntersection = CannotCombineTargets | CanCombineTargets -- | Type level intersection for Targeting -type family IntersectTargeting (list1 :: [a]) (list2 :: [a]) :: [a] -type instance IntersectTargeting '[] list2 = '[] -type instance IntersectTargeting (a ': rest) list2 = +type family IntersectTarget (list1 :: [a]) (list2 :: [a]) :: [a] +type instance IntersectTarget '[] list2 = '[] +type instance IntersectTarget (a ': rest) list2 = If (ElemTargeting a list2) - (a ': IntersectTargeting rest list2) - (IntersectTargeting rest list2) + (a ': IntersectTarget rest list2) + (IntersectTarget rest list2) -- | Type level elem for Targeting type family ElemTargeting (a :: Target) (list :: [Target]) :: Bool -- cgit v1.2.3 From ed84544297dd1483eeaf7c5bde706d773651496a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Mar 2016 12:11:42 -0400 Subject: note bug --- src/Propellor/Types/Target.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index a7d33412..6e91d57c 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -40,7 +40,7 @@ foo = Property supportedos $ do ensureProperty supportedos jail where supportedos = includeTarget debian freeBSD -jail :: Property (Targeting '[OSFreeBSD]) +jail :: Property FreeBSDOnly jail = target freeBSD $ mkProperty $ do return () ----- END DEMO ---------- @@ -76,6 +76,9 @@ freeBSD = targeting OSFreeBSD targeting :: Target -> Targeting os targeting o = Targeting [o] +-- FIXME: Wrong for eg, inner [Debian] vs outer [Debian,FreeBSD], since +-- they interesect to [Debian]. All things in the outer *must* be present +-- in the inner. ensureProperty :: (CannotCombineTargets outertarget innertarget (IntersectTarget outertarget innertarget) ~ CanCombineTargets) => Targeting outertarget -- cgit v1.2.3 From 83359452a84ffcc71cf755168c064f6c5a5c6dd8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 11:13:11 -0400 Subject: fix ensureProperty superset checking --- src/Propellor/Types/Target.hs | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 6e91d57c..9e78a03a 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -35,10 +35,10 @@ target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget ne ----- DEMO ---------- -- Intentionally a type error! :) -foo :: Property (Targeting '[OSDebian, OSFreeBSD]) -foo = Property supportedos $ do - ensureProperty supportedos jail - where supportedos = includeTarget debian freeBSD +--foo :: Property (Targeting '[OSDebian, OSFreeBSD]) +--foo = Property supportedos $ do +-- ensureProperty supportedos jail +-- where supportedos = includeTarget debian freeBSD jail :: Property FreeBSDOnly jail = target freeBSD $ mkProperty $ do @@ -76,11 +76,8 @@ freeBSD = targeting OSFreeBSD targeting :: Target -> Targeting os targeting o = Targeting [o] --- FIXME: Wrong for eg, inner [Debian] vs outer [Debian,FreeBSD], since --- they interesect to [Debian]. All things in the outer *must* be present --- in the inner. ensureProperty - :: (CannotCombineTargets outertarget innertarget (IntersectTarget outertarget innertarget) ~ CanCombineTargets) + :: ((innertarget `NotSupersetTargets` outertarget) ~ CanCombineTargets) => Targeting outertarget -> Property (Targeting innertarget) -> IO () @@ -107,26 +104,37 @@ intersectTarget -> Targeting r intersectTarget (Targeting l1) (Targeting l2) = Targeting (filter (`elem` l2) l1) +data CheckCombineTargets = CannotCombineTargets | CanCombineTargets + -- | Detect intersection of two lists that don't have any common OS. -- -- The name of this was chosen to make type errors a more understandable. -type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckIntersection +type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets -data CheckIntersection = CannotCombineTargets | CanCombineTargets + +-- | Everything in the subset must be in the superset. +-- +-- The name of this was chosen to make type errors a more understandable. +type family NotSupersetTargets (superset :: [a]) (subset :: [a]) :: CheckCombineTargets +type instance NotSupersetTargets superset '[] = 'CanCombineTargets +type instance NotSupersetTargets superset (s ': rest) = + If (ElemTarget s superset) + (NotSupersetTargets superset rest) + 'CannotCombineTargets -- | Type level intersection for Targeting type family IntersectTarget (list1 :: [a]) (list2 :: [a]) :: [a] type instance IntersectTarget '[] list2 = '[] type instance IntersectTarget (a ': rest) list2 = - If (ElemTargeting a list2) + If (ElemTarget a list2) (a ': IntersectTarget rest list2) (IntersectTarget rest list2) --- | Type level elem for Targeting -type family ElemTargeting (a :: Target) (list :: [Target]) :: Bool -type instance ElemTargeting a '[] = 'False -type instance ElemTargeting a (b ': bs) = EqTarget a b || ElemTargeting a bs +-- | Type level elem for Target +type family ElemTarget (a :: Target) (list :: [Target]) :: Bool +type instance ElemTarget a '[] = 'False +type instance ElemTarget a (b ': bs) = EqTarget a b || ElemTarget a bs -- | Type level equality for Target -- -- cgit v1.2.3 From 199d10fe18d69f7eac1b2acbc0133d35c42ff2b8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 16 Mar 2016 14:12:41 -0400 Subject: wip --- src/Propellor/Types/Target.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 9e78a03a..228aae70 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -33,6 +33,22 @@ target => Targeting newtarget -> Property (Targeting oldtarget) -> Property (Targeting newtarget') target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget newtarget) a +-- | Makes a property that uses either of the two input properties, +-- depending on the targeted OS. +-- +-- If both input properties support the targeted OS, then the first will be +-- used. +orProperty + :: Property (Targeting a) + -> Property (Targeting b) + -> Property (Targeting (UnionTarget a b)) +orProperty a@(Property ta ioa) b@(Property tb iob) = + Property (unionTarget ta tb) io + where + -- TODO pick with of ioa or iob to use based on final OS of + -- system being run on. + io = undefined + ----- DEMO ---------- -- Intentionally a type error! :) --foo :: Property (Targeting '[OSDebian, OSFreeBSD]) @@ -40,6 +56,13 @@ target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget ne -- ensureProperty supportedos jail -- where supportedos = includeTarget debian freeBSD +--bar :: Property (Targeting '[OSDebian, OSFreeBSD]) +bar = aptinstall `orProperty` jail + +aptinstall :: Property DebianOnly +aptinstall = target debian $ mkProperty $ do + return () + jail :: Property FreeBSDOnly jail = target freeBSD $ mkProperty $ do return () -- cgit v1.2.3 From 70b77dd31c4538361a844ef049bed9ad2f273a3b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 16 Mar 2016 14:40:14 -0400 Subject: wip --- propellor.cabal | 3 +- src/Propellor/Types/Target.hs | 78 +++++++++++++++++++++++++++---------------- 2 files changed, 51 insertions(+), 30 deletions(-) diff --git a/propellor.cabal b/propellor.cabal index 4e0e1db2..4db210d0 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -144,6 +144,7 @@ Library Propellor.Exception Propellor.Types Propellor.Types.Chroot + Propellor.Types.CmdLine Propellor.Types.Container Propellor.Types.Docker Propellor.Types.Dns @@ -153,7 +154,7 @@ Library Propellor.Types.PrivData Propellor.Types.Result Propellor.Types.ResultCheck - Propellor.Types.CmdLine + Propellor.Types.Target Propellor.Types.ZFS Other-Modules: Propellor.Bootstrap diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 228aae70..4d80f35c 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -12,13 +12,16 @@ module Propellor.Types.Target ( buntish, FreeBSDOnly, freeBSD, - includeTarget, + unionTargets, intersectTarget, + orProperty, + ensureProperty, ) where import Network.BSD (HostName) import Data.Typeable import Data.String +import Data.List data Property target = Property target (IO ()) @@ -29,21 +32,23 @@ mkProperty a = Property unixLike a -- -- This can only tighten the target list to contain fewer targets. target - :: (newtarget' ~ IntersectTarget oldtarget newtarget, CannotCombineTargets oldtarget newtarget newtarget' ~ CanCombineTargets) - => Targeting newtarget -> Property (Targeting oldtarget) -> Property (Targeting newtarget') + :: (combinedtarget ~ IntersectTarget oldtarget newtarget, CannotCombineTargets oldtarget newtarget combinedtarget ~ CanCombineTargets) + => Targeting newtarget + -> Property (Targeting oldtarget) + -> Property (Targeting combinedtarget) target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget newtarget) a --- | Makes a property that uses either of the two input properties, +-- | Picks one of the two input properties to use, -- depending on the targeted OS. -- --- If both input properties support the targeted OS, then the first will be --- used. +-- If both input properties support the targeted OS, then the +-- first will be used. orProperty :: Property (Targeting a) -> Property (Targeting b) -> Property (Targeting (UnionTarget a b)) orProperty a@(Property ta ioa) b@(Property tb iob) = - Property (unionTarget ta tb) io + Property (unionTargets ta tb) io where -- TODO pick with of ioa or iob to use based on final OS of -- system being run on. @@ -54,7 +59,7 @@ orProperty a@(Property ta ioa) b@(Property tb iob) = --foo :: Property (Targeting '[OSDebian, OSFreeBSD]) --foo = Property supportedos $ do -- ensureProperty supportedos jail --- where supportedos = includeTarget debian freeBSD +-- where supportedos = unionTargets debian freeBSD --bar :: Property (Targeting '[OSDebian, OSFreeBSD]) bar = aptinstall `orProperty` jail @@ -73,7 +78,7 @@ data Target = OSDebian | OSBuntish | OSFreeBSD deriving (Show, Eq) -- | A type-level and value-level list of targets. -data Targeting (os :: [Target]) = Targeting [Target] +data Targeting (targets :: [Target]) = Targeting [Target] deriving (Show, Eq) type UnixLike = Targeting '[OSDebian, OSBuntish, OSFreeBSD] @@ -99,6 +104,9 @@ freeBSD = targeting OSFreeBSD targeting :: Target -> Targeting os targeting o = Targeting [o] +-- Demo. The outeros parameter would come from the Propellor monad in real +-- life. +-- XXX Can type inference work if outeros comes from Propellor monad? ensureProperty :: ((innertarget `NotSupersetTargets` outertarget) ~ CanCombineTargets) => Targeting outertarget @@ -106,18 +114,13 @@ ensureProperty -> IO () ensureProperty outeros (Property inneros a) = a --- | Adds to a list of targets. -includeTarget - :: (r ~ ConcatTargeting l1 l2) - => Targeting l1 +-- | The union of two lists of Targets. +unionTargets + :: Targeting l1 -> Targeting l2 - -> Targeting r -includeTarget (Targeting l1) (Targeting l2) = Targeting (l1 ++ l2) - --- | Type level concat for Targeting. -type family ConcatTargeting (list1 :: [a]) (list2 :: [a]) :: [a] -type instance ConcatTargeting '[] list2 = list2 -type instance ConcatTargeting (a ': rest) list2 = a ': ConcatTargeting rest list2 + -> Targeting (UnionTarget l1 l2) +unionTargets (Targeting l1) (Targeting l2) = + Targeting $ nub $ l1 ++ l2 -- | The intersection between two lists of Targets. intersectTarget @@ -125,7 +128,8 @@ intersectTarget => Targeting l1 -> Targeting l2 -> Targeting r -intersectTarget (Targeting l1) (Targeting l2) = Targeting (filter (`elem` l2) l1) +intersectTarget (Targeting l1) (Targeting l2) = + Targeting $ nub $ filter (`elem` l2) l1 data CheckCombineTargets = CannotCombineTargets | CanCombineTargets @@ -146,14 +150,22 @@ type instance NotSupersetTargets superset (s ': rest) = (NotSupersetTargets superset rest) 'CannotCombineTargets --- | Type level intersection for Targeting +-- | Type level intersection of lists of Targets type family IntersectTarget (list1 :: [a]) (list2 :: [a]) :: [a] type instance IntersectTarget '[] list2 = '[] type instance IntersectTarget (a ': rest) list2 = - If (ElemTarget a list2) + If (ElemTarget a list2 && Not (ElemTarget a rest)) (a ': IntersectTarget rest list2) (IntersectTarget rest list2) +-- | Type level union of lists of Targets +type family UnionTarget (list1 :: [a]) (list2 :: [a]) :: [a] +type instance UnionTarget '[] list2 = list2 +type instance UnionTarget (a ': rest) list2 = + If (ElemTarget a list2 || ElemTarget a rest) + (UnionTarget rest list2) + (a ': UnionTarget rest list2) + -- | Type level elem for Target type family ElemTarget (a :: Target) (list :: [Target]) :: Bool type instance ElemTarget a '[] = 'False @@ -178,13 +190,21 @@ type instance EqTarget OSFreeBSD OSBuntish = 'False -- EqTarget a a = True -- EqTarget a b = False --- | This is in Data.Type.Bool with modern versions of ghc, but is included --- here to support ghc 7.6. +-- | An equivilant to the following is in Data.Type.Bool in +-- modern versions of ghc, but is included here to support ghc 7.6. type family If (cond :: Bool) (tru :: a) (fls :: a) :: a type instance If 'True tru fls = tru type instance If 'False tru fls = fls type family (a :: Bool) || (b :: Bool) :: Bool -type instance 'False || 'False = 'False -type instance 'True || 'True = 'True -type instance 'True || 'False = 'True -type instance 'False || 'True = 'True +type instance 'False || 'False = 'False +type instance 'True || 'True = 'True +type instance 'True || 'False = 'True +type instance 'False || 'True = 'True +type family (a :: Bool) && (b :: Bool) :: Bool +type instance 'False && 'False = 'False +type instance 'True && 'True = 'True +type instance 'True && 'False = 'False +type instance 'False && 'True = 'False +type family Not (a :: Bool) :: Bool +type instance Not 'False = 'True +type instance Not 'True = 'False -- cgit v1.2.3 From 86f3373dc429bd16f0153787eaa45049e44c6bb0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 17 Mar 2016 11:26:35 -0400 Subject: let's not try to get outertarget from monad To get outertarget from the Propellor monad, the monad would have to be parameteriszed with an outertarget type, since there's no single type. For example: newtype Propellor target p = Propellor { runWithHost :: RWST target () () IO p } deriving (Monad, Applicative, Functor) But then mkProperty becomes a problem, since the Propellor action passed to it needs to already be of UnixLike type: mkProperty :: Propellor UnixLike () -> Property UnixLike mkProperty a = Property unixLike a Could maybe live with that, but then `target` type check fails: Expected type: Propellor (Targeting combinedtarget) () Actual type: Propellor (Targeting oldtarget) () Problem being that it's reusing the `a` which is a Propellor target () target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget newtarget) a And, the new Property has a different target, so it can't use the old `a`. So, I'd need a way to cast one Propellor target () to a different target. Maybe: target newtarget (Property oldtarget (Propellor a)) = let combinedtarget = intersectTarget oldtarget newtarget in Property combinedtarget (Propellor (unsafeCoerce a)) But is that safe?? Even if it is, I can't see how to make ensureProperty get the outertarget type. It returns Propellor (Targeting outertarget) (), which can read the target from the RWST monad, but how to use that where the type of the function is defined? Rather than all that complication, it doesn't seem too bad to require outertarget be passed to ensureProperty. --- src/Propellor/Types/Target.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 4d80f35c..40b3891e 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -104,15 +104,13 @@ freeBSD = targeting OSFreeBSD targeting :: Target -> Targeting os targeting o = Targeting [o] --- Demo. The outeros parameter would come from the Propellor monad in real --- life. --- XXX Can type inference work if outeros comes from Propellor monad? +-- The outertarget parameter needs to be passed in from the outer property. ensureProperty :: ((innertarget `NotSupersetTargets` outertarget) ~ CanCombineTargets) => Targeting outertarget -> Property (Targeting innertarget) -> IO () -ensureProperty outeros (Property inneros a) = a +ensureProperty outertarget (Property inneros a) = a -- | The union of two lists of Targets. unionTargets -- cgit v1.2.3 From 761d06c789733cbeb9dc1f966c48417e54b055c4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 17 Mar 2016 12:20:17 -0400 Subject: add OuterTarget Separate data type to guarantee that ensureProperty is passed the actual outer target, and not some other Targeting value from eg, unixLike. --- src/Propellor/Types/Target.hs | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 40b3891e..e4d8c9c1 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -3,6 +3,11 @@ module Propellor.Types.Target ( Target(..), Targeting(..), + mkProperty, + mkProperty', + OuterTarget, + ensureProperty, + orProperty, target, UnixLike, unixLike, @@ -14,8 +19,6 @@ module Propellor.Types.Target ( freeBSD, unionTargets, intersectTarget, - orProperty, - ensureProperty, ) where import Network.BSD (HostName) @@ -25,8 +28,22 @@ import Data.List data Property target = Property target (IO ()) -mkProperty :: IO () -> Property UnixLike -mkProperty a = Property unixLike a +mkProperty :: Targeting targets -> IO () -> Property (Targeting targets) +mkProperty target a = Property target a + +mkProperty' :: Targeting targets -> (OuterTarget targets -> IO ()) -> Property (Targeting targets) +mkProperty' target@(Targeting l) a = Property target (a (OuterTarget l)) + +data OuterTarget (targets :: [Target]) = OuterTarget [Target] + +-- | Use `mkProperty'` to get the `OuterTarget`. Only properties whose +-- targets are a superset of the outer targets can be ensured. +ensureProperty + :: ((innertargets `NotSupersetTargets` outertargets) ~ CanCombineTargets) + => OuterTarget outertargets + -> Property (Targeting innertargets) + -> IO () +ensureProperty outertarget (Property innertarget a) = a -- | Changes the target of a property. -- @@ -61,15 +78,19 @@ orProperty a@(Property ta ioa) b@(Property tb iob) = -- ensureProperty supportedos jail -- where supportedos = unionTargets debian freeBSD +foo :: Property (Targeting '[OSFreeBSD]) +foo = mkProperty' freeBSD $ \t -> do + ensureProperty t jail + --bar :: Property (Targeting '[OSDebian, OSFreeBSD]) bar = aptinstall `orProperty` jail aptinstall :: Property DebianOnly -aptinstall = target debian $ mkProperty $ do +aptinstall = mkProperty debian $ do return () jail :: Property FreeBSDOnly -jail = target freeBSD $ mkProperty $ do +jail = mkProperty freeBSD $ do return () ----- END DEMO ---------- @@ -104,14 +125,6 @@ freeBSD = targeting OSFreeBSD targeting :: Target -> Targeting os targeting o = Targeting [o] --- The outertarget parameter needs to be passed in from the outer property. -ensureProperty - :: ((innertarget `NotSupersetTargets` outertarget) ~ CanCombineTargets) - => Targeting outertarget - -> Property (Targeting innertarget) - -> IO () -ensureProperty outertarget (Property inneros a) = a - -- | The union of two lists of Targets. unionTargets :: Targeting l1 -- cgit v1.2.3 From 48f9af6fc69f8daab3a80d041bb760d1f6d17406 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 17 Mar 2016 12:37:37 -0400 Subject: comments --- src/Propellor/Types/Target.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index e4d8c9c1..1d8107f1 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -53,7 +53,8 @@ target => Targeting newtarget -> Property (Targeting oldtarget) -> Property (Targeting combinedtarget) -target newtarget (Property oldtarget a) = Property (intersectTarget oldtarget newtarget) a +target newtarget (Property oldtarget a) = + Property (intersectTarget oldtarget newtarget) a -- | Picks one of the two input properties to use, -- depending on the targeted OS. @@ -82,7 +83,7 @@ foo :: Property (Targeting '[OSFreeBSD]) foo = mkProperty' freeBSD $ \t -> do ensureProperty t jail ---bar :: Property (Targeting '[OSDebian, OSFreeBSD]) +bar :: Property (Targeting '[OSDebian, OSFreeBSD]) bar = aptinstall `orProperty` jail aptinstall :: Property DebianOnly @@ -98,7 +99,13 @@ jail = mkProperty freeBSD $ do data Target = OSDebian | OSBuntish | OSFreeBSD deriving (Show, Eq) --- | A type-level and value-level list of targets. +-- | A type-level and value-level set of targets. +-- +-- Note that the current implementation uses a list, although most +-- operations remove duplicate values. The ordering of the list should not +-- matter; it would be better to use the type-level-sets package, but it +-- needs a newer version of ghc than the minimum version propellor +-- supports. data Targeting (targets :: [Target]) = Targeting [Target] deriving (Show, Eq) -- cgit v1.2.3 From f3d4a06360e16ab3db050b1064651555204f5218 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 17 Mar 2016 14:44:07 -0400 Subject: wip --- src/Propellor/Types/Target.hs | 63 ++++++++++++++++++++++++++++--------------- 1 file changed, 41 insertions(+), 22 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 1d8107f1..8b17d32f 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes #-} module Propellor.Types.Target ( +{- Target(..), Targeting(..), mkProperty, @@ -19,6 +20,7 @@ module Propellor.Types.Target ( freeBSD, unionTargets, intersectTarget, +-} ) where import Network.BSD (HostName) @@ -26,15 +28,17 @@ import Data.Typeable import Data.String import Data.List -data Property target = Property target (IO ()) +data Property proptypes = Property proptypes (IO ()) -mkProperty :: Targeting targets -> IO () -> Property (Targeting targets) -mkProperty target a = Property target a +mkProperty :: proptypes -> IO () -> Property proptypes +mkProperty proptypes a = Property proptypes a -mkProperty' :: Targeting targets -> (OuterTarget targets -> IO ()) -> Property (Targeting targets) -mkProperty' target@(Targeting l) a = Property target (a (OuterTarget l)) +{- -data OuterTarget (targets :: [Target]) = OuterTarget [Target] +mkProperty' :: proptypes -> (OuterPropTypes proptypes -> IO ()) -> Property proptypes +mkProperty' target@l a = Property target (a (OuterPropTypes l)) + +data OuterPropTypes (proptypes :: PropTypes) = OuterPropTypes PropTypes -- | Use `mkProperty'` to get the `OuterTarget`. Only properties whose -- targets are a superset of the outer targets can be ensured. @@ -95,42 +99,54 @@ jail = mkProperty freeBSD $ do return () ----- END DEMO ---------- +-} + -- | A Target system, where a Property is indended to be used. data Target = OSDebian | OSBuntish | OSFreeBSD deriving (Show, Eq) --- | A type-level and value-level set of targets. --- --- Note that the current implementation uses a list, although most --- operations remove duplicate values. The ordering of the list should not --- matter; it would be better to use the type-level-sets package, but it --- needs a newer version of ghc than the minimum version propellor --- supports. -data Targeting (targets :: [Target]) = Targeting [Target] +-- | A property has a list of associated PropType's +data PropType + = Targeting Target -- ^ A target OS of a Property + | HasInfo -- ^ Indicates that a Property has associated Info deriving (Show, Eq) -type UnixLike = Targeting '[OSDebian, OSBuntish, OSFreeBSD] +data PropTypes (proptypes :: [PropType]) = PropTypes [PropType] + +type UnixLike = PropTypes '[Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] unixLike :: UnixLike -unixLike = Targeting [OSDebian, OSBuntish, OSFreeBSD] +unixLike = PropTypes [Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] -type DebianOnly = Targeting '[OSDebian] +type DebianOnly = PropTypes '[Targeting OSDebian] debian :: DebianOnly debian = targeting OSDebian -type BuntishOnly = Targeting '[OSBuntish] +type BuntishOnly = PropTypes '[Targeting OSBuntish] buntish :: BuntishOnly buntish = targeting OSBuntish -type FreeBSDOnly = Targeting '[OSFreeBSD] +type FreeBSDOnly = PropTypes '[Targeting OSFreeBSD] freeBSD :: FreeBSDOnly freeBSD = targeting OSFreeBSD -targeting :: Target -> Targeting os -targeting o = Targeting [o] +targeting :: Target -> PropTypes l +targeting o = PropTypes [Targeting o] + +foo :: PropTypes (HasInfo :+: DebianOnly) +foo = HasInfo `also` debian + +also :: (l' ~ (:+:) t (PropTypes l)) => PropType -> (PropTypes l) -> PropTypes l' +p `also` PropTypes l = PropTypes (p:l) + +-- | Add a PropType to a PropTypes +type family (p :: PropType) :+: l :: l2 +type instance p :+: (PropTypes l) = PropTypes (p ': l) + +{- -- | The union of two lists of Targets. unionTargets @@ -226,3 +242,6 @@ type instance 'False && 'True = 'False type family Not (a :: Bool) :: Bool type instance Not 'False = 'True type instance Not 'True = 'False + + +-} -- cgit v1.2.3 From f19184ed9e061bd2574922994dc1e4736744b25e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 18 Mar 2016 09:10:06 -0400 Subject: wip Converted to singletons. Type level functions not updated yet. --- src/Propellor/Types/Target.hs | 202 ++++++++++++++++++++++++------------------ 1 file changed, 114 insertions(+), 88 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 8b17d32f..4f781f55 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes #-} +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, GADTs #-} module Propellor.Types.Target ( {- @@ -28,126 +28,144 @@ import Data.Typeable import Data.String import Data.List -data Property proptypes = Property proptypes (IO ()) - -mkProperty :: proptypes -> IO () -> Property proptypes -mkProperty proptypes a = Property proptypes a - -{- - -mkProperty' :: proptypes -> (OuterPropTypes proptypes -> IO ()) -> Property proptypes -mkProperty' target@l a = Property target (a (OuterPropTypes l)) - -data OuterPropTypes (proptypes :: PropTypes) = OuterPropTypes PropTypes - --- | Use `mkProperty'` to get the `OuterTarget`. Only properties whose --- targets are a superset of the outer targets can be ensured. -ensureProperty - :: ((innertargets `NotSupersetTargets` outertargets) ~ CanCombineTargets) - => OuterTarget outertargets - -> Property (Targeting innertargets) - -> IO () -ensureProperty outertarget (Property innertarget a) = a - --- | Changes the target of a property. --- --- This can only tighten the target list to contain fewer targets. -target - :: (combinedtarget ~ IntersectTarget oldtarget newtarget, CannotCombineTargets oldtarget newtarget combinedtarget ~ CanCombineTargets) - => Targeting newtarget - -> Property (Targeting oldtarget) - -> Property (Targeting combinedtarget) -target newtarget (Property oldtarget a) = - Property (intersectTarget oldtarget newtarget) a - --- | Picks one of the two input properties to use, --- depending on the targeted OS. --- --- If both input properties support the targeted OS, then the --- first will be used. -orProperty - :: Property (Targeting a) - -> Property (Targeting b) - -> Property (Targeting (UnionTarget a b)) -orProperty a@(Property ta ioa) b@(Property tb iob) = - Property (unionTargets ta tb) io - where - -- TODO pick with of ioa or iob to use based on final OS of - -- system being run on. - io = undefined - ----- DEMO ---------- + -- Intentionally a type error! :) --foo :: Property (Targeting '[OSDebian, OSFreeBSD]) --foo = Property supportedos $ do -- ensureProperty supportedos jail -- where supportedos = unionTargets debian freeBSD -foo :: Property (Targeting '[OSFreeBSD]) -foo = mkProperty' freeBSD $ \t -> do - ensureProperty t jail - +{- bar :: Property (Targeting '[OSDebian, OSFreeBSD]) bar = aptinstall `orProperty` jail +-} + +foo :: Property FreeBSDOnly +foo = mkProperty' $ \t -> do + ensureProperty t jail + aptinstall :: Property DebianOnly -aptinstall = mkProperty debian $ do +aptinstall = mkProperty $ do return () -jail :: Property FreeBSDOnly -jail = mkProperty freeBSD $ do +jail :: Property (HasInfo :+: FreeBSDOnly) +jail = mkProperty $ do return () + ----- END DEMO ---------- --} +data Property proptypes = Property proptypes (IO ()) --- | A Target system, where a Property is indended to be used. -data Target = OSDebian | OSBuntish | OSFreeBSD +mkProperty :: Sing l => IO () -> Property (WithTypes l) +mkProperty = mkProperty' . const + +mkProperty' :: Sing l => (OuterPropTypes l -> IO ()) -> Property (WithTypes l) +mkProperty' a = + let p = Property sing (a (outerPropTypes p)) + in p + +data OS = OSDebian | OSBuntish | OSFreeBSD deriving (Show, Eq) --- | A property has a list of associated PropType's data PropType - = Targeting Target -- ^ A target OS of a Property - | HasInfo -- ^ Indicates that a Property has associated Info + = Targeting OS -- ^ A target OS of a Property + | WithInfo -- ^ Indicates that a Property has associated Info deriving (Show, Eq) -data PropTypes (proptypes :: [PropType]) = PropTypes [PropType] - -type UnixLike = PropTypes '[Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] +-- | Any unix-like system +type UnixLike = WithTypes '[Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] +type DebianOnly = WithTypes '[Targeting OSDebian] +type BuntishOnly = WithTypes '[Targeting OSBuntish] +type FreeBSDOnly = WithTypes '[Targeting OSFreeBSD] -unixLike :: UnixLike -unixLike = PropTypes [Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] +type HasInfo = WithTypes '[WithInfo] -type DebianOnly = PropTypes '[Targeting OSDebian] +data family WithTypes (x :: k) -debian :: DebianOnly -debian = targeting OSDebian +class Sing t where + -- Constructor for a singleton WithTypes list. + sing :: WithTypes t -type BuntishOnly = PropTypes '[Targeting OSBuntish] +data instance WithTypes (x :: [k]) where + Nil :: WithTypes '[] + Cons :: WithTypes x -> WithTypes xs -> WithTypes (x ': xs) -buntish :: BuntishOnly -buntish = targeting OSBuntish +instance (Sing x, Sing xs) => Sing (x ': xs) where sing = Cons sing sing +instance Sing '[] where sing = Nil -type FreeBSDOnly = PropTypes '[Targeting OSFreeBSD] +-- This boilerplatw would not be needed if the singletons library were +-- used. However, we're targeting too old a version of ghc to use it yet. +data instance WithTypes (x :: PropType) where + OSDebianS :: WithTypes ('Targeting OSDebian) + OSBuntishS :: WithTypes ('Targeting OSBuntish) + OSFreeBSDS :: WithTypes ('Targeting OSFreeBSD) + WithInfoS :: WithTypes 'WithInfo +instance Sing ('Targeting OSDebian) where sing = OSDebianS +instance Sing ('Targeting OSBuntish) where sing = OSBuntishS +instance Sing ('Targeting OSFreeBSD) where sing = OSFreeBSDS +instance Sing 'WithInfo where sing = WithInfoS -freeBSD :: FreeBSDOnly -freeBSD = targeting OSFreeBSD +-- | Convenience type operator to combine two WithTypes lists. +-- +-- For example, to add HasInfo to the DebianOnly list: +-- +-- > HasInfo :+: DebianOnly +-- +-- Which is shorthand for this type: +-- +-- > WithTypes '[WithInfo, Targeting OSDebian] +type family a :+: b :: ab +type instance (WithTypes a) :+: (WithTypes b) = WithTypes (Concat a b) -targeting :: Target -> PropTypes l -targeting o = PropTypes [Targeting o] +type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Concat '[] bs = bs +type instance Concat (a ': as) bs = a ': (Concat as bs) -foo :: PropTypes (HasInfo :+: DebianOnly) -foo = HasInfo `also` debian +newtype OuterPropTypes l = OuterPropTypes (WithTypes l) -also :: (l' ~ (:+:) t (PropTypes l)) => PropType -> (PropTypes l) -> PropTypes l' -p `also` PropTypes l = PropTypes (p:l) +outerPropTypes :: Property (WithTypes l) -> OuterPropTypes l +outerPropTypes (Property proptypes _) = OuterPropTypes proptypes --- | Add a PropType to a PropTypes -type family (p :: PropType) :+: l :: l2 -type instance p :+: (PropTypes l) = PropTypes (p ': l) +-- | Use `mkProperty''` to get the `OuterPropTypes`. Only properties whose +-- PropTypes are a superset of the OuterPropTypes can be ensured. +ensureProperty + :: ((inner `NotSupersetTargets` outer) ~ CanCombineTargets) + => OuterPropTypes outer + -> Property inner + -> IO () +ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a {- +-- | Changes the target of a property. +-- +-- This can only tighten the target list to contain fewer targets. +target + :: (combinedtarget ~ IntersectTarget oldtarget newtarget, CannotCombineTargets oldtarget newtarget combinedtarget ~ CanCombineTargets) + => Targeting newtarget + -> Property (Targeting oldtarget) + -> Property (Targeting combinedtarget) +target newtarget (Property oldtarget a) = + Property (intersectTarget oldtarget newtarget) a + +-- | Picks one of the two input properties to use, +-- depending on the targeted OS. +-- +-- If both input properties support the targeted OS, then the +-- first will be used. +orProperty + :: Property (Targeting a) + -> Property (Targeting b) + -> Property (Targeting (UnionTarget a b)) +orProperty a@(Property ta ioa) b@(Property tb iob) = + Property (unionTargets ta tb) io + where + -- TODO pick with of ioa or iob to use based on final OS of + -- system being run on. + io = undefined + -- | The union of two lists of Targets. unionTargets :: Targeting l1 @@ -165,8 +183,12 @@ intersectTarget intersectTarget (Targeting l1) (Targeting l2) = Targeting $ nub $ filter (`elem` l2) l1 +-} + data CheckCombineTargets = CannotCombineTargets | CanCombineTargets +{- + -- | Detect intersection of two lists that don't have any common OS. -- -- The name of this was chosen to make type errors a more understandable. @@ -174,7 +196,9 @@ type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets --- | Everything in the subset must be in the superset. +-} + +-- | Every target in the subset must be in the superset. -- -- The name of this was chosen to make type errors a more understandable. type family NotSupersetTargets (superset :: [a]) (subset :: [a]) :: CheckCombineTargets @@ -184,6 +208,8 @@ type instance NotSupersetTargets superset (s ': rest) = (NotSupersetTargets superset rest) 'CannotCombineTargets +{- + -- | Type level intersection of lists of Targets type family IntersectTarget (list1 :: [a]) (list2 :: [a]) :: [a] type instance IntersectTarget '[] list2 = '[] @@ -224,6 +250,8 @@ type instance EqTarget OSFreeBSD OSBuntish = 'False -- EqTarget a a = True -- EqTarget a b = False +-} + -- | An equivilant to the following is in Data.Type.Bool in -- modern versions of ghc, but is included here to support ghc 7.6. type family If (cond :: Bool) (tru :: a) (fls :: a) :: a @@ -243,5 +271,3 @@ type family Not (a :: Bool) :: Bool type instance Not 'False = 'True type instance Not 'True = 'False - --} -- cgit v1.2.3 From e64ef009d9ee5d21acb1e7de2ee03a23c4ff2c27 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 18 Mar 2016 12:28:19 -0400 Subject: wip --- src/Propellor/Types/Target.hs | 112 ++++++++++++++++++++++++++---------------- 1 file changed, 71 insertions(+), 41 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 4f781f55..42cdb26a 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -42,15 +42,15 @@ bar = aptinstall `orProperty` jail -} -foo :: Property FreeBSDOnly +foo :: Property (HasInfo :+: FreeBSD) foo = mkProperty' $ \t -> do ensureProperty t jail -aptinstall :: Property DebianOnly +aptinstall :: Property Debian aptinstall = mkProperty $ do return () -jail :: Property (HasInfo :+: FreeBSDOnly) +jail :: Property FreeBSD jail = mkProperty $ do return () @@ -76,9 +76,9 @@ data PropType -- | Any unix-like system type UnixLike = WithTypes '[Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] -type DebianOnly = WithTypes '[Targeting OSDebian] -type BuntishOnly = WithTypes '[Targeting OSBuntish] -type FreeBSDOnly = WithTypes '[Targeting OSFreeBSD] +type Debian = WithTypes '[Targeting OSDebian] +type Buntish = WithTypes '[Targeting OSBuntish] +type FreeBSD = WithTypes '[Targeting OSFreeBSD] type HasInfo = WithTypes '[WithInfo] @@ -109,9 +109,9 @@ instance Sing 'WithInfo where sing = WithInfoS -- | Convenience type operator to combine two WithTypes lists. -- --- For example, to add HasInfo to the DebianOnly list: +-- For example: -- --- > HasInfo :+: DebianOnly +-- > HasInfo :+: Debian -- -- Which is shorthand for this type: -- @@ -128,15 +128,30 @@ newtype OuterPropTypes l = OuterPropTypes (WithTypes l) outerPropTypes :: Property (WithTypes l) -> OuterPropTypes l outerPropTypes (Property proptypes _) = OuterPropTypes proptypes --- | Use `mkProperty''` to get the `OuterPropTypes`. Only properties whose --- PropTypes are a superset of the OuterPropTypes can be ensured. +-- | Use `mkProperty''` to get the `OuterPropTypes`. For example: +-- +-- > foo = Property Debian +-- > foo = mkProperty' $ \t -> do +-- > ensureProperty t (aptInstall "foo") +-- +-- The type checker will prevent using ensureProperty with a property +-- that does not support the target OSes needed by the OuterPropTypes. +-- In the example above, aptInstall must support Debian. +-- +-- The type checker will also prevent using ensureProperty with a property +-- with HasInfo in its PropTypes. Doing so would cause the info associated +-- with the property to be lost. ensureProperty - :: ((inner `NotSupersetTargets` outer) ~ CanCombineTargets) + :: ((Targets inner `NotSuperset` Targets outer) ~ CanCombine, NoInfo inner ~ True) => OuterPropTypes outer - -> Property inner + -> Property (WithTypes inner) -> IO () ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a +type family NoInfo (l :: [a]) :: Bool +type instance NoInfo '[] = 'True +type instance NoInfo (t ': ts) = Not (t `EqT` WithInfo) && NoInfo ts + {- -- | Changes the target of a property. @@ -185,28 +200,39 @@ intersectTarget (Targeting l1) (Targeting l2) = -} -data CheckCombineTargets = CannotCombineTargets | CanCombineTargets +data CheckCombine = CannotCombine | CanCombine {- -- | Detect intersection of two lists that don't have any common OS. -- -- The name of this was chosen to make type errors a more understandable. -type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets +type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombine type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets -} --- | Every target in the subset must be in the superset. +-- | Every item in the subset must be in the superset. -- -- The name of this was chosen to make type errors a more understandable. -type family NotSupersetTargets (superset :: [a]) (subset :: [a]) :: CheckCombineTargets -type instance NotSupersetTargets superset '[] = 'CanCombineTargets -type instance NotSupersetTargets superset (s ': rest) = - If (ElemTarget s superset) - (NotSupersetTargets superset rest) - 'CannotCombineTargets +type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombine +type instance NotSuperset superset '[] = 'CanCombine +type instance NotSuperset superset (s ': rest) = + If (Elem s superset) + (NotSuperset superset rest) + 'CannotCombine + +type family Targets (l :: [a]) :: [a] +type instance Targets '[] = '[] +type instance Targets (x ': xs) = + If (IsTarget x) + (x ': Targets xs) + (Targets xs) + +type family IsTarget (a :: t) :: Bool +type instance IsTarget (Targeting a) = True +type instance IsTarget HasInfo = False {- @@ -226,31 +252,35 @@ type instance UnionTarget (a ': rest) list2 = (UnionTarget rest list2) (a ': UnionTarget rest list2) --- | Type level elem for Target -type family ElemTarget (a :: Target) (list :: [Target]) :: Bool -type instance ElemTarget a '[] = 'False -type instance ElemTarget a (b ': bs) = EqTarget a b || ElemTarget a bs +-} + +-- | Type level elem +type family Elem (a :: t) (list :: [t]) :: Bool +type instance Elem a '[] = 'False +type instance Elem a (b ': bs) = EqT a b || Elem a bs --- | Type level equality for Target +-- | Type level equality -- -- This is a very clumsy implmentation, but it works back to ghc 7.6. -type family EqTarget (a :: Target) (b :: Target) :: Bool -type instance EqTarget OSDebian OSDebian = 'True -type instance EqTarget OSBuntish OSBuntish = 'True -type instance EqTarget OSFreeBSD OSFreeBSD = 'True -type instance EqTarget OSDebian OSBuntish = 'False -type instance EqTarget OSDebian OSFreeBSD = 'False -type instance EqTarget OSBuntish OSDebian = 'False -type instance EqTarget OSBuntish OSFreeBSD = 'False -type instance EqTarget OSFreeBSD OSDebian = 'False -type instance EqTarget OSFreeBSD OSBuntish = 'False +type family EqT (a :: t) (b :: t) :: Bool +type instance EqT (Targeting a) (Targeting b) = EqT a b +type instance EqT WithInfo WithInfo = 'True +type instance EqT WithInfo (Targeting b) = 'False +type instance EqT (Targeting a) WithInfo = 'False +type instance EqT OSDebian OSDebian = 'True +type instance EqT OSBuntish OSBuntish = 'True +type instance EqT OSFreeBSD OSFreeBSD = 'True +type instance EqT OSDebian OSBuntish = 'False +type instance EqT OSDebian OSFreeBSD = 'False +type instance EqT OSBuntish OSDebian = 'False +type instance EqT OSBuntish OSFreeBSD = 'False +type instance EqT OSFreeBSD OSDebian = 'False +type instance EqT OSFreeBSD OSBuntish = 'False -- More modern version if the combinatiorial explosion gets too bad later: -- --- type family EqTarget (a :: Target) (b :: Target) where --- EqTarget a a = True --- EqTarget a b = False - --} +-- type family Eq (a :: PropType) (b :: PropType) where +-- Eq a a = True +-- Eq a b = False -- | An equivilant to the following is in Data.Type.Bool in -- modern versions of ghc, but is included here to support ghc 7.6. -- cgit v1.2.3 From ae84f01f6df1ffe3e2de747132eb8e092582d0f0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Mar 2016 08:49:10 -0400 Subject: fix type error --- src/Propellor/Types/Target.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 42cdb26a..1ffd53e2 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -142,15 +142,16 @@ outerPropTypes (Property proptypes _) = OuterPropTypes proptypes -- with HasInfo in its PropTypes. Doing so would cause the info associated -- with the property to be lost. ensureProperty - :: ((Targets inner `NotSuperset` Targets outer) ~ CanCombine, NoInfo inner ~ True) + :: ((Targets inner `NotSuperset` Targets outer) ~ CanCombine, CannotUseEnsurePropertyWithInfo inner ~ True) => OuterPropTypes outer -> Property (WithTypes inner) -> IO () ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a -type family NoInfo (l :: [a]) :: Bool -type instance NoInfo '[] = 'True -type instance NoInfo (t ': ts) = Not (t `EqT` WithInfo) && NoInfo ts +-- The name of this was chosen to make type errors a more understandable. +type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool +type instance CannotUseEnsurePropertyWithInfo '[] = 'True +type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` WithInfo) && CannotUseEnsurePropertyWithInfo ts {- @@ -232,7 +233,7 @@ type instance Targets (x ': xs) = type family IsTarget (a :: t) :: Bool type instance IsTarget (Targeting a) = True -type instance IsTarget HasInfo = False +type instance IsTarget WithInfo = False {- -- cgit v1.2.3 From 5d146511b7666791c2fe183ff5705491a03547d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Mar 2016 09:30:33 -0400 Subject: haddock --- src/Propellor/Types/Target.hs | 53 +++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 1ffd53e2..d84385a8 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -1,26 +1,21 @@ {-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, GADTs #-} module Propellor.Types.Target ( -{- - Target(..), - Targeting(..), + Property(..), mkProperty, mkProperty', - OuterTarget, - ensureProperty, - orProperty, - target, + OS(..), + PropType(..), UnixLike, - unixLike, - DebianOnly, - debian, - BuntishOnly, - buntish, - FreeBSDOnly, - freeBSD, - unionTargets, - intersectTarget, --} + Debian, + Buntish, + FreeBSD, + HasInfo, + (:+:), + OuterPropTypes, + ensureProperty, + Sing, + WithTypes, ) where import Network.BSD (HostName) @@ -30,22 +25,15 @@ import Data.List ----- DEMO ---------- --- Intentionally a type error! :) ---foo :: Property (Targeting '[OSDebian, OSFreeBSD]) ---foo = Property supportedos $ do --- ensureProperty supportedos jail --- where supportedos = unionTargets debian freeBSD +foo :: Property (HasInfo :+: FreeBSD) +foo = mkProperty' $ \t -> do + ensureProperty t jail {- bar :: Property (Targeting '[OSDebian, OSFreeBSD]) bar = aptinstall `orProperty` jail - -} -foo :: Property (HasInfo :+: FreeBSD) -foo = mkProperty' $ \t -> do - ensureProperty t jail - aptinstall :: Property Debian aptinstall = mkProperty $ do return () @@ -66,7 +54,10 @@ mkProperty' a = let p = Property sing (a (outerPropTypes p)) in p -data OS = OSDebian | OSBuntish | OSFreeBSD +data OS + = OSDebian + | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per ) + | OSFreeBSD deriving (Show, Eq) data PropType @@ -80,12 +71,14 @@ type Debian = WithTypes '[Targeting OSDebian] type Buntish = WithTypes '[Targeting OSBuntish] type FreeBSD = WithTypes '[Targeting OSFreeBSD] +-- | Used to indicate that a Property adds Info to the Host where it's used. type HasInfo = WithTypes '[WithInfo] +-- | A family of type-level lists of [`PropType`] data family WithTypes (x :: k) +-- | Singletons class Sing t where - -- Constructor for a singleton WithTypes list. sing :: WithTypes t data instance WithTypes (x :: [k]) where @@ -107,7 +100,7 @@ instance Sing ('Targeting OSBuntish) where sing = OSBuntishS instance Sing ('Targeting OSFreeBSD) where sing = OSFreeBSDS instance Sing 'WithInfo where sing = WithInfoS --- | Convenience type operator to combine two WithTypes lists. +-- | Convenience type operator to combine two `WithTypes` lists. -- -- For example: -- -- cgit v1.2.3 From 345dbafc5131030fd56f2fb442bb89e56fb34dff Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Mar 2016 09:35:16 -0400 Subject: typo --- src/Propellor/Types/OS.hs | 2 +- src/Propellor/Types/Target.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index a1ba14d4..94a37936 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -28,7 +28,7 @@ data System = System Distribution Architecture data Distribution = Debian DebianSuite - | Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per ) + | Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per | FreeBSD FreeBSDRelease deriving (Show, Eq) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index d84385a8..dd098c3b 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -56,7 +56,7 @@ mkProperty' a = data OS = OSDebian - | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per ) + | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per | OSFreeBSD deriving (Show, Eq) -- cgit v1.2.3 From 368eaf569846199f4a68fe52d74ff50e19cc3820 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Mar 2016 14:35:10 -0400 Subject: wip --- src/Propellor/Types/Target.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index dd098c3b..549cf99b 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -146,18 +146,17 @@ type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool type instance CannotUseEnsurePropertyWithInfo '[] = 'True type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` WithInfo) && CannotUseEnsurePropertyWithInfo ts -{- - -- | Changes the target of a property. -- -- This can only tighten the target list to contain fewer targets. target - :: (combinedtarget ~ IntersectTarget oldtarget newtarget, CannotCombineTargets oldtarget newtarget combinedtarget ~ CanCombineTargets) + :: (combined ~ IntersectTarget old new, CannotCombineTargets old new combined ~ CanCombineTargets) => Targeting newtarget - -> Property (Targeting oldtarget) - -> Property (Targeting combinedtarget) -target newtarget (Property oldtarget a) = - Property (intersectTarget oldtarget newtarget) a + -> Property (WithTypes old) + -> Property (WithTypes new) +target newtarget (Property old a) = Property (intersectTarget old new) a + +{- -- | Picks one of the two input properties to use, -- depending on the targeted OS. @@ -183,6 +182,8 @@ unionTargets unionTargets (Targeting l1) (Targeting l2) = Targeting $ nub $ l1 ++ l2 +-} + -- | The intersection between two lists of Targets. intersectTarget :: (r ~ IntersectTarget l1 l2, CannotCombineTargets l1 l2 r ~ CanCombineTargets) @@ -192,8 +193,6 @@ intersectTarget intersectTarget (Targeting l1) (Targeting l2) = Targeting $ nub $ filter (`elem` l2) l1 --} - data CheckCombine = CannotCombine | CanCombine {- -- cgit v1.2.3 From 72005752b3a86303217cb67add37ca5d515da8ae Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Mar 2016 16:49:48 -0400 Subject: wip --- src/Propellor/Types/Target.hs | 103 ++++++++++++++++++------------------------ 1 file changed, 44 insertions(+), 59 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 549cf99b..3b21d1f8 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -135,7 +135,9 @@ outerPropTypes (Property proptypes _) = OuterPropTypes proptypes -- with HasInfo in its PropTypes. Doing so would cause the info associated -- with the property to be lost. ensureProperty - :: ((Targets inner `NotSuperset` Targets outer) ~ CanCombine, CannotUseEnsurePropertyWithInfo inner ~ True) + :: ((Targets inner `NotSuperset` Targets outer) ~ CanCombineTargets + , CannotUseEnsurePropertyWithInfo inner ~ True + ) => OuterPropTypes outer -> Property (WithTypes inner) -> IO () @@ -146,15 +148,17 @@ type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool type instance CannotUseEnsurePropertyWithInfo '[] = 'True type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` WithInfo) && CannotUseEnsurePropertyWithInfo ts --- | Changes the target of a property. +-- | Tightens the PropType list of a Property, to contain fewer targets. -- --- This can only tighten the target list to contain fewer targets. -target - :: (combined ~ IntersectTarget old new, CannotCombineTargets old new combined ~ CanCombineTargets) - => Targeting newtarget +-- Anything else in the PropType list is passed through unchanged. +tightenTargets + :: ( combined ~ Concat (NonTargets old) (Intersect (Targets old) newtargets) + , CannotCombineTargets old new combined ~ CanCombineTargets + ) + => Targeting newtargets -> Property (WithTypes old) - -> Property (WithTypes new) -target newtarget (Property old a) = Property (intersectTarget old new) a + -> Property (WithTypes combined) +tightenTargets _ (Property old a) = Property sing a {- @@ -167,54 +171,44 @@ orProperty :: Property (Targeting a) -> Property (Targeting b) -> Property (Targeting (UnionTarget a b)) -orProperty a@(Property ta ioa) b@(Property tb iob) = - Property (unionTargets ta tb) io +orProperty a@(Property ta ioa) b@(Property tb iob) = Property sing io where -- TODO pick with of ioa or iob to use based on final OS of -- system being run on. io = undefined --- | The union of two lists of Targets. -unionTargets - :: Targeting l1 - -> Targeting l2 - -> Targeting (UnionTarget l1 l2) -unionTargets (Targeting l1) (Targeting l2) = - Targeting $ nub $ l1 ++ l2 +-- | Type level union of lists of Targets +type family UnionTarget (list1 :: [a]) (list2 :: [a]) :: [a] +type instance UnionTarget '[] list2 = list2 +type instance UnionTarget (a ': rest) list2 = + If (ElemTarget a list2 || ElemTarget a rest) + (UnionTarget rest list2) + (a ': UnionTarget rest list2) -} --- | The intersection between two lists of Targets. -intersectTarget - :: (r ~ IntersectTarget l1 l2, CannotCombineTargets l1 l2 r ~ CanCombineTargets) - => Targeting l1 - -> Targeting l2 - -> Targeting r -intersectTarget (Targeting l1) (Targeting l2) = - Targeting $ nub $ filter (`elem` l2) l1 - -data CheckCombine = CannotCombine | CanCombine - -{- +data CheckCombineTargets = CannotCombineTargets | CanCombineTargets --- | Detect intersection of two lists that don't have any common OS. +-- | Detect intersection of two lists that don't have any common targets. -- -- The name of this was chosen to make type errors a more understandable. -type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombine +type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets --} - -- | Every item in the subset must be in the superset. -- -- The name of this was chosen to make type errors a more understandable. -type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombine -type instance NotSuperset superset '[] = 'CanCombine +type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets +type instance NotSuperset superset '[] = 'CanCombineTargets type instance NotSuperset superset (s ': rest) = If (Elem s superset) (NotSuperset superset rest) - 'CannotCombine + 'CannotCombineTargets + +type family IsTarget (a :: t) :: Bool +type instance IsTarget (Targeting a) = True +type instance IsTarget WithInfo = False type family Targets (l :: [a]) :: [a] type instance Targets '[] = '[] @@ -223,35 +217,26 @@ type instance Targets (x ': xs) = (x ': Targets xs) (Targets xs) -type family IsTarget (a :: t) :: Bool -type instance IsTarget (Targeting a) = True -type instance IsTarget WithInfo = False - -{- - --- | Type level intersection of lists of Targets -type family IntersectTarget (list1 :: [a]) (list2 :: [a]) :: [a] -type instance IntersectTarget '[] list2 = '[] -type instance IntersectTarget (a ': rest) list2 = - If (ElemTarget a list2 && Not (ElemTarget a rest)) - (a ': IntersectTarget rest list2) - (IntersectTarget rest list2) - --- | Type level union of lists of Targets -type family UnionTarget (list1 :: [a]) (list2 :: [a]) :: [a] -type instance UnionTarget '[] list2 = list2 -type instance UnionTarget (a ': rest) list2 = - If (ElemTarget a list2 || ElemTarget a rest) - (UnionTarget rest list2) - (a ': UnionTarget rest list2) - --} +type family NonTargets (l :: [a]) :: [a] +type instance NonTargets '[] = '[] +type instance NonTargets (x ': xs) = + If (IsTarget x) + (Targets xs) + (x ': Targets xs) -- | Type level elem type family Elem (a :: t) (list :: [t]) :: Bool type instance Elem a '[] = 'False type instance Elem a (b ': bs) = EqT a b || Elem a bs +-- | Type level intersection. Duplicate list items are eliminated. +type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Intersect '[] list2 = '[] +type instance Intersect (a ': rest) list2 = + If (Elem a list2 && Not (Elem a rest)) + (a ': Intersect rest list2) + (Intersect rest list2) + -- | Type level equality -- -- This is a very clumsy implmentation, but it works back to ghc 7.6. -- cgit v1.2.3 From 5b517effceed913b3fcc0e6b43ee2cbc614f7b63 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 12:09:40 -0400 Subject: fix tightenTargets --- src/Propellor/Types/Target.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 3b21d1f8..1c0f79ee 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -135,9 +135,10 @@ outerPropTypes (Property proptypes _) = OuterPropTypes proptypes -- with HasInfo in its PropTypes. Doing so would cause the info associated -- with the property to be lost. ensureProperty - :: ((Targets inner `NotSuperset` Targets outer) ~ CanCombineTargets - , CannotUseEnsurePropertyWithInfo inner ~ True - ) + :: + ( (Targets inner `NotSuperset` Targets outer) ~ CanCombineTargets + , CannotUseEnsurePropertyWithInfo inner ~ True + ) => OuterPropTypes outer -> Property (WithTypes inner) -> IO () @@ -152,10 +153,12 @@ type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` WithInfo) -- -- Anything else in the PropType list is passed through unchanged. tightenTargets - :: ( combined ~ Concat (NonTargets old) (Intersect (Targets old) newtargets) - , CannotCombineTargets old new combined ~ CanCombineTargets - ) - => Targeting newtargets + :: + ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) + , CannotCombineTargets old new combined ~ CanCombineTargets + , Sing combined + ) + => WithTypes new -> Property (WithTypes old) -> Property (WithTypes combined) tightenTargets _ (Property old a) = Property sing a -- cgit v1.2.3 From 7972bc1b5a4dbc24f0625556bedb161cb559ffc4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 12:12:39 -0400 Subject: finished conversion to singletons --- src/Propellor/Types/Target.hs | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 1c0f79ee..55b4c947 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -29,10 +29,8 @@ foo :: Property (HasInfo :+: FreeBSD) foo = mkProperty' $ \t -> do ensureProperty t jail -{- -bar :: Property (Targeting '[OSDebian, OSFreeBSD]) +bar :: Property (Debian :+: FreeBSD) bar = aptinstall `orProperty` jail --} aptinstall :: Property Debian aptinstall = mkProperty $ do @@ -163,33 +161,25 @@ tightenTargets -> Property (WithTypes combined) tightenTargets _ (Property old a) = Property sing a -{- - -- | Picks one of the two input properties to use, -- depending on the targeted OS. -- -- If both input properties support the targeted OS, then the -- first will be used. orProperty - :: Property (Targeting a) - -> Property (Targeting b) - -> Property (Targeting (UnionTarget a b)) + :: + ( combined ~ Union a b + , Sing combined + ) + => Property (WithTypes a) + -> Property (WithTypes b) + -> Property (WithTypes combined) orProperty a@(Property ta ioa) b@(Property tb iob) = Property sing io where -- TODO pick with of ioa or iob to use based on final OS of -- system being run on. io = undefined --- | Type level union of lists of Targets -type family UnionTarget (list1 :: [a]) (list2 :: [a]) :: [a] -type instance UnionTarget '[] list2 = list2 -type instance UnionTarget (a ': rest) list2 = - If (ElemTarget a list2 || ElemTarget a rest) - (UnionTarget rest list2) - (a ': UnionTarget rest list2) - --} - data CheckCombineTargets = CannotCombineTargets | CanCombineTargets -- | Detect intersection of two lists that don't have any common targets. @@ -232,6 +222,14 @@ type family Elem (a :: t) (list :: [t]) :: Bool type instance Elem a '[] = 'False type instance Elem a (b ': bs) = EqT a b || Elem a bs +-- | Type level union. +type family Union (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Union '[] list2 = list2 +type instance Union (a ': rest) list2 = + If (Elem a list2 || Elem a rest) + (Union rest list2) + (a ': Union rest list2) + -- | Type level intersection. Duplicate list items are eliminated. type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a] type instance Intersect '[] list2 = '[] -- cgit v1.2.3 From 3ad1bf47a85a201dc0922c46bf862930d248e5a1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 12:18:09 -0400 Subject: cleanup --- src/Propellor/Types/Target.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 55b4c947..784937b1 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, GADTs #-} +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} module Propellor.Types.Target ( Property(..), -- cgit v1.2.3 From 4be7bb8c9f9120654a95788ff9b6a34226dea06a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 12:19:26 -0400 Subject: fix tick warning --- src/Propellor/Types/Target.hs | 67 +++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 35 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 784937b1..2b4699c0 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -14,15 +14,12 @@ module Propellor.Types.Target ( (:+:), OuterPropTypes, ensureProperty, + tightenTargets, + orProperty, Sing, WithTypes, ) where -import Network.BSD (HostName) -import Data.Typeable -import Data.String -import Data.List - ----- DEMO ---------- foo :: Property (HasInfo :+: FreeBSD) @@ -64,13 +61,13 @@ data PropType deriving (Show, Eq) -- | Any unix-like system -type UnixLike = WithTypes '[Targeting OSDebian, Targeting OSBuntish, Targeting OSFreeBSD] -type Debian = WithTypes '[Targeting OSDebian] -type Buntish = WithTypes '[Targeting OSBuntish] -type FreeBSD = WithTypes '[Targeting OSFreeBSD] +type UnixLike = WithTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +type Debian = WithTypes '[ 'Targeting 'OSDebian ] +type Buntish = WithTypes '[ 'Targeting 'OSBuntish ] +type FreeBSD = WithTypes '[ 'Targeting 'OSFreeBSD ] -- | Used to indicate that a Property adds Info to the Host where it's used. -type HasInfo = WithTypes '[WithInfo] +type HasInfo = WithTypes '[ 'WithInfo ] -- | A family of type-level lists of [`PropType`] data family WithTypes (x :: k) @@ -89,13 +86,13 @@ instance Sing '[] where sing = Nil -- This boilerplatw would not be needed if the singletons library were -- used. However, we're targeting too old a version of ghc to use it yet. data instance WithTypes (x :: PropType) where - OSDebianS :: WithTypes ('Targeting OSDebian) - OSBuntishS :: WithTypes ('Targeting OSBuntish) - OSFreeBSDS :: WithTypes ('Targeting OSFreeBSD) + OSDebianS :: WithTypes ('Targeting 'OSDebian) + OSBuntishS :: WithTypes ('Targeting 'OSBuntish) + OSFreeBSDS :: WithTypes ('Targeting 'OSFreeBSD) WithInfoS :: WithTypes 'WithInfo -instance Sing ('Targeting OSDebian) where sing = OSDebianS -instance Sing ('Targeting OSBuntish) where sing = OSBuntishS -instance Sing ('Targeting OSFreeBSD) where sing = OSFreeBSDS +instance Sing ('Targeting 'OSDebian) where sing = OSDebianS +instance Sing ('Targeting 'OSBuntish) where sing = OSBuntishS +instance Sing ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS instance Sing 'WithInfo where sing = WithInfoS -- | Convenience type operator to combine two `WithTypes` lists. @@ -134,8 +131,8 @@ outerPropTypes (Property proptypes _) = OuterPropTypes proptypes -- with the property to be lost. ensureProperty :: - ( (Targets inner `NotSuperset` Targets outer) ~ CanCombineTargets - , CannotUseEnsurePropertyWithInfo inner ~ True + ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets + , CannotUseEnsurePropertyWithInfo inner ~ 'True ) => OuterPropTypes outer -> Property (WithTypes inner) @@ -145,7 +142,7 @@ ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a -- The name of this was chosen to make type errors a more understandable. type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool type instance CannotUseEnsurePropertyWithInfo '[] = 'True -type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` WithInfo) && CannotUseEnsurePropertyWithInfo ts +type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts -- | Tightens the PropType list of a Property, to contain fewer targets. -- @@ -153,7 +150,7 @@ type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` WithInfo) tightenTargets :: ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) - , CannotCombineTargets old new combined ~ CanCombineTargets + , CannotCombineTargets old new combined ~ 'CanCombineTargets , Sing combined ) => WithTypes new @@ -200,8 +197,8 @@ type instance NotSuperset superset (s ': rest) = 'CannotCombineTargets type family IsTarget (a :: t) :: Bool -type instance IsTarget (Targeting a) = True -type instance IsTarget WithInfo = False +type instance IsTarget ('Targeting a) = 'True +type instance IsTarget 'WithInfo = 'False type family Targets (l :: [a]) :: [a] type instance Targets '[] = '[] @@ -242,19 +239,19 @@ type instance Intersect (a ': rest) list2 = -- -- This is a very clumsy implmentation, but it works back to ghc 7.6. type family EqT (a :: t) (b :: t) :: Bool -type instance EqT (Targeting a) (Targeting b) = EqT a b -type instance EqT WithInfo WithInfo = 'True -type instance EqT WithInfo (Targeting b) = 'False -type instance EqT (Targeting a) WithInfo = 'False -type instance EqT OSDebian OSDebian = 'True -type instance EqT OSBuntish OSBuntish = 'True -type instance EqT OSFreeBSD OSFreeBSD = 'True -type instance EqT OSDebian OSBuntish = 'False -type instance EqT OSDebian OSFreeBSD = 'False -type instance EqT OSBuntish OSDebian = 'False -type instance EqT OSBuntish OSFreeBSD = 'False -type instance EqT OSFreeBSD OSDebian = 'False -type instance EqT OSFreeBSD OSBuntish = 'False +type instance EqT ('Targeting a) ('Targeting b) = EqT a b +type instance EqT 'WithInfo 'WithInfo = 'True +type instance EqT 'WithInfo ('Targeting b) = 'False +type instance EqT ('Targeting a) 'WithInfo = 'False +type instance EqT 'OSDebian 'OSDebian = 'True +type instance EqT 'OSBuntish 'OSBuntish = 'True +type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True +type instance EqT 'OSDebian 'OSBuntish = 'False +type instance EqT 'OSDebian 'OSFreeBSD = 'False +type instance EqT 'OSBuntish 'OSDebian = 'False +type instance EqT 'OSBuntish 'OSFreeBSD = 'False +type instance EqT 'OSFreeBSD 'OSDebian = 'False +type instance EqT 'OSFreeBSD 'OSBuntish = 'False -- More modern version if the combinatiorial explosion gets too bad later: -- -- type family Eq (a :: PropType) (b :: PropType) where -- cgit v1.2.3 From 827b5a8fbc2a39ac9ebfa8571dab096071a1471d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 13:06:05 -0400 Subject: rename --- src/Propellor/Types/Target.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs index 2b4699c0..420c6ed2 100644 --- a/src/Propellor/Types/Target.hs +++ b/src/Propellor/Types/Target.hs @@ -15,7 +15,7 @@ module Propellor.Types.Target ( OuterPropTypes, ensureProperty, tightenTargets, - orProperty, + pickOS, Sing, WithTypes, ) where @@ -27,7 +27,7 @@ foo = mkProperty' $ \t -> do ensureProperty t jail bar :: Property (Debian :+: FreeBSD) -bar = aptinstall `orProperty` jail +bar = aptinstall `pickOS` jail aptinstall :: Property Debian aptinstall = mkProperty $ do @@ -163,7 +163,7 @@ tightenTargets _ (Property old a) = Property sing a -- -- If both input properties support the targeted OS, then the -- first will be used. -orProperty +pickOS :: ( combined ~ Union a b , Sing combined @@ -171,7 +171,7 @@ orProperty => Property (WithTypes a) -> Property (WithTypes b) -> Property (WithTypes combined) -orProperty a@(Property ta ioa) b@(Property tb iob) = Property sing io +pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io where -- TODO pick with of ioa or iob to use based on final OS of -- system being run on. -- cgit v1.2.3 From 719286cb036d2623ce0604bd10584f2e88c7e49e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 13:10:48 -0400 Subject: rename module --- propellor.cabal | 2 +- src/Propellor/Types/PropTypes.hs | 279 +++++++++++++++++++++++++++++++++++++++ src/Propellor/Types/Target.hs | 279 --------------------------------------- 3 files changed, 280 insertions(+), 280 deletions(-) create mode 100644 src/Propellor/Types/PropTypes.hs delete mode 100644 src/Propellor/Types/Target.hs diff --git a/propellor.cabal b/propellor.cabal index 4db210d0..f84403f2 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -152,9 +152,9 @@ Library Propellor.Types.Info Propellor.Types.OS Propellor.Types.PrivData + Propellor.Types.PropTypes Propellor.Types.Result Propellor.Types.ResultCheck - Propellor.Types.Target Propellor.Types.ZFS Other-Modules: Propellor.Bootstrap diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs new file mode 100644 index 00000000..d3d04dca --- /dev/null +++ b/src/Propellor/Types/PropTypes.hs @@ -0,0 +1,279 @@ +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} + +module Propellor.Types.PropTypes ( + Property(..), + mkProperty, + mkProperty', + OS(..), + PropType(..), + UnixLike, + Debian, + Buntish, + FreeBSD, + HasInfo, + (:+:), + OuterPropTypes, + ensureProperty, + tightenTargets, + pickOS, + Sing, + WithTypes, +) where + +----- DEMO ---------- + +foo :: Property (HasInfo :+: FreeBSD) +foo = mkProperty' $ \t -> do + ensureProperty t jail + +bar :: Property (Debian :+: FreeBSD) +bar = aptinstall `pickOS` jail + +aptinstall :: Property Debian +aptinstall = mkProperty $ do + return () + +jail :: Property FreeBSD +jail = mkProperty $ do + return () + +----- END DEMO ---------- + +data Property proptypes = Property proptypes (IO ()) + +mkProperty :: Sing l => IO () -> Property (WithTypes l) +mkProperty = mkProperty' . const + +mkProperty' :: Sing l => (OuterPropTypes l -> IO ()) -> Property (WithTypes l) +mkProperty' a = + let p = Property sing (a (outerPropTypes p)) + in p + +data OS + = OSDebian + | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per + | OSFreeBSD + deriving (Show, Eq) + +data PropType + = Targeting OS -- ^ A target OS of a Property + | WithInfo -- ^ Indicates that a Property has associated Info + deriving (Show, Eq) + +-- | Any unix-like system +type UnixLike = WithTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +type Debian = WithTypes '[ 'Targeting 'OSDebian ] +type Buntish = WithTypes '[ 'Targeting 'OSBuntish ] +type FreeBSD = WithTypes '[ 'Targeting 'OSFreeBSD ] + +-- | Used to indicate that a Property adds Info to the Host where it's used. +type HasInfo = WithTypes '[ 'WithInfo ] + +-- | A family of type-level lists of [`PropType`] +data family WithTypes (x :: k) + +-- | Singletons +class Sing t where + sing :: WithTypes t + +data instance WithTypes (x :: [k]) where + Nil :: WithTypes '[] + Cons :: WithTypes x -> WithTypes xs -> WithTypes (x ': xs) + +instance (Sing x, Sing xs) => Sing (x ': xs) where sing = Cons sing sing +instance Sing '[] where sing = Nil + +-- This boilerplatw would not be needed if the singletons library were +-- used. However, we're targeting too old a version of ghc to use it yet. +data instance WithTypes (x :: PropType) where + OSDebianS :: WithTypes ('Targeting 'OSDebian) + OSBuntishS :: WithTypes ('Targeting 'OSBuntish) + OSFreeBSDS :: WithTypes ('Targeting 'OSFreeBSD) + WithInfoS :: WithTypes 'WithInfo +instance Sing ('Targeting 'OSDebian) where sing = OSDebianS +instance Sing ('Targeting 'OSBuntish) where sing = OSBuntishS +instance Sing ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS +instance Sing 'WithInfo where sing = WithInfoS + +-- | Convenience type operator to combine two `WithTypes` lists. +-- +-- For example: +-- +-- > HasInfo :+: Debian +-- +-- Which is shorthand for this type: +-- +-- > WithTypes '[WithInfo, Targeting OSDebian] +type family a :+: b :: ab +type instance (WithTypes a) :+: (WithTypes b) = WithTypes (Concat a b) + +type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Concat '[] bs = bs +type instance Concat (a ': as) bs = a ': (Concat as bs) + +newtype OuterPropTypes l = OuterPropTypes (WithTypes l) + +outerPropTypes :: Property (WithTypes l) -> OuterPropTypes l +outerPropTypes (Property proptypes _) = OuterPropTypes proptypes + +-- | Use `mkProperty''` to get the `OuterPropTypes`. For example: +-- +-- > foo = Property Debian +-- > foo = mkProperty' $ \t -> do +-- > ensureProperty t (aptInstall "foo") +-- +-- The type checker will prevent using ensureProperty with a property +-- that does not support the target OSes needed by the OuterPropTypes. +-- In the example above, aptInstall must support Debian. +-- +-- The type checker will also prevent using ensureProperty with a property +-- with HasInfo in its PropTypes. Doing so would cause the info associated +-- with the property to be lost. +ensureProperty + :: + ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets + , CannotUseEnsurePropertyWithInfo inner ~ 'True + ) + => OuterPropTypes outer + -> Property (WithTypes inner) + -> IO () +ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a + +-- The name of this was chosen to make type errors a more understandable. +type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool +type instance CannotUseEnsurePropertyWithInfo '[] = 'True +type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts + +-- | Tightens the PropType list of a Property, to contain fewer targets. +-- +-- Anything else in the PropType list is passed through unchanged. +tightenTargets + :: + ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) + , CannotCombineTargets old new combined ~ 'CanCombineTargets + , Sing combined + ) + => WithTypes new + -> Property (WithTypes old) + -> Property (WithTypes combined) +tightenTargets _ (Property old a) = Property sing a + +-- | Picks one of the two input properties to use, +-- depending on the targeted OS. +-- +-- If both input properties support the targeted OS, then the +-- first will be used. +pickOS + :: + ( combined ~ Union a b + , Sing combined + ) + => Property (WithTypes a) + -> Property (WithTypes b) + -> Property (WithTypes combined) +pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io + where + -- TODO pick with of ioa or iob to use based on final OS of + -- system being run on. + io = undefined + +data CheckCombineTargets = CannotCombineTargets | CanCombineTargets + +-- | Detect intersection of two lists that don't have any common targets. +-- +-- The name of this was chosen to make type errors a more understandable. +type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets +type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets +type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets + +-- | Every item in the subset must be in the superset. +-- +-- The name of this was chosen to make type errors a more understandable. +type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets +type instance NotSuperset superset '[] = 'CanCombineTargets +type instance NotSuperset superset (s ': rest) = + If (Elem s superset) + (NotSuperset superset rest) + 'CannotCombineTargets + +type family IsTarget (a :: t) :: Bool +type instance IsTarget ('Targeting a) = 'True +type instance IsTarget 'WithInfo = 'False + +type family Targets (l :: [a]) :: [a] +type instance Targets '[] = '[] +type instance Targets (x ': xs) = + If (IsTarget x) + (x ': Targets xs) + (Targets xs) + +type family NonTargets (l :: [a]) :: [a] +type instance NonTargets '[] = '[] +type instance NonTargets (x ': xs) = + If (IsTarget x) + (Targets xs) + (x ': Targets xs) + +-- | Type level elem +type family Elem (a :: t) (list :: [t]) :: Bool +type instance Elem a '[] = 'False +type instance Elem a (b ': bs) = EqT a b || Elem a bs + +-- | Type level union. +type family Union (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Union '[] list2 = list2 +type instance Union (a ': rest) list2 = + If (Elem a list2 || Elem a rest) + (Union rest list2) + (a ': Union rest list2) + +-- | Type level intersection. Duplicate list items are eliminated. +type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Intersect '[] list2 = '[] +type instance Intersect (a ': rest) list2 = + If (Elem a list2 && Not (Elem a rest)) + (a ': Intersect rest list2) + (Intersect rest list2) + +-- | Type level equality +-- +-- This is a very clumsy implmentation, but it works back to ghc 7.6. +type family EqT (a :: t) (b :: t) :: Bool +type instance EqT ('Targeting a) ('Targeting b) = EqT a b +type instance EqT 'WithInfo 'WithInfo = 'True +type instance EqT 'WithInfo ('Targeting b) = 'False +type instance EqT ('Targeting a) 'WithInfo = 'False +type instance EqT 'OSDebian 'OSDebian = 'True +type instance EqT 'OSBuntish 'OSBuntish = 'True +type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True +type instance EqT 'OSDebian 'OSBuntish = 'False +type instance EqT 'OSDebian 'OSFreeBSD = 'False +type instance EqT 'OSBuntish 'OSDebian = 'False +type instance EqT 'OSBuntish 'OSFreeBSD = 'False +type instance EqT 'OSFreeBSD 'OSDebian = 'False +type instance EqT 'OSFreeBSD 'OSBuntish = 'False +-- More modern version if the combinatiorial explosion gets too bad later: +-- +-- type family Eq (a :: PropType) (b :: PropType) where +-- Eq a a = True +-- Eq a b = False + +-- | An equivilant to the following is in Data.Type.Bool in +-- modern versions of ghc, but is included here to support ghc 7.6. +type family If (cond :: Bool) (tru :: a) (fls :: a) :: a +type instance If 'True tru fls = tru +type instance If 'False tru fls = fls +type family (a :: Bool) || (b :: Bool) :: Bool +type instance 'False || 'False = 'False +type instance 'True || 'True = 'True +type instance 'True || 'False = 'True +type instance 'False || 'True = 'True +type family (a :: Bool) && (b :: Bool) :: Bool +type instance 'False && 'False = 'False +type instance 'True && 'True = 'True +type instance 'True && 'False = 'False +type instance 'False && 'True = 'False +type family Not (a :: Bool) :: Bool +type instance Not 'False = 'True +type instance Not 'True = 'False + diff --git a/src/Propellor/Types/Target.hs b/src/Propellor/Types/Target.hs deleted file mode 100644 index 420c6ed2..00000000 --- a/src/Propellor/Types/Target.hs +++ /dev/null @@ -1,279 +0,0 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} - -module Propellor.Types.Target ( - Property(..), - mkProperty, - mkProperty', - OS(..), - PropType(..), - UnixLike, - Debian, - Buntish, - FreeBSD, - HasInfo, - (:+:), - OuterPropTypes, - ensureProperty, - tightenTargets, - pickOS, - Sing, - WithTypes, -) where - ------ DEMO ---------- - -foo :: Property (HasInfo :+: FreeBSD) -foo = mkProperty' $ \t -> do - ensureProperty t jail - -bar :: Property (Debian :+: FreeBSD) -bar = aptinstall `pickOS` jail - -aptinstall :: Property Debian -aptinstall = mkProperty $ do - return () - -jail :: Property FreeBSD -jail = mkProperty $ do - return () - ------ END DEMO ---------- - -data Property proptypes = Property proptypes (IO ()) - -mkProperty :: Sing l => IO () -> Property (WithTypes l) -mkProperty = mkProperty' . const - -mkProperty' :: Sing l => (OuterPropTypes l -> IO ()) -> Property (WithTypes l) -mkProperty' a = - let p = Property sing (a (outerPropTypes p)) - in p - -data OS - = OSDebian - | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per - | OSFreeBSD - deriving (Show, Eq) - -data PropType - = Targeting OS -- ^ A target OS of a Property - | WithInfo -- ^ Indicates that a Property has associated Info - deriving (Show, Eq) - --- | Any unix-like system -type UnixLike = WithTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] -type Debian = WithTypes '[ 'Targeting 'OSDebian ] -type Buntish = WithTypes '[ 'Targeting 'OSBuntish ] -type FreeBSD = WithTypes '[ 'Targeting 'OSFreeBSD ] - --- | Used to indicate that a Property adds Info to the Host where it's used. -type HasInfo = WithTypes '[ 'WithInfo ] - --- | A family of type-level lists of [`PropType`] -data family WithTypes (x :: k) - --- | Singletons -class Sing t where - sing :: WithTypes t - -data instance WithTypes (x :: [k]) where - Nil :: WithTypes '[] - Cons :: WithTypes x -> WithTypes xs -> WithTypes (x ': xs) - -instance (Sing x, Sing xs) => Sing (x ': xs) where sing = Cons sing sing -instance Sing '[] where sing = Nil - --- This boilerplatw would not be needed if the singletons library were --- used. However, we're targeting too old a version of ghc to use it yet. -data instance WithTypes (x :: PropType) where - OSDebianS :: WithTypes ('Targeting 'OSDebian) - OSBuntishS :: WithTypes ('Targeting 'OSBuntish) - OSFreeBSDS :: WithTypes ('Targeting 'OSFreeBSD) - WithInfoS :: WithTypes 'WithInfo -instance Sing ('Targeting 'OSDebian) where sing = OSDebianS -instance Sing ('Targeting 'OSBuntish) where sing = OSBuntishS -instance Sing ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS -instance Sing 'WithInfo where sing = WithInfoS - --- | Convenience type operator to combine two `WithTypes` lists. --- --- For example: --- --- > HasInfo :+: Debian --- --- Which is shorthand for this type: --- --- > WithTypes '[WithInfo, Targeting OSDebian] -type family a :+: b :: ab -type instance (WithTypes a) :+: (WithTypes b) = WithTypes (Concat a b) - -type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] -type instance Concat '[] bs = bs -type instance Concat (a ': as) bs = a ': (Concat as bs) - -newtype OuterPropTypes l = OuterPropTypes (WithTypes l) - -outerPropTypes :: Property (WithTypes l) -> OuterPropTypes l -outerPropTypes (Property proptypes _) = OuterPropTypes proptypes - --- | Use `mkProperty''` to get the `OuterPropTypes`. For example: --- --- > foo = Property Debian --- > foo = mkProperty' $ \t -> do --- > ensureProperty t (aptInstall "foo") --- --- The type checker will prevent using ensureProperty with a property --- that does not support the target OSes needed by the OuterPropTypes. --- In the example above, aptInstall must support Debian. --- --- The type checker will also prevent using ensureProperty with a property --- with HasInfo in its PropTypes. Doing so would cause the info associated --- with the property to be lost. -ensureProperty - :: - ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets - , CannotUseEnsurePropertyWithInfo inner ~ 'True - ) - => OuterPropTypes outer - -> Property (WithTypes inner) - -> IO () -ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a - --- The name of this was chosen to make type errors a more understandable. -type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool -type instance CannotUseEnsurePropertyWithInfo '[] = 'True -type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts - --- | Tightens the PropType list of a Property, to contain fewer targets. --- --- Anything else in the PropType list is passed through unchanged. -tightenTargets - :: - ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) - , CannotCombineTargets old new combined ~ 'CanCombineTargets - , Sing combined - ) - => WithTypes new - -> Property (WithTypes old) - -> Property (WithTypes combined) -tightenTargets _ (Property old a) = Property sing a - --- | Picks one of the two input properties to use, --- depending on the targeted OS. --- --- If both input properties support the targeted OS, then the --- first will be used. -pickOS - :: - ( combined ~ Union a b - , Sing combined - ) - => Property (WithTypes a) - -> Property (WithTypes b) - -> Property (WithTypes combined) -pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io - where - -- TODO pick with of ioa or iob to use based on final OS of - -- system being run on. - io = undefined - -data CheckCombineTargets = CannotCombineTargets | CanCombineTargets - --- | Detect intersection of two lists that don't have any common targets. --- --- The name of this was chosen to make type errors a more understandable. -type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets -type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets -type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets - --- | Every item in the subset must be in the superset. --- --- The name of this was chosen to make type errors a more understandable. -type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets -type instance NotSuperset superset '[] = 'CanCombineTargets -type instance NotSuperset superset (s ': rest) = - If (Elem s superset) - (NotSuperset superset rest) - 'CannotCombineTargets - -type family IsTarget (a :: t) :: Bool -type instance IsTarget ('Targeting a) = 'True -type instance IsTarget 'WithInfo = 'False - -type family Targets (l :: [a]) :: [a] -type instance Targets '[] = '[] -type instance Targets (x ': xs) = - If (IsTarget x) - (x ': Targets xs) - (Targets xs) - -type family NonTargets (l :: [a]) :: [a] -type instance NonTargets '[] = '[] -type instance NonTargets (x ': xs) = - If (IsTarget x) - (Targets xs) - (x ': Targets xs) - --- | Type level elem -type family Elem (a :: t) (list :: [t]) :: Bool -type instance Elem a '[] = 'False -type instance Elem a (b ': bs) = EqT a b || Elem a bs - --- | Type level union. -type family Union (list1 :: [a]) (list2 :: [a]) :: [a] -type instance Union '[] list2 = list2 -type instance Union (a ': rest) list2 = - If (Elem a list2 || Elem a rest) - (Union rest list2) - (a ': Union rest list2) - --- | Type level intersection. Duplicate list items are eliminated. -type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a] -type instance Intersect '[] list2 = '[] -type instance Intersect (a ': rest) list2 = - If (Elem a list2 && Not (Elem a rest)) - (a ': Intersect rest list2) - (Intersect rest list2) - --- | Type level equality --- --- This is a very clumsy implmentation, but it works back to ghc 7.6. -type family EqT (a :: t) (b :: t) :: Bool -type instance EqT ('Targeting a) ('Targeting b) = EqT a b -type instance EqT 'WithInfo 'WithInfo = 'True -type instance EqT 'WithInfo ('Targeting b) = 'False -type instance EqT ('Targeting a) 'WithInfo = 'False -type instance EqT 'OSDebian 'OSDebian = 'True -type instance EqT 'OSBuntish 'OSBuntish = 'True -type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True -type instance EqT 'OSDebian 'OSBuntish = 'False -type instance EqT 'OSDebian 'OSFreeBSD = 'False -type instance EqT 'OSBuntish 'OSDebian = 'False -type instance EqT 'OSBuntish 'OSFreeBSD = 'False -type instance EqT 'OSFreeBSD 'OSDebian = 'False -type instance EqT 'OSFreeBSD 'OSBuntish = 'False --- More modern version if the combinatiorial explosion gets too bad later: --- --- type family Eq (a :: PropType) (b :: PropType) where --- Eq a a = True --- Eq a b = False - --- | An equivilant to the following is in Data.Type.Bool in --- modern versions of ghc, but is included here to support ghc 7.6. -type family If (cond :: Bool) (tru :: a) (fls :: a) :: a -type instance If 'True tru fls = tru -type instance If 'False tru fls = fls -type family (a :: Bool) || (b :: Bool) :: Bool -type instance 'False || 'False = 'False -type instance 'True || 'True = 'True -type instance 'True || 'False = 'True -type instance 'False || 'True = 'True -type family (a :: Bool) && (b :: Bool) :: Bool -type instance 'False && 'False = 'False -type instance 'True && 'True = 'True -type instance 'True && 'False = 'False -type instance 'False && 'True = 'False -type family Not (a :: Bool) :: Bool -type instance Not 'False = 'True -type instance Not 'True = 'False - -- cgit v1.2.3 From 8e27dce708f9af48712dfa26274715ce22cb40e0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 13:18:29 -0400 Subject: use + rather than :+: type operator This seems to not overlap with the + function and is nicer to read and write --- src/Propellor/Types/PropTypes.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs index d3d04dca..5185e1ba 100644 --- a/src/Propellor/Types/PropTypes.hs +++ b/src/Propellor/Types/PropTypes.hs @@ -11,7 +11,7 @@ module Propellor.Types.PropTypes ( Buntish, FreeBSD, HasInfo, - (:+:), + (+), OuterPropTypes, ensureProperty, tightenTargets, @@ -22,11 +22,11 @@ module Propellor.Types.PropTypes ( ----- DEMO ---------- -foo :: Property (HasInfo :+: FreeBSD) +foo :: Property (HasInfo + FreeBSD) foo = mkProperty' $ \t -> do ensureProperty t jail -bar :: Property (Debian :+: FreeBSD) +bar :: Property (Debian + FreeBSD) bar = aptinstall `pickOS` jail aptinstall :: Property Debian @@ -99,13 +99,13 @@ instance Sing 'WithInfo where sing = WithInfoS -- -- For example: -- --- > HasInfo :+: Debian +-- > HasInfo + Debian -- -- Which is shorthand for this type: -- -- > WithTypes '[WithInfo, Targeting OSDebian] -type family a :+: b :: ab -type instance (WithTypes a) :+: (WithTypes b) = WithTypes (Concat a b) +type family a + b :: ab +type instance (WithTypes a) + (WithTypes b) = WithTypes (Concat a b) type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] type instance Concat '[] bs = bs -- cgit v1.2.3 From d2079518e248fc3a9526cc60079440f155846af4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 17:19:49 -0400 Subject: really bad implementation of type level OS detection --- src/Propellor/Types/PropTypes.hs | 59 ++++++++++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 17 deletions(-) diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs index 5185e1ba..586ed0a9 100644 --- a/src/Propellor/Types/PropTypes.hs +++ b/src/Propellor/Types/PropTypes.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} +{-# LANGUAGE CPP, TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} module Propellor.Types.PropTypes ( Property(..), mkProperty, mkProperty', - OS(..), PropType(..), + OS(..), UnixLike, Debian, Buntish, @@ -20,16 +20,23 @@ module Propellor.Types.PropTypes ( WithTypes, ) where +import GHC.TypeLits (Nat) + +-- Older versions of ghc lack this module. +-- #if MIN_VERSION_base(4,8,0) +-- import Data.Type.Equality +-- #endif + ----- DEMO ---------- foo :: Property (HasInfo + FreeBSD) foo = mkProperty' $ \t -> do ensureProperty t jail -bar :: Property (Debian + FreeBSD) -bar = aptinstall `pickOS` jail +-- bar :: Property (Debian + UsesPort 80 + FreeBSD) +-- bar = aptinstall `pickOS` jail -aptinstall :: Property Debian +aptinstall :: Property (Debian + UsesPort 80) aptinstall = mkProperty $ do return () @@ -49,17 +56,17 @@ mkProperty' a = let p = Property sing (a (outerPropTypes p)) in p +data PropType + = Targeting OS -- ^ A target OS of a Property + | WithInfo -- ^ Indicates that a Property has associated Info + | UsedPort Nat -- ^ Indicates that a network port is used by a Property + data OS = OSDebian | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per | OSFreeBSD deriving (Show, Eq) -data PropType - = Targeting OS -- ^ A target OS of a Property - | WithInfo -- ^ Indicates that a Property has associated Info - deriving (Show, Eq) - -- | Any unix-like system type UnixLike = WithTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] type Debian = WithTypes '[ 'Targeting 'OSDebian ] @@ -69,6 +76,9 @@ type FreeBSD = WithTypes '[ 'Targeting 'OSFreeBSD ] -- | Used to indicate that a Property adds Info to the Host where it's used. type HasInfo = WithTypes '[ 'WithInfo ] +-- | Used to indicate that a Property uses a network port +type UsesPort n = WithTypes '[ 'UsedPort n ] + -- | A family of type-level lists of [`PropType`] data family WithTypes (x :: k) @@ -76,13 +86,6 @@ data family WithTypes (x :: k) class Sing t where sing :: WithTypes t -data instance WithTypes (x :: [k]) where - Nil :: WithTypes '[] - Cons :: WithTypes x -> WithTypes xs -> WithTypes (x ': xs) - -instance (Sing x, Sing xs) => Sing (x ': xs) where sing = Cons sing sing -instance Sing '[] where sing = Nil - -- This boilerplatw would not be needed if the singletons library were -- used. However, we're targeting too old a version of ghc to use it yet. data instance WithTypes (x :: PropType) where @@ -90,10 +93,24 @@ data instance WithTypes (x :: PropType) where OSBuntishS :: WithTypes ('Targeting 'OSBuntish) OSFreeBSDS :: WithTypes ('Targeting 'OSFreeBSD) WithInfoS :: WithTypes 'WithInfo + WithUsedPortS :: WithTypes n -> WithTypes ('UsedPort n) instance Sing ('Targeting 'OSDebian) where sing = OSDebianS instance Sing ('Targeting 'OSBuntish) where sing = OSBuntishS instance Sing ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS instance Sing 'WithInfo where sing = WithInfoS +instance (Sing n) => Sing ('UsedPort n) where sing = WithUsedPortS sing + +data instance WithTypes (x :: [k]) where + Nil :: WithTypes '[] + Cons :: WithTypes x -> WithTypes xs -> WithTypes (x ': xs) +instance (Sing x, Sing xs) => Sing (x ': xs) where sing = Cons sing sing +instance Sing '[] where sing = Nil + +-- FIXME: How to implement sing for Nat? +-- +-- Since we don't actually currently use the values of singletons, +-- getting by with undefined for now. +instance Sing (n :: Nat) where sing = undefined -- | Convenience type operator to combine two `WithTypes` lists. -- @@ -252,6 +269,14 @@ type instance EqT 'OSBuntish 'OSDebian = 'False type instance EqT 'OSBuntish 'OSFreeBSD = 'False type instance EqT 'OSFreeBSD 'OSDebian = 'False type instance EqT 'OSFreeBSD 'OSBuntish = 'False +-- #if MIN_VERSION_base(4,8,0) +-- type instance EqT ('UsedPort a) ('UsedPort b) = a == b +-- #else +-- On older ghc, equality testing of type Nats is not implemented. +-- Assume two Nats are equal. This means that type level port conflict +-- detection won't work when using ghc 7.6.3. +type instance EqT ('UsedPort a) ('UsedPort b) = True +-- #endif -- More modern version if the combinatiorial explosion gets too bad later: -- -- type family Eq (a :: PropType) (b :: PropType) where -- cgit v1.2.3 From 7083214c0cf4e2c1ea4e2c0bc87b8fe822236d8f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 17:51:09 -0400 Subject: rename for consistency with singletons library --- src/Propellor/Types/PropTypes.hs | 93 ++++++++++++++++++++-------------------- 1 file changed, 47 insertions(+), 46 deletions(-) diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs index 586ed0a9..8d613633 100644 --- a/src/Propellor/Types/PropTypes.hs +++ b/src/Propellor/Types/PropTypes.hs @@ -17,7 +17,8 @@ module Propellor.Types.PropTypes ( tightenTargets, pickOS, Sing, - WithTypes, + sing, + SingI, ) where import GHC.TypeLits (Nat) @@ -48,10 +49,10 @@ jail = mkProperty $ do data Property proptypes = Property proptypes (IO ()) -mkProperty :: Sing l => IO () -> Property (WithTypes l) +mkProperty :: SingI l => IO () -> Property (Sing l) mkProperty = mkProperty' . const -mkProperty' :: Sing l => (OuterPropTypes l -> IO ()) -> Property (WithTypes l) +mkProperty' :: SingI l => (OuterPropTypes l -> IO ()) -> Property (Sing l) mkProperty' a = let p = Property sing (a (outerPropTypes p)) in p @@ -68,51 +69,51 @@ data OS deriving (Show, Eq) -- | Any unix-like system -type UnixLike = WithTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] -type Debian = WithTypes '[ 'Targeting 'OSDebian ] -type Buntish = WithTypes '[ 'Targeting 'OSBuntish ] -type FreeBSD = WithTypes '[ 'Targeting 'OSFreeBSD ] +type UnixLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +type Debian = Sing '[ 'Targeting 'OSDebian ] +type Buntish = Sing '[ 'Targeting 'OSBuntish ] +type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] -- | Used to indicate that a Property adds Info to the Host where it's used. -type HasInfo = WithTypes '[ 'WithInfo ] +type HasInfo = Sing '[ 'WithInfo ] -- | Used to indicate that a Property uses a network port -type UsesPort n = WithTypes '[ 'UsedPort n ] +type UsesPort n = Sing '[ 'UsedPort n ] --- | A family of type-level lists of [`PropType`] -data family WithTypes (x :: k) +-- | The data family of singleton types. +data family Sing (x :: k) --- | Singletons -class Sing t where - sing :: WithTypes t +-- | A class used to pass singleton values implicitly. +class SingI t where + sing :: Sing t -- This boilerplatw would not be needed if the singletons library were -- used. However, we're targeting too old a version of ghc to use it yet. -data instance WithTypes (x :: PropType) where - OSDebianS :: WithTypes ('Targeting 'OSDebian) - OSBuntishS :: WithTypes ('Targeting 'OSBuntish) - OSFreeBSDS :: WithTypes ('Targeting 'OSFreeBSD) - WithInfoS :: WithTypes 'WithInfo - WithUsedPortS :: WithTypes n -> WithTypes ('UsedPort n) -instance Sing ('Targeting 'OSDebian) where sing = OSDebianS -instance Sing ('Targeting 'OSBuntish) where sing = OSBuntishS -instance Sing ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS -instance Sing 'WithInfo where sing = WithInfoS -instance (Sing n) => Sing ('UsedPort n) where sing = WithUsedPortS sing - -data instance WithTypes (x :: [k]) where - Nil :: WithTypes '[] - Cons :: WithTypes x -> WithTypes xs -> WithTypes (x ': xs) -instance (Sing x, Sing xs) => Sing (x ': xs) where sing = Cons sing sing -instance Sing '[] where sing = Nil +data instance Sing (x :: PropType) where + OSDebianS :: Sing ('Targeting 'OSDebian) + OSBuntishS :: Sing ('Targeting 'OSBuntish) + OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD) + WithInfoS :: Sing 'WithInfo + WithUsedPortS :: Sing n -> Sing ('UsedPort n) +instance SingI ('Targeting 'OSDebian) where sing = OSDebianS +instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS +instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS +instance SingI 'WithInfo where sing = WithInfoS +instance (SingI n) => SingI ('UsedPort n) where sing = WithUsedPortS sing + +data instance Sing (x :: [k]) where + Nil :: Sing '[] + Cons :: Sing x -> Sing xs -> Sing (x ': xs) +instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing +instance SingI '[] where sing = Nil -- FIXME: How to implement sing for Nat? -- -- Since we don't actually currently use the values of singletons, -- getting by with undefined for now. -instance Sing (n :: Nat) where sing = undefined +instance SingI (n :: Nat) where sing = undefined --- | Convenience type operator to combine two `WithTypes` lists. +-- | Convenience type operator to combine two `Sing` lists. -- -- For example: -- @@ -120,17 +121,17 @@ instance Sing (n :: Nat) where sing = undefined -- -- Which is shorthand for this type: -- --- > WithTypes '[WithInfo, Targeting OSDebian] +-- > Sing '[WithInfo, Targeting OSDebian] type family a + b :: ab -type instance (WithTypes a) + (WithTypes b) = WithTypes (Concat a b) +type instance (Sing a) + (Sing b) = Sing (Concat a b) type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] type instance Concat '[] bs = bs type instance Concat (a ': as) bs = a ': (Concat as bs) -newtype OuterPropTypes l = OuterPropTypes (WithTypes l) +newtype OuterPropTypes l = OuterPropTypes (Sing l) -outerPropTypes :: Property (WithTypes l) -> OuterPropTypes l +outerPropTypes :: Property (Sing l) -> OuterPropTypes l outerPropTypes (Property proptypes _) = OuterPropTypes proptypes -- | Use `mkProperty''` to get the `OuterPropTypes`. For example: @@ -152,7 +153,7 @@ ensureProperty , CannotUseEnsurePropertyWithInfo inner ~ 'True ) => OuterPropTypes outer - -> Property (WithTypes inner) + -> Property (Sing inner) -> IO () ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a @@ -168,11 +169,11 @@ tightenTargets :: ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) , CannotCombineTargets old new combined ~ 'CanCombineTargets - , Sing combined + , SingI combined ) - => WithTypes new - -> Property (WithTypes old) - -> Property (WithTypes combined) + => Sing new + -> Property (Sing old) + -> Property (Sing combined) tightenTargets _ (Property old a) = Property sing a -- | Picks one of the two input properties to use, @@ -183,11 +184,11 @@ tightenTargets _ (Property old a) = Property sing a pickOS :: ( combined ~ Union a b - , Sing combined + , SingI combined ) - => Property (WithTypes a) - -> Property (WithTypes b) - -> Property (WithTypes combined) + => Property (Sing a) + -> Property (Sing b) + -> Property (Sing combined) pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io where -- TODO pick with of ioa or iob to use based on final OS of -- cgit v1.2.3 From 84bb4d3e1590d143627be61eba05017e073d9cc7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Mar 2016 17:59:13 -0400 Subject: flip to modern version --- src/Propellor/Types/PropTypes.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs index 8d613633..65706b19 100644 --- a/src/Propellor/Types/PropTypes.hs +++ b/src/Propellor/Types/PropTypes.hs @@ -25,7 +25,7 @@ import GHC.TypeLits (Nat) -- Older versions of ghc lack this module. -- #if MIN_VERSION_base(4,8,0) --- import Data.Type.Equality +import Data.Type.Equality -- #endif ----- DEMO ---------- @@ -271,12 +271,12 @@ type instance EqT 'OSBuntish 'OSFreeBSD = 'False type instance EqT 'OSFreeBSD 'OSDebian = 'False type instance EqT 'OSFreeBSD 'OSBuntish = 'False -- #if MIN_VERSION_base(4,8,0) --- type instance EqT ('UsedPort a) ('UsedPort b) = a == b +type instance EqT ('UsedPort a) ('UsedPort b) = a == b -- #else -- On older ghc, equality testing of type Nats is not implemented. -- Assume two Nats are equal. This means that type level port conflict -- detection won't work when using ghc 7.6.3. -type instance EqT ('UsedPort a) ('UsedPort b) = True +--type instance EqT ('UsedPort a) ('UsedPort b) = True -- #endif -- More modern version if the combinatiorial explosion gets too bad later: -- -- cgit v1.2.3 From 7b7ad7e685cccb7ff2c609d92192bf7d983fc400 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 11:41:56 -0400 Subject: fix export --- src/Propellor/Types/PropTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs index 65706b19..d20a4345 100644 --- a/src/Propellor/Types/PropTypes.hs +++ b/src/Propellor/Types/PropTypes.hs @@ -11,7 +11,7 @@ module Propellor.Types.PropTypes ( Buntish, FreeBSD, HasInfo, - (+), + type (+), OuterPropTypes, ensureProperty, tightenTargets, -- cgit v1.2.3 From fa2a2324f8223a0f628472e2ee5fdb69495cd17f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 11:43:19 -0400 Subject: temporarily remove UsedPort This can come back later as a full Resource data type. For now, I want to focus on merging what I have working. --- src/Propellor/Types/PropTypes.hs | 31 ++----------------------------- 1 file changed, 2 insertions(+), 29 deletions(-) diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs index d20a4345..4ea4746a 100644 --- a/src/Propellor/Types/PropTypes.hs +++ b/src/Propellor/Types/PropTypes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} module Propellor.Types.PropTypes ( Property(..), @@ -21,13 +21,6 @@ module Propellor.Types.PropTypes ( SingI, ) where -import GHC.TypeLits (Nat) - --- Older versions of ghc lack this module. --- #if MIN_VERSION_base(4,8,0) -import Data.Type.Equality --- #endif - ----- DEMO ---------- foo :: Property (HasInfo + FreeBSD) @@ -37,7 +30,7 @@ foo = mkProperty' $ \t -> do -- bar :: Property (Debian + UsesPort 80 + FreeBSD) -- bar = aptinstall `pickOS` jail -aptinstall :: Property (Debian + UsesPort 80) +aptinstall :: Property Debian aptinstall = mkProperty $ do return () @@ -60,7 +53,6 @@ mkProperty' a = data PropType = Targeting OS -- ^ A target OS of a Property | WithInfo -- ^ Indicates that a Property has associated Info - | UsedPort Nat -- ^ Indicates that a network port is used by a Property data OS = OSDebian @@ -77,9 +69,6 @@ type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] -- | Used to indicate that a Property adds Info to the Host where it's used. type HasInfo = Sing '[ 'WithInfo ] --- | Used to indicate that a Property uses a network port -type UsesPort n = Sing '[ 'UsedPort n ] - -- | The data family of singleton types. data family Sing (x :: k) @@ -94,12 +83,10 @@ data instance Sing (x :: PropType) where OSBuntishS :: Sing ('Targeting 'OSBuntish) OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD) WithInfoS :: Sing 'WithInfo - WithUsedPortS :: Sing n -> Sing ('UsedPort n) instance SingI ('Targeting 'OSDebian) where sing = OSDebianS instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS instance SingI 'WithInfo where sing = WithInfoS -instance (SingI n) => SingI ('UsedPort n) where sing = WithUsedPortS sing data instance Sing (x :: [k]) where Nil :: Sing '[] @@ -107,12 +94,6 @@ data instance Sing (x :: [k]) where instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing instance SingI '[] where sing = Nil --- FIXME: How to implement sing for Nat? --- --- Since we don't actually currently use the values of singletons, --- getting by with undefined for now. -instance SingI (n :: Nat) where sing = undefined - -- | Convenience type operator to combine two `Sing` lists. -- -- For example: @@ -270,14 +251,6 @@ type instance EqT 'OSBuntish 'OSDebian = 'False type instance EqT 'OSBuntish 'OSFreeBSD = 'False type instance EqT 'OSFreeBSD 'OSDebian = 'False type instance EqT 'OSFreeBSD 'OSBuntish = 'False --- #if MIN_VERSION_base(4,8,0) -type instance EqT ('UsedPort a) ('UsedPort b) = a == b --- #else --- On older ghc, equality testing of type Nats is not implemented. --- Assume two Nats are equal. This means that type level port conflict --- detection won't work when using ghc 7.6.3. ---type instance EqT ('UsedPort a) ('UsedPort b) = True --- #endif -- More modern version if the combinatiorial explosion gets too bad later: -- -- type family Eq (a :: PropType) (b :: PropType) where -- cgit v1.2.3 From 7cc8250a1ac0ad0d95e1ecad35280e3572cc6a89 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 11:48:32 -0400 Subject: rename --- src/Propellor/Types/MetaTypes.hs | 278 +++++++++++++++++++++++++++++++++++++++ src/Propellor/Types/PropTypes.hs | 278 --------------------------------------- 2 files changed, 278 insertions(+), 278 deletions(-) create mode 100644 src/Propellor/Types/MetaTypes.hs delete mode 100644 src/Propellor/Types/PropTypes.hs diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs new file mode 100644 index 00000000..de6ffea3 --- /dev/null +++ b/src/Propellor/Types/MetaTypes.hs @@ -0,0 +1,278 @@ +{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} + +module Propellor.Types.MetaTypes ( + Property(..), + mkProperty, + mkProperty', + MetaType(..), + OS(..), + UnixLike, + Debian, + Buntish, + FreeBSD, + HasInfo, + type (+), + OuterMetaTypes, + ensureProperty, + tightenTargets, + pickOS, + Sing, + sing, + SingI, +) where + +----- DEMO ---------- + +foo :: Property (HasInfo + FreeBSD) +foo = mkProperty' $ \t -> do + ensureProperty t jail + +-- bar :: Property (Debian + UsesPort 80 + FreeBSD) +-- bar = aptinstall `pickOS` jail + +aptinstall :: Property Debian +aptinstall = mkProperty $ do + return () + +jail :: Property FreeBSD +jail = mkProperty $ do + return () + +----- END DEMO ---------- + +data Property metatypes = Property metatypes (IO ()) + +mkProperty :: SingI l => IO () -> Property (Sing l) +mkProperty = mkProperty' . const + +mkProperty' :: SingI l => (OuterMetaTypes l -> IO ()) -> Property (Sing l) +mkProperty' a = + let p = Property sing (a (outerMetaTypes p)) + in p + +data MetaType + = Targeting OS -- ^ A target OS of a Property + | WithInfo -- ^ Indicates that a Property has associated Info + +data OS + = OSDebian + | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per + | OSFreeBSD + deriving (Show, Eq) + +-- | Any unix-like system +type UnixLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +type Debian = Sing '[ 'Targeting 'OSDebian ] +type Buntish = Sing '[ 'Targeting 'OSBuntish ] +type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] + +-- | Used to indicate that a Property adds Info to the Host where it's used. +type HasInfo = Sing '[ 'WithInfo ] + +-- | The data family of singleton types. +data family Sing (x :: k) + +-- | A class used to pass singleton values implicitly. +class SingI t where + sing :: Sing t + +-- This boilerplatw would not be needed if the singletons library were +-- used. However, we're targeting too old a version of ghc to use it yet. +data instance Sing (x :: MetaType) where + OSDebianS :: Sing ('Targeting 'OSDebian) + OSBuntishS :: Sing ('Targeting 'OSBuntish) + OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD) + WithInfoS :: Sing 'WithInfo +instance SingI ('Targeting 'OSDebian) where sing = OSDebianS +instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS +instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS +instance SingI 'WithInfo where sing = WithInfoS + +data instance Sing (x :: [k]) where + Nil :: Sing '[] + Cons :: Sing x -> Sing xs -> Sing (x ': xs) +instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing +instance SingI '[] where sing = Nil + +-- | Convenience type operator to combine two `Sing` lists. +-- +-- For example: +-- +-- > HasInfo + Debian +-- +-- Which is shorthand for this type: +-- +-- > Sing '[WithInfo, Targeting OSDebian] +type family a + b :: ab +type instance (Sing a) + (Sing b) = Sing (Concat a b) + +type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Concat '[] bs = bs +type instance Concat (a ': as) bs = a ': (Concat as bs) + +newtype OuterMetaTypes l = OuterMetaTypes (Sing l) + +outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l +outerMetaTypes (Property metatypes _) = OuterMetaTypes metatypes + +-- | Use `mkProperty''` to get the `OuterMetaTypes`. For example: +-- +-- > foo = Property Debian +-- > foo = mkProperty' $ \t -> do +-- > ensureProperty t (aptInstall "foo") +-- +-- The type checker will prevent using ensureProperty with a property +-- that does not support the target OSes needed by the OuterMetaTypes. +-- In the example above, aptInstall must support Debian. +-- +-- The type checker will also prevent using ensureProperty with a property +-- with HasInfo in its MetaTypes. Doing so would cause the info associated +-- with the property to be lost. +ensureProperty + :: + ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets + , CannotUseEnsurePropertyWithInfo inner ~ 'True + ) + => OuterMetaTypes outer + -> Property (Sing inner) + -> IO () +ensureProperty (OuterMetaTypes outermetatypes) (Property innermetatypes a) = a + +-- The name of this was chosen to make type errors a more understandable. +type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool +type instance CannotUseEnsurePropertyWithInfo '[] = 'True +type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts + +-- | Tightens the MetaType list of a Property, to contain fewer targets. +-- +-- Anything else in the MetaType list is passed through unchanged. +tightenTargets + :: + ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) + , CannotCombineTargets old new combined ~ 'CanCombineTargets + , SingI combined + ) + => Sing new + -> Property (Sing old) + -> Property (Sing combined) +tightenTargets _ (Property old a) = Property sing a + +-- | Picks one of the two input properties to use, +-- depending on the targeted OS. +-- +-- If both input properties support the targeted OS, then the +-- first will be used. +pickOS + :: + ( combined ~ Union a b + , SingI combined + ) + => Property (Sing a) + -> Property (Sing b) + -> Property (Sing combined) +pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io + where + -- TODO pick with of ioa or iob to use based on final OS of + -- system being run on. + io = undefined + +data CheckCombineTargets = CannotCombineTargets | CanCombineTargets + +-- | Detect intersection of two lists that don't have any common targets. +-- +-- The name of this was chosen to make type errors a more understandable. +type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets +type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets +type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets + +-- | Every item in the subset must be in the superset. +-- +-- The name of this was chosen to make type errors a more understandable. +type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets +type instance NotSuperset superset '[] = 'CanCombineTargets +type instance NotSuperset superset (s ': rest) = + If (Elem s superset) + (NotSuperset superset rest) + 'CannotCombineTargets + +type family IsTarget (a :: t) :: Bool +type instance IsTarget ('Targeting a) = 'True +type instance IsTarget 'WithInfo = 'False + +type family Targets (l :: [a]) :: [a] +type instance Targets '[] = '[] +type instance Targets (x ': xs) = + If (IsTarget x) + (x ': Targets xs) + (Targets xs) + +type family NonTargets (l :: [a]) :: [a] +type instance NonTargets '[] = '[] +type instance NonTargets (x ': xs) = + If (IsTarget x) + (Targets xs) + (x ': Targets xs) + +-- | Type level elem +type family Elem (a :: t) (list :: [t]) :: Bool +type instance Elem a '[] = 'False +type instance Elem a (b ': bs) = EqT a b || Elem a bs + +-- | Type level union. +type family Union (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Union '[] list2 = list2 +type instance Union (a ': rest) list2 = + If (Elem a list2 || Elem a rest) + (Union rest list2) + (a ': Union rest list2) + +-- | Type level intersection. Duplicate list items are eliminated. +type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Intersect '[] list2 = '[] +type instance Intersect (a ': rest) list2 = + If (Elem a list2 && Not (Elem a rest)) + (a ': Intersect rest list2) + (Intersect rest list2) + +-- | Type level equality +-- +-- This is a very clumsy implmentation, but it works back to ghc 7.6. +type family EqT (a :: t) (b :: t) :: Bool +type instance EqT ('Targeting a) ('Targeting b) = EqT a b +type instance EqT 'WithInfo 'WithInfo = 'True +type instance EqT 'WithInfo ('Targeting b) = 'False +type instance EqT ('Targeting a) 'WithInfo = 'False +type instance EqT 'OSDebian 'OSDebian = 'True +type instance EqT 'OSBuntish 'OSBuntish = 'True +type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True +type instance EqT 'OSDebian 'OSBuntish = 'False +type instance EqT 'OSDebian 'OSFreeBSD = 'False +type instance EqT 'OSBuntish 'OSDebian = 'False +type instance EqT 'OSBuntish 'OSFreeBSD = 'False +type instance EqT 'OSFreeBSD 'OSDebian = 'False +type instance EqT 'OSFreeBSD 'OSBuntish = 'False +-- More modern version if the combinatiorial explosion gets too bad later: +-- +-- type family Eq (a :: MetaType) (b :: MetaType) where +-- Eq a a = True +-- Eq a b = False + +-- | An equivilant to the following is in Data.Type.Bool in +-- modern versions of ghc, but is included here to support ghc 7.6. +type family If (cond :: Bool) (tru :: a) (fls :: a) :: a +type instance If 'True tru fls = tru +type instance If 'False tru fls = fls +type family (a :: Bool) || (b :: Bool) :: Bool +type instance 'False || 'False = 'False +type instance 'True || 'True = 'True +type instance 'True || 'False = 'True +type instance 'False || 'True = 'True +type family (a :: Bool) && (b :: Bool) :: Bool +type instance 'False && 'False = 'False +type instance 'True && 'True = 'True +type instance 'True && 'False = 'False +type instance 'False && 'True = 'False +type family Not (a :: Bool) :: Bool +type instance Not 'False = 'True +type instance Not 'True = 'False + diff --git a/src/Propellor/Types/PropTypes.hs b/src/Propellor/Types/PropTypes.hs deleted file mode 100644 index 4ea4746a..00000000 --- a/src/Propellor/Types/PropTypes.hs +++ /dev/null @@ -1,278 +0,0 @@ -{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} - -module Propellor.Types.PropTypes ( - Property(..), - mkProperty, - mkProperty', - PropType(..), - OS(..), - UnixLike, - Debian, - Buntish, - FreeBSD, - HasInfo, - type (+), - OuterPropTypes, - ensureProperty, - tightenTargets, - pickOS, - Sing, - sing, - SingI, -) where - ------ DEMO ---------- - -foo :: Property (HasInfo + FreeBSD) -foo = mkProperty' $ \t -> do - ensureProperty t jail - --- bar :: Property (Debian + UsesPort 80 + FreeBSD) --- bar = aptinstall `pickOS` jail - -aptinstall :: Property Debian -aptinstall = mkProperty $ do - return () - -jail :: Property FreeBSD -jail = mkProperty $ do - return () - ------ END DEMO ---------- - -data Property proptypes = Property proptypes (IO ()) - -mkProperty :: SingI l => IO () -> Property (Sing l) -mkProperty = mkProperty' . const - -mkProperty' :: SingI l => (OuterPropTypes l -> IO ()) -> Property (Sing l) -mkProperty' a = - let p = Property sing (a (outerPropTypes p)) - in p - -data PropType - = Targeting OS -- ^ A target OS of a Property - | WithInfo -- ^ Indicates that a Property has associated Info - -data OS - = OSDebian - | OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per - | OSFreeBSD - deriving (Show, Eq) - --- | Any unix-like system -type UnixLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] -type Debian = Sing '[ 'Targeting 'OSDebian ] -type Buntish = Sing '[ 'Targeting 'OSBuntish ] -type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] - --- | Used to indicate that a Property adds Info to the Host where it's used. -type HasInfo = Sing '[ 'WithInfo ] - --- | The data family of singleton types. -data family Sing (x :: k) - --- | A class used to pass singleton values implicitly. -class SingI t where - sing :: Sing t - --- This boilerplatw would not be needed if the singletons library were --- used. However, we're targeting too old a version of ghc to use it yet. -data instance Sing (x :: PropType) where - OSDebianS :: Sing ('Targeting 'OSDebian) - OSBuntishS :: Sing ('Targeting 'OSBuntish) - OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD) - WithInfoS :: Sing 'WithInfo -instance SingI ('Targeting 'OSDebian) where sing = OSDebianS -instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS -instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS -instance SingI 'WithInfo where sing = WithInfoS - -data instance Sing (x :: [k]) where - Nil :: Sing '[] - Cons :: Sing x -> Sing xs -> Sing (x ': xs) -instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing -instance SingI '[] where sing = Nil - --- | Convenience type operator to combine two `Sing` lists. --- --- For example: --- --- > HasInfo + Debian --- --- Which is shorthand for this type: --- --- > Sing '[WithInfo, Targeting OSDebian] -type family a + b :: ab -type instance (Sing a) + (Sing b) = Sing (Concat a b) - -type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] -type instance Concat '[] bs = bs -type instance Concat (a ': as) bs = a ': (Concat as bs) - -newtype OuterPropTypes l = OuterPropTypes (Sing l) - -outerPropTypes :: Property (Sing l) -> OuterPropTypes l -outerPropTypes (Property proptypes _) = OuterPropTypes proptypes - --- | Use `mkProperty''` to get the `OuterPropTypes`. For example: --- --- > foo = Property Debian --- > foo = mkProperty' $ \t -> do --- > ensureProperty t (aptInstall "foo") --- --- The type checker will prevent using ensureProperty with a property --- that does not support the target OSes needed by the OuterPropTypes. --- In the example above, aptInstall must support Debian. --- --- The type checker will also prevent using ensureProperty with a property --- with HasInfo in its PropTypes. Doing so would cause the info associated --- with the property to be lost. -ensureProperty - :: - ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets - , CannotUseEnsurePropertyWithInfo inner ~ 'True - ) - => OuterPropTypes outer - -> Property (Sing inner) - -> IO () -ensureProperty (OuterPropTypes outerproptypes) (Property innerproptypes a) = a - --- The name of this was chosen to make type errors a more understandable. -type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool -type instance CannotUseEnsurePropertyWithInfo '[] = 'True -type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts - --- | Tightens the PropType list of a Property, to contain fewer targets. --- --- Anything else in the PropType list is passed through unchanged. -tightenTargets - :: - ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) - , CannotCombineTargets old new combined ~ 'CanCombineTargets - , SingI combined - ) - => Sing new - -> Property (Sing old) - -> Property (Sing combined) -tightenTargets _ (Property old a) = Property sing a - --- | Picks one of the two input properties to use, --- depending on the targeted OS. --- --- If both input properties support the targeted OS, then the --- first will be used. -pickOS - :: - ( combined ~ Union a b - , SingI combined - ) - => Property (Sing a) - -> Property (Sing b) - -> Property (Sing combined) -pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io - where - -- TODO pick with of ioa or iob to use based on final OS of - -- system being run on. - io = undefined - -data CheckCombineTargets = CannotCombineTargets | CanCombineTargets - --- | Detect intersection of two lists that don't have any common targets. --- --- The name of this was chosen to make type errors a more understandable. -type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets -type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets -type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets - --- | Every item in the subset must be in the superset. --- --- The name of this was chosen to make type errors a more understandable. -type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets -type instance NotSuperset superset '[] = 'CanCombineTargets -type instance NotSuperset superset (s ': rest) = - If (Elem s superset) - (NotSuperset superset rest) - 'CannotCombineTargets - -type family IsTarget (a :: t) :: Bool -type instance IsTarget ('Targeting a) = 'True -type instance IsTarget 'WithInfo = 'False - -type family Targets (l :: [a]) :: [a] -type instance Targets '[] = '[] -type instance Targets (x ': xs) = - If (IsTarget x) - (x ': Targets xs) - (Targets xs) - -type family NonTargets (l :: [a]) :: [a] -type instance NonTargets '[] = '[] -type instance NonTargets (x ': xs) = - If (IsTarget x) - (Targets xs) - (x ': Targets xs) - --- | Type level elem -type family Elem (a :: t) (list :: [t]) :: Bool -type instance Elem a '[] = 'False -type instance Elem a (b ': bs) = EqT a b || Elem a bs - --- | Type level union. -type family Union (list1 :: [a]) (list2 :: [a]) :: [a] -type instance Union '[] list2 = list2 -type instance Union (a ': rest) list2 = - If (Elem a list2 || Elem a rest) - (Union rest list2) - (a ': Union rest list2) - --- | Type level intersection. Duplicate list items are eliminated. -type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a] -type instance Intersect '[] list2 = '[] -type instance Intersect (a ': rest) list2 = - If (Elem a list2 && Not (Elem a rest)) - (a ': Intersect rest list2) - (Intersect rest list2) - --- | Type level equality --- --- This is a very clumsy implmentation, but it works back to ghc 7.6. -type family EqT (a :: t) (b :: t) :: Bool -type instance EqT ('Targeting a) ('Targeting b) = EqT a b -type instance EqT 'WithInfo 'WithInfo = 'True -type instance EqT 'WithInfo ('Targeting b) = 'False -type instance EqT ('Targeting a) 'WithInfo = 'False -type instance EqT 'OSDebian 'OSDebian = 'True -type instance EqT 'OSBuntish 'OSBuntish = 'True -type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True -type instance EqT 'OSDebian 'OSBuntish = 'False -type instance EqT 'OSDebian 'OSFreeBSD = 'False -type instance EqT 'OSBuntish 'OSDebian = 'False -type instance EqT 'OSBuntish 'OSFreeBSD = 'False -type instance EqT 'OSFreeBSD 'OSDebian = 'False -type instance EqT 'OSFreeBSD 'OSBuntish = 'False --- More modern version if the combinatiorial explosion gets too bad later: --- --- type family Eq (a :: PropType) (b :: PropType) where --- Eq a a = True --- Eq a b = False - --- | An equivilant to the following is in Data.Type.Bool in --- modern versions of ghc, but is included here to support ghc 7.6. -type family If (cond :: Bool) (tru :: a) (fls :: a) :: a -type instance If 'True tru fls = tru -type instance If 'False tru fls = fls -type family (a :: Bool) || (b :: Bool) :: Bool -type instance 'False || 'False = 'False -type instance 'True || 'True = 'True -type instance 'True || 'False = 'True -type instance 'False || 'True = 'True -type family (a :: Bool) && (b :: Bool) :: Bool -type instance 'False && 'False = 'False -type instance 'True && 'True = 'True -type instance 'True && 'False = 'False -type instance 'False && 'True = 'False -type family Not (a :: Bool) :: Bool -type instance Not 'False = 'True -type instance Not 'True = 'False - -- cgit v1.2.3 From 3aca4c62203c9586f396f35cb780c4a79fa0c099 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 14:39:17 -0400 Subject: 1st stage integrating MetaTypes --- propellor.cabal | 2 +- src/Propellor/Types.hs | 298 ++++++++++++++++----------------------- src/Propellor/Types/MetaTypes.hs | 8 +- 3 files changed, 125 insertions(+), 183 deletions(-) diff --git a/propellor.cabal b/propellor.cabal index c78b6d5f..fcad09e5 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -152,9 +152,9 @@ Library Propellor.Types.Dns Propellor.Types.Empty Propellor.Types.Info + Propellor.Types.MetaTypes Propellor.Types.OS Propellor.Types.PrivData - Propellor.Types.PropTypes Propellor.Types.Result Propellor.Types.ResultCheck Propellor.Types.ZFS diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 542a1f66..d1a93f47 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -7,23 +7,29 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE PolyKinds #-} module Propellor.Types ( Host(..) , Property , Info - , HasInfo - , NoInfo - , CInfo , Desc - , infoProperty - , simpleProperty + , mkProperty + , MetaType(..) + , OS(..) + , UnixLike + , Debian + , Buntish + , FreeBSD + , HasInfo + , type (+) + , addInfoProperty , adjustPropertySatisfy , propertyInfo , propertyDesc , propertyChildren , RevertableProperty(..) - , MkRevertableProperty(..) , IsProp(..) , Combines(..) , CombinedType @@ -36,7 +42,6 @@ module Propellor.Types , module Propellor.Types.Result , module Propellor.Types.ZFS , propertySatisfy - , ignoreInfo ) where import Data.Monoid @@ -50,13 +55,14 @@ import Propellor.Types.Info import Propellor.Types.OS import Propellor.Types.Dns import Propellor.Types.Result +import Propellor.Types.MetaTypes import Propellor.Types.ZFS -- | Everything Propellor knows about a system: Its hostname, -- properties and their collected info. data Host = Host { hostName :: HostName - , hostProperties :: [Property HasInfo] + , hostProperties :: [ChildProperty] , hostInfo :: Info } deriving (Show, Typeable) @@ -103,162 +109,158 @@ data EndAction = EndAction Desc (Result -> Propellor Result) type Desc = String -- | The core data type of Propellor, this represents a property --- that the system should have, and an action to ensure it has the --- property. +-- that the system should have, with a descrition, an action to ensure +-- it has the property, and perhaps some Info that can be added to Hosts +-- that have the property. -- --- A property can have associated `Info` or not. This is tracked at the --- type level with Property `NoInfo` and Property `HasInfo`. +-- A property has a list of `[MetaType]`, which is part of its type. -- -- There are many instances and type families, which are mostly used -- internally, so you needn't worry about them. -data Property i where - IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo - SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo - --- | Indicates that a Property has associated Info. -data HasInfo --- | Indicates that a Property does not have Info. -data NoInfo - --- | Type level calculation of the combination of HasInfo and/or NoInfo -type family CInfo x y -type instance CInfo HasInfo HasInfo = HasInfo -type instance CInfo HasInfo NoInfo = HasInfo -type instance CInfo NoInfo HasInfo = HasInfo -type instance CInfo NoInfo NoInfo = NoInfo - --- | Constructs a Property with associated Info. -infoProperty - :: Desc -- ^ description of the property - -> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly) - -> Info -- ^ info associated with the property - -> [Property i] -- ^ child properties - -> Property HasInfo -infoProperty d a i cs = IProperty d a i (map toIProperty cs) - --- | Constructs a Property with no Info. -simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo -simpleProperty = SProperty - -toIProperty :: Property i -> Property HasInfo -toIProperty p@(IProperty {}) = p -toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs) - -toSProperty :: Property i -> Property NoInfo -toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs) -toSProperty p@(SProperty {}) = p +data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty] + +-- | Since there are many different types of Properties, they cannot be put +-- into a list. The simplified ChildProperty can be put into a list. +data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty] + +instance Show ChildProperty where + show (ChildProperty desc _ _ _) = desc + +-- | Constructs a Property. +-- +-- You can specify any metatypes that make sense to indicate what OS +-- the property targets, etc. +-- +-- For example: +-- +-- > foo :: Property Debian +-- > foo = mkProperty "foo" (...) +-- +-- Note that using this needs LANGUAGE PolyKinds. +mkProperty + :: SingI metatypes + => Desc + -> Propellor Result + -> Property (Sing metatypes) +mkProperty d a = Property sing d a mempty mempty + +-- | Adds info to a Property. +-- +-- The new Property will include HasInfo in its metatypes. +addInfoProperty + :: (metatypes' ~ (+) HasInfo metatypes, SingI metatypes') + => Property metatypes + -> Info + -> Property (Sing metatypes') +addInfoProperty (Property metatypes d a i c) newi = Property sing d a (i <> newi) c + +{- -- | Makes a version of a Proprty without its Info. -- Use with caution! -ignoreInfo :: Property i -> Property NoInfo -ignoreInfo = toSProperty +ignoreInfo + :: (metatypes' ~ + => Property metatypes + -> Property (Sing metatypes') +ignoreInfo = + +-} -- | Gets the action that can be run to satisfy a Property. -- You should never run this action directly. Use -- 'Propellor.Engine.ensureProperty` instead. -propertySatisfy :: Property i -> Propellor Result -propertySatisfy (IProperty _ a _ _) = a -propertySatisfy (SProperty _ a _) = a +propertySatisfy :: Property metatypes -> Propellor Result +propertySatisfy (Property _ _ a _ _) = a -- | Changes the action that is performed to satisfy a property. -adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i -adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs -adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs +adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes +adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c -propertyInfo :: Property i -> Info -propertyInfo (IProperty _ _ i _) = i -propertyInfo (SProperty {}) = mempty +propertyInfo :: Property metatypes -> Info +propertyInfo (Property _ _ _ i _) = i -propertyDesc :: Property i -> Desc -propertyDesc (IProperty d _ _ _) = d -propertyDesc (SProperty d _ _) = d +propertyDesc :: Property metatypes -> Desc +propertyDesc (Property _ d _ _ _) = d -instance Show (Property i) where +instance Show (Property metatypes) where show p = "property " ++ show (propertyDesc p) -- | A Property can include a list of child properties that it also -- satisfies. This allows them to be introspected to collect their info, etc. -propertyChildren :: Property i -> [Property i] -propertyChildren (IProperty _ _ _ cs) = cs -propertyChildren (SProperty _ _ cs) = cs +propertyChildren :: Property metatypes -> [ChildProperty] +propertyChildren (Property _ _ _ _ c) = c -- | A property that can be reverted. The first Property is run -- normally and the second is run when it's reverted. -data RevertableProperty i = RevertableProperty - { setupRevertableProperty :: Property i - , undoRevertableProperty :: Property i +data RevertableProperty metatypes = RevertableProperty + { setupRevertableProperty :: Property metatypes + , undoRevertableProperty :: Property metatypes } -instance Show (RevertableProperty i) where +instance Show (RevertableProperty metatypes) where show (RevertableProperty p _) = show p -class MkRevertableProperty i1 i2 where - -- | Shorthand to construct a revertable property. - () :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2) - -instance MkRevertableProperty HasInfo HasInfo where - x y = RevertableProperty x y -instance MkRevertableProperty NoInfo NoInfo where - x y = RevertableProperty x y -instance MkRevertableProperty NoInfo HasInfo where - x y = RevertableProperty (toProp x) y -instance MkRevertableProperty HasInfo NoInfo where - x y = RevertableProperty x (toProp y) +-- | Shorthand to construct a revertable property from any two Properties +-- whose MetaTypes can be combined. +() + :: (metatypes ~ (+) metatypes1 metatypes2, SingI metatypes) + => Property metatypes1 + -> Property metatypes2 + -> RevertableProperty (Sing metatypes) +Property _ d1 s1 i1 c1 Property _ d2 s2 i2 c2 = RevertableProperty + (Property sing d1 s1 i1 c1) + (Property sing d2 s2 i2 c2) -- | Class of types that can be used as properties of a host. class IsProp p where setDesc :: p -> Desc -> p - toProp :: p -> Property HasInfo + -- toProp :: p -> Property HasInfo getDesc :: p -> Desc -- | Gets the info of the property, combined with all info -- of all children properties. getInfoRecursive :: p -> Info -instance IsProp (Property HasInfo) where - setDesc (IProperty _ a i cs) d = IProperty d a i cs - toProp = id +instance IsProp (Property metatypes) where + setDesc (Property t _ a i c) d = Property t d a i c + -- toProp = id getDesc = propertyDesc - getInfoRecursive (IProperty _ _ i cs) = - i <> mconcat (map getInfoRecursive cs) -instance IsProp (Property NoInfo) where - setDesc (SProperty _ a cs) d = SProperty d a cs - toProp = toIProperty - getDesc = propertyDesc - getInfoRecursive _ = mempty + getInfoRecursive (Property _ _ _ i c) = + i <> mconcat (map getInfoRecursive c) + +instance IsProp ChildProperty where + setDesc (ChildProperty _ a i c) d = ChildProperty d a i c + getDesc (ChildProperty d _ _ _) = d + getInfoRecursive (ChildProperty _ _ i c) = + i <> mconcat (map getInfoRecursive c) -instance IsProp (RevertableProperty HasInfo) where +instance IsProp (RevertableProperty metatypes) where setDesc = setDescR getDesc (RevertableProperty p1 _) = getDesc p1 - toProp (RevertableProperty p1 _) = p1 + -- toProp (RevertableProperty p1 _) = p1 -- | Return the Info of the currently active side. getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 -instance IsProp (RevertableProperty NoInfo) where - setDesc = setDescR - getDesc (RevertableProperty p1 _) = getDesc p1 - toProp (RevertableProperty p1 _) = toProp p1 - getInfoRecursive (RevertableProperty _ _) = mempty -- | Sets the description of both sides. -setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i +setDescR :: IsProp (Property metatypes) => RevertableProperty metatypes -> Desc -> RevertableProperty metatypes setDescR (RevertableProperty p1 p2) d = RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) -- | Type level calculation of the type that results from combining two -- types of properties. type family CombinedType x y -type instance CombinedType (Property x) (Property y) = Property (CInfo x y) -type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y) +type instance CombinedType (Property (Sing x)) (Property (Sing y)) = Property (Sing (Union x y)) +type instance CombinedType (RevertableProperty (Sing x)) (RevertableProperty (Sing y)) = RevertableProperty (Sing (Union x y)) -- When only one of the properties is revertable, the combined property is -- not fully revertable, so is not a RevertableProperty. -type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y) -type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y) +type instance CombinedType (RevertableProperty (Sing x)) (Property (Sing y)) = Property (Sing (Union x y)) +type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y)) = Property (Sing (Union x y)) type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result class Combines x y where -- | Combines together two properties, yielding a property that - -- has the description and info of the first, and that has the second - -- property as a child. + -- has the description and info of the first, and that has the + -- second property as a child property. combineWith :: ResultCombiner -- ^ How to combine the actions to satisfy the properties. @@ -269,73 +271,15 @@ class Combines x y where -> y -> CombinedType x y -instance Combines (Property HasInfo) (Property HasInfo) where - combineWith f _ (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) = - IProperty d1 (f a1 a2) i1 (y : cs1) - -instance Combines (Property HasInfo) (Property NoInfo) where - combineWith f _ (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) = - IProperty d1 (f a1 a2) i1 (toIProperty y : cs1) - -instance Combines (Property NoInfo) (Property HasInfo) where - combineWith f _ (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) = - IProperty d1 (f a1 a2) mempty (y : map toIProperty cs1) - -instance Combines (Property NoInfo) (Property NoInfo) where - combineWith f _ (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) = - SProperty d1 (f a1 a2) (y : cs1) - -instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where - combineWith = combineWithRR -instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where - combineWith = combineWithRR -instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where - combineWith = combineWithRR -instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where - combineWith = combineWithRR -instance Combines (RevertableProperty NoInfo) (Property HasInfo) where - combineWith = combineWithRP -instance Combines (RevertableProperty NoInfo) (Property NoInfo) where - combineWith = combineWithRP -instance Combines (RevertableProperty HasInfo) (Property HasInfo) where - combineWith = combineWithRP -instance Combines (RevertableProperty HasInfo) (Property NoInfo) where - combineWith = combineWithRP -instance Combines (Property HasInfo) (RevertableProperty NoInfo) where - combineWith = combineWithPR -instance Combines (Property NoInfo) (RevertableProperty NoInfo) where - combineWith = combineWithPR -instance Combines (Property HasInfo) (RevertableProperty HasInfo) where - combineWith = combineWithPR -instance Combines (Property NoInfo) (RevertableProperty HasInfo) where - combineWith = combineWithPR - -combineWithRR - :: Combines (Property x) (Property y) - => ResultCombiner - -> ResultCombiner - -> RevertableProperty x - -> RevertableProperty y - -> RevertableProperty (CInfo x y) -combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = - RevertableProperty - (combineWith sf tf s1 s2) - (combineWith tf sf t1 t2) - -combineWithRP - :: Combines (Property i) y - => (Propellor Result -> Propellor Result -> Propellor Result) - -> (Propellor Result -> Propellor Result -> Propellor Result) - -> RevertableProperty i - -> y - -> CombinedType (Property i) y -combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y - -combineWithPR - :: Combines x (Property i) - => (Propellor Result -> Propellor Result -> Propellor Result) - -> (Propellor Result -> Propellor Result -> Propellor Result) - -> x - -> RevertableProperty i - -> CombinedType x (Property i) -combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y +instance (CombinedType (Property (Sing x)) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (Property (Sing y)) where + combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) = + Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) +instance (CombinedType (RevertableProperty (Sing x)) (RevertableProperty (Sing y)) ~ RevertableProperty (Sing (Union x y)), SingI (Union x y)) => Combines (RevertableProperty (Sing x)) (RevertableProperty (Sing y)) where + combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = + RevertableProperty + (combineWith sf tf s1 s2) + (combineWith tf sf t1 t2) +instance (CombinedType (RevertableProperty (Sing x)) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (RevertableProperty (Sing x)) (Property (Sing y)) where + combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y +instance (CombinedType (Property (Sing x)) (RevertableProperty (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y)) where + combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index de6ffea3..b6d72dcd 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -1,9 +1,6 @@ {-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-} module Propellor.Types.MetaTypes ( - Property(..), - mkProperty, - mkProperty', MetaType(..), OS(..), UnixLike, @@ -19,6 +16,7 @@ module Propellor.Types.MetaTypes ( Sing, sing, SingI, + Union, ) where ----- DEMO ---------- @@ -27,8 +25,8 @@ foo :: Property (HasInfo + FreeBSD) foo = mkProperty' $ \t -> do ensureProperty t jail --- bar :: Property (Debian + UsesPort 80 + FreeBSD) --- bar = aptinstall `pickOS` jail +bar :: Property (Debian + FreeBSD) +bar = aptinstall `pickOS` jail aptinstall :: Property Debian aptinstall = mkProperty $ do -- cgit v1.2.3 From 416ae178ec7ed54d5740006a8dc6e1d2e30f00f4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 14:47:08 -0400 Subject: don't unify the two types of properties inside a RevertableProperty While it was ok to have RevertableProperty HasInfo even when the undo property did not have any info, and it would be ok to have RevertableProperty Debian even when the undo property targeted a wider set of OS's, type-level resource conflict detection needs to keep the two straight, as in RevertableProperty (Port 80 + Debian) Debian Without that, reverting a web server property and also including another property that uses port 80 would fail to compile, since the type system would not know if reverting RevertableProperty (Port 80 + Debian) continued using the resource or not. The downside is the need to write RevertableProperty Debian Debian ... Perhaps I'll add a type alias to avoid that or something. --- src/Propellor/Types.hs | 38 +++++++++++++++++--------------------- 1 file changed, 17 insertions(+), 21 deletions(-) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index d1a93f47..6c1412c1 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -192,24 +192,20 @@ propertyChildren (Property _ _ _ _ c) = c -- | A property that can be reverted. The first Property is run -- normally and the second is run when it's reverted. -data RevertableProperty metatypes = RevertableProperty - { setupRevertableProperty :: Property metatypes - , undoRevertableProperty :: Property metatypes +data RevertableProperty setupmetatypes undometatypes = RevertableProperty + { setupRevertableProperty :: Property setupmetatypes + , undoRevertableProperty :: Property undometatypes } -instance Show (RevertableProperty metatypes) where +instance Show (RevertableProperty setupmetatypes undometatypes) where show (RevertableProperty p _) = show p --- | Shorthand to construct a revertable property from any two Properties --- whose MetaTypes can be combined. +-- | Shorthand to construct a revertable property from any two Properties. () - :: (metatypes ~ (+) metatypes1 metatypes2, SingI metatypes) - => Property metatypes1 - -> Property metatypes2 - -> RevertableProperty (Sing metatypes) -Property _ d1 s1 i1 c1 Property _ d2 s2 i2 c2 = RevertableProperty - (Property sing d1 s1 i1 c1) - (Property sing d2 s2 i2 c2) + :: Property setupmetatypes + -> Property undometatypes + -> RevertableProperty setupmetatypes undometatypes +setup undo = RevertableProperty setup undo -- | Class of types that can be used as properties of a host. class IsProp p where @@ -233,7 +229,7 @@ instance IsProp ChildProperty where getInfoRecursive (ChildProperty _ _ i c) = i <> mconcat (map getInfoRecursive c) -instance IsProp (RevertableProperty metatypes) where +instance IsProp (RevertableProperty setupmetatypes undometatypes) where setDesc = setDescR getDesc (RevertableProperty p1 _) = getDesc p1 -- toProp (RevertableProperty p1 _) = p1 @@ -241,7 +237,7 @@ instance IsProp (RevertableProperty metatypes) where getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 -- | Sets the description of both sides. -setDescR :: IsProp (Property metatypes) => RevertableProperty metatypes -> Desc -> RevertableProperty metatypes +setDescR :: IsProp (Property setupmetatypes) => RevertableProperty setupmetatypes undometatypes -> Desc -> RevertableProperty setupmetatypes undometatypes setDescR (RevertableProperty p1 p2) d = RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) @@ -249,11 +245,11 @@ setDescR (RevertableProperty p1 p2) d = -- types of properties. type family CombinedType x y type instance CombinedType (Property (Sing x)) (Property (Sing y)) = Property (Sing (Union x y)) -type instance CombinedType (RevertableProperty (Sing x)) (RevertableProperty (Sing y)) = RevertableProperty (Sing (Union x y)) +type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) = RevertableProperty (Sing (Union x y)) (Sing (Union x' y')) -- When only one of the properties is revertable, the combined property is -- not fully revertable, so is not a RevertableProperty. -type instance CombinedType (RevertableProperty (Sing x)) (Property (Sing y)) = Property (Sing (Union x y)) -type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y)) = Property (Sing (Union x y)) +type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) = Property (Sing (Union x y)) +type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) = Property (Sing (Union x y)) type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result @@ -274,12 +270,12 @@ class Combines x y where instance (CombinedType (Property (Sing x)) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (Property (Sing y)) where combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) = Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) -instance (CombinedType (RevertableProperty (Sing x)) (RevertableProperty (Sing y)) ~ RevertableProperty (Sing (Union x y)), SingI (Union x y)) => Combines (RevertableProperty (Sing x)) (RevertableProperty (Sing y)) where +instance (CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) ~ RevertableProperty (Sing (Union x y)) (Sing (Union x' y')), SingI (Union x y), SingI (Union x' y')) => Combines (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) where combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = RevertableProperty (combineWith sf tf s1 s2) (combineWith tf sf t1 t2) -instance (CombinedType (RevertableProperty (Sing x)) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (RevertableProperty (Sing x)) (Property (Sing y)) where +instance (CombinedType (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) where combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y -instance (CombinedType (Property (Sing x)) (RevertableProperty (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y)) where +instance (CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) where combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y -- cgit v1.2.3 From 7ee3157ab1922fd2f7158fd40927dca8a83ad4b0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 15:17:16 -0400 Subject: docs and enable PolyKinds globally --- debian/changelog | 32 ++++++++++++++++++++++++++++++-- propellor.cabal | 6 +++--- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/debian/changelog b/debian/changelog index 2c2b2ea7..c9286fcf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,31 @@ +propellor (3.0.0) UNRELEASED; urgency=medium + + * Property types have been improved to indicate what systems they target. + Transition guide: + - Change "Property NoInfo" to "Property UnixLike" + - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" + - Change "RevertableProperty NoInfo" to + "RevertableProperty UnixLike UnixLike" + - Change "RevertableProperty HasInfo" to + "RevertableProperty (HasInfo + UnixLike) UnixLike" + - GHC needs {-# LANGUAGE PolyKinds #-} to use these new type signatures. + This is enabled by default for all modules in propellor.cabal. But + if you are using propellor as a library, you may need to enable it + manually. + - If you know a property only works on a particular OS, like Debian + or FreeBSD, use that instead of "UnixLike". For example: + "Property (HasInfo + Debian)" + - It's also possible make a property support a set of OS's, for example: + "Property (HasInfo + Debian + FreeBSD)" + - The new `pickOS` property combinator can be used to combine different + properties, supporting different OS's, into one Property that chooses + what to do based on the Host's OS. + - `ensureProperty` now needs information about the metatypes of the + property it's used in to be passed to it. See the documentation + of `ensureProperty` for an example. + + -- Joey Hess Thu, 24 Mar 2016 15:02:33 -0400 + propellor (2.17.0) unstable; urgency=medium * Added initial support for FreeBSD. @@ -470,12 +498,12 @@ propellor (2.0.0) unstable; urgency=medium This was done to make sure that ensureProperty is only used on properties that do not have Info. Transition guide: - - Change all "Property" to "Property NoInfo" or "Property WithInfo" + - Change all "Property" to "Property NoInfo" or "Property HasInfo" (The compiler can tell you if you got it wrong!) - To construct a RevertableProperty, it is useful to use the new () operator - Constructing a list of properties can be problimatic, since - Property NoInto and Property WithInfo are different types and cannot + Property NoInto and Property HasInfo are different types and cannot appear in the same list. To deal with this, "props" has been added, and can built up a list of properties of different types, using the same (&) and (!) operators that are used to build diff --git a/propellor.cabal b/propellor.cabal index a631f262..1179ca23 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -36,7 +36,7 @@ Description: Executable propellor Main-Is: wrapper.hs - GHC-Options: -threaded -Wall -fno-warn-tabs + GHC-Options: -threaded -Wall -fno-warn-tabs -XPolyKinds Hs-Source-Dirs: src Build-Depends: -- propellor needs to support the ghc shipped in Debian stable @@ -47,7 +47,7 @@ Executable propellor Executable propellor-config Main-Is: config.hs - GHC-Options: -threaded -Wall -fno-warn-tabs + GHC-Options: -threaded -Wall -fno-warn-tabs -XPolyKinds Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, @@ -55,7 +55,7 @@ Executable propellor-config exceptions (>= 0.6), stm, text, unix Library - GHC-Options: -Wall -fno-warn-tabs + GHC-Options: -Wall -fno-warn-tabs -XPolyKinds Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, -- cgit v1.2.3 From 413c74cdd336eeae59aea9660e6fc7331d599a1b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 15:21:48 -0400 Subject: simplify --- src/Propellor/Types.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 6c1412c1..25269969 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -30,6 +30,7 @@ module Propellor.Types , propertyDesc , propertyChildren , RevertableProperty(..) + , ChildProperty , IsProp(..) , Combines(..) , CombinedType @@ -230,17 +231,14 @@ instance IsProp ChildProperty where i <> mconcat (map getInfoRecursive c) instance IsProp (RevertableProperty setupmetatypes undometatypes) where - setDesc = setDescR + -- | Sets the description of both sides. + setDesc (RevertableProperty p1 p2) d = + RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) getDesc (RevertableProperty p1 _) = getDesc p1 -- toProp (RevertableProperty p1 _) = p1 -- | Return the Info of the currently active side. getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 --- | Sets the description of both sides. -setDescR :: IsProp (Property setupmetatypes) => RevertableProperty setupmetatypes undometatypes -> Desc -> RevertableProperty setupmetatypes undometatypes -setDescR (RevertableProperty p1 p2) d = - RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) - -- | Type level calculation of the type that results from combining two -- types of properties. type family CombinedType x y -- cgit v1.2.3 From ab2204fc868f8f0e9fbc57a4b0b75996a38d934d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 15:41:30 -0400 Subject: TypeOperators, not PolyKinds is needed --- propellor.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/propellor.cabal b/propellor.cabal index 1179ca23..0a7746ed 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -36,7 +36,7 @@ Description: Executable propellor Main-Is: wrapper.hs - GHC-Options: -threaded -Wall -fno-warn-tabs -XPolyKinds + GHC-Options: -threaded -Wall -fno-warn-tabs -XTypeOperators Hs-Source-Dirs: src Build-Depends: -- propellor needs to support the ghc shipped in Debian stable @@ -47,7 +47,7 @@ Executable propellor Executable propellor-config Main-Is: config.hs - GHC-Options: -threaded -Wall -fno-warn-tabs -XPolyKinds + GHC-Options: -threaded -Wall -fno-warn-tabs -XTypeOperators Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, @@ -55,7 +55,7 @@ Executable propellor-config exceptions (>= 0.6), stm, text, unix Library - GHC-Options: -Wall -fno-warn-tabs -XPolyKinds + GHC-Options: -Wall -fno-warn-tabs -XTypeOperators Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, -- cgit v1.2.3 From f5e7596cb9183158644fdd2df9996871dc0a8efa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 15:42:47 -0400 Subject: converted Propellor.Info --- debian/changelog | 2 +- src/Propellor/Info.hs | 19 +++++++++++-------- src/Propellor/Types.hs | 5 +++-- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/debian/changelog b/debian/changelog index c9286fcf..f1138eb2 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,7 +8,7 @@ propellor (3.0.0) UNRELEASED; urgency=medium "RevertableProperty UnixLike UnixLike" - Change "RevertableProperty HasInfo" to "RevertableProperty (HasInfo + UnixLike) UnixLike" - - GHC needs {-# LANGUAGE PolyKinds #-} to use these new type signatures. + - GHC needs {-# LANGUAGE TypeOperators #-} to use these new type signatures. This is enabled by default for all modules in propellor.cabal. But if you are using propellor as a library, you may need to enable it manually. diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index 7eb7d4a8..4827ba8a 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -13,11 +13,14 @@ import Data.Monoid import Control.Applicative import Prelude -pureInfoProperty :: (IsInfo v) => Desc -> v -> Property HasInfo +pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike) pureInfoProperty desc v = pureInfoProperty' desc (addInfo mempty v) -pureInfoProperty' :: Desc -> Info -> Property HasInfo -pureInfoProperty' desc i = infoProperty ("has " ++ desc) (return NoChange) i mempty +pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike) +pureInfoProperty' desc i = addInfoProperty p i + where + p :: Property UnixLike + p = mkProperty ("has " ++ desc) (return NoChange) -- | Gets a value from the host's Info. askInfo :: (IsInfo v) => Propellor v @@ -27,7 +30,7 @@ askInfo = asks (getInfo . hostInfo) -- -- This only provides info for other Properties, so they can act -- conditionally on the os. -os :: System -> Property HasInfo +os :: System -> Property (HasInfo + UnixLike) os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system) -- Gets the operating system of a host, if it has been specified. @@ -43,11 +46,11 @@ getOS = fromInfoVal <$> askInfo -- When propellor --spin is used to deploy a host, it checks -- if the host's IP Property matches the DNS. If the DNS is missing or -- out of date, the host will instead be contacted directly by IP address. -ipv4 :: String -> Property HasInfo +ipv4 :: String -> Property (HasInfo + UnixLike) ipv4 = addDNS . Address . IPv4 -- | Indicate that a host has an AAAA record in the DNS. -ipv6 :: String -> Property HasInfo +ipv6 :: String -> Property (HasInfo + UnixLike) ipv6 = addDNS . Address . IPv6 -- | Indicates another name for the host in the DNS. @@ -56,14 +59,14 @@ ipv6 = addDNS . Address . IPv6 -- to use their address, rather than using a CNAME. This avoids various -- problems with CNAMEs, and also means that when multiple hosts have the -- same alias, a DNS round-robin is automatically set up. -alias :: Domain -> Property HasInfo +alias :: Domain -> Property (HasInfo + UnixLike) alias d = pureInfoProperty' ("alias " ++ d) $ mempty `addInfo` toAliasesInfo [d] -- A CNAME is added here, but the DNS setup code converts it to an -- IP address when that makes sense. `addInfo` (toDnsInfo $ S.singleton $ CNAME $ AbsDomain d) -addDNS :: Record -> Property HasInfo +addDNS :: Record -> Property (HasInfo + UnixLike) addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r)) where rdesc (CNAME d) = unwords ["alias", ddesc d] diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 25269969..49ba9220 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -149,11 +149,12 @@ mkProperty d a = Property sing d a mempty mempty -- -- The new Property will include HasInfo in its metatypes. addInfoProperty - :: (metatypes' ~ (+) HasInfo metatypes, SingI metatypes') + :: (Sing metatypes' ~ (+) HasInfo metatypes, SingI metatypes') => Property metatypes -> Info -> Property (Sing metatypes') -addInfoProperty (Property metatypes d a i c) newi = Property sing d a (i <> newi) c +addInfoProperty (Property metatypes d a oldi c) newi = + Property sing d a (oldi <> newi) c {- -- cgit v1.2.3 From 04c973a4ef966e4f3da8d8bda8b3eb489cd4fbf8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 16:55:31 -0400 Subject: refactor --- src/Propellor/Info.hs | 4 ++-- src/Propellor/Types/Info.hs | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index 4827ba8a..071bf4c2 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -14,13 +14,13 @@ import Control.Applicative import Prelude pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike) -pureInfoProperty desc v = pureInfoProperty' desc (addInfo mempty v) +pureInfoProperty desc v = pureInfoProperty' desc (toInfo v) pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike) pureInfoProperty' desc i = addInfoProperty p i where p :: Property UnixLike - p = mkProperty ("has " ++ desc) (return NoChange) + p = property ("has " ++ desc) (return NoChange) -- | Gets a value from the host's Info. askInfo :: (IsInfo v) => Propellor v diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs index 53fa9e77..bc1543e2 100644 --- a/src/Propellor/Types/Info.hs +++ b/src/Propellor/Types/Info.hs @@ -4,6 +4,7 @@ module Propellor.Types.Info ( Info, IsInfo(..), addInfo, + toInfo, getInfo, mapInfo, propagatableInfo, @@ -46,6 +47,9 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where addInfo :: IsInfo v => Info -> v -> Info addInfo (Info l) v = Info (InfoEntry v:l) +toInfo :: IsInfo v => v -> Info +toInfo = addInfo mempty + -- The list is reversed here because addInfo builds it up in reverse order. getInfo :: IsInfo v => Info -> v getInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l)) -- cgit v1.2.3 From f1168d4b46e9a1c73afe4885f1b14b1bd81b7d50 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 16:55:48 -0400 Subject: IncludesInfo --- src/Propellor/Types/MetaTypes.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index b6d72dcd..7f7dae13 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -17,6 +17,7 @@ module Propellor.Types.MetaTypes ( sing, SingI, Union, + IncludesInfo, ) where ----- DEMO ---------- @@ -108,6 +109,9 @@ type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] type instance Concat '[] bs = bs type instance Concat (a ': as) bs = a ': (Concat as bs) +type family IncludesInfo t :: Bool +type instance IncludesInfo (Sing l) = Elem 'WithInfo l + newtype OuterMetaTypes l = OuterMetaTypes (Sing l) outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l -- cgit v1.2.3 From c0236e92be55cec267b425a3b1fffc65b119b1aa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 16:56:01 -0400 Subject: converted PrivData Somewhat poorly; I don't like needing to export the Property constructor to use it here, and there's a use of undefined where it should be able to use sing. I got quite stuck on this, so am happy to have anything that works. --- src/Propellor/PrivData.hs | 37 ++++++++++++++++++++++++++----------- src/Propellor/Types.hs | 12 +++++++----- 2 files changed, 33 insertions(+), 16 deletions(-) diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index bc09f0c6..6f3d4771 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} module Propellor.PrivData ( withPrivData, @@ -40,6 +42,7 @@ import Prelude import Propellor.Types import Propellor.Types.PrivData +import Propellor.Types.MetaTypes import Propellor.Types.Info import Propellor.Message import Propellor.Info @@ -75,29 +78,41 @@ import Utility.FileSystemEncoding -- being used, which is necessary to ensure that the privdata is sent to -- the remote host by propellor. withPrivData - :: (IsContext c, IsPrivDataSource s, IsProp (Property i)) + :: + ( IsContext c + , IsPrivDataSource s + , IncludesInfo metatypes ~ True + ) => s -> c - -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property i) - -> Property HasInfo + -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property metatypes) + -> Property metatypes withPrivData s = withPrivData' snd [s] -- Like withPrivData, but here any one of a list of PrivDataFields can be used. withSomePrivData - :: (IsContext c, IsPrivDataSource s, IsProp (Property i)) + :: + ( IsContext c + , IsPrivDataSource s + , IncludesInfo metatypes ~ True + ) => [s] -> c - -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property i) - -> Property HasInfo + -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property metatypes) + -> Property metatypes withSomePrivData = withPrivData' id withPrivData' - :: (IsContext c, IsPrivDataSource s, IsProp (Property i)) + :: + ( IsContext c + , IsPrivDataSource s + , IncludesInfo metatypes ~ True + ) => ((PrivDataField, PrivData) -> v) -> [s] -> c - -> (((v -> Propellor Result) -> Propellor Result) -> Property i) - -> Property HasInfo + -> (((v -> Propellor Result) -> Propellor Result) -> Property metatypes) + -> Property metatypes withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a -> maybe missing (a . feed) =<< getM get fieldlist where @@ -112,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a -> "Fix this by running:" : showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist) return FailedChange - addinfo p = infoProperty + addinfo p = Property undefined -- FIXME: should use sing here (propertyDesc p) (propertySatisfy p) (propertyInfo p `addInfo` privset) @@ -132,7 +147,7 @@ showSet = concatMap go , Just "" ] -addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property HasInfo +addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike) addPrivData v = pureInfoProperty (show v) (PrivInfo (S.singleton v)) {- Gets the requested field's value, in the specified context if it's diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 49ba9220..866e8090 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -12,10 +12,10 @@ module Propellor.Types ( Host(..) - , Property + , Property(..) , Info , Desc - , mkProperty + , property , MetaType(..) , OS(..) , UnixLike @@ -43,6 +43,7 @@ module Propellor.Types , module Propellor.Types.Result , module Propellor.Types.ZFS , propertySatisfy + , Sing ) where import Data.Monoid @@ -127,7 +128,8 @@ data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty] instance Show ChildProperty where show (ChildProperty desc _ _ _) = desc --- | Constructs a Property. +-- | Constructs a Property, from a description and an action to run to +-- ensure the Property is met. -- -- You can specify any metatypes that make sense to indicate what OS -- the property targets, etc. @@ -138,12 +140,12 @@ instance Show ChildProperty where -- > foo = mkProperty "foo" (...) -- -- Note that using this needs LANGUAGE PolyKinds. -mkProperty +property :: SingI metatypes => Desc -> Propellor Result -> Property (Sing metatypes) -mkProperty d a = Property sing d a mempty mempty +property d a = Property sing d a mempty mempty -- | Adds info to a Property. -- -- cgit v1.2.3 From 841a98dc1a2f6147621cf1ef2295624c9d066715 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 16:56:55 -0400 Subject: converted to metatypes --- src/Propellor/Property/Cmd.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs index 6da2e643..6b84acb5 100644 --- a/src/Propellor/Property/Cmd.hs +++ b/src/Propellor/Property/Cmd.hs @@ -58,10 +58,10 @@ import Utility.Process (createProcess, CreateProcess, waitForProcess) -- | A property that can be satisfied by running a command. -- -- The command must exit 0 on success. -cmdProperty :: String -> [String] -> UncheckedProperty NoInfo +cmdProperty :: String -> [String] -> UncheckedProperty UnixLike cmdProperty cmd params = cmdProperty' cmd params id -cmdProperty' :: String -> [String] -> (CreateProcess -> CreateProcess) -> UncheckedProperty NoInfo +cmdProperty' :: String -> [String] -> (CreateProcess -> CreateProcess) -> UncheckedProperty UnixLike cmdProperty' cmd params mkprocess = unchecked $ property desc $ liftIO $ cmdResult <$> boolSystem' cmd (map Param params) mkprocess where @@ -74,7 +74,7 @@ cmdResult True = NoChange -- | A property that can be satisfied by running a command, -- with added environment variables in addition to the standard -- environment. -cmdPropertyEnv :: String -> [String] -> [(String, String)] -> UncheckedProperty NoInfo +cmdPropertyEnv :: String -> [String] -> [(String, String)] -> UncheckedProperty UnixLike cmdPropertyEnv cmd params env = unchecked $ property desc $ liftIO $ do env' <- addEntries env <$> getEnvironment cmdResult <$> boolSystemEnv cmd (map Param params) (Just env') @@ -85,14 +85,14 @@ cmdPropertyEnv cmd params env = unchecked $ property desc $ liftIO $ do type Script = [String] -- | A property that can be satisfied by running a script. -scriptProperty :: Script -> UncheckedProperty NoInfo +scriptProperty :: Script -> UncheckedProperty UnixLike scriptProperty script = cmdProperty "sh" ["-c", shellcmd] where shellcmd = intercalate " ; " ("set -e" : script) -- | A property that can satisfied by running a script -- as user (cd'd to their home directory). -userScriptProperty :: User -> Script -> UncheckedProperty NoInfo +userScriptProperty :: User -> Script -> UncheckedProperty UnixLike userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user] where shellcmd = intercalate " ; " ("set -e" : "cd" : script) -- cgit v1.2.3 From c012af576a6c55e03447cfb6ed3b047a623c0944 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 16:57:21 -0400 Subject: partially converted; a few things commented out for now --- src/Propellor/Property.hs | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index b6b8dc0d..e5ccf9b1 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -18,8 +18,8 @@ module Propellor.Property ( -- * Constructing properties , Propellor , property - , ensureProperty - , withOS + --, ensureProperty + --, withOS , unsupportedOS , makeChange , noChange @@ -55,11 +55,6 @@ import Utility.Exception import Utility.Monad import Utility.Misc --- | Constructs a Property, from a description and an action to run to --- ensure the Property is met. -property :: Desc -> Propellor Result -> Property NoInfo -property d s = simpleProperty d s mempty - -- | Makes a perhaps non-idempotent Property be idempotent by using a flag -- file to indicate whether it has run before. -- Use with caution. @@ -168,8 +163,8 @@ infixl 1 ==> -- Property. -- -- This can only be used on a Property that has NoInfo. -ensureProperty :: Property NoInfo -> Propellor Result -ensureProperty = catchPropellor . propertySatisfy +--ensureProperty :: Property NoInfo -> Propellor Result +--ensureProperty = catchPropellor . propertySatisfy -- | Tries the first property, but if it fails to work, instead uses -- the second. @@ -258,8 +253,8 @@ isNewerThan x y = do -- > (Just (System (Debian suite) arch)) -> ... -- > (Just (System (Buntish release) arch)) -> ... -- > Nothing -> unsupportedOS -withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo -withOS desc a = property desc $ a =<< getOS +--withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo +--withOS desc a = property desc $ a =<< getOS -- | Throws an error, for use in `withOS` when a property is lacking -- support for an OS. @@ -270,7 +265,7 @@ unsupportedOS = go =<< getOS go (Just o) = error $ "This property is not implemented for " ++ show o -- | Undoes the effect of a RevertableProperty. -revert :: RevertableProperty i -> RevertableProperty i +revert :: RevertableProperty setup undo -> RevertableProperty undo setup revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 makeChange :: IO () -> Propellor Result @@ -279,7 +274,7 @@ makeChange a = liftIO a >> return MadeChange noChange :: Propellor Result noChange = return NoChange -doNothing :: Property NoInfo +doNothing :: Property UnixLike doNothing = property "noop property" noChange -- | Registers an action that should be run at the very end, after -- cgit v1.2.3 From 3d6a0d8663d32344a9f0761a144bfcacf9667378 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 16:57:46 -0400 Subject: converted to metatypes A few parts using ensureProperty need more work to compile --- src/Propellor/Property/File.hs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 3021617c..1f66dda2 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -9,14 +9,14 @@ import System.Exit type Line = String -- | Replaces all the content of a file. -hasContent :: FilePath -> [Line] -> Property NoInfo +hasContent :: FilePath -> [Line] -> Property UnixLike f `hasContent` newcontent = fileProperty ("replace " ++ f) (\_oldcontent -> newcontent) f -- | Replaces all the content of a file, ensuring that its modes do not -- allow it to be read or written by anyone other than the current user -hasContentProtected :: FilePath -> [Line] -> Property NoInfo +hasContentProtected :: FilePath -> [Line] -> Property UnixLike f `hasContentProtected` newcontent = fileProperty' writeFileProtected ("replace " ++ f) (\_oldcontent -> newcontent) f @@ -53,10 +53,10 @@ hasPrivContent' writer source f context = desc = "privcontent " ++ f -- | Ensures that a line is present in a file, adding it to the end if not. -containsLine :: FilePath -> Line -> Property NoInfo +containsLine :: FilePath -> Line -> Property UnixLike f `containsLine` l = f `containsLines` [l] -containsLines :: FilePath -> [Line] -> Property NoInfo +containsLines :: FilePath -> [Line] -> Property UnixLike f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f where go content = content ++ filter (`notElem` content) ls @@ -64,27 +64,27 @@ f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f -- | Ensures that a line is not present in a file. -- Note that the file is ensured to exist, so if it doesn't, an empty -- file will be written. -lacksLine :: FilePath -> Line -> Property NoInfo +lacksLine :: FilePath -> Line -> Property UnixLike f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f -lacksLines :: FilePath -> [Line] -> Property NoInfo +lacksLines :: FilePath -> [Line] -> Property UnixLike f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f -- | Replaces the content of a file with the transformed content of another file -basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property NoInfo +basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike f `basedOn` (f', a) = property desc $ go =<< (liftIO $ readFile f') where desc = "replace " ++ f go tmpl = ensureProperty $ fileProperty desc (\_ -> a $ lines $ tmpl) f -- | Removes a file. Does not remove symlinks or non-plain-files. -notPresent :: FilePath -> Property NoInfo +notPresent :: FilePath -> Property UnixLike notPresent f = check (doesFileExist f) $ property (f ++ " not present") $ makeChange $ nukeFile f -fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property NoInfo +fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike fileProperty = fileProperty' writeFile -fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property NoInfo +fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f) where go True = do @@ -103,7 +103,7 @@ fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f) setOwnerAndGroup f' (fileOwner s) (fileGroup s) -- | Ensures a directory exists. -dirExists :: FilePath -> Property NoInfo +dirExists :: FilePath -> Property UnixLike dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $ makeChange $ createDirectoryIfMissing True d @@ -113,7 +113,7 @@ newtype LinkTarget = LinkTarget FilePath -- | Creates or atomically updates a symbolic link. -- -- Does not overwrite regular files or directories. -isSymlinkedTo :: FilePath -> LinkTarget -> Property NoInfo +isSymlinkedTo :: FilePath -> LinkTarget -> Property UnixLike link `isSymlinkedTo` (LinkTarget target) = property desc $ go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link) where @@ -135,7 +135,7 @@ link `isSymlinkedTo` (LinkTarget target) = property desc $ updateLink = createSymbolicLink target `viaStableTmp` link -- | Ensures that a file is a copy of another (regular) file. -isCopyOf :: FilePath -> FilePath -> Property NoInfo +isCopyOf :: FilePath -> FilePath -> Property UnixLike f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f') where desc = f ++ " is copy of " ++ f' @@ -156,7 +156,7 @@ f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f') [Param "--preserve=all", Param "--", File src, File dest] -- | Ensures that a file/dir has the specified owner and group. -ownerGroup :: FilePath -> User -> Group -> Property NoInfo +ownerGroup :: FilePath -> User -> Group -> Property UnixLike ownerGroup f (User owner) (Group group) = p `describe` (f ++ " owner " ++ og) where p = cmdProperty "chown" [og, f] @@ -164,7 +164,7 @@ ownerGroup f (User owner) (Group group) = p `describe` (f ++ " owner " ++ og) og = owner ++ ":" ++ group -- | Ensures that a file/dir has the specfied mode. -mode :: FilePath -> FileMode -> Property NoInfo +mode :: FilePath -> FileMode -> Property UnixLike mode f v = p `changesFile` f where p = property (f ++ " mode " ++ show v) $ do -- cgit v1.2.3 From 83cd812ab5ac787769b34f59d1763f3c8648f06a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 17:25:58 -0400 Subject: convert ensureProperty Moved to its own module to keep everything related in one place. --- propellor.cabal | 1 + src/Propellor/Base.hs | 12 +++---- src/Propellor/EnsureProperty.hs | 66 +++++++++++++++++++++++++++++++++++++ src/Propellor/Property.hs | 12 +++---- src/Propellor/Property/File.hs | 9 ++--- src/Propellor/Types.hs | 4 +-- src/Propellor/Types/MetaTypes.hs | 71 ++++++---------------------------------- 7 files changed, 94 insertions(+), 81 deletions(-) create mode 100644 src/Propellor/EnsureProperty.hs diff --git a/propellor.cabal b/propellor.cabal index 0a7746ed..a13ebcb5 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -143,6 +143,7 @@ Library Propellor.Debug Propellor.PrivData Propellor.Engine + Propellor.EnsureProperty Propellor.Exception Propellor.Types Propellor.Types.Chroot diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs index 2a0f5cbc..e50adf10 100644 --- a/src/Propellor/Base.hs +++ b/src/Propellor/Base.hs @@ -7,12 +7,12 @@ module Propellor.Base ( module Propellor.Types , module Propellor.Property , module Propellor.Property.Cmd - , module Propellor.Property.List + --, module Propellor.Property.List , module Propellor.Types.PrivData - , module Propellor.PropAccum + --, module Propellor.PropAccum , module Propellor.Info , module Propellor.PrivData - , module Propellor.Engine + --, module Propellor.Engine , module Propellor.Exception , module Propellor.Message , module Propellor.Debug @@ -34,8 +34,8 @@ module Propellor.Base ( import Propellor.Types import Propellor.Property -import Propellor.Engine -import Propellor.Property.List +--import Propellor.Engine +--import Propellor.Property.List import Propellor.Property.Cmd import Propellor.PrivData import Propellor.Types.PrivData @@ -43,7 +43,7 @@ import Propellor.Message import Propellor.Debug import Propellor.Exception import Propellor.Info -import Propellor.PropAccum +--import Propellor.PropAccum import Propellor.Location import Propellor.Utilities diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs new file mode 100644 index 00000000..c72f7ecd --- /dev/null +++ b/src/Propellor/EnsureProperty.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Propellor.EnsureProperty + ( ensureProperty + , property' + , OuterMetaTypes + ) where + +import Propellor.Types +import Propellor.Types.MetaTypes +import Propellor.Exception + +-- | For when code running in the Propellor monad needs to ensure a +-- Property. +-- +-- Use `property'` to get the `OuterMetaTypes`. For example: +-- +-- > foo = Property Debian +-- > foo = property' $ \o -> do +-- > ensureProperty o (aptInstall "foo") +-- +-- The type checker will prevent using ensureProperty with a property +-- that does not support the target OSes needed by the OuterMetaTypes. +-- In the example above, aptInstall must support Debian, since foo +-- is supposed to support Debian. +-- +-- The type checker will also prevent using ensureProperty with a property +-- with HasInfo in its MetaTypes. Doing so would cause the `Info` associated +-- with the property to be lost. +ensureProperty + :: + ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets + , CannotUseEnsurePropertyWithInfo inner ~ 'True + ) + => OuterMetaTypes outer + -> Property (Sing inner) + -> Propellor Result +ensureProperty _ = catchPropellor . propertySatisfy + +-- The name of this was chosen to make type errors a more understandable. +type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool +type instance CannotUseEnsurePropertyWithInfo '[] = 'True +type instance CannotUseEnsurePropertyWithInfo (t ': ts) = + Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts + +-- | Constructs a property, like `property`, but provides its +-- `OuterMetaTypes`. +property' + :: SingI metatypes + => Desc + -> (OuterMetaTypes metatypes -> Propellor Result) + -> Property (Sing metatypes) +property' d a = + let p = Property sing d (a (outerMetaTypes p)) mempty mempty + in p + +-- | Used to provide the metatypes of a Property to calls to +-- 'ensureProperty` within it. +newtype OuterMetaTypes metatypes = OuterMetaTypes (Sing metatypes) + +outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l +outerMetaTypes (Property metatypes _ _ _ _) = OuterMetaTypes metatypes diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index e5ccf9b1..27d17135 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -18,7 +18,8 @@ module Propellor.Property ( -- * Constructing properties , Propellor , property - --, ensureProperty + , property' + , ensureProperty --, withOS , unsupportedOS , makeChange @@ -49,8 +50,10 @@ import Prelude import Propellor.Types import Propellor.Types.ResultCheck +import Propellor.Types.MetaTypes import Propellor.Info import Propellor.Exception +import Propellor.EnsureProperty import Utility.Exception import Utility.Monad import Utility.Misc @@ -159,13 +162,6 @@ describe = setDesc (==>) = flip describe infixl 1 ==> --- | For when code running in the Propellor monad needs to ensure a --- Property. --- --- This can only be used on a Property that has NoInfo. ---ensureProperty :: Property NoInfo -> Propellor Result ---ensureProperty = catchPropellor . propertySatisfy - -- | Tries the first property, but if it fails to work, instead uses -- the second. fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2 diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 1f66dda2..2a74b5ed 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -46,8 +46,8 @@ hasPrivContentExposedFrom = hasPrivContent' writeFile hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property HasInfo hasPrivContent' writer source f context = withPrivData source context $ \getcontent -> - property desc $ getcontent $ \privcontent -> - ensureProperty $ fileProperty' writer desc + property' desc $ \o -> getcontent $ \privcontent -> + ensureProperty o $ fileProperty' writer desc (\_oldcontent -> privDataLines privcontent) f where desc = "privcontent " ++ f @@ -72,10 +72,11 @@ f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notEl -- | Replaces the content of a file with the transformed content of another file basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike -f `basedOn` (f', a) = property desc $ go =<< (liftIO $ readFile f') +f `basedOn` (f', a) = property' desc $ \o -> do + tmpl <- liftIO $ readFile f' + ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f where desc = "replace " ++ f - go tmpl = ensureProperty $ fileProperty desc (\_ -> a $ lines $ tmpl) f -- | Removes a file. Does not remove symlinks or non-plain-files. notPresent :: FilePath -> Property UnixLike diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 866e8090..d30a39f3 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -13,9 +13,9 @@ module Propellor.Types ( Host(..) , Property(..) + , property , Info , Desc - , property , MetaType(..) , OS(..) , UnixLike @@ -172,7 +172,7 @@ ignoreInfo = -- | Gets the action that can be run to satisfy a Property. -- You should never run this action directly. Use --- 'Propellor.Engine.ensureProperty` instead. +-- 'Propellor.EnsureProperty.ensureProperty` instead. propertySatisfy :: Property metatypes -> Propellor Result propertySatisfy (Property _ _ a _ _) = a diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 7f7dae13..3d178641 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -9,46 +9,19 @@ module Propellor.Types.MetaTypes ( FreeBSD, HasInfo, type (+), - OuterMetaTypes, - ensureProperty, - tightenTargets, - pickOS, Sing, sing, SingI, Union, IncludesInfo, + Targets, + NotSuperset, + CheckCombineTargets(..), + type (&&), + Not, + EqT, ) where ------ DEMO ---------- - -foo :: Property (HasInfo + FreeBSD) -foo = mkProperty' $ \t -> do - ensureProperty t jail - -bar :: Property (Debian + FreeBSD) -bar = aptinstall `pickOS` jail - -aptinstall :: Property Debian -aptinstall = mkProperty $ do - return () - -jail :: Property FreeBSD -jail = mkProperty $ do - return () - ------ END DEMO ---------- - -data Property metatypes = Property metatypes (IO ()) - -mkProperty :: SingI l => IO () -> Property (Sing l) -mkProperty = mkProperty' . const - -mkProperty' :: SingI l => (OuterMetaTypes l -> IO ()) -> Property (Sing l) -mkProperty' a = - let p = Property sing (a (outerMetaTypes p)) - in p - data MetaType = Targeting OS -- ^ A target OS of a Property | WithInfo -- ^ Indicates that a Property has associated Info @@ -112,39 +85,13 @@ type instance Concat (a ': as) bs = a ': (Concat as bs) type family IncludesInfo t :: Bool type instance IncludesInfo (Sing l) = Elem 'WithInfo l -newtype OuterMetaTypes l = OuterMetaTypes (Sing l) - -outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l -outerMetaTypes (Property metatypes _) = OuterMetaTypes metatypes - --- | Use `mkProperty''` to get the `OuterMetaTypes`. For example: --- --- > foo = Property Debian --- > foo = mkProperty' $ \t -> do --- > ensureProperty t (aptInstall "foo") --- --- The type checker will prevent using ensureProperty with a property --- that does not support the target OSes needed by the OuterMetaTypes. --- In the example above, aptInstall must support Debian. --- --- The type checker will also prevent using ensureProperty with a property --- with HasInfo in its MetaTypes. Doing so would cause the info associated --- with the property to be lost. -ensureProperty - :: - ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets - , CannotUseEnsurePropertyWithInfo inner ~ 'True - ) - => OuterMetaTypes outer - -> Property (Sing inner) - -> IO () -ensureProperty (OuterMetaTypes outermetatypes) (Property innermetatypes a) = a - -- The name of this was chosen to make type errors a more understandable. type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool type instance CannotUseEnsurePropertyWithInfo '[] = 'True type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts +{- + -- | Tightens the MetaType list of a Property, to contain fewer targets. -- -- Anything else in the MetaType list is passed through unchanged. @@ -178,6 +125,8 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io -- system being run on. io = undefined +-} + data CheckCombineTargets = CannotCombineTargets | CanCombineTargets -- | Detect intersection of two lists that don't have any common targets. -- cgit v1.2.3 From 84e3b7c5e2984055d090c5c27c0f1487573301fc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 17:31:06 -0400 Subject: prune --- src/Propellor/Types.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index d30a39f3..3ca7c8dc 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -1,13 +1,9 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE PolyKinds #-} module Propellor.Types -- cgit v1.2.3 From 63ed6dcd7b2e916f17514abe7860df9a135e1be9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 17:31:47 -0400 Subject: docs --- debian/changelog | 11 +++++++---- propellor.cabal | 2 +- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/debian/changelog b/debian/changelog index f1138eb2..323394f9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,7 +1,8 @@ propellor (3.0.0) UNRELEASED; urgency=medium * Property types have been improved to indicate what systems they target. - Transition guide: + This allows, eg, Property Debian to not be used on a FreeBSD system. + Transition guide for this sweeping API change: - Change "Property NoInfo" to "Property UnixLike" - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" - Change "RevertableProperty NoInfo" to @@ -17,12 +18,14 @@ propellor (3.0.0) UNRELEASED; urgency=medium "Property (HasInfo + Debian)" - It's also possible make a property support a set of OS's, for example: "Property (HasInfo + Debian + FreeBSD)" + - `ensureProperty` now needs information about the metatypes of the + property it's used in to be passed to it. See the documentation + of `ensureProperty` for an example, but basically, change + this: foo = property desc $ ... ensureProperty bar + to this: foo = property' desc $ \o -> ... ensureProperty o bar - The new `pickOS` property combinator can be used to combine different properties, supporting different OS's, into one Property that chooses what to do based on the Host's OS. - - `ensureProperty` now needs information about the metatypes of the - property it's used in to be passed to it. See the documentation - of `ensureProperty` for an example. -- Joey Hess Thu, 24 Mar 2016 15:02:33 -0400 diff --git a/propellor.cabal b/propellor.cabal index a13ebcb5..c8c68e48 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.17.0 +Version: 3.0.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess -- cgit v1.2.3 From b7655817371807ed44e89a3dd52a30846544832a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 20:12:00 -0400 Subject: fix bug in NonTargets impl --- src/Propellor/Types/MetaTypes.hs | 50 ++++++++-------------------------------- 1 file changed, 10 insertions(+), 40 deletions(-) diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 3d178641..60af33ef 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -5,6 +5,7 @@ module Propellor.Types.MetaTypes ( OS(..), UnixLike, Debian, + DebianLike, Buntish, FreeBSD, HasInfo, @@ -13,10 +14,14 @@ module Propellor.Types.MetaTypes ( sing, SingI, Union, + Intersect, + Concat, IncludesInfo, Targets, + NonTargets, NotSuperset, CheckCombineTargets(..), + CannotCombineTargets, type (&&), Not, EqT, @@ -35,6 +40,8 @@ data OS -- | Any unix-like system type UnixLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] type Debian = Sing '[ 'Targeting 'OSDebian ] +-- | Debian and derivatives. +type DebianLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ] type Buntish = Sing '[ 'Targeting 'OSBuntish ] type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] @@ -90,43 +97,6 @@ type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool type instance CannotUseEnsurePropertyWithInfo '[] = 'True type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts -{- - --- | Tightens the MetaType list of a Property, to contain fewer targets. --- --- Anything else in the MetaType list is passed through unchanged. -tightenTargets - :: - ( combined ~ Concat (NonTargets old) (Intersect (Targets old) (Targets new)) - , CannotCombineTargets old new combined ~ 'CanCombineTargets - , SingI combined - ) - => Sing new - -> Property (Sing old) - -> Property (Sing combined) -tightenTargets _ (Property old a) = Property sing a - --- | Picks one of the two input properties to use, --- depending on the targeted OS. --- --- If both input properties support the targeted OS, then the --- first will be used. -pickOS - :: - ( combined ~ Union a b - , SingI combined - ) - => Property (Sing a) - -> Property (Sing b) - -> Property (Sing combined) -pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io - where - -- TODO pick with of ioa or iob to use based on final OS of - -- system being run on. - io = undefined - --} - data CheckCombineTargets = CannotCombineTargets | CanCombineTargets -- | Detect intersection of two lists that don't have any common targets. @@ -138,7 +108,7 @@ type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets -- | Every item in the subset must be in the superset. -- --- The name of this was chosen to make type errors a more understandable. +-- The name of this was chosen to make type errors more understandable. type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets type instance NotSuperset superset '[] = 'CanCombineTargets type instance NotSuperset superset (s ': rest) = @@ -161,8 +131,8 @@ type family NonTargets (l :: [a]) :: [a] type instance NonTargets '[] = '[] type instance NonTargets (x ': xs) = If (IsTarget x) - (Targets xs) - (x ': Targets xs) + (NonTargets xs) + (x ': NonTargets xs) -- | Type level elem type family Elem (a :: t) (list :: [t]) :: Bool -- cgit v1.2.3 From 16ea40620ef2dbd62a2e8d5d8eb153e03d0c5848 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 20:20:26 -0400 Subject: ported most of PropAccum --- src/Propellor/PropAccum.hs | 17 +++++++++++------ src/Propellor/Types.hs | 7 +++++-- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 85a30af5..7c838c92 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -6,7 +6,7 @@ module Propellor.PropAccum , (&) , (&^) , (!) - , propagateContainer + --, propagateContainer ) where import Data.Monoid @@ -33,7 +33,7 @@ class PropAccum h where -- | Like addProp, but adds the property at the front of the list. addPropFront :: IsProp p => h -> p -> h - getProperties :: h -> [Property HasInfo] + getProperties :: h -> [ChildProperty] -- | Adds a property to a `Host` or other `PropAccum` -- @@ -46,7 +46,7 @@ class PropAccum h where (&^) = addPropFront -- | Adds a property in reverted form. -(!) :: IsProp (RevertableProperty i) => PropAccum h => h -> RevertableProperty i -> h +(!) :: IsProp (RevertableProperty undometatypes setupmetatypes) => PropAccum h => h -> RevertableProperty setupmetatypes undometatypes -> h h ! p = h & revert p infixl 1 & @@ -60,6 +60,8 @@ instance PropAccum Host where (getInfoRecursive p <> is) getProperties = hostProperties +{- + -- | Adjust the provided Property, adding to its -- propertyChidren the properties of the provided container. -- @@ -72,9 +74,10 @@ propagateContainer :: (PropAccum container) => String -> container - -> Property HasInfo - -> Property HasInfo -propagateContainer containername c prop = infoProperty + -> Property metatypes + -> Property metatypes +propagateContainer containername c prop = Property + undefined (propertyDesc prop) (propertySatisfy prop) (propertyInfo prop) @@ -86,3 +89,5 @@ propagateContainer containername c prop = infoProperty (propagatableInfo (propertyInfo p)) cs = map go (propertyChildren p) in infoProperty (propertyDesc p) (propertySatisfy p) i cs + +-} diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 3ca7c8dc..743787cc 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -16,6 +16,7 @@ module Propellor.Types , OS(..) , UnixLike , Debian + , DebianLike , Buntish , FreeBSD , HasInfo @@ -210,24 +211,25 @@ setup undo = RevertableProperty setup undo -- | Class of types that can be used as properties of a host. class IsProp p where setDesc :: p -> Desc -> p - -- toProp :: p -> Property HasInfo getDesc :: p -> Desc -- | Gets the info of the property, combined with all info -- of all children properties. getInfoRecursive :: p -> Info + toProp :: p -> ChildProperty instance IsProp (Property metatypes) where setDesc (Property t _ a i c) d = Property t d a i c - -- toProp = id getDesc = propertyDesc getInfoRecursive (Property _ _ _ i c) = i <> mconcat (map getInfoRecursive c) + toProp (Property _ d a i c) = ChildProperty d a i c instance IsProp ChildProperty where setDesc (ChildProperty _ a i c) d = ChildProperty d a i c getDesc (ChildProperty d _ _ _) = d getInfoRecursive (ChildProperty _ _ i c) = i <> mconcat (map getInfoRecursive c) + toProp = id instance IsProp (RevertableProperty setupmetatypes undometatypes) where -- | Sets the description of both sides. @@ -237,6 +239,7 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where -- toProp (RevertableProperty p1 _) = p1 -- | Return the Info of the currently active side. getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 + toProp (RevertableProperty p1 _p2) = toProp p1 -- | Type level calculation of the type that results from combining two -- types of properties. -- cgit v1.2.3 From e3a44ab5825466f9db9c4749497445bd0af1068e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 20:20:34 -0400 Subject: add tightenTargets, ported Network properties (DebinLike only) --- debian/changelog | 6 +++++ src/Propellor/Property.hs | 47 +++++++++++++++++++++++++++++++++++++++ src/Propellor/Property/Network.hs | 39 ++++++++++++++++++-------------- 3 files changed, 75 insertions(+), 17 deletions(-) diff --git a/debian/changelog b/debian/changelog index 323394f9..ead6585e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -23,6 +23,12 @@ propellor (3.0.0) UNRELEASED; urgency=medium of `ensureProperty` for an example, but basically, change this: foo = property desc $ ... ensureProperty bar to this: foo = property' desc $ \o -> ... ensureProperty o bar + - General purpose properties like cmdProperty have type "Property UnixLike". + When using that to run a command only available on Debian, you can + tighten the targets to only the OS that your more specific + property works on. For example: + upgraded :: Property Debian + upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"]) - The new `pickOS` property combinator can be used to combine different properties, supporting different OS's, into one Property that chooses what to do based on the Host's OS. diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 27d17135..cab233d0 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -1,5 +1,8 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} module Propellor.Property ( -- * Property combinators @@ -20,6 +23,7 @@ module Propellor.Property ( , property , property' , ensureProperty + , tightenTargets --, withOS , unsupportedOS , makeChange @@ -240,6 +244,49 @@ isNewerThan x y = do where mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f +-- | Tightens the MetaType list of a Property, to contain fewer targets. +-- +-- Anything else in the MetaType list is passed through unchanged. +-- +-- For example, to make a property that uses apt-get, which is only +-- available on DebianLike systems: +-- +-- > upgraded :: Property DebianLike +-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"] +tightenTargets + :: + -- Note that this uses PolyKinds + ( (Targets old `NotSuperset` Targets new) ~ CanCombineTargets + , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets + , SingI new + ) + => Property (Sing old) + -> Property (Sing new) +tightenTargets (Property old d a i c) = Property sing d a i c + +{- + +-- | Picks one of the two input properties to use, +-- depending on the targeted OS. +-- +-- If both input properties support the targeted OS, then the +-- first will be used. +pickOS + :: + ( combined ~ Union a b + , SingI combined + ) + => Property (Sing a) + -> Property (Sing b) + -> Property (Sing combined) +pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io + where + -- TODO pick with of ioa or iob to use based on final OS of + -- system being run on. + io = undefined + +-} + -- | Makes a property that is satisfied differently depending on the host's -- operating system. -- diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs index 382f5d9d..46f5cef3 100644 --- a/src/Propellor/Property/Network.hs +++ b/src/Propellor/Property/Network.hs @@ -2,13 +2,14 @@ module Propellor.Property.Network where import Propellor.Base import Propellor.Property.File +import Propellor.Types.MetaTypes import Data.Char type Interface = String -ifUp :: Interface -> Property NoInfo -ifUp iface = cmdProperty "ifup" [iface] +ifUp :: Interface -> Property DebianLike +ifUp iface = tightenTargets $ cmdProperty "ifup" [iface] `assume` MadeChange -- | Resets /etc/network/interfaces to a clean and empty state, @@ -18,8 +19,8 @@ ifUp iface = cmdProperty "ifup" [iface] -- This can be used as a starting point to defining other interfaces. -- -- No interfaces are brought up or down by this property. -cleanInterfacesFile :: Property NoInfo -cleanInterfacesFile = hasContent interfacesFile +cleanInterfacesFile :: Property DebianLike +cleanInterfacesFile = tightenTargets $ hasContent interfacesFile [ "# Deployed by propellor, do not edit." , "" , "source-directory interfaces.d" @@ -31,8 +32,8 @@ cleanInterfacesFile = hasContent interfacesFile `describe` ("clean " ++ interfacesFile) -- | Configures an interface to get its address via dhcp. -dhcp :: Interface -> Property NoInfo -dhcp iface = hasContent (interfaceDFile iface) +dhcp :: Interface -> Property DebianLike +dhcp iface = tightenTargets $ hasContent (interfaceDFile iface) [ "auto " ++ iface , "iface " ++ iface ++ " inet dhcp" ] @@ -50,18 +51,20 @@ dhcp iface = hasContent (interfaceDFile iface) -- -- (ipv6 addresses are not included because it's assumed they come up -- automatically in most situations.) -static :: Interface -> Property NoInfo -static iface = check (not <$> doesFileExist f) setup - `describe` desc - `requires` interfacesDEnabled +static :: Interface -> Property DebianLike +static iface = tightenTargets $ + check (not <$> doesFileExist f) setup + `describe` desc + `requires` interfacesDEnabled where f = interfaceDFile iface desc = "static " ++ iface - setup = property desc $ do + setup :: Property DebianLike + setup = property' desc $ \o -> do ls <- liftIO $ lines <$> readProcess "ip" ["-o", "addr", "show", iface, "scope", "global"] stanzas <- liftIO $ concat <$> mapM mkstanza ls - ensureProperty $ hasContent f $ ("auto " ++ iface) : stanzas + ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas mkstanza ipline = case words ipline of -- Note that the IP address is written CIDR style, so -- the netmask does not need to be specified separately. @@ -81,8 +84,8 @@ static iface = check (not <$> doesFileExist f) setup _ -> Nothing -- | 6to4 ipv6 connection, should work anywhere -ipv6to4 :: Property NoInfo -ipv6to4 = hasContent (interfaceDFile "sit0") +ipv6to4 :: Property DebianLike +ipv6to4 = tightenTargets $ hasContent (interfaceDFile "sit0") [ "# Deployed by propellor, do not edit." , "iface sit0 inet6 static" , "\taddress 2002:5044:5531::1" @@ -107,6 +110,8 @@ escapeInterfaceDName :: Interface -> FilePath escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-")) -- | Ensures that files in the the interfaces.d directory are used. -interfacesDEnabled :: Property NoInfo -interfacesDEnabled = containsLine interfacesFile "source-directory interfaces.d" - `describe` "interfaces.d directory enabled" +-- interfacesDEnabled :: Property DebianLike +interfacesDEnabled :: Property DebianLike +interfacesDEnabled = tightenTargets $ + containsLine interfacesFile "source-directory interfaces.d" + `describe` "interfaces.d directory enabled" -- cgit v1.2.3 From 027864bd1a18f2240f56cd3fb499c4d5d8caa45a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 20:41:46 -0400 Subject: ported --- src/Propellor/Property/Scheduled.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs index 64a530bc..534e1e88 100644 --- a/src/Propellor/Property/Scheduled.hs +++ b/src/Propellor/Property/Scheduled.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} module Propellor.Property.Scheduled ( period @@ -36,10 +36,10 @@ period prop recurrance = flip describe desc $ adjustPropertySatisfy prop $ \sati desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")" -- | Like period, but parse a human-friendly string. -periodParse :: Property NoInfo -> String -> Property NoInfo +periodParse :: (IsProp (Property i)) => Property i -> String -> Property i periodParse prop s = case toRecurrance s of Just recurrance -> period prop recurrance - Nothing -> property "periodParse" $ do + Nothing -> adjustPropertySatisfy prop $ \_ -> do liftIO $ warningMessage $ "failed periodParse: " ++ s noChange -- cgit v1.2.3 From 2a3530695c90f889df91f6a3a38a8989091f65a3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 22:01:30 -0400 Subject: fix combineWith to only accept properties that have common targets --- src/Propellor/Types.hs | 17 +++++++++-------- src/Propellor/Types/MetaTypes.hs | 17 ++++++++++++----- 2 files changed, 21 insertions(+), 13 deletions(-) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 743787cc..3cd5a368 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -5,6 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} module Propellor.Types ( Host(..) @@ -244,12 +245,12 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where -- | Type level calculation of the type that results from combining two -- types of properties. type family CombinedType x y -type instance CombinedType (Property (Sing x)) (Property (Sing y)) = Property (Sing (Union x y)) -type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) = RevertableProperty (Sing (Union x y)) (Sing (Union x' y')) +type instance CombinedType (Property (Sing x)) (Property (Sing y)) = Property (Sing (Combine x y)) +type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) = RevertableProperty (Sing (Combine x y)) (Sing (Combine x' y')) -- When only one of the properties is revertable, the combined property is -- not fully revertable, so is not a RevertableProperty. -type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) = Property (Sing (Union x y)) -type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) = Property (Sing (Union x y)) +type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) = Property (Sing (Combine x y)) +type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) = Property (Sing (Combine x y)) type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result @@ -267,15 +268,15 @@ class Combines x y where -> y -> CombinedType x y -instance (CombinedType (Property (Sing x)) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (Property (Sing y)) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (Sing x)) (Property (Sing y)) where combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) = Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) -instance (CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) ~ RevertableProperty (Sing (Union x y)) (Sing (Union x' y')), SingI (Union x y), SingI (Union x' y')) => Combines (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) where combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = RevertableProperty (combineWith sf tf s1 s2) (combineWith tf sf t1 t2) -instance (CombinedType (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) where combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y -instance (CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) ~ Property (Sing (Union x y)), SingI (Union x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) where combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 60af33ef..6edea291 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -13,14 +13,12 @@ module Propellor.Types.MetaTypes ( Sing, sing, SingI, - Union, - Intersect, - Concat, IncludesInfo, Targets, NonTargets, NotSuperset, CheckCombineTargets(..), + Combine, CannotCombineTargets, type (&&), Not, @@ -89,6 +87,15 @@ type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] type instance Concat '[] bs = bs type instance Concat (a ': as) bs = a ': (Concat as bs) +-- | Combine two MetaTypes lists, yielding a list +-- that has targets present in both, and nontargets present in either. +type family Combine (list1 :: [a]) (list2 :: [a]) :: [a] +type instance Combine (list1 :: [a]) (list2 :: [a]) = + (Concat + (NonTargets list1 `Union` NonTargets list2) + (Targets list1 `Intersect` Targets list2) + ) + type family IncludesInfo t :: Bool type instance IncludesInfo (Sing l) = Elem 'WithInfo l @@ -97,8 +104,6 @@ type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool type instance CannotUseEnsurePropertyWithInfo '[] = 'True type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts -data CheckCombineTargets = CannotCombineTargets | CanCombineTargets - -- | Detect intersection of two lists that don't have any common targets. -- -- The name of this was chosen to make type errors a more understandable. @@ -106,6 +111,8 @@ type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets +data CheckCombineTargets = CannotCombineTargets | CanCombineTargets + -- | Every item in the subset must be in the superset. -- -- The name of this was chosen to make type errors more understandable. -- cgit v1.2.3 From 639ac5cad21d60387007e66338864eff4d018786 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 22:04:46 -0400 Subject: converted Assuming DebianLike for all these properties until I hear otherwise. --- src/Propellor/Property/User.hs | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index c9c91a77..8cbd11e4 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -7,7 +7,7 @@ import qualified Propellor.Property.File as File data Eep = YesReallyDeleteHome -accountFor :: User -> Property NoInfo +accountFor :: User -> Property DebianLike accountFor user@(User u) = check nohomedir go `describe` ("account for " ++ u) where @@ -18,10 +18,10 @@ accountFor user@(User u) = check nohomedir go , u ] -systemAccountFor :: User -> Property NoInfo +systemAccountFor :: User -> Property DebianLike systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u)) -systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property NoInfo +systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike systemAccountFor' (User u) mhome mgroup = check nouser go `describe` ("system account for " ++ u) where @@ -43,7 +43,7 @@ systemAccountFor' (User u) mhome mgroup = check nouser go ] -- | Removes user home directory!! Use with caution. -nuked :: User -> Eep -> Property NoInfo +nuked :: User -> Eep -> Property DebianLike nuked user@(User u) _ = check hashomedir go `describe` ("nuked user " ++ u) where @@ -55,13 +55,13 @@ nuked user@(User u) _ = check hashomedir go -- | Only ensures that the user has some password set. It may or may -- not be a password from the PrivData. -hasSomePassword :: User -> Property HasInfo +hasSomePassword :: User -> Property (HasInfo + DebianLike) hasSomePassword user = hasSomePassword' user hostContext -- | While hasSomePassword uses the name of the host as context, -- this allows specifying a different context. This is useful when -- you want to use the same password on multiple hosts, for example. -hasSomePassword' :: IsContext c => User -> c -> Property HasInfo +hasSomePassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike) hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $ hasPassword' user context @@ -71,10 +71,10 @@ hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus us -- A user's password can be stored in the PrivData in either of two forms; -- the full cleartext or a hash. The latter -- is obviously more secure. -hasPassword :: User -> Property HasInfo +hasPassword :: User -> Property (HasInfo + DebianLike) hasPassword user = hasPassword' user hostContext -hasPassword' :: IsContext c => User -> c -> Property HasInfo +hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike) hasPassword' (User u) context = go `requires` shadowConfig True where go = withSomePrivData srcs context $ @@ -94,7 +94,7 @@ setPassword getpassword = getpassword $ go -- | Makes a user's password be the passed String. Highly insecure: -- The password is right there in your config file for anyone to see! -hasInsecurePassword :: User -> String -> Property NoInfo +hasInsecurePassword :: User -> String -> Property DebianLike hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $ chpasswd u p [] @@ -104,7 +104,7 @@ chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuc hPutStrLn h $ user ++ ":" ++ v hClose h -lockedPassword :: User -> Property NoInfo +lockedPassword :: User -> Property DebianLike lockedPassword user@(User u) = check (not <$> isLockedPassword user) go `describe` ("locked " ++ u ++ " password") where @@ -130,7 +130,7 @@ isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user homedir :: User -> IO FilePath homedir (User user) = homeDirectory <$> getUserEntryForName user -hasGroup :: User -> Group -> Property NoInfo +hasGroup :: User -> Group -> Property DebianLike hasGroup (User user) (Group group') = check test go `describe` unwords ["user", user, "in group", group'] where @@ -145,12 +145,12 @@ hasGroup (User user) (Group group') = check test go -- -- Note that some groups may only exit after installation of other -- software. When a group does not exist yet, the user won't be added to it. -hasDesktopGroups :: User -> Property NoInfo -hasDesktopGroups user@(User u) = property desc $ do +hasDesktopGroups :: User -> Property DebianLike +hasDesktopGroups user@(User u) = property' desc $ \o -> do existinggroups <- map (fst . break (== ':')) . lines <$> liftIO (readFile "/etc/group") let toadd = filter (`elem` existinggroups) desktopgroups - ensureProperty $ propertyList desc $ map (hasGroup user . Group) toadd + ensureProperty o $ propertyList desc $ map (hasGroup user . Group) toadd where desc = "user " ++ u ++ " is in standard desktop groups" -- This list comes from user-setup's debconf @@ -170,7 +170,7 @@ hasDesktopGroups user@(User u) = property desc $ do ] -- | Controls whether shadow passwords are enabled or not. -shadowConfig :: Bool -> Property NoInfo +shadowConfig :: Bool -> Property DebianLike shadowConfig True = check (not <$> shadowExists) (cmdProperty "shadowconfig" ["on"]) `describe` "shadow passwords enabled" @@ -183,10 +183,10 @@ shadowExists = doesFileExist "/etc/shadow" -- | Ensures that a user has a specified login shell, and that the shell -- is enabled in /etc/shells. -hasLoginShell :: User -> FilePath -> Property NoInfo +hasLoginShell :: User -> FilePath -> Property DebianLike hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell -shellSetTo :: User -> FilePath -> Property NoInfo +shellSetTo :: User -> FilePath -> Property DebianLike shellSetTo (User u) loginshell = check needchangeshell (cmdProperty "chsh" ["--shell", loginshell, u]) `describe` (u ++ " has login shell " ++ loginshell) @@ -196,5 +196,5 @@ shellSetTo (User u) loginshell = check needchangeshell return (currshell /= loginshell) -- | Ensures that /etc/shells contains a shell. -shellEnabled :: FilePath -> Property NoInfo +shellEnabled :: FilePath -> Property DebianLike shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell -- cgit v1.2.3 From 80ace2f30bea2ed850cf400a85fe68b3784751d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 01:11:24 -0400 Subject: improve type error --- src/Propellor/EnsureProperty.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index c72f7ecd..00495f87 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -34,7 +34,7 @@ import Propellor.Exception ensureProperty :: ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets - , CannotUseEnsurePropertyWithInfo inner ~ 'True + , CannotUse_ensureProperty_WithInfo inner ~ 'True ) => OuterMetaTypes outer -> Property (Sing inner) @@ -42,10 +42,10 @@ ensureProperty ensureProperty _ = catchPropellor . propertySatisfy -- The name of this was chosen to make type errors a more understandable. -type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool -type instance CannotUseEnsurePropertyWithInfo '[] = 'True -type instance CannotUseEnsurePropertyWithInfo (t ': ts) = - Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts +type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool +type instance CannotUse_ensureProperty_WithInfo '[] = 'True +type instance CannotUse_ensureProperty_WithInfo (t ': ts) = + Not (t `EqT` 'WithInfo) && CannotUse_ensureProperty_WithInfo ts -- | Constructs a property, like `property`, but provides its -- `OuterMetaTypes`. -- cgit v1.2.3 From 2506453874aa30968d8533a603d295ac248273c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 02:00:23 -0400 Subject: add type alias for Sing to be less confusing for users --- src/Propellor/EnsureProperty.hs | 8 ++++---- src/Propellor/Property.hs | 10 +++++----- src/Propellor/Types.hs | 26 +++++++++++++------------- src/Propellor/Types/MetaTypes.hs | 16 +++++++++------- 4 files changed, 31 insertions(+), 29 deletions(-) diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index 00495f87..f3e79ae5 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -37,7 +37,7 @@ ensureProperty , CannotUse_ensureProperty_WithInfo inner ~ 'True ) => OuterMetaTypes outer - -> Property (Sing inner) + -> Property (MetaTypes inner) -> Propellor Result ensureProperty _ = catchPropellor . propertySatisfy @@ -53,14 +53,14 @@ property' :: SingI metatypes => Desc -> (OuterMetaTypes metatypes -> Propellor Result) - -> Property (Sing metatypes) + -> Property (MetaTypes metatypes) property' d a = let p = Property sing d (a (outerMetaTypes p)) mempty mempty in p -- | Used to provide the metatypes of a Property to calls to -- 'ensureProperty` within it. -newtype OuterMetaTypes metatypes = OuterMetaTypes (Sing metatypes) +newtype OuterMetaTypes metatypes = OuterMetaTypes (MetaTypes metatypes) -outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l +outerMetaTypes :: Property (MetaTypes l) -> OuterMetaTypes l outerMetaTypes (Property metatypes _ _ _ _) = OuterMetaTypes metatypes diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index cab233d0..c665b6a0 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -260,8 +260,8 @@ tightenTargets , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets , SingI new ) - => Property (Sing old) - -> Property (Sing new) + => Property (MetaTypes old) + -> Property (MetaTypes new) tightenTargets (Property old d a i c) = Property sing d a i c {- @@ -276,9 +276,9 @@ pickOS ( combined ~ Union a b , SingI combined ) - => Property (Sing a) - -> Property (Sing b) - -> Property (Sing combined) + => Property (MetaTypes a) + -> Property (MetaTypes b) + -> Property (MetaTypes combined) pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io where -- TODO pick with of ioa or iob to use based on final OS of diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 3cd5a368..f23a18dd 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -41,7 +41,7 @@ module Propellor.Types , module Propellor.Types.Result , module Propellor.Types.ZFS , propertySatisfy - , Sing + , MetaTypes ) where import Data.Monoid @@ -142,17 +142,17 @@ property :: SingI metatypes => Desc -> Propellor Result - -> Property (Sing metatypes) + -> Property (MetaTypes metatypes) property d a = Property sing d a mempty mempty -- | Adds info to a Property. -- -- The new Property will include HasInfo in its metatypes. addInfoProperty - :: (Sing metatypes' ~ (+) HasInfo metatypes, SingI metatypes') + :: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes') => Property metatypes -> Info - -> Property (Sing metatypes') + -> Property (MetaTypes metatypes') addInfoProperty (Property metatypes d a oldi c) newi = Property sing d a (oldi <> newi) c @@ -163,7 +163,7 @@ addInfoProperty (Property metatypes d a oldi c) newi = ignoreInfo :: (metatypes' ~ => Property metatypes - -> Property (Sing metatypes') + -> Property (MetaTypes metatypes') ignoreInfo = -} @@ -245,12 +245,12 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where -- | Type level calculation of the type that results from combining two -- types of properties. type family CombinedType x y -type instance CombinedType (Property (Sing x)) (Property (Sing y)) = Property (Sing (Combine x y)) -type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) = RevertableProperty (Sing (Combine x y)) (Sing (Combine x' y')) +type instance CombinedType (Property (MetaTypes x)) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y)) +type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) = RevertableProperty (MetaTypes (Combine x y)) (MetaTypes (Combine x' y')) -- When only one of the properties is revertable, the combined property is -- not fully revertable, so is not a RevertableProperty. -type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) = Property (Sing (Combine x y)) -type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) = Property (Sing (Combine x y)) +type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y)) +type instance CombinedType (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) = Property (MetaTypes (Combine x y)) type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result @@ -268,15 +268,15 @@ class Combines x y where -> y -> CombinedType x y -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (Sing x)) (Property (Sing y)) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) = Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = RevertableProperty (combineWith sf tf s1 s2) (combineWith tf sf t1 t2) -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 6edea291..7dafe422 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -10,7 +10,7 @@ module Propellor.Types.MetaTypes ( FreeBSD, HasInfo, type (+), - Sing, + MetaTypes, sing, SingI, IncludesInfo, @@ -36,15 +36,17 @@ data OS deriving (Show, Eq) -- | Any unix-like system -type UnixLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] -type Debian = Sing '[ 'Targeting 'OSDebian ] +type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +type Debian = MetaTypes '[ 'Targeting 'OSDebian ] +type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ] +type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ] -- | Debian and derivatives. -type DebianLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ] -type Buntish = Sing '[ 'Targeting 'OSBuntish ] -type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] +type DebianLike = Debian + Buntish -- | Used to indicate that a Property adds Info to the Host where it's used. -type HasInfo = Sing '[ 'WithInfo ] +type HasInfo = MetaTypes '[ 'WithInfo ] + +type MetaTypes = Sing -- | The data family of singleton types. data family Sing (x :: k) -- cgit v1.2.3 From 5d2d64678f506d23bdfddb3f7cc452ac1d7c42eb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 02:05:26 -0400 Subject: fix warnings --- src/Propellor/PrivData.hs | 6 +++--- src/Propellor/Property.hs | 7 +++---- src/Propellor/Types.hs | 5 +++-- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index 6f3d4771..bc61c538 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -81,7 +81,7 @@ withPrivData :: ( IsContext c , IsPrivDataSource s - , IncludesInfo metatypes ~ True + , IncludesInfo metatypes ~ 'True ) => s -> c @@ -94,7 +94,7 @@ withSomePrivData :: ( IsContext c , IsPrivDataSource s - , IncludesInfo metatypes ~ True + , IncludesInfo metatypes ~ 'True ) => [s] -> c @@ -106,7 +106,7 @@ withPrivData' :: ( IsContext c , IsPrivDataSource s - , IncludesInfo metatypes ~ True + , IncludesInfo metatypes ~ 'True ) => ((PrivDataField, PrivData) -> v) -> [s] diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index c665b6a0..582b7cfb 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -56,7 +56,6 @@ import Propellor.Types import Propellor.Types.ResultCheck import Propellor.Types.MetaTypes import Propellor.Info -import Propellor.Exception import Propellor.EnsureProperty import Utility.Exception import Utility.Monad @@ -256,13 +255,13 @@ isNewerThan x y = do tightenTargets :: -- Note that this uses PolyKinds - ( (Targets old `NotSuperset` Targets new) ~ CanCombineTargets - , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets + ( (Targets old `NotSuperset` Targets new) ~ 'CanCombineTargets + , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombineTargets , SingI new ) => Property (MetaTypes old) -> Property (MetaTypes new) -tightenTargets (Property old d a i c) = Property sing d a i c +tightenTargets (Property _old d a i c) = Property sing d a i c {- diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index f23a18dd..23716e58 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -28,6 +28,7 @@ module Propellor.Types , propertyDesc , propertyChildren , RevertableProperty(..) + , () , ChildProperty , IsProp(..) , Combines(..) @@ -153,7 +154,7 @@ addInfoProperty => Property metatypes -> Info -> Property (MetaTypes metatypes') -addInfoProperty (Property metatypes d a oldi c) newi = +addInfoProperty (Property _ d a oldi c) newi = Property sing d a (oldi <> newi) c {- @@ -269,7 +270,7 @@ class Combines x y where -> CombinedType x y instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where - combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) = + combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) = Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = -- cgit v1.2.3 From de3a9a722847685b267ce396166de9245cd0d566 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 02:30:07 -0400 Subject: use MetaTypes more --- src/Propellor/Types/MetaTypes.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 7dafe422..4006914e 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -9,8 +9,8 @@ module Propellor.Types.MetaTypes ( Buntish, FreeBSD, HasInfo, - type (+), MetaTypes, + type (+), sing, SingI, IncludesInfo, @@ -73,7 +73,7 @@ data instance Sing (x :: [k]) where instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing instance SingI '[] where sing = Nil --- | Convenience type operator to combine two `Sing` lists. +-- | Convenience type operator to combine two `MetaTypes` lists. -- -- For example: -- @@ -81,9 +81,9 @@ instance SingI '[] where sing = Nil -- -- Which is shorthand for this type: -- --- > Sing '[WithInfo, Targeting OSDebian] +-- > MetaTypes '[WithInfo, Targeting OSDebian] type family a + b :: ab -type instance (Sing a) + (Sing b) = Sing (Concat a b) +type instance (MetaTypes a) + (MetaTypes b) = MetaTypes (Concat a b) type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] type instance Concat '[] bs = bs @@ -99,7 +99,7 @@ type instance Combine (list1 :: [a]) (list2 :: [a]) = ) type family IncludesInfo t :: Bool -type instance IncludesInfo (Sing l) = Elem 'WithInfo l +type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l -- The name of this was chosen to make type errors a more understandable. type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool -- cgit v1.2.3 From a7560c9677485dbecd7283aedf977c4653cfacb4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 13:10:33 -0400 Subject: fix CheckCombinable Was wrong when there was a non-target in the MetaTypes list. Also, rework to improve type checker errors. --- src/Propellor/EnsureProperty.hs | 2 +- src/Propellor/Types.hs | 8 +++---- src/Propellor/Types/MetaTypes.hs | 51 ++++++++++++++++++++++++---------------- 3 files changed, 36 insertions(+), 25 deletions(-) diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index f3e79ae5..f42003c0 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -33,7 +33,7 @@ import Propellor.Exception -- with the property to be lost. ensureProperty :: - ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets + ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine , CannotUse_ensureProperty_WithInfo inner ~ 'True ) => OuterMetaTypes outer diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 23716e58..42c12492 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -269,15 +269,15 @@ class Combines x y where -> y -> CombinedType x y -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where +instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) = Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where +instance (CheckCombinable x y ~ 'CanCombine, CheckCombinable x' y' ~ 'CanCombine, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = RevertableProperty (combineWith sf tf s1 s2) (combineWith tf sf t1 t2) -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where +instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where +instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 4006914e..80fa454e 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -17,9 +17,9 @@ module Propellor.Types.MetaTypes ( Targets, NonTargets, NotSuperset, - CheckCombineTargets(..), Combine, - CannotCombineTargets, + CheckCombine(..), + CheckCombinable, type (&&), Not, EqT, @@ -46,6 +46,9 @@ type DebianLike = Debian + Buntish -- | Used to indicate that a Property adds Info to the Host where it's used. type HasInfo = MetaTypes '[ 'WithInfo ] +type family IncludesInfo t :: Bool +type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l + type MetaTypes = Sing -- | The data family of singleton types. @@ -98,28 +101,36 @@ type instance Combine (list1 :: [a]) (list2 :: [a]) = (Targets list1 `Intersect` Targets list2) ) -type family IncludesInfo t :: Bool -type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l - --- The name of this was chosen to make type errors a more understandable. -type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool -type instance CannotUseEnsurePropertyWithInfo '[] = 'True -type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts - --- | Detect intersection of two lists that don't have any common targets. --- --- The name of this was chosen to make type errors a more understandable. -type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets -type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets -type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets - -data CheckCombineTargets = CannotCombineTargets | CanCombineTargets +-- | Checks if two MetaTypes lists can be safely combined. +-- +-- This should be used anywhere Combine is used, as an additional +-- constraint. For example: +-- +-- > foo :: (CheckCombinable x y ~ 'CanCombine) => x -> y -> Combine x y +type family CheckCombinable (list1 :: [a]) (list2 :: [a]) :: CheckCombine +-- As a special case, if either list is empty, let it be combined with the +-- other. This relies on MetaTypes list always containing at least +-- one target, so can only happen if there's already been a type error. +-- This special case lets the type checker show only the original type +-- error, and not an extra error due to a later CheckCombinable constraint. +type instance CheckCombinable '[] list2 = CanCombine +type instance CheckCombinable list1 '[] = CanCombine +type instance CheckCombinable (l1 ': list1) (l2 ': list2) = + CheckCombinable' (Combine (l1 ': list1) (l2 ': list2)) +type family CheckCombinable' (combinedlist :: [a]) :: CheckCombine +type instance CheckCombinable' '[] = 'CannotCombineTargets +type instance CheckCombinable' (a ': rest) + = If (IsTarget a) + 'CanCombine + (CheckCombinable' rest) + +data CheckCombine = CannotCombineTargets | CanCombine -- | Every item in the subset must be in the superset. -- -- The name of this was chosen to make type errors more understandable. -type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets -type instance NotSuperset superset '[] = 'CanCombineTargets +type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombine +type instance NotSuperset superset '[] = 'CanCombine type instance NotSuperset superset (s ': rest) = If (Elem s superset) (NotSuperset superset rest) -- cgit v1.2.3 From 48a05503493caeb80794a872b0e3b4482d5859ce Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 13:11:55 -0400 Subject: ported PropAccum Was not able to keep it a type class -- the type checker got too confused. (Or I did.) So, Host, Docker, and Chroot now need to be passed a Props, which is constructed using props. This is a small user-visible API change, but acceptable. --- src/Propellor/PropAccum.hs | 85 +++++++++++++++++++++++++++++----------------- 1 file changed, 54 insertions(+), 31 deletions(-) diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 7c838c92..fb38e260 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -1,8 +1,14 @@ -{-# LANGUAGE PackageImports, FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DataKinds #-} module Propellor.PropAccum ( host - , PropAccum(..) + , Props(..) + , props , (&) , (&^) , (!) @@ -12,53 +18,70 @@ module Propellor.PropAccum import Data.Monoid import Propellor.Types +import Propellor.Types.MetaTypes import Propellor.Property import Propellor.Types.Info import Propellor.PrivData --- | Starts accumulating the properties of a Host. +-- | Defines a host and its properties. -- --- > host "example.com" +-- > host "example.com" $ props -- > & someproperty -- > ! oldproperty -- > & otherproperty -host :: HostName -> Host -host hn = Host hn [] mempty +host :: HostName -> Props metatypes -> Host +host hn (Props i c) = Host hn c i --- | Something that can accumulate properties. -class PropAccum h where - -- | Adds a property. - addProp :: IsProp p => h -> p -> h +-- | Props is a combination of a list of properties, with their combined +-- metatypes and info. +data Props metatypes = Props Info [ChildProperty] - -- | Like addProp, but adds the property at the front of the list. - addPropFront :: IsProp p => h -> p -> h +-- | Start constructing a Props. Properties can then be added to it using +-- `(&)` etc. +props :: Props UnixLike +props = Props mempty [] - getProperties :: h -> [ChildProperty] +infixl 1 & +infixl 1 &^ +infixl 1 ! --- | Adds a property to a `Host` or other `PropAccum` +type family GetMetaTypes x +type instance GetMetaTypes (Property (MetaTypes t)) = MetaTypes t +type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t + +-- | Adds a property to a Props. -- -- Can add Properties and RevertableProperties -(&) :: (PropAccum h, IsProp p) => h -> p -> h -(&) = addProp +(&) + :: + ( IsProp p + , MetaTypes y ~ GetMetaTypes p + , CheckCombinable x y ~ 'CanCombine + ) + => Props (MetaTypes x) + -> p + -> Props (MetaTypes (Combine x y)) +Props i c & p = Props (i <> getInfoRecursive p) (c ++ [toProp p]) -- | Adds a property before any other properties. -(&^) :: (PropAccum h, IsProp p) => h -> p -> h -(&^) = addPropFront +(&^) + :: + ( IsProp p + , MetaTypes y ~ GetMetaTypes p + , CheckCombinable x y ~ 'CanCombine + ) + => Props (MetaTypes x) + -> p + -> Props (MetaTypes (Combine x y)) +Props i c &^ p = Props (i <> getInfoRecursive p) (toProp p : c) -- | Adds a property in reverted form. -(!) :: IsProp (RevertableProperty undometatypes setupmetatypes) => PropAccum h => h -> RevertableProperty setupmetatypes undometatypes -> h -h ! p = h & revert p - -infixl 1 & -infixl 1 &^ -infixl 1 ! - -instance PropAccum Host where - (Host hn ps is) `addProp` p = Host hn (ps ++ [toProp p]) - (is <> getInfoRecursive p) - (Host hn ps is) `addPropFront` p = Host hn (toProp p : ps) - (getInfoRecursive p <> is) - getProperties = hostProperties +(!) + :: (CheckCombinable x z ~ 'CanCombine) + => Props (MetaTypes x) + -> RevertableProperty (MetaTypes y) (MetaTypes z) + -> Props (MetaTypes (Combine x z)) +Props i c ! p = Props (i <> getInfoRecursive p) (c ++ [toProp (revert p)]) {- -- cgit v1.2.3 From 91d1833155a2e8be2c435d0a92a750cc9d2f30b5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 14:04:40 -0400 Subject: ported Property.List I wanted to keep propertyList [foo, bar] working, but had some difficulty making the type class approach work. Anyway, that's unlikely to be useful, since foo and bar probably have different types, or could easiy have their types updated breaking it. --- debian/changelog | 34 +++++++----- src/Propellor/Base.hs | 4 +- src/Propellor/Engine.hs | 16 ++++-- src/Propellor/EnsureProperty.hs | 2 +- src/Propellor/PrivData.hs | 2 +- src/Propellor/PropAccum.hs | 9 +-- src/Propellor/Property.hs | 4 +- src/Propellor/Property/Chroot.hs | 2 +- src/Propellor/Property/Concurrent.hs | 4 +- src/Propellor/Property/Docker.hs | 2 +- src/Propellor/Property/List.hs | 104 ++++++++++++----------------------- src/Propellor/Types.hs | 20 ++++--- 12 files changed, 93 insertions(+), 110 deletions(-) diff --git a/debian/changelog b/debian/changelog index ead6585e..b27559bd 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,37 +1,43 @@ propellor (3.0.0) UNRELEASED; urgency=medium * Property types have been improved to indicate what systems they target. - This allows, eg, Property Debian to not be used on a FreeBSD system. + This prevents using eg, Property FreeBSD on a Debian system. Transition guide for this sweeping API change: + - Change "host name & foo & bar" + to "host name $ props & foo & bar" + - Similarly, Chroot and Docker need `props` to be used to combine + together the properies used inside them. + - And similarly, `propertyList` and `combineProperties` need `props` + to be used to combine together properties; lists of properties will + no longer work. - Change "Property NoInfo" to "Property UnixLike" - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" - Change "RevertableProperty NoInfo" to "RevertableProperty UnixLike UnixLike" - Change "RevertableProperty HasInfo" to "RevertableProperty (HasInfo + UnixLike) UnixLike" - - GHC needs {-# LANGUAGE TypeOperators #-} to use these new type signatures. + - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types. This is enabled by default for all modules in propellor.cabal. But if you are using propellor as a library, you may need to enable it manually. - If you know a property only works on a particular OS, like Debian or FreeBSD, use that instead of "UnixLike". For example: - "Property (HasInfo + Debian)" + "Property Debian" - It's also possible make a property support a set of OS's, for example: - "Property (HasInfo + Debian + FreeBSD)" - - `ensureProperty` now needs information about the metatypes of the - property it's used in to be passed to it. See the documentation - of `ensureProperty` for an example, but basically, change - this: foo = property desc $ ... ensureProperty bar - to this: foo = property' desc $ \o -> ... ensureProperty o bar + "Property (Debian + FreeBSD)" + - `ensureProperty` now needs to be passed information about the + property it's used in. + change this: foo = property desc $ ... ensureProperty bar + to this: foo = property' desc $ \o -> ... ensureProperty o bar - General purpose properties like cmdProperty have type "Property UnixLike". When using that to run a command only available on Debian, you can - tighten the targets to only the OS that your more specific - property works on. For example: + tighten the type to only the OS that your more specific property works on. + For example: upgraded :: Property Debian upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"]) - - The new `pickOS` property combinator can be used to combine different - properties, supporting different OS's, into one Property that chooses - what to do based on the Host's OS. + * The new `pickOS` property combinator can be used to combine different + properties, supporting different OS's, into one Property that chooses + what to do based on the Host's OS. -- Joey Hess Thu, 24 Mar 2016 15:02:33 -0400 diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs index e50adf10..4afad2ab 100644 --- a/src/Propellor/Base.hs +++ b/src/Propellor/Base.hs @@ -9,7 +9,7 @@ module Propellor.Base ( , module Propellor.Property.Cmd --, module Propellor.Property.List , module Propellor.Types.PrivData - --, module Propellor.PropAccum + , module Propellor.PropAccum , module Propellor.Info , module Propellor.PrivData --, module Propellor.Engine @@ -43,7 +43,7 @@ import Propellor.Message import Propellor.Debug import Propellor.Exception import Propellor.Info ---import Propellor.PropAccum +import Propellor.PropAccum import Propellor.Location import Propellor.Utilities diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 2e914d67..62fad5af 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -2,10 +2,10 @@ {-# LANGUAGE GADTs #-} module Propellor.Engine ( - mainProperties, + -- mainProperties, runPropellor, ensureProperty, - ensureProperties, + ensureChildProperties, fromHost, fromHost', onlyProcess, @@ -29,6 +29,8 @@ import Propellor.Info import Propellor.Property import Utility.Exception +{- + -- | Gets the Properties of a Host, and ensures them all, -- with nice display of what's being done. mainProperties :: Host -> IO () @@ -42,6 +44,8 @@ mainProperties host = do where ps = map ignoreInfo $ hostProperties host +-} + -- | Runs a Propellor action with the specified host. -- -- If the Result is not FailedChange, any EndActions @@ -58,14 +62,14 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc (ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host () return ret --- | Ensures a list of Properties, with a display of each as it runs. -ensureProperties :: [Property NoInfo] -> Propellor Result -ensureProperties ps = ensure ps NoChange +-- | Ensures the child properties, with a display of each as it runs. +ensureChildProperties :: [ChildProperty] -> Propellor Result +ensureChildProperties ps = ensure ps NoChange where ensure [] rs = return rs ensure (p:ls) rs = do hn <- asks hostName - r <- actionMessageOn hn (propertyDesc p) (ensureProperty p) + r <- actionMessageOn hn (getDesc p) (catchPropellor $ getSatisfy p) ensure ls (r <> rs) -- | Lifts an action into the context of a different host. diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index f42003c0..21f8acce 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -39,7 +39,7 @@ ensureProperty => OuterMetaTypes outer -> Property (MetaTypes inner) -> Propellor Result -ensureProperty _ = catchPropellor . propertySatisfy +ensureProperty _ = catchPropellor . getSatisfy -- The name of this was chosen to make type errors a more understandable. type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index bc61c538..5e6e0869 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -129,7 +129,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a -> return FailedChange addinfo p = Property undefined -- FIXME: should use sing here (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) (propertyInfo p `addInfo` privset) (propertyChildren p) privset = PrivInfo $ S.fromList $ diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index fb38e260..8177b97b 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -36,8 +36,9 @@ host hn (Props i c) = Host hn c i -- metatypes and info. data Props metatypes = Props Info [ChildProperty] --- | Start constructing a Props. Properties can then be added to it using --- `(&)` etc. +-- | Start accumulating a list of properties. +-- +-- Properties can be added to it using `(&)` etc. props :: Props UnixLike props = Props mempty [] @@ -102,7 +103,7 @@ propagateContainer propagateContainer containername c prop = Property undefined (propertyDesc prop) - (propertySatisfy prop) + (getSatisfy prop) (propertyInfo prop) (propertyChildren prop ++ hostprops) where @@ -111,6 +112,6 @@ propagateContainer containername c prop = Property let i = mapInfo (forceHostContext containername) (propagatableInfo (propertyInfo p)) cs = map go (propertyChildren p) - in infoProperty (propertyDesc p) (propertySatisfy p) i cs + in infoProperty (propertyDesc p) (getSatisfy p) i cs -} diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 582b7cfb..8999d8d8 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -255,8 +255,8 @@ isNewerThan x y = do tightenTargets :: -- Note that this uses PolyKinds - ( (Targets old `NotSuperset` Targets new) ~ 'CanCombineTargets - , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombineTargets + ( (Targets old `NotSuperset` Targets new) ~ 'CanCombine + , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombine , SingI new ) => Property (MetaTypes old) diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 378836e8..fb05d659 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -148,7 +148,7 @@ propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p' where p' = infoProperty (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) (propertyInfo p <> chrootInfo c) (propertyChildren p) diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs index 74afecc4..8d608a54 100644 --- a/src/Propellor/Property/Concurrent.hs +++ b/src/Propellor/Property/Concurrent.hs @@ -97,7 +97,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps (p:rest) -> return (rest, Just p) case v of Nothing -> return r - -- This use of propertySatisfy does not lose any + -- This use of getSatisfy does not lose any -- Info asociated with the property, because -- concurrentList sets all the properties as -- children, and so propigates their info. @@ -105,7 +105,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps hn <- asks hostName r' <- actionMessageOn hn (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) worker q (r <> r') -- | Run an action with the number of capabiities increased as necessary to diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index ebc0b301..c2c131c7 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -178,7 +178,7 @@ propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p' where p' = infoProperty (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) (propertyInfo p <> dockerinfo) (propertyChildren p) dockerinfo = dockerInfo $ diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs index 74aa6ca6..b4a72fa8 100644 --- a/src/Propellor/Property/List.hs +++ b/src/Propellor/Property/List.hs @@ -1,86 +1,54 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module Propellor.Property.List ( props, - PropertyList(..), - PropertyListType, - PropList(..), + Props, + propertyList, + combineProperties, ) where import Propellor.Types +import Propellor.Types.MetaTypes import Propellor.Engine import Propellor.PropAccum +import Propellor.Exception import Data.Monoid --- | Starts accumulating a list of properties. +-- | Combines a list of properties, resulting in a single property +-- that when run will run each property in the list in turn, +-- and print out the description of each as it's run. Does not stop +-- on failure; does propagate overall success/failure. +-- +-- For example: -- -- > propertyList "foo" $ props --- > & someproperty --- > ! oldproperty --- > & otherproperty -props :: PropList -props = PropList [] - -data PropList = PropList [Property HasInfo] - -instance PropAccum PropList where - PropList l `addProp` p = PropList (toProp p : l) - PropList l `addPropFront` p = PropList (l ++ [toProp p]) - getProperties (PropList l) = reverse l - -class PropertyList l where - -- | Combines a list of properties, resulting in a single property - -- that when run will run each property in the list in turn, - -- and print out the description of each as it's run. Does not stop - -- on failure; does propagate overall success/failure. - -- - -- Note that Property HasInfo and Property NoInfo are not the same - -- type, and so cannot be mixed in a list. To make a list of - -- mixed types, which can also include RevertableProperty, - -- use `props` - propertyList :: Desc -> l -> Property (PropertyListType l) - - -- | Combines a list of properties, resulting in one property that - -- ensures each in turn. Stops if a property fails. - combineProperties :: Desc -> l -> Property (PropertyListType l) - --- | Type level function to calculate whether a PropertyList has Info. -type family PropertyListType t -type instance PropertyListType [Property HasInfo] = HasInfo -type instance PropertyListType [Property NoInfo] = NoInfo -type instance PropertyListType [RevertableProperty NoInfo] = NoInfo -type instance PropertyListType [RevertableProperty HasInfo] = HasInfo -type instance PropertyListType PropList = HasInfo - -instance PropertyList [Property NoInfo] where - propertyList desc ps = simpleProperty desc (ensureProperties ps) ps - combineProperties desc ps = simpleProperty desc (combineSatisfy ps NoChange) ps - -instance PropertyList [Property HasInfo] where - -- It's ok to use ignoreInfo here, because the ps are made the - -- child properties of the property, and so their info is visible - -- that way. - propertyList desc ps = infoProperty desc (ensureProperties $ map ignoreInfo ps) mempty ps - combineProperties desc ps = infoProperty desc (combineSatisfy ps NoChange) mempty ps - -instance PropertyList [RevertableProperty HasInfo] where - propertyList desc ps = propertyList desc (map setupRevertableProperty ps) - combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps) - -instance PropertyList [RevertableProperty NoInfo] where - propertyList desc ps = propertyList desc (map setupRevertableProperty ps) - combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps) - -instance PropertyList PropList where - propertyList desc = propertyList desc . getProperties - combineProperties desc = combineProperties desc . getProperties - -combineSatisfy :: [Property i] -> Result -> Propellor Result +-- > & bar +-- > & baz +propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) +propertyList desc (Props _i ps) = + property desc (ensureChildProperties cs) + `modifyChildren` (++ cs) + where + cs = map toProp ps + +-- | Combines a list of properties, resulting in one property that +-- ensures each in turn. Stops if a property fails. +combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) +combineProperties desc (Props _i ps) = + property desc (combineSatisfy cs NoChange) + `modifyChildren` (++ cs) + where + cs = map toProp ps + +combineSatisfy :: [ChildProperty] -> Result -> Propellor Result combineSatisfy [] rs = return rs -combineSatisfy (l:ls) rs = do - r <- ensureProperty $ ignoreInfo l +combineSatisfy (p:ps) rs = do + r <- catchPropellor $ getSatisfy p case r of FailedChange -> return FailedChange - _ -> combineSatisfy ls (r <> rs) + _ -> combineSatisfy ps (r <> rs) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 42c12492..db05e100 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -14,6 +14,7 @@ module Propellor.Types , Info , Desc , MetaType(..) + , MetaTypes , OS(..) , UnixLike , Debian @@ -41,8 +42,6 @@ module Propellor.Types , module Propellor.Types.Dns , module Propellor.Types.Result , module Propellor.Types.ZFS - , propertySatisfy - , MetaTypes ) where import Data.Monoid @@ -169,12 +168,6 @@ ignoreInfo = -} --- | Gets the action that can be run to satisfy a Property. --- You should never run this action directly. Use --- 'Propellor.EnsureProperty.ensureProperty` instead. -propertySatisfy :: Property metatypes -> Propellor Result -propertySatisfy (Property _ _ a _ _) = a - -- | Changes the action that is performed to satisfy a property. adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c @@ -214,34 +207,45 @@ setup undo = RevertableProperty setup undo class IsProp p where setDesc :: p -> Desc -> p getDesc :: p -> Desc + modifyChildren :: p -> ([ChildProperty] -> [ChildProperty]) -> p -- | Gets the info of the property, combined with all info -- of all children properties. getInfoRecursive :: p -> Info toProp :: p -> ChildProperty + -- | Gets the action that can be run to satisfy a Property. + -- You should never run this action directly. Use + -- 'Propellor.EnsureProperty.ensureProperty` instead. + getSatisfy :: p -> Propellor Result instance IsProp (Property metatypes) where setDesc (Property t _ a i c) d = Property t d a i c getDesc = propertyDesc + modifyChildren (Property t d a i c) f = Property t d a i (f c) getInfoRecursive (Property _ _ _ i c) = i <> mconcat (map getInfoRecursive c) toProp (Property _ d a i c) = ChildProperty d a i c + getSatisfy (Property _ _ a _ _) = a instance IsProp ChildProperty where setDesc (ChildProperty _ a i c) d = ChildProperty d a i c getDesc (ChildProperty d _ _ _) = d + modifyChildren (ChildProperty d a i c) f = ChildProperty d a i (f c) getInfoRecursive (ChildProperty _ _ i c) = i <> mconcat (map getInfoRecursive c) toProp = id + getSatisfy (ChildProperty _ a _ _) = a instance IsProp (RevertableProperty setupmetatypes undometatypes) where -- | Sets the description of both sides. setDesc (RevertableProperty p1 p2) d = RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) getDesc (RevertableProperty p1 _) = getDesc p1 + modifyChildren (RevertableProperty p1 p2) f = RevertableProperty (modifyChildren p1 f) (modifyChildren p2 f) -- toProp (RevertableProperty p1 _) = p1 -- | Return the Info of the currently active side. getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 toProp (RevertableProperty p1 _p2) = toProp p1 + getSatisfy (RevertableProperty p1 _) = getSatisfy p1 -- | Type level calculation of the type that results from combining two -- types of properties. -- cgit v1.2.3 From 9768434f5fa2f2ed0bbb0212763a76471186a3cd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 14:24:09 -0400 Subject: finished porting Property.User --- src/Propellor/Base.hs | 8 ++++---- src/Propellor/PropAccum.hs | 14 +++++++------- src/Propellor/Property.hs | 10 +++++----- src/Propellor/Property/List.hs | 10 +++++++--- src/Propellor/Property/User.hs | 29 +++++++++++++++++------------ 5 files changed, 40 insertions(+), 31 deletions(-) diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs index 4afad2ab..2a0f5cbc 100644 --- a/src/Propellor/Base.hs +++ b/src/Propellor/Base.hs @@ -7,12 +7,12 @@ module Propellor.Base ( module Propellor.Types , module Propellor.Property , module Propellor.Property.Cmd - --, module Propellor.Property.List + , module Propellor.Property.List , module Propellor.Types.PrivData , module Propellor.PropAccum , module Propellor.Info , module Propellor.PrivData - --, module Propellor.Engine + , module Propellor.Engine , module Propellor.Exception , module Propellor.Message , module Propellor.Debug @@ -34,8 +34,8 @@ module Propellor.Base ( import Propellor.Types import Propellor.Property ---import Propellor.Engine ---import Propellor.Property.List +import Propellor.Engine +import Propellor.Property.List import Propellor.Property.Cmd import Propellor.PrivData import Propellor.Types.PrivData diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 8177b97b..91d7b80d 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -30,17 +30,17 @@ import Propellor.PrivData -- > ! oldproperty -- > & otherproperty host :: HostName -> Props metatypes -> Host -host hn (Props i c) = Host hn c i +host hn (Props c) = Host hn c (mconcat (map getInfoRecursive c)) -- | Props is a combination of a list of properties, with their combined --- metatypes and info. -data Props metatypes = Props Info [ChildProperty] +-- metatypes. +data Props metatypes = Props [ChildProperty] -- | Start accumulating a list of properties. -- -- Properties can be added to it using `(&)` etc. props :: Props UnixLike -props = Props mempty [] +props = Props [] infixl 1 & infixl 1 &^ @@ -62,7 +62,7 @@ type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) -Props i c & p = Props (i <> getInfoRecursive p) (c ++ [toProp p]) +Props c & p = Props (c ++ [toProp p]) -- | Adds a property before any other properties. (&^) @@ -74,7 +74,7 @@ Props i c & p = Props (i <> getInfoRecursive p) (c ++ [toProp p]) => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) -Props i c &^ p = Props (i <> getInfoRecursive p) (toProp p : c) +Props c &^ p = Props (toProp p : c) -- | Adds a property in reverted form. (!) @@ -82,7 +82,7 @@ Props i c &^ p = Props (i <> getInfoRecursive p) (toProp p : c) => Props (MetaTypes x) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z)) -Props i c ! p = Props (i <> getInfoRecursive p) (c ++ [toProp (revert p)]) +Props c ! p = Props (c ++ [toProp (revert p)]) {- diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 8999d8d8..ba30209e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -255,12 +255,12 @@ isNewerThan x y = do tightenTargets :: -- Note that this uses PolyKinds - ( (Targets old `NotSuperset` Targets new) ~ 'CanCombine - , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombine - , SingI new + ( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine + , (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine + , SingI tightened ) - => Property (MetaTypes old) - -> Property (MetaTypes new) + => Property (MetaTypes untightened) + -> Property (MetaTypes tightened) tightenTargets (Property _old d a i c) = Property sing d a i c {- diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs index b4a72fa8..44916f23 100644 --- a/src/Propellor/Property/List.hs +++ b/src/Propellor/Property/List.hs @@ -7,18 +7,22 @@ module Propellor.Property.List ( props, Props, + toProps, propertyList, combineProperties, ) where import Propellor.Types import Propellor.Types.MetaTypes -import Propellor.Engine import Propellor.PropAccum +import Propellor.Engine import Propellor.Exception import Data.Monoid +toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes) +toProps ps = Props (map toProp ps) + -- | Combines a list of properties, resulting in a single property -- that when run will run each property in the list in turn, -- and print out the description of each as it's run. Does not stop @@ -30,7 +34,7 @@ import Data.Monoid -- > & bar -- > & baz propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) -propertyList desc (Props _i ps) = +propertyList desc (Props ps) = property desc (ensureChildProperties cs) `modifyChildren` (++ cs) where @@ -39,7 +43,7 @@ propertyList desc (Props _i ps) = -- | Combines a list of properties, resulting in one property that -- ensures each in turn. Stops if a property fails. combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) -combineProperties desc (Props _i ps) = +combineProperties desc (Props ps) = property desc (combineSatisfy cs NoChange) `modifyChildren` (++ cs) where diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index 8cbd11e4..76eae647 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -8,7 +8,7 @@ import qualified Propellor.Property.File as File data Eep = YesReallyDeleteHome accountFor :: User -> Property DebianLike -accountFor user@(User u) = check nohomedir go +accountFor user@(User u) = tightenTargets $ check nohomedir go `describe` ("account for " ++ u) where nohomedir = isNothing <$> catchMaybeIO (homedir user) @@ -22,7 +22,7 @@ systemAccountFor :: User -> Property DebianLike systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u)) systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike -systemAccountFor' (User u) mhome mgroup = check nouser go +systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go `describe` ("system account for " ++ u) where nouser = isNothing <$> catchMaybeIO (getUserEntryForName u) @@ -44,7 +44,7 @@ systemAccountFor' (User u) mhome mgroup = check nouser go -- | Removes user home directory!! Use with caution. nuked :: User -> Eep -> Property DebianLike -nuked user@(User u) _ = check hashomedir go +nuked user@(User u) _ = tightenTargets $ check hashomedir go `describe` ("nuked user " ++ u) where hashomedir = isJust <$> catchMaybeIO (homedir user) @@ -75,8 +75,10 @@ hasPassword :: User -> Property (HasInfo + DebianLike) hasPassword user = hasPassword' user hostContext hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike) -hasPassword' (User u) context = go `requires` shadowConfig True +hasPassword' (User u) context = go + `requires` shadowConfig True where + go :: Property (HasInfo + UnixLike) go = withSomePrivData srcs context $ property (u ++ " has password") . setPassword srcs = @@ -105,8 +107,9 @@ chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuc hClose h lockedPassword :: User -> Property DebianLike -lockedPassword user@(User u) = check (not <$> isLockedPassword user) go - `describe` ("locked " ++ u ++ " password") +lockedPassword user@(User u) = tightenTargets $ + check (not <$> isLockedPassword user) go + `describe` ("locked " ++ u ++ " password") where go = cmdProperty "passwd" [ "--lock" @@ -131,7 +134,7 @@ homedir :: User -> IO FilePath homedir (User user) = homeDirectory <$> getUserEntryForName user hasGroup :: User -> Group -> Property DebianLike -hasGroup (User user) (Group group') = check test go +hasGroup (User user) (Group group') = tightenTargets $ check test go `describe` unwords ["user", user, "in group", group'] where test = not . elem group' . words <$> readProcess "groups" [user] @@ -150,7 +153,8 @@ hasDesktopGroups user@(User u) = property' desc $ \o -> do existinggroups <- map (fst . break (== ':')) . lines <$> liftIO (readFile "/etc/group") let toadd = filter (`elem` existinggroups) desktopgroups - ensureProperty o $ propertyList desc $ map (hasGroup user . Group) toadd + ensureProperty o $ propertyList desc $ toProps $ + map (hasGroup user . Group) toadd where desc = "user " ++ u ++ " is in standard desktop groups" -- This list comes from user-setup's debconf @@ -171,10 +175,10 @@ hasDesktopGroups user@(User u) = property' desc $ \o -> do -- | Controls whether shadow passwords are enabled or not. shadowConfig :: Bool -> Property DebianLike -shadowConfig True = check (not <$> shadowExists) +shadowConfig True = tightenTargets $ check (not <$> shadowExists) (cmdProperty "shadowconfig" ["on"]) `describe` "shadow passwords enabled" -shadowConfig False = check shadowExists +shadowConfig False = tightenTargets $ check shadowExists (cmdProperty "shadowconfig" ["off"]) `describe` "shadow passwords disabled" @@ -187,7 +191,7 @@ hasLoginShell :: User -> FilePath -> Property DebianLike hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell shellSetTo :: User -> FilePath -> Property DebianLike -shellSetTo (User u) loginshell = check needchangeshell +shellSetTo (User u) loginshell = tightenTargets $ check needchangeshell (cmdProperty "chsh" ["--shell", loginshell, u]) `describe` (u ++ " has login shell " ++ loginshell) where @@ -197,4 +201,5 @@ shellSetTo (User u) loginshell = check needchangeshell -- | Ensures that /etc/shells contains a shell. shellEnabled :: FilePath -> Property DebianLike -shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell +shellEnabled loginshell = tightenTargets $ + "/etc/shells" `File.containsLine` loginshell -- cgit v1.2.3 From 1edce2b72614e2e8eceefde97436db024799ff20 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 15:28:31 -0400 Subject: ported Property.Apt --- config-simple.hs | 4 +- src/Propellor/EnsureProperty.hs | 14 ++--- src/Propellor/Property.hs | 54 ++++++++---------- src/Propellor/Property/Apt.hs | 113 +++++++++++++++++++------------------ src/Propellor/Property/Service.hs | 10 ++-- src/Propellor/Types.hs | 23 ++++++++ src/Propellor/Types/ResultCheck.hs | 3 + 7 files changed, 121 insertions(+), 100 deletions(-) diff --git a/config-simple.hs b/config-simple.hs index 21accd18..28b38409 100644 --- a/config-simple.hs +++ b/config-simple.hs @@ -25,7 +25,7 @@ hosts = -- An example host. mybox :: Host -mybox = host "mybox.example.com" +mybox = host "mybox.example.com" $ props & os (System (Debian Unstable) "amd64") & Apt.stdSourcesList & Apt.unattendedUpgrades @@ -40,7 +40,7 @@ mybox = host "mybox.example.com" -- A generic webserver in a Docker container. webserverContainer :: Docker.Container -webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") +webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props & os (System (Debian (Stable "jessie")) "amd64") & Apt.stdSourcesList & Docker.publish "80:80" diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index 21f8acce..c4b5fde1 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -7,7 +7,7 @@ module Propellor.EnsureProperty ( ensureProperty , property' - , OuterMetaTypes + , OuterMetaTypes(..) ) where import Propellor.Types @@ -33,8 +33,8 @@ import Propellor.Exception -- with the property to be lost. ensureProperty :: - ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine - , CannotUse_ensureProperty_WithInfo inner ~ 'True + ( Cannot_ensureProperty_WithInfo inner ~ 'True + , (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine ) => OuterMetaTypes outer -> Property (MetaTypes inner) @@ -42,10 +42,10 @@ ensureProperty ensureProperty _ = catchPropellor . getSatisfy -- The name of this was chosen to make type errors a more understandable. -type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool -type instance CannotUse_ensureProperty_WithInfo '[] = 'True -type instance CannotUse_ensureProperty_WithInfo (t ': ts) = - Not (t `EqT` 'WithInfo) && CannotUse_ensureProperty_WithInfo ts +type family Cannot_ensureProperty_WithInfo (l :: [a]) :: Bool +type instance Cannot_ensureProperty_WithInfo '[] = 'True +type instance Cannot_ensureProperty_WithInfo (t ': ts) = + Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts -- | Constructs a property, like `property`, but provides its -- `OuterMetaTypes`. diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index ba30209e..2ddec439 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -22,9 +22,9 @@ module Propellor.Property ( , Propellor , property , property' + , OuterMetaTypes , ensureProperty - , tightenTargets - --, withOS + , withOS , unsupportedOS , makeChange , noChange @@ -243,26 +243,6 @@ isNewerThan x y = do where mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f --- | Tightens the MetaType list of a Property, to contain fewer targets. --- --- Anything else in the MetaType list is passed through unchanged. --- --- For example, to make a property that uses apt-get, which is only --- available on DebianLike systems: --- --- > upgraded :: Property DebianLike --- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"] -tightenTargets - :: - -- Note that this uses PolyKinds - ( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine - , (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine - , SingI tightened - ) - => Property (MetaTypes untightened) - -> Property (MetaTypes tightened) -tightenTargets (Property _old d a i c) = Property sing d a i c - {- -- | Picks one of the two input properties to use, @@ -286,17 +266,29 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io -} --- | Makes a property that is satisfied differently depending on the host's --- operating system. +-- | Makes a property that is satisfied differently depending on specifics +-- of the host's operating system. -- --- Note that the operating system may not be declared for all hosts. +-- > myproperty :: Property Debian +-- > myproperty = withOS "foo installed" $ \o os -> case os of +-- > (Just (System (Debian (Stable release)) arch)) -> ensureProperty o ... +-- > (Just (System (Debian suite) arch)) -> ensureProperty o ... +-- > _ -> unsupportedOS -- --- > myproperty = withOS "foo installed" $ \o -> case o of --- > (Just (System (Debian suite) arch)) -> ... --- > (Just (System (Buntish release) arch)) -> ... --- > Nothing -> unsupportedOS ---withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo ---withOS desc a = property desc $ a =<< getOS +-- Note that the operating system specifics may not be declared for all hosts, +-- which is where Nothing comes in. +withOS + :: (SingI metatypes) + => Desc + -> (OuterMetaTypes '[] -> Maybe System -> Propellor Result) + -> Property (MetaTypes metatypes) +withOS desc a = property desc $ a dummyoutermetatypes =<< getOS + where + -- Using this dummy value allows ensureProperty to be used + -- even though the inner property probably doesn't target everything + -- that the outer withOS property targets. + dummyoutermetatypes :: OuterMetaTypes ('[]) + dummyoutermetatypes = OuterMetaTypes sing -- | Throws an error, for use in `withOS` when a property is lacking -- support for an OS. diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 7301a6ae..3dd7277e 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -80,37 +80,36 @@ securityUpdates suite -- -- Since the CDN is sometimes unreliable, also adds backup lines using -- kernel.org. -stdSourcesList :: Property NoInfo -stdSourcesList = withOS "standard sources.list" $ \o -> - case o of - (Just (System (Debian suite) _)) -> - ensureProperty $ stdSourcesListFor suite - _ -> error "os is not declared to be Debian" - -stdSourcesListFor :: DebianSuite -> Property NoInfo +stdSourcesList :: Property Debian +stdSourcesList = withOS "standard sources.list" $ \o os -> case os of + (Just (System (Debian suite) _)) -> + ensureProperty o $ stdSourcesListFor suite + _ -> unsupportedOS + +stdSourcesListFor :: DebianSuite -> Property Debian stdSourcesListFor suite = stdSourcesList' suite [] -- | Adds additional sources.list generators. -- -- Note that if a Property needs to enable an apt source, it's better -- to do so via a separate file in -stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property NoInfo -stdSourcesList' suite more = setSourcesList +stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian +stdSourcesList' suite more = tightenTargets $ setSourcesList (concatMap (\gen -> gen suite) generators) `describe` ("standard sources.list for " ++ show suite) where generators = [debCdn, kernelOrg, securityUpdates] ++ more -setSourcesList :: [Line] -> Property NoInfo +setSourcesList :: [Line] -> Property DebianLike setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update -setSourcesListD :: [Line] -> FilePath -> Property NoInfo +setSourcesListD :: [Line] -> FilePath -> Property DebianLike setSourcesListD ls basename = f `File.hasContent` ls `onChange` update where f = "/etc/apt/sources.list.d/" ++ basename ++ ".list" -runApt :: [String] -> UncheckedProperty NoInfo -runApt ps = cmdPropertyEnv "apt-get" ps noninteractiveEnv +runApt :: [String] -> UncheckedProperty DebianLike +runApt ps = tightenTargets $ cmdPropertyEnv "apt-get" ps noninteractiveEnv noninteractiveEnv :: [(String, String)] noninteractiveEnv = @@ -118,51 +117,51 @@ noninteractiveEnv = , ("APT_LISTCHANGES_FRONTEND", "none") ] -update :: Property NoInfo +update :: Property DebianLike update = runApt ["update"] `assume` MadeChange `describe` "apt update" -- | Have apt upgrade packages, adding new packages and removing old as -- necessary. -upgrade :: Property NoInfo +upgrade :: Property DebianLike upgrade = upgrade' "dist-upgrade" -upgrade' :: String -> Property NoInfo -upgrade' p = combineProperties ("apt " ++ p) - [ pendingConfigured - , runApt ["-y", p] +upgrade' :: String -> Property DebianLike +upgrade' p = combineProperties ("apt " ++ p) $ props + & pendingConfigured + & runApt ["-y", p] `assume` MadeChange - ] -- | Have apt upgrade packages, but never add new packages or remove -- old packages. Not suitable for upgrading acrocess major versions -- of the distribution. -safeUpgrade :: Property NoInfo +safeUpgrade :: Property DebianLike safeUpgrade = upgrade' "upgrade" -- | Have dpkg try to configure any packages that are not fully configured. -pendingConfigured :: Property NoInfo -pendingConfigured = cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv - `assume` MadeChange - `describe` "dpkg configured pending" +pendingConfigured :: Property DebianLike +pendingConfigured = tightenTargets $ + cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv + `assume` MadeChange + `describe` "dpkg configured pending" type Package = String -installed :: [Package] -> Property NoInfo +installed :: [Package] -> Property DebianLike installed = installed' ["-y"] -installed' :: [String] -> [Package] -> Property NoInfo +installed' :: [String] -> [Package] -> Property DebianLike installed' params ps = robustly $ check (isInstallable ps) go `describe` unwords ("apt installed":ps) where go = runApt (params ++ ["install"] ++ ps) -installedBackport :: [Package] -> Property NoInfo -installedBackport ps = withOS desc $ \o -> case o of +installedBackport :: [Package] -> Property DebianLike +installedBackport ps = withOS desc $ \o os -> case os of (Just (System (Debian suite) _)) -> case backportSuite suite of Nothing -> unsupportedOS - Just bs -> ensureProperty $ + Just bs -> ensureProperty o $ runApt (["install", "-t", bs, "-y"] ++ ps) `changesFile` dpkgStatus _ -> unsupportedOS @@ -170,14 +169,14 @@ installedBackport ps = withOS desc $ \o -> case o of desc = unwords ("apt installed backport":ps) -- | Minimal install of package, without recommends. -installedMin :: [Package] -> Property NoInfo +installedMin :: [Package] -> Property DebianLike installedMin = installed' ["--no-install-recommends", "-y"] -removed :: [Package] -> Property NoInfo +removed :: [Package] -> Property DebianLike removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps)) `describe` unwords ("apt removed":ps) -buildDep :: [Package] -> Property NoInfo +buildDep :: [Package] -> Property DebianLike buildDep ps = robustly $ go `changesFile` dpkgStatus `describe` unwords ("apt build-dep":ps) @@ -187,7 +186,7 @@ buildDep ps = robustly $ go -- | Installs the build deps for the source package unpacked -- in the specifed directory, with a dummy package also -- installed so that autoRemove won't remove them. -buildDepIn :: FilePath -> Property NoInfo +buildDepIn :: FilePath -> Property DebianLike buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv `changesFile` dpkgStatus `requires` installedMin ["devscripts", "equivs"] @@ -196,13 +195,13 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv -- | Package installation may fail becuse the archive has changed. -- Run an update in that case and retry. -robustly :: (Combines (Property i) (Property NoInfo)) => Property i -> Property i +robustly :: Property DebianLike -> Property DebianLike robustly p = adjustPropertySatisfy p $ \satisfy -> do r <- satisfy if r == FailedChange - -- Safe to use ignoreInfo because we're re-running - -- the same property. - then ensureProperty $ ignoreInfo $ p `requires` update + -- Safe to use getSatisfy because we're re-running + -- the same property as before. + then getSatisfy $ p `requires` update else return r isInstallable :: [Package] -> IO Bool @@ -228,13 +227,13 @@ isInstalled' ps = (mapMaybe parse . lines) <$> policy environ <- addEntry "LANG" "C" <$> getEnvironment readProcessEnv "apt-cache" ("policy":ps) (Just environ) -autoRemove :: Property NoInfo +autoRemove :: Property DebianLike autoRemove = runApt ["-y", "autoremove"] `changesFile` dpkgStatus `describe` "apt autoremove" -- | Enables unattended upgrades. Revert to disable. -unattendedUpgrades :: RevertableProperty NoInfo +unattendedUpgrades :: RevertableProperty DebianLike DebianLike unattendedUpgrades = enable disable where enable = setup True @@ -253,11 +252,12 @@ unattendedUpgrades = enable disable | enabled = "true" | otherwise = "false" - configure = withOS "unattended upgrades configured" $ \o -> - case o of + configure :: Property DebianLike + configure = withOS "unattended upgrades configured" $ \o os -> + case os of -- the package defaults to only upgrading stable (Just (System (Debian suite) _)) - | not (isStable suite) -> ensureProperty $ + | not (isStable suite) -> ensureProperty o $ "/etc/apt/apt.conf.d/50unattended-upgrades" `File.containsLine` ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };") @@ -269,10 +269,13 @@ type DebconfTemplateValue = String -- | Preseeds debconf values and reconfigures the package so it takes -- effect. -reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property NoInfo -reConfigure package vals = reconfigure `requires` setselections - `describe` ("reconfigure " ++ package) +reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike +reConfigure package vals = tightenTargets $ + reconfigure + `requires` setselections + `describe` ("reconfigure " ++ package) where + setselections :: Property DebianLike setselections = property "preseed" $ if null vals then noChange @@ -289,7 +292,7 @@ reConfigure package vals = reconfigure `requires` setselections -- -- Assumes that there is a 1:1 mapping between service names and apt -- package names. -serviceInstalledRunning :: Package -> Property NoInfo +serviceInstalledRunning :: Package -> Property DebianLike serviceInstalledRunning svc = Service.running svc `requires` installed [svc] data AptKey = AptKey @@ -297,10 +300,10 @@ data AptKey = AptKey , pubkey :: String } -trustsKey :: AptKey -> RevertableProperty NoInfo +trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike trustsKey k = trustsKey' k untrustKey k -trustsKey' :: AptKey -> Property NoInfo +trustsKey' :: AptKey -> Property DebianLike trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do withHandle StdinHandle createProcessSuccess (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do @@ -311,21 +314,21 @@ trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do desc = "apt trusts key " ++ keyname k f = aptKeyFile k -untrustKey :: AptKey -> Property NoInfo -untrustKey = File.notPresent . aptKeyFile +untrustKey :: AptKey -> Property DebianLike +untrustKey = tightenTargets . File.notPresent . aptKeyFile aptKeyFile :: AptKey -> FilePath aptKeyFile k = "/etc/apt/trusted.gpg.d" keyname k ++ ".gpg" -- | Cleans apt's cache of downloaded packages to avoid using up disk -- space. -cacheCleaned :: Property NoInfo -cacheCleaned = cmdProperty "apt-get" ["clean"] +cacheCleaned :: Property DebianLike +cacheCleaned = tightenTargets $ cmdProperty "apt-get" ["clean"] `assume` NoChange `describe` "apt cache cleaned" -- | Add a foreign architecture to dpkg and apt. -hasForeignArch :: String -> Property NoInfo +hasForeignArch :: String -> Property DebianLike hasForeignArch arch = check notAdded (add `before` update) `describe` ("dpkg has foreign architecture " ++ arch) where diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs index 0e96ed4c..46f9e8ef 100644 --- a/src/Propellor/Property/Service.hs +++ b/src/Propellor/Property/Service.hs @@ -11,17 +11,17 @@ type ServiceName = String -- Note that due to the general poor state of init scripts, the best -- we can do is try to start the service, and if it fails, assume -- this means it's already running. -running :: ServiceName -> Property NoInfo +running :: ServiceName -> Property DebianLike running = signaled "start" "running" -restarted :: ServiceName -> Property NoInfo +restarted :: ServiceName -> Property DebianLike restarted = signaled "restart" "restarted" -reloaded :: ServiceName -> Property NoInfo +reloaded :: ServiceName -> Property DebianLike reloaded = signaled "reload" "reloaded" -signaled :: String -> Desc -> ServiceName -> Property NoInfo -signaled cmd desc svc = p `describe` (desc ++ " " ++ svc) +signaled :: String -> Desc -> ServiceName -> Property DebianLike +signaled cmd desc svc = tightenTargets $ p `describe` (desc ++ " " ++ svc) where p = scriptProperty ["service " ++ shellEscape svc ++ " " ++ cmd ++ " >/dev/null 2>&1 || true"] `assume` NoChange diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index db05e100..7098c83f 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -42,6 +42,7 @@ module Propellor.Types , module Propellor.Types.Dns , module Propellor.Types.Result , module Propellor.Types.ZFS + , TightenTargets(..) ) where import Data.Monoid @@ -285,3 +286,25 @@ instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (R combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y + +class TightenTargets p where + -- | Tightens the MetaType list of a Property (or similar), + -- to contain fewer targets. + -- + -- For example, to make a property that uses apt-get, which is only + -- available on DebianLike systems: + -- + -- > upgraded :: Property DebianLike + -- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"] + tightenTargets + :: + -- Note that this uses PolyKinds + ( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine + , (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine + , SingI tightened + ) + => p (MetaTypes untightened) + -> p (MetaTypes tightened) + +instance TightenTargets Property where + tightenTargets (Property _ d a i c) = Property sing d a i c diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs index 4c6524ee..f03c174f 100644 --- a/src/Propellor/Types/ResultCheck.hs +++ b/src/Propellor/Types/ResultCheck.hs @@ -22,6 +22,9 @@ import Data.Monoid -- and `FailedChange` is still an error. data UncheckedProperty i = UncheckedProperty (Property i) +instance TightenTargets UncheckedProperty where + tightenTargets (UncheckedProperty p) = UncheckedProperty (tightenTargets p) + -- | Use to indicate that a Property is unchecked. unchecked :: Property i -> UncheckedProperty i unchecked = UncheckedProperty -- cgit v1.2.3 From e28f49b7d1ae361e42809977bf12d3f126c3d90d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 15:32:16 -0400 Subject: much simpler and more type safe implementation of Apt.robustly, using fallback! --- src/Propellor/Property/Apt.hs | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 3dd7277e..9c3b05c4 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -75,7 +75,7 @@ securityUpdates suite in [l, srcLine l] | otherwise = [] --- | Makes sources.list have a standard content using the mirror CDN, +-- | Makes sources.list have a standard content using the Debian mirror CDN, -- with the Debian suite configured by the os. -- -- Since the CDN is sometimes unreliable, also adds backup lines using @@ -196,13 +196,7 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv -- | Package installation may fail becuse the archive has changed. -- Run an update in that case and retry. robustly :: Property DebianLike -> Property DebianLike -robustly p = adjustPropertySatisfy p $ \satisfy -> do - r <- satisfy - if r == FailedChange - -- Safe to use getSatisfy because we're re-running - -- the same property as before. - then getSatisfy $ p `requires` update - else return r +robustly p = p `fallback` (update `before` p) isInstallable :: [Package] -> IO Bool isInstallable ps = do -- cgit v1.2.3 From 4694a4c36cca1c7b52421297a62548d8bbb2ec0b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 16:04:31 -0400 Subject: continued porting --- src/Propellor/Property/Cron.hs | 27 +++++++++--------- src/Propellor/Property/Debootstrap.hs | 31 +++++++++++--------- src/Propellor/Property/Docker.hs | 52 +++++++++++++++------------------- src/Propellor/Property/Mount.hs | 17 +++++------ src/Propellor/Property/Systemd/Core.hs | 2 +- src/Propellor/Types.hs | 3 +- src/Propellor/Types/MetaTypes.hs | 9 ++++-- 7 files changed, 71 insertions(+), 70 deletions(-) diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs index 365e2903..267c6cbc 100644 --- a/src/Propellor/Property/Cron.hs +++ b/src/Propellor/Property/Cron.hs @@ -27,9 +27,11 @@ data Times -- job file. -- -- The cron job's output will only be emailed if it exits nonzero. -job :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo -job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) - [ cronjobfile `File.hasContent` +job :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike +job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) $ props + & Apt.serviceInstalledRunning "cron" + & Apt.installed ["util-linux", "moreutils"] + & cronjobfile `File.hasContent` [ case times of Times _ -> "" _ -> "#!/bin/sh\nset -e" @@ -44,22 +46,19 @@ job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) "root" -> "chronic " ++ shellEscape scriptfile _ -> "chronic su " ++ u ++ " -c " ++ shellEscape scriptfile ] - , case times of + & case times of Times _ -> doNothing _ -> cronjobfile `File.mode` combineModes (readModes ++ executeModes) -- Use a separate script because it makes the cron job name -- prettier in emails, and also allows running the job manually. - , scriptfile `File.hasContent` + & scriptfile `File.hasContent` [ "#!/bin/sh" , "# Generated by propellor" , "set -e" , "flock -n " ++ shellEscape cronjobfile ++ " sh -c " ++ shellEscape cmdline ] - , scriptfile `File.mode` combineModes (readModes ++ executeModes) - ] - `requires` Apt.serviceInstalledRunning "cron" - `requires` Apt.installed ["util-linux", "moreutils"] + & scriptfile `File.mode` combineModes (readModes ++ executeModes) where cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )" cronjobfile = "/etc" cronjobdir name @@ -75,13 +74,13 @@ job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) | otherwise = '_' -- | Installs a cron job, and runs it niced and ioniced. -niceJob :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo +niceJob :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike niceJob desc times user cddir command = job desc times user cddir ("nice ionice -c 3 sh -c " ++ shellEscape command) -- | Installs a cron job to run propellor. -runPropellor :: Times -> Property NoInfo -runPropellor times = withOS "propellor cron job" $ \o -> - ensureProperty $ +runPropellor :: Times -> Property UnixLike +runPropellor times = withOS "propellor cron job" $ \o os -> + ensureProperty o $ niceJob "propellor" times (User "root") localdir - (bootstrapPropellorCommand o ++ "; ./propellor") + (bootstrapPropellorCommand os ++ "; ./propellor") diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 5716be38..7cbf3d98 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} - module Propellor.Property.Debootstrap ( Url, DebootstrapConfig(..), @@ -48,14 +46,15 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2 -- -- The System can be any OS and architecture that debootstrap -- and the kernel support. -built :: FilePath -> System -> DebootstrapConfig -> Property HasInfo -built target system config = built' (toProp installed) target system config +built :: FilePath -> System -> DebootstrapConfig -> Property Linux +built target system config = built' (setupRevertableProperty installed) target system config -built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i) +built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property Linux built' installprop target system@(System _ arch) config = check (unpopulated target <||> ispartial) setupprop `requires` installprop where + setupprop :: Property Linux setupprop = property ("debootstrapped " ++ target) $ liftIO $ do createDirectoryIfMissing True target -- Don't allow non-root users to see inside the chroot, @@ -99,20 +98,21 @@ extractSuite (System (FreeBSD _) _) = Nothing -- When necessary, falls back to installing debootstrap from source. -- Note that installation from source is done by downloading the tarball -- from a Debian mirror, with no cryptographic verification. -installed :: RevertableProperty NoInfo +installed :: RevertableProperty Linux Linux installed = install remove where - install = withOS "debootstrap installed" $ \o -> + install = withOS "debootstrap installed" $ \o os -> ifM (liftIO $ isJust <$> programPath) ( return NoChange - , ensureProperty (installon o) + , ensureProperty o (installon os) ) installon (Just (System (Debian _) _)) = aptinstall installon (Just (System (Buntish _) _)) = aptinstall installon _ = sourceInstall - remove = withOS "debootstrap removed" $ ensureProperty . removefrom + remove = withOS "debootstrap removed" $ \o os -> + ensureProperty o (removefrom os) removefrom (Just (System (Debian _) _)) = aptremove removefrom (Just (System (Buntish _) _)) = aptremove removefrom _ = sourceRemove @@ -120,18 +120,21 @@ installed = install remove aptinstall = Apt.installed ["debootstrap"] aptremove = Apt.removed ["debootstrap"] -sourceInstall :: Property NoInfo -sourceInstall = property "debootstrap installed from source" (liftIO sourceInstall') +sourceInstall :: Property Linux +sourceInstall = go `requires` perlInstalled `requires` arInstalled + where + go :: Property Linux + go = property "debootstrap installed from source" (liftIO sourceInstall') -perlInstalled :: Property NoInfo +perlInstalled :: Property Linux perlInstalled = check (not <$> inPath "perl") $ property "perl installed" $ liftIO $ toResult . isJust <$> firstM id [ yumInstall "perl" ] -arInstalled :: Property NoInfo +arInstalled :: Property Linux arInstalled = check (not <$> inPath "ar") $ property "ar installed" $ liftIO $ toResult . isJust <$> firstM id [ yumInstall "binutils" @@ -175,7 +178,7 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do return MadeChange _ -> errorMessage "debootstrap tar file did not contain exactly one dirctory" -sourceRemove :: Property NoInfo +sourceRemove :: Property Linux sourceRemove = property "debootstrap not installed from source" $ liftIO $ ifM (doesDirectoryExist sourceInstallDir) ( do diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index c2c131c7..4bbfeef3 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -66,12 +66,12 @@ import Data.List.Utils import qualified Data.Map as M import System.Console.Concurrent -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["docker.io"] -- | Configures docker with an authentication file, so that images can be -- pushed to index.docker.io. Optional. -configured :: Property HasInfo +configured :: Property DebianLike configured = prop `requires` installed where prop = withPrivData src anyContext $ \getcfg -> @@ -97,22 +97,17 @@ instance HasImage Image where instance HasImage Container where getImageName (Container i _) = i -instance PropAccum Container where - (Container i h) `addProp` p = Container i (h `addProp` p) - (Container i h) `addPropFront` p = Container i (h `addPropFront` p) - getProperties (Container _ h) = hostProperties h - -- | Defines a Container with a given name, image, and properties. --- Properties can be added to configure the Container. +-- Add properties to configure the Container. -- --- > container "web-server" "debian" +-- > container "web-server" (latestImage "debian") $ props -- > & publish "80:80" -- > & Apt.installed {"apache2"] -- > & ... -container :: ContainerName -> Image -> Container -container cn image = Container image (Host cn [] info) +container :: ContainerName -> Image -> Props -> Container +container cn image (Props ps) = Container image (Host cn ps info) where - info = dockerInfo mempty + info = dockerInfo mempty <> mconcat (map getInfoRecursive ps) -- | Ensures that a docker container is set up and running. -- @@ -135,7 +130,7 @@ docked ctr@(Container _ h) = go desc a = property (desc ++ " " ++ cn) $ do hn <- asks hostName let cid = ContainerId hn cn - ensureProperties [a cid (mkContainerInfo cid ctr)] + ensureChildProperties [a cid (mkContainerInfo cid ctr)] setup cid (ContainerInfo image runparams) = provisionContainer cid @@ -155,7 +150,7 @@ docked ctr@(Container _ h) = ] -- | Build the image from a directory containing a Dockerfile. -imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo +imageBuilt :: HasImage c => FilePath -> c -> Property Linux imageBuilt directory ctr = describe built msg where msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory @@ -165,7 +160,7 @@ imageBuilt directory ctr = describe built msg image = getImageName ctr -- | Pull the image from the standard Docker Hub registry. -imagePulled :: HasImage c => c -> Property NoInfo +imagePulled :: HasImage c => c -> Property Linux imagePulled ctr = describe pulled msg where msg = "docker image " ++ (imageIdentifier image) ++ " pulled" @@ -173,7 +168,7 @@ imagePulled ctr = describe pulled msg `assume` MadeChange image = getImageName ctr -propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo +propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property (HasInfo + Linux) propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p' where p' = infoProperty @@ -209,11 +204,10 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = -- that were not set up using propellor. -- -- Generally, should come after the properties for the desired containers. -garbageCollected :: Property NoInfo -garbageCollected = propertyList "docker garbage collected" - [ gccontainers - , gcimages - ] +garbageCollected :: Property Linux +garbageCollected = propertyList "docker garbage collected" $ props + & gccontainers + & gcimages where gccontainers = property "docker containers garbage collected" $ liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers) @@ -225,7 +219,7 @@ garbageCollected = propertyList "docker garbage collected" -- Currently, this consists of making pam_loginuid lines optional in -- the pam config, to work around -- which affects docker 1.2.0. -tweaked :: Property NoInfo +tweaked :: Property Linux tweaked = cmdProperty "sh" [ "-c" , "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*" @@ -239,7 +233,7 @@ tweaked = cmdProperty "sh" -- other GRUB_CMDLINE_LINUX_DEFAULT settings. -- -- Only takes effect after reboot. (Not automated.) -memoryLimited :: Property NoInfo +memoryLimited :: Property DebianLike memoryLimited = "/etc/default/grub" `File.containsLine` cfg `describe` "docker memory limited" `onChange` (cmdProperty "update-grub" [] `assume` MadeChange) @@ -443,7 +437,7 @@ containerDesc cid p = p `describe` desc where desc = "container " ++ fromContainerId cid ++ " " ++ propertyDesc p -runningContainer :: ContainerId -> Image -> [RunParam] -> Property NoInfo +runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do l <- liftIO $ listContainers RunningContainers if cid `elem` l @@ -558,7 +552,7 @@ init s = case toContainerId s of -- | Once a container is running, propellor can be run inside -- it to provision it. -provisionContainer :: ContainerId -> Property NoInfo +provisionContainer :: ContainerId -> Property Linux provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do let shim = Shim.file (localdir "propellor") (localdir shimdir cid) let params = ["--continue", show $ toChain cid] @@ -587,7 +581,7 @@ chain hostlist hn s = case toContainerId s of go cid h = do changeWorkingDirectory localdir onlyProcess (provisioningLock cid) $ do - r <- runPropellor h $ ensureProperties $ + r <- runPropellor h $ ensureChildProperties $ map ignoreInfo $ hostProperties h flushConcurrentOutput @@ -599,10 +593,10 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId startContainer :: ContainerId -> IO Bool startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ] -stoppedContainer :: ContainerId -> Property NoInfo -stoppedContainer cid = containerDesc cid $ property desc $ +stoppedContainer :: ContainerId -> Property Linux +stoppedContainer cid = containerDesc cid $ property' desc $ \o -> ifM (liftIO $ elem cid <$> listContainers RunningContainers) - ( liftIO cleanup `after` ensureProperty + ( liftIO cleanup `after` ensureProperty o (property desc $ liftIO $ toResult <$> stopContainer cid) , return NoChange ) diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 590cede9..5921755c 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -37,16 +37,17 @@ formatMountOpts (MountOpts []) = "defaults" formatMountOpts (MountOpts l) = intercalate "," l -- | Mounts a device. -mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property NoInfo +mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike mounted fs src mnt opts = property (mnt ++ " mounted") $ toResult <$> liftIO (mount fs src mnt opts) -- | Bind mounts the first directory so its contents also appear -- in the second directory. -bindMount :: FilePath -> FilePath -> Property NoInfo -bindMount src dest = cmdProperty "mount" ["--bind", src, dest] - `assume` MadeChange - `describe` ("bind mounted " ++ src ++ " to " ++ dest) +bindMount :: FilePath -> FilePath -> Property Linux +bindMount src dest = tightenTargets $ + cmdProperty "mount" ["--bind", src, dest] + `assume` MadeChange + `describe` ("bind mounted " ++ src ++ " to " ++ dest) mount :: FsType -> Source -> MountPoint -> MountOpts -> IO Bool mount fs src mnt opts = boolSystem "mount" $ @@ -66,10 +67,10 @@ newtype SwapPartition = SwapPartition FilePath -- and its mount options are all automatically probed. -- -- The SwapPartitions are also included in the generated fstab. -fstabbed :: [MountPoint] -> [SwapPartition] -> Property NoInfo -fstabbed mnts swaps = property "fstabbed" $ do +fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux +fstabbed mnts swaps = property' "fstabbed" $ \o -> do fstab <- liftIO $ genFstab mnts swaps id - ensureProperty $ + ensureProperty o $ "/etc/fstab" `File.hasContent` fstab genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String] diff --git a/src/Propellor/Property/Systemd/Core.hs b/src/Propellor/Property/Systemd/Core.hs index 7842f177..0290bce5 100644 --- a/src/Propellor/Property/Systemd/Core.hs +++ b/src/Propellor/Property/Systemd/Core.hs @@ -6,5 +6,5 @@ import qualified Propellor.Property.Apt as Apt -- dbus is only a Recommends of systemd, but is needed for communication -- from the systemd inside a container to the one outside, so make sure it -- gets installed. -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["systemd", "dbus"] diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 7098c83f..dd8721ac 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -17,8 +17,9 @@ module Propellor.Types , MetaTypes , OS(..) , UnixLike - , Debian + , Linux , DebianLike + , Debian , Buntish , FreeBSD , HasInfo diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 80fa454e..6545c924 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -4,8 +4,9 @@ module Propellor.Types.MetaTypes ( MetaType(..), OS(..), UnixLike, - Debian, + Linux, DebianLike, + Debian, Buntish, FreeBSD, HasInfo, @@ -37,11 +38,13 @@ data OS -- | Any unix-like system type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +-- | Any linux system +type Linux = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ] +-- | Debian and derivatives. +type DebianLike = Debian + Buntish type Debian = MetaTypes '[ 'Targeting 'OSDebian ] type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ] type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ] --- | Debian and derivatives. -type DebianLike = Debian + Buntish -- | Used to indicate that a Property adds Info to the Host where it's used. type HasInfo = MetaTypes '[ 'WithInfo ] -- cgit v1.2.3 From 6b9f3158df63e18b32b7175205ef686badc3bc1b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 16:12:27 -0400 Subject: ported mainProperties --- src/Propellor/Engine.hs | 15 ++++++--------- src/Propellor/PropAccum.hs | 2 +- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 62fad5af..bf49b95f 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -1,8 +1,8 @@ {-# LANGUAGE PackageImports #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} module Propellor.Engine ( - -- mainProperties, + mainProperties, runPropellor, ensureProperty, ensureChildProperties, @@ -29,22 +29,19 @@ import Propellor.Info import Propellor.Property import Utility.Exception -{- - -- | Gets the Properties of a Host, and ensures them all, -- with nice display of what's being done. mainProperties :: Host -> IO () mainProperties host = do - ret <- runPropellor host $ - ensureProperties [ignoreInfo $ infoProperty "overall" (ensureProperties ps) mempty mempty] + ret <- runPropellor host $ ensureChildProperties [toProp overall] messagesDone case ret of FailedChange -> exitWith (ExitFailure 1) _ -> exitWith ExitSuccess where - ps = map ignoreInfo $ hostProperties host - --} + overall :: Property (MetaTypes '[]) + overall = property "overall" $ + ensureChildProperties (hostProperties host) -- | Runs a Propellor action with the specified host. -- diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 91d7b80d..06b8ad3f 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -30,7 +30,7 @@ import Propellor.PrivData -- > ! oldproperty -- > & otherproperty host :: HostName -> Props metatypes -> Host -host hn (Props c) = Host hn c (mconcat (map getInfoRecursive c)) +host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps)) -- | Props is a combination of a list of properties, with their combined -- metatypes. -- cgit v1.2.3 From f01776d64b1b8fcf89903d0de1ffe27f10d620ee Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 16:20:32 -0400 Subject: rename toProp to toChildProperties and note that it's not meant to be used by regular users --- config-simple.hs | 12 ------------ src/Propellor/Engine.hs | 2 +- src/Propellor/PropAccum.hs | 6 +++--- src/Propellor/Property/Chroot.hs | 7 +++---- src/Propellor/Property/Docker.hs | 4 +--- src/Propellor/Property/List.hs | 6 +++--- src/Propellor/Types.hs | 23 ++++++----------------- 7 files changed, 17 insertions(+), 43 deletions(-) diff --git a/config-simple.hs b/config-simple.hs index 28b38409..da1580c6 100644 --- a/config-simple.hs +++ b/config-simple.hs @@ -12,7 +12,6 @@ import Propellor.Property.Scheduled import qualified Propellor.Property.User as User --import qualified Propellor.Property.Hostname as Hostname --import qualified Propellor.Property.Tor as Tor -import qualified Propellor.Property.Docker as Docker main :: IO () main = defaultMain hosts @@ -34,15 +33,4 @@ mybox = host "mybox.example.com" $ props & User.hasSomePassword (User "root") & Network.ipv6to4 & File.dirExists "/var/www" - & Docker.docked webserverContainer - & Docker.garbageCollected `period` Daily & Cron.runPropellor (Cron.Times "30 * * * *") - --- A generic webserver in a Docker container. -webserverContainer :: Docker.Container -webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props - & os (System (Debian (Stable "jessie")) "amd64") - & Apt.stdSourcesList - & Docker.publish "80:80" - & Docker.volume "/var/www:/var/www" - & Apt.serviceInstalledRunning "apache2" diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index bf49b95f..4c37e704 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -33,7 +33,7 @@ import Utility.Exception -- with nice display of what's being done. mainProperties :: Host -> IO () mainProperties host = do - ret <- runPropellor host $ ensureChildProperties [toProp overall] + ret <- runPropellor host $ ensureChildProperties [toChildProperty overall] messagesDone case ret of FailedChange -> exitWith (ExitFailure 1) diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 06b8ad3f..7547a81d 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -62,7 +62,7 @@ type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) -Props c & p = Props (c ++ [toProp p]) +Props c & p = Props (c ++ [toChildProperty p]) -- | Adds a property before any other properties. (&^) @@ -74,7 +74,7 @@ Props c & p = Props (c ++ [toProp p]) => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) -Props c &^ p = Props (toProp p : c) +Props c &^ p = Props (toChildProperty p : c) -- | Adds a property in reverted form. (!) @@ -82,7 +82,7 @@ Props c &^ p = Props (toProp p : c) => Props (MetaTypes x) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z)) -Props c ! p = Props (c ++ [toProp (revert p)]) +Props c ! p = Props (c ++ [toChildProperty (revert p)]) {- diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index fb05d659..bf6f2083 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -213,11 +213,10 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = changeWorkingDirectory localdir when onconsole forceConsole onlyProcess (provisioningLock loc) $ do - r <- runPropellor (setInChroot h) $ ensureProperties $ + r <- runPropellor (setInChroot h) $ ensureChildProperties $ if systemdonly - then [Systemd.installed] - else map ignoreInfo $ - hostProperties h + then [toProp Systemd.installed] + else hostProperties h flushConcurrentOutput putStrLn $ "\n" ++ show r chain _ _ = errorMessage "bad chain command" diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 4bbfeef3..d19d15aa 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -581,9 +581,7 @@ chain hostlist hn s = case toContainerId s of go cid h = do changeWorkingDirectory localdir onlyProcess (provisioningLock cid) $ do - r <- runPropellor h $ ensureChildProperties $ - map ignoreInfo $ - hostProperties h + r <- runPropellor h $ ensureChildProperties $ hostProperties h flushConcurrentOutput putStrLn $ "\n" ++ show r diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs index 44916f23..d8c5cff4 100644 --- a/src/Propellor/Property/List.hs +++ b/src/Propellor/Property/List.hs @@ -21,7 +21,7 @@ import Propellor.Exception import Data.Monoid toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes) -toProps ps = Props (map toProp ps) +toProps ps = Props (map toChildProperty ps) -- | Combines a list of properties, resulting in a single property -- that when run will run each property in the list in turn, @@ -38,7 +38,7 @@ propertyList desc (Props ps) = property desc (ensureChildProperties cs) `modifyChildren` (++ cs) where - cs = map toProp ps + cs = map toChildProperty ps -- | Combines a list of properties, resulting in one property that -- ensures each in turn. Stops if a property fails. @@ -47,7 +47,7 @@ combineProperties desc (Props ps) = property desc (combineSatisfy cs NoChange) `modifyChildren` (++ cs) where - cs = map toProp ps + cs = map toChildProperty ps combineSatisfy :: [ChildProperty] -> Result -> Propellor Result combineSatisfy [] rs = return rs diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index dd8721ac..f42f55d7 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -158,18 +158,6 @@ addInfoProperty addInfoProperty (Property _ d a oldi c) newi = Property sing d a (oldi <> newi) c -{- - --- | Makes a version of a Proprty without its Info. --- Use with caution! -ignoreInfo - :: (metatypes' ~ - => Property metatypes - -> Property (MetaTypes metatypes') -ignoreInfo = - --} - -- | Changes the action that is performed to satisfy a property. adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c @@ -213,7 +201,9 @@ class IsProp p where -- | Gets the info of the property, combined with all info -- of all children properties. getInfoRecursive :: p -> Info - toProp :: p -> ChildProperty + -- | Gets a ChildProperty representing the Property. + -- You should not normally need to use this. + toChildProperty :: p -> ChildProperty -- | Gets the action that can be run to satisfy a Property. -- You should never run this action directly. Use -- 'Propellor.EnsureProperty.ensureProperty` instead. @@ -225,7 +215,7 @@ instance IsProp (Property metatypes) where modifyChildren (Property t d a i c) f = Property t d a i (f c) getInfoRecursive (Property _ _ _ i c) = i <> mconcat (map getInfoRecursive c) - toProp (Property _ d a i c) = ChildProperty d a i c + toChildProperty (Property _ d a i c) = ChildProperty d a i c getSatisfy (Property _ _ a _ _) = a instance IsProp ChildProperty where @@ -234,7 +224,7 @@ instance IsProp ChildProperty where modifyChildren (ChildProperty d a i c) f = ChildProperty d a i (f c) getInfoRecursive (ChildProperty _ _ i c) = i <> mconcat (map getInfoRecursive c) - toProp = id + toChildProperty = id getSatisfy (ChildProperty _ a _ _) = a instance IsProp (RevertableProperty setupmetatypes undometatypes) where @@ -243,10 +233,9 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) getDesc (RevertableProperty p1 _) = getDesc p1 modifyChildren (RevertableProperty p1 p2) f = RevertableProperty (modifyChildren p1 f) (modifyChildren p2 f) - -- toProp (RevertableProperty p1 _) = p1 -- | Return the Info of the currently active side. getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 - toProp (RevertableProperty p1 _p2) = toProp p1 + toChildProperty (RevertableProperty p1 _p2) = toChildProperty p1 getSatisfy (RevertableProperty p1 _) = getSatisfy p1 -- | Type level calculation of the type that results from combining two -- cgit v1.2.3 From 860d1dd77e1789a91ed61bdceab667d94c9bd345 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 17:36:52 -0400 Subject: cleanup warnings --- src/Propellor/EnsureProperty.hs | 24 ++++++++++++------------ src/Propellor/Property.hs | 14 +++++++------- src/Propellor/Property/Apt.hs | 14 +++++++------- src/Propellor/Types/MetaTypes.hs | 4 ++-- 4 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index c4b5fde1..c19dc025 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -7,7 +7,7 @@ module Propellor.EnsureProperty ( ensureProperty , property' - , OuterMetaTypes(..) + , OuterMetaTypesWitness(..) ) where import Propellor.Types @@ -17,14 +17,14 @@ import Propellor.Exception -- | For when code running in the Propellor monad needs to ensure a -- Property. -- --- Use `property'` to get the `OuterMetaTypes`. For example: +-- Use `property'` to get the `OuterMetaTypesWithness`. For example: -- -- > foo = Property Debian --- > foo = property' $ \o -> do --- > ensureProperty o (aptInstall "foo") +-- > foo = property' $ \w -> do +-- > ensureProperty w (aptInstall "foo") -- -- The type checker will prevent using ensureProperty with a property --- that does not support the target OSes needed by the OuterMetaTypes. +-- that does not support the target OSes needed by the OuterMetaTypesWitness. -- In the example above, aptInstall must support Debian, since foo -- is supposed to support Debian. -- @@ -36,7 +36,7 @@ ensureProperty ( Cannot_ensureProperty_WithInfo inner ~ 'True , (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine ) - => OuterMetaTypes outer + => OuterMetaTypesWitness outer -> Property (MetaTypes inner) -> Propellor Result ensureProperty _ = catchPropellor . getSatisfy @@ -48,19 +48,19 @@ type instance Cannot_ensureProperty_WithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts -- | Constructs a property, like `property`, but provides its --- `OuterMetaTypes`. +-- `OuterMetaTypesWitness`. property' :: SingI metatypes => Desc - -> (OuterMetaTypes metatypes -> Propellor Result) + -> (OuterMetaTypesWitness metatypes -> Propellor Result) -> Property (MetaTypes metatypes) property' d a = - let p = Property sing d (a (outerMetaTypes p)) mempty mempty + let p = Property sing d (a (outerMetaTypesWitness p)) mempty mempty in p -- | Used to provide the metatypes of a Property to calls to -- 'ensureProperty` within it. -newtype OuterMetaTypes metatypes = OuterMetaTypes (MetaTypes metatypes) +newtype OuterMetaTypesWitness metatypes = OuterMetaTypesWitness (MetaTypes metatypes) -outerMetaTypes :: Property (MetaTypes l) -> OuterMetaTypes l -outerMetaTypes (Property metatypes _ _ _ _) = OuterMetaTypes metatypes +outerMetaTypesWitness :: Property (MetaTypes l) -> OuterMetaTypesWitness l +outerMetaTypesWitness (Property metatypes _ _ _ _) = OuterMetaTypesWitness metatypes diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 2ddec439..9fa29888 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -22,7 +22,7 @@ module Propellor.Property ( , Propellor , property , property' - , OuterMetaTypes + , OuterMetaTypesWitness , ensureProperty , withOS , unsupportedOS @@ -270,9 +270,9 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io -- of the host's operating system. -- -- > myproperty :: Property Debian --- > myproperty = withOS "foo installed" $ \o os -> case os of --- > (Just (System (Debian (Stable release)) arch)) -> ensureProperty o ... --- > (Just (System (Debian suite) arch)) -> ensureProperty o ... +-- > myproperty = withOS "foo installed" $ \w o -> case o of +-- > (Just (System (Debian (Stable release)) arch)) -> ensureProperty w ... +-- > (Just (System (Debian suite) arch)) -> ensureProperty w ... -- > _ -> unsupportedOS -- -- Note that the operating system specifics may not be declared for all hosts, @@ -280,15 +280,15 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io withOS :: (SingI metatypes) => Desc - -> (OuterMetaTypes '[] -> Maybe System -> Propellor Result) + -> (OuterMetaTypesWitness '[] -> Maybe System -> Propellor Result) -> Property (MetaTypes metatypes) withOS desc a = property desc $ a dummyoutermetatypes =<< getOS where -- Using this dummy value allows ensureProperty to be used -- even though the inner property probably doesn't target everything -- that the outer withOS property targets. - dummyoutermetatypes :: OuterMetaTypes ('[]) - dummyoutermetatypes = OuterMetaTypes sing + dummyoutermetatypes :: OuterMetaTypesWitness ('[]) + dummyoutermetatypes = OuterMetaTypesWitness sing -- | Throws an error, for use in `withOS` when a property is lacking -- support for an OS. diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 9c3b05c4..c8ad92e4 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -81,9 +81,9 @@ securityUpdates suite -- Since the CDN is sometimes unreliable, also adds backup lines using -- kernel.org. stdSourcesList :: Property Debian -stdSourcesList = withOS "standard sources.list" $ \o os -> case os of +stdSourcesList = withOS "standard sources.list" $ \w o -> case o of (Just (System (Debian suite) _)) -> - ensureProperty o $ stdSourcesListFor suite + ensureProperty w $ stdSourcesListFor suite _ -> unsupportedOS stdSourcesListFor :: DebianSuite -> Property Debian @@ -158,10 +158,10 @@ installed' params ps = robustly $ check (isInstallable ps) go go = runApt (params ++ ["install"] ++ ps) installedBackport :: [Package] -> Property DebianLike -installedBackport ps = withOS desc $ \o os -> case os of +installedBackport ps = withOS desc $ \w o -> case o of (Just (System (Debian suite) _)) -> case backportSuite suite of Nothing -> unsupportedOS - Just bs -> ensureProperty o $ + Just bs -> ensureProperty w $ runApt (["install", "-t", bs, "-y"] ++ ps) `changesFile` dpkgStatus _ -> unsupportedOS @@ -247,11 +247,11 @@ unattendedUpgrades = enable disable | otherwise = "false" configure :: Property DebianLike - configure = withOS "unattended upgrades configured" $ \o os -> - case os of + configure = withOS "unattended upgrades configured" $ \w o -> + case o of -- the package defaults to only upgrading stable (Just (System (Debian suite) _)) - | not (isStable suite) -> ensureProperty o $ + | not (isStable suite) -> ensureProperty w $ "/etc/apt/apt.conf.d/50unattended-upgrades" `File.containsLine` ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };") diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 6545c924..6033ec27 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -116,8 +116,8 @@ type family CheckCombinable (list1 :: [a]) (list2 :: [a]) :: CheckCombine -- one target, so can only happen if there's already been a type error. -- This special case lets the type checker show only the original type -- error, and not an extra error due to a later CheckCombinable constraint. -type instance CheckCombinable '[] list2 = CanCombine -type instance CheckCombinable list1 '[] = CanCombine +type instance CheckCombinable '[] list2 = 'CanCombine +type instance CheckCombinable list1 '[] = 'CanCombine type instance CheckCombinable (l1 ': list1) (l2 ': list2) = CheckCombinable' (Combine (l1 ': list1) (l2 ': list2)) type family CheckCombinable' (combinedlist :: [a]) :: CheckCombine -- cgit v1.2.3 From ce8d34d094be30e1432ecaaae81b188671180624 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 18:39:50 -0400 Subject: ported more Ssh is WIP and failing to compile quite badly --- src/Propellor/PropAccum.hs | 7 +- src/Propellor/Property/Aiccu.hs | 16 ++-- src/Propellor/Property/Apache.hs | 54 +++++------ src/Propellor/Property/Concurrent.hs | 10 +- src/Propellor/Property/ConfFile.hs | 8 +- src/Propellor/Property/Cron.hs | 6 +- src/Propellor/Property/Debootstrap.hs | 8 +- src/Propellor/Property/LetsEncrypt.hs | 7 +- src/Propellor/Property/List.hs | 1 - src/Propellor/Property/Ssh.hs | 167 +++++++++++++++++----------------- src/Propellor/Types.hs | 1 + 11 files changed, 143 insertions(+), 142 deletions(-) diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 7547a81d..8281b9a1 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -15,13 +15,12 @@ module Propellor.PropAccum --, propagateContainer ) where -import Data.Monoid - import Propellor.Types import Propellor.Types.MetaTypes import Propellor.Property -import Propellor.Types.Info -import Propellor.PrivData + +import Data.Monoid +import Prelude -- | Defines a host and its properties. -- diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index 47841a7b..1b28759c 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} + -- | Maintainer: Jelmer Vernooij module Propellor.Property.Aiccu ( @@ -14,10 +16,10 @@ import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service import qualified Propellor.Property.File as File -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["aiccu"] -restarted :: Property NoInfo +restarted :: Property DebianLike restarted = Service.restarted "aiccu" confPath :: FilePath @@ -41,12 +43,12 @@ config u t p = -- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId -- and sixx.net UserName. -hasConfig :: TunnelId -> UserName -> Property HasInfo -hasConfig t u = prop `onChange` restarted +hasConfig :: TunnelId -> UserName -> Property (HasInfo + DebianLike) +hasConfig t u = prop `onChange` restarted where + prop :: Property (HasInfo + UnixLike) prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ - property "aiccu configured" . writeConfig - writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result - writeConfig getpassword = getpassword $ ensureProperty . go + property' "aiccu configured" . writeConfig + writeConfig getpassword w = getpassword $ ensureProperty w . go go (Password u', p) = confPath `File.hasContentProtected` config u' t p go (f, _) = error $ "Unexpected type of privdata: " ++ show f diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs index e107cb9f..f321143f 100644 --- a/src/Propellor/Property/Apache.hs +++ b/src/Propellor/Property/Apache.hs @@ -6,50 +6,50 @@ import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service import qualified Propellor.Property.LetsEncrypt as LetsEncrypt -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["apache2"] -restarted :: Property NoInfo +restarted :: Property DebianLike restarted = Service.restarted "apache2" -reloaded :: Property NoInfo +reloaded :: Property DebianLike reloaded = Service.reloaded "apache2" type ConfigLine = String type ConfigFile = [ConfigLine] -siteEnabled :: Domain -> ConfigFile -> RevertableProperty NoInfo +siteEnabled :: Domain -> ConfigFile -> RevertableProperty DebianLike DebianLike siteEnabled domain cf = siteEnabled' domain cf siteDisabled domain -siteEnabled' :: Domain -> ConfigFile -> Property NoInfo -siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain) - [ siteAvailable domain cf +siteEnabled' :: Domain -> ConfigFile -> Property DebianLike +siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain) $ props + & siteAvailable domain cf `requires` installed `onChange` reloaded - , check (not <$> isenabled) + & check (not <$> isenabled) (cmdProperty "a2ensite" ["--quiet", domain]) `requires` installed `onChange` reloaded - ] where isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param domain] -siteDisabled :: Domain -> Property NoInfo +siteDisabled :: Domain -> Property DebianLike siteDisabled domain = combineProperties ("apache site disabled " ++ domain) - (map File.notPresent (siteCfg domain)) + (toProps $ map File.notPresent (siteCfg domain)) `onChange` (cmdProperty "a2dissite" ["--quiet", domain] `assume` MadeChange) `requires` installed `onChange` reloaded -siteAvailable :: Domain -> ConfigFile -> Property NoInfo +siteAvailable :: Domain -> ConfigFile -> Property DebianLike siteAvailable domain cf = combineProperties ("apache site available " ++ domain) $ - map (`File.hasContent` (comment:cf)) (siteCfg domain) + toProps $ map tightenTargets $ + map (`File.hasContent` (comment:cf)) (siteCfg domain) where comment = "# deployed with propellor, do not modify" -modEnabled :: String -> RevertableProperty NoInfo +modEnabled :: String -> RevertableProperty DebianLike DebianLike modEnabled modname = enable disable where enable = check (not <$> isenabled) @@ -68,7 +68,7 @@ modEnabled modname = enable disable -- -- Note that ports are also specified inside a site's config file, -- so that also needs to be changed. -listenPorts :: [Port] -> Property NoInfo +listenPorts :: [Port] -> Property DebianLike listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps `onChange` restarted where @@ -89,7 +89,7 @@ siteCfg domain = -- -- This was off by default in apache 2.2.22. Newver versions enable -- it by default. This property uses the filename used by the old version. -multiSSL :: Property NoInfo +multiSSL :: Property DebianLike multiSSL = check (doesDirectoryExist "/etc/apache2/conf.d") $ "/etc/apache2/conf.d/ssl" `File.hasContent` [ "NameVirtualHost *:443" @@ -129,11 +129,11 @@ type WebRoot = FilePath -- | A basic virtual host, publishing a directory, and logging to -- the combined apache log file. Not https capable. -virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty NoInfo +virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty DebianLike DebianLike virtualHost domain port docroot = virtualHost' domain port docroot [] -- | Like `virtualHost` but with additional config lines added. -virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty NoInfo +virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike virtualHost' domain port docroot addedcfg = siteEnabled domain $ [ "" , "ServerName " ++ domain ++ ":" ++ fromPort port @@ -159,11 +159,11 @@ virtualHost' domain port docroot addedcfg = siteEnabled domain $ -- -- Note that reverting this property does not remove the certificate from -- letsencrypt's cert store. -httpsVirtualHost :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> RevertableProperty NoInfo +httpsVirtualHost :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> RevertableProperty DebianLike DebianLike httpsVirtualHost domain docroot letos = httpsVirtualHost' domain docroot letos [] -- | Like `httpsVirtualHost` but with additional config lines added. -httpsVirtualHost' :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> [ConfigLine] -> RevertableProperty NoInfo +httpsVirtualHost' :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> [ConfigLine] -> RevertableProperty DebianLike DebianLike httpsVirtualHost' domain docroot letos addedcfg = setup teardown where setup = setuphttp @@ -185,13 +185,13 @@ httpsVirtualHost' domain docroot letos addedcfg = setup teardown , "RewriteRule ^/(.*) https://" ++ domain ++ "/$1 [L,R,NE]" ] setuphttps = LetsEncrypt.letsEncrypt letos domain docroot - `onChange` combineProperties (domain ++ " ssl cert installed") - [ File.dirExists (takeDirectory cf) - , File.hasContent cf sslvhost - `onChange` reloaded - -- always reload since the cert has changed - , reloaded - ] + `onChange` postsetuphttps + postsetuphttps = combineProperties (domain ++ " ssl cert installed") $ props + & File.dirExists (takeDirectory cf) + & File.hasContent cf sslvhost + `onChange` reloaded + -- always reload since the cert has changed + & reloaded where cf = sslconffile "letsencrypt" sslvhost = vhost (Port 443) diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs index 8d608a54..a86c839f 100644 --- a/src/Propellor/Property/Concurrent.hs +++ b/src/Propellor/Property/Concurrent.hs @@ -77,8 +77,8 @@ concurrently p1 p2 = (combineWith go go p1 p2) -- -- The above example will run foo and bar concurrently, and once either of -- those 2 properties finishes, will start running baz. -concurrentList :: IO Int -> Desc -> PropList -> Property HasInfo -concurrentList getn d (PropList ps) = infoProperty d go mempty ps +concurrentList :: SingI metatypes => IO Int -> Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) +concurrentList getn d (Props ps) = property d go `modifyChildren` (++ ps) where go = do n <- liftIO getn @@ -97,14 +97,10 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps (p:rest) -> return (rest, Just p) case v of Nothing -> return r - -- This use of getSatisfy does not lose any - -- Info asociated with the property, because - -- concurrentList sets all the properties as - -- children, and so propigates their info. Just p -> do hn <- asks hostName r' <- actionMessageOn hn - (propertyDesc p) + (getDesc p) (getSatisfy p) worker q (r <> r') diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs index dac4e564..270e04f1 100644 --- a/src/Propellor/Property/ConfFile.hs +++ b/src/Propellor/Property/ConfFile.hs @@ -37,7 +37,7 @@ adjustSection -> AdjustSection -> InsertSection -> FilePath - -> Property NoInfo + -> Property UnixLike adjustSection desc start past adjust insert = fileProperty desc go where go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls @@ -68,7 +68,7 @@ adjustIniSection -> AdjustSection -> InsertSection -> FilePath - -> Property NoInfo + -> Property UnixLike adjustIniSection desc header = adjustSection desc @@ -77,7 +77,7 @@ adjustIniSection desc header = -- | Ensures that a .ini file exists and contains a section -- with a key=value setting. -containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property NoInfo +containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike containsIniSetting f (header, key, value) = adjustIniSection (f ++ " section [" ++ header ++ "] contains " ++ key ++ "=" ++ value) @@ -93,7 +93,7 @@ containsIniSetting f (header, key, value) = isKeyVal x = (filter (/= ' ') . takeWhile (/= '=')) x `elem` [key, '#':key] -- | Ensures that a .ini file does not contain the specified section. -lacksIniSection :: FilePath -> IniSection -> Property NoInfo +lacksIniSection :: FilePath -> IniSection -> Property UnixLike lacksIniSection f header = adjustIniSection (f ++ " lacks section [" ++ header ++ "]") diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs index 267c6cbc..0966a7e5 100644 --- a/src/Propellor/Property/Cron.hs +++ b/src/Propellor/Property/Cron.hs @@ -80,7 +80,7 @@ niceJob desc times user cddir command = job desc times user cddir -- | Installs a cron job to run propellor. runPropellor :: Times -> Property UnixLike -runPropellor times = withOS "propellor cron job" $ \o os -> - ensureProperty o $ +runPropellor times = withOS "propellor cron job" $ \w o -> + ensureProperty w $ niceJob "propellor" times (User "root") localdir - (bootstrapPropellorCommand os ++ "; ./propellor") + (bootstrapPropellorCommand o ++ "; ./propellor") diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 7cbf3d98..fd5f6c96 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -101,18 +101,18 @@ extractSuite (System (FreeBSD _) _) = Nothing installed :: RevertableProperty Linux Linux installed = install remove where - install = withOS "debootstrap installed" $ \o os -> + install = withOS "debootstrap installed" $ \w o -> ifM (liftIO $ isJust <$> programPath) ( return NoChange - , ensureProperty o (installon os) + , ensureProperty w (installon o) ) installon (Just (System (Debian _) _)) = aptinstall installon (Just (System (Buntish _) _)) = aptinstall installon _ = sourceInstall - remove = withOS "debootstrap removed" $ \o os -> - ensureProperty o (removefrom os) + remove = withOS "debootstrap removed" $ \w o -> + ensureProperty w (removefrom o) removefrom (Just (System (Debian _) _)) = aptremove removefrom (Just (System (Buntish _) _)) = aptremove removefrom _ = sourceRemove diff --git a/src/Propellor/Property/LetsEncrypt.hs b/src/Propellor/Property/LetsEncrypt.hs index d5528c64..bf38046b 100644 --- a/src/Propellor/Property/LetsEncrypt.hs +++ b/src/Propellor/Property/LetsEncrypt.hs @@ -7,7 +7,7 @@ import qualified Propellor.Property.Apt as Apt import System.Posix.Files -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["letsencrypt"] -- | Tell the letsencrypt client that you agree with the Let's Encrypt @@ -39,15 +39,16 @@ type WebRoot = FilePath -- -- See `Propellor.Property.Apache.httpsVirtualHost` for a more complete -- integration of apache with letsencrypt, that's built on top of this. -letsEncrypt :: AgreeTOS -> Domain -> WebRoot -> Property NoInfo +letsEncrypt :: AgreeTOS -> Domain -> WebRoot -> Property DebianLike letsEncrypt tos domain = letsEncrypt' tos domain [] -- | Like `letsEncrypt`, but the certificate can be obtained for multiple -- domains. -letsEncrypt' :: AgreeTOS -> Domain -> [Domain] -> WebRoot -> Property NoInfo +letsEncrypt' :: AgreeTOS -> Domain -> [Domain] -> WebRoot -> Property DebianLike letsEncrypt' (AgreeTOS memail) domain domains webroot = prop `requires` installed where + prop :: Property UnixLike prop = property desc $ do startstats <- liftIO getstats (transcript, ok) <- liftIO $ diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs index d8c5cff4..304d0863 100644 --- a/src/Propellor/Property/List.hs +++ b/src/Propellor/Property/List.hs @@ -13,7 +13,6 @@ module Propellor.Property.List ( ) where import Propellor.Types -import Propellor.Types.MetaTypes import Propellor.PropAccum import Propellor.Engine import Propellor.Exception diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 26cdbeb7..12c06919 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-} module Propellor.Property.Ssh ( installed, @@ -47,10 +47,10 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.List -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["ssh"] -restarted :: Property NoInfo +restarted :: Property DebianLike restarted = Service.restarted "ssh" sshBool :: Bool -> String @@ -62,10 +62,10 @@ sshdConfig = "/etc/ssh/sshd_config" type ConfigKeyword = String -setSshdConfigBool :: ConfigKeyword -> Bool -> Property NoInfo +setSshdConfigBool :: ConfigKeyword -> Bool -> Property DebianLike setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed) -setSshdConfig :: ConfigKeyword -> String -> Property NoInfo +setSshdConfig :: ConfigKeyword -> String -> Property DebianLike setSshdConfig setting val = File.fileProperty desc f sshdConfig `onChange` restarted where @@ -84,19 +84,19 @@ data RootLogin | WithoutPassword -- ^ disable password authentication for root, while allowing other authentication methods | ForcedCommandsOnly -- ^ allow root login with public-key authentication, but only if a forced command has been specified for the public key -permitRootLogin :: RootLogin -> Property NoInfo +permitRootLogin :: RootLogin -> Property DebianLike permitRootLogin (RootLogin b) = setSshdConfigBool "PermitRootLogin" b permitRootLogin WithoutPassword = setSshdConfig "PermitRootLogin" "without-password" permitRootLogin ForcedCommandsOnly = setSshdConfig "PermitRootLogin" "forced-commands-only" -passwordAuthentication :: Bool -> Property NoInfo +passwordAuthentication :: Bool -> Property DebianLike passwordAuthentication = setSshdConfigBool "PasswordAuthentication" -- | Configure ssh to not allow password logins. -- -- To prevent lock-out, this is done only once root's -- authorized_keys is in place. -noPasswords :: Property NoInfo +noPasswords :: Property DebianLike noPasswords = check (hasAuthorizedKeys (User "root")) $ passwordAuthentication False @@ -114,7 +114,7 @@ dotFile f user = do -- ports it is configured to listen on. -- -- Revert to prevent it listening on a particular port. -listenPort :: Port -> RevertableProperty NoInfo +listenPort :: Port -> RevertableProperty DebianLike DebianLike listenPort port = enable disable where portline = "Port " ++ fromPort port @@ -133,16 +133,17 @@ hasAuthorizedKeys = go <=< dotFile "authorized_keys" -- | Blows away existing host keys and make new ones. -- Useful for systems installed from an image that might reuse host keys. -- A flag file is used to only ever do this once. -randomHostKeys :: Property NoInfo +randomHostKeys :: Property DebianLike randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" `onChange` restarted where - prop = property "ssh random host keys" $ do + prop :: Property UnixLike + prop = property' "ssh random host keys" $ \w -> do void $ liftIO $ boolSystem "sh" [ Param "-c" , Param "rm -f /etc/ssh/ssh_host_*" ] - ensureProperty $ scriptProperty [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ] + ensureProperty w $ scriptProperty [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ] `assume` MadeChange -- | The text of a ssh public key, for example, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI" @@ -153,8 +154,8 @@ type PubKeyText = String -- The corresponding private keys come from the privdata. -- -- Any host keys that are not in the list are removed from the host. -hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property HasInfo -hostKeys ctx l = propertyList desc $ catMaybes $ +hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + DebianLike) +hostKeys ctx l = propertyList desc $ toProps $ catMaybes $ map (\(t, pub) -> Just $ hostKey ctx t pub) l ++ [cleanup] where desc = "ssh host keys configured " ++ typelist (map fst l) @@ -162,34 +163,36 @@ hostKeys ctx l = propertyList desc $ catMaybes $ alltypes = [minBound..maxBound] staletypes = let have = map fst l in filter (`notElem` have) alltypes removestale b = map (File.notPresent . flip keyFile b) staletypes + cleanup :: Maybe (Property DebianLike) cleanup | null staletypes || null l = Nothing - | otherwise = Just $ toProp $ - property ("any other ssh host keys removed " ++ typelist staletypes) $ - ensureProperty $ - combineProperties desc (removestale True ++ removestale False) - `onChange` restarted + | otherwise = Just $ + combineProperties ("any other ssh host keys removed " ++ typelist staletypes) + (toProps $ removestale True ++ removestale False) + `onChange` restarted -- | Installs a single ssh host key of a particular type. -- -- The public key is provided to this function; -- the private key comes from the privdata; -hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo -hostKey context keytype pub = combineProperties desc - [ hostPubKey keytype pub - , toProp $ property desc $ install File.hasContent True (lines pub) - , withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey -> - property desc $ getkey $ - install File.hasContentProtected False . privDataLines - ] - `onChange` restarted +hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property (HasInfo + DebianLike) +hostKey context keytype pub = combineProperties desc (props + & hostPubKey keytype pub + & installpub + & installpriv + ) `onChange` restarted where desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")" - install writer ispub keylines = do + install w writer ispub keylines = do let f = keyFile keytype ispub - ensureProperty $ writer f (keyFileContent keylines) + ensureProperty w $ writer f (keyFileContent keylines) keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext) ("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey") + installpub = property' desc $ \w -> install w File.hasContent True (lines pub) + installpriv = withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey -> + property' desc $ \w -> getkey $ + install w File.hasContentProtected False . privDataLines + -- Make sure that there is a newline at the end; -- ssh requires this for some types of private keys. @@ -204,7 +207,7 @@ keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ -- | Indicates the host key that is used by a Host, but does not actually -- configure the host to use it. Normally this does not need to be used; -- use 'hostKey' instead. -hostPubKey :: SshKeyType -> PubKeyText -> Property HasInfo +hostPubKey :: SshKeyType -> PubKeyText -> Property (HasInfo + DebianLike) hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText) @@ -224,7 +227,7 @@ instance Monoid HostKeyInfo where -- parameter when there is a duplicate key HostKeyInfo (new `M.union` old) -userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property HasInfo +userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike) userPubKeys u@(User n) l = pureInfoProperty ("ssh pubkey for " ++ n) $ UserKeyInfo (M.singleton u (S.fromList l)) @@ -248,8 +251,8 @@ instance Monoid UserKeyInfo where -- -- The public keys are added to the Info, so other properties like -- `authorizedKeysFrom` can use them. -userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo -userKeys user@(User name) context ks = combineProperties desc $ +userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike) +userKeys user@(User name) context ks = combineProperties desc $ toProps $ userPubKeys user ks : map (userKeyAt Nothing user context) ks where desc = unwords @@ -264,7 +267,7 @@ userKeys user@(User name) context ks = combineProperties desc $ -- A file can be specified to write the key to somewhere other than -- the default locations. Allows a user to have multiple keys for -- different roles. -userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property HasInfo +userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property (HasInfo + UnixLike) userKeyAt dest user@(User u) context (keytype, pubkeytext) = combineProperties desc $ props & pubkey @@ -276,17 +279,16 @@ userKeyAt dest user@(User u) context (keytype, pubkeytext) = , dest , Just $ "(" ++ fromKeyType keytype ++ ")" ] - pubkey = property desc $ install File.hasContent ".pub" [pubkeytext] + pubkey = property' desc $ \w -> install w File.hasContent ".pub" [pubkeytext] privkey = withPrivData (SshPrivKey keytype u) context $ \getkey -> - property desc $ getkey $ - install File.hasContentProtected "" . privDataLines - install writer ext key = do + property' desc $ \w -> getkey $ + install w File.hasContentProtected "" . privDataLines + install w writer ext key = do f <- liftIO $ keyfile ext - ensureProperty $ combineProperties desc - [ writer f (keyFileContent key) - , File.ownerGroup f user (userGroup user) - , File.ownerGroup (takeDirectory f) user (userGroup user) - ] + ensureProperty w $ combineProperties desc $ props + & writer f (keyFileContent key) + & File.ownerGroup f user (userGroup user) + & File.ownerGroup (takeDirectory f) user (userGroup user) keyfile ext = case dest of Nothing -> do home <- homeDirectory <$> getUserEntryForName u @@ -301,33 +303,34 @@ fromKeyType SshEd25519 = "ed25519" -- | Puts some host's ssh public key(s), as set using `hostPubKey` -- or `hostKey` into the known_hosts file for a user. -knownHost :: [Host] -> HostName -> User -> Property NoInfo -knownHost hosts hn user@(User u) = property desc $ - go =<< knownHostLines hosts hn +knownHost :: [Host] -> HostName -> User -> Property UnixLike +knownHost hosts hn user@(User u) = property' desc $ \w -> + go w =<< knownHostLines hosts hn where desc = u ++ " knows ssh key for " ++ hn - go [] = do + go _ [] = do warningMessage $ "no configured ssh host keys for " ++ hn return FailedChange - go ls = do + go w ls = do f <- liftIO $ dotFile "known_hosts" user - modKnownHost user f $ + ensureProperty w $ modKnownHost user f $ f `File.containsLines` ls `requires` File.dirExists (takeDirectory f) -- | Reverts `knownHost` -unknownHost :: [Host] -> HostName -> User -> Property NoInfo -unknownHost hosts hn user@(User u) = property desc $ - go =<< knownHostLines hosts hn +unknownHost :: [Host] -> HostName -> User -> Property UnixLike +unknownHost hosts hn user@(User u) = property' desc $ \w -> + go w =<< knownHostLines hosts hn where desc = u ++ " does not know ssh key for " ++ hn - go [] = return NoChange - go ls = do + go w [] = return NoChange + go w ls = do f <- liftIO $ dotFile "known_hosts" user ifM (liftIO $ doesFileExist f) - ( modKnownHost user f $ f `File.lacksLines` ls + ( ensureProperty w $ modKnownHost user f $ + f `File.lacksLines` ls , return NoChange ) @@ -337,8 +340,8 @@ knownHostLines hosts hn = keylines <$> fromHost hosts hn getHostPubKey keylines (Just m) = map (\k -> hn ++ " " ++ k) (M.elems m) keylines Nothing = [] -modKnownHost :: User -> FilePath -> Property NoInfo -> Propellor Result -modKnownHost user f p = ensureProperty $ p +modKnownHost :: User -> FilePath -> Property UnixLike -> Property UnixLike +modKnownHost user f p = p `requires` File.ownerGroup f user (userGroup user) `requires` File.ownerGroup (takeDirectory f) user (userGroup user) @@ -348,30 +351,30 @@ modKnownHost user f p = ensureProperty $ p -- The ssh keys of the remote user can be set using `keysImported` -- -- Any other lines in the authorized_keys file are preserved as-is. -authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo +authorizedKeysFrom :: User -> (User, Host) -> Property UnixLike localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) = - property desc (go =<< authorizedKeyLines remoteuser remotehost) + property' desc (\w -> go w =<< authorizedKeyLines remoteuser remotehost) where remote = rn ++ "@" ++ hostName remotehost desc = ln ++ " authorized_keys from " ++ remote - go [] = do + go _ [] = do warningMessage $ "no configured ssh user keys for " ++ remote return FailedChange - go ls = ensureProperty $ combineProperties desc $ - map (authorizedKey localuser) ls + go w ls = ensureProperty w $ combineProperties desc $ toProps $ + map (setupRevertableProperty . authorizedKey localuser) ls -- | Reverts `authorizedKeysFrom` -unauthorizedKeysFrom :: User -> (User, Host) -> Property NoInfo +unauthorizedKeysFrom :: User -> (User, Host) -> Property UnixLike localuser@(User ln) `unauthorizedKeysFrom` (remoteuser@(User rn), remotehost) = - property desc (go =<< authorizedKeyLines remoteuser remotehost) + property' desc (\w -> go w =<< authorizedKeyLines remoteuser remotehost) where remote = rn ++ "@" ++ hostName remotehost desc = ln ++ " unauthorized_keys from " ++ remote - go [] = return NoChange - go ls = ensureProperty $ combineProperties desc $ - map (revert . authorizedKey localuser) ls + go _ [] = return NoChange + go w ls = ensureProperty w $ combineProperties desc $ toProps $ + map (undoRevertableProperty . authorizedKey localuser) ls authorizedKeyLines :: User -> Host -> Propellor [File.Line] authorizedKeyLines remoteuser remotehost = @@ -380,37 +383,37 @@ authorizedKeyLines remoteuser remotehost = -- | Makes a user have authorized_keys from the PrivData -- -- This removes any other lines from the file. -authorizedKeys :: IsContext c => User -> c -> Property HasInfo +authorizedKeys :: IsContext c => User -> c -> Property (HasInfo + UnixLike) authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get -> - property desc $ get $ \v -> do + property' desc $ \w -> get $ \v -> do f <- liftIO $ dotFile "authorized_keys" user - ensureProperty $ combineProperties desc - [ File.hasContentProtected f (keyFileContent (privDataLines v)) - , File.ownerGroup f user (userGroup user) - , File.ownerGroup (takeDirectory f) user (userGroup user) - ] + ensureProperty w $ combineProperties desc $ props + & File.hasContentProtected f (keyFileContent (privDataLines v)) + & File.ownerGroup f user (userGroup user) + & File.ownerGroup (takeDirectory f) user (userGroup user) where desc = u ++ " has authorized_keys" -- | Ensures that a user's authorized_keys contains a line. -- Any other lines in the file are preserved as-is. -authorizedKey :: User -> String -> RevertableProperty NoInfo +authorizedKey :: User -> String -> RevertableProperty UnixLike UnixLike authorizedKey user@(User u) l = add remove where - add = property (u ++ " has authorized_keys") $ do + add = property' (u ++ " has authorized_keys") $ \w -> do f <- liftIO $ dotFile "authorized_keys" user - modAuthorizedKey f user $ + ensureProperty w $ modAuthorizedKey f user $ f `File.containsLine` l `requires` File.dirExists (takeDirectory f) - remove = property (u ++ " lacks authorized_keys") $ do + remove = property' (u ++ " lacks authorized_keys") $ \w -> do f <- liftIO $ dotFile "authorized_keys" user ifM (liftIO $ doesFileExist f) - ( modAuthorizedKey f user $ f `File.lacksLine` l + ( ensureProperty w $ modAuthorizedKey f user $ + f `File.lacksLine` l , return NoChange ) -modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result -modAuthorizedKey f user p = ensureProperty $ p +modAuthorizedKey :: FilePath -> User -> Property UnixLike -> Property UnixLike +modAuthorizedKey f user p = p `before` File.mode f (combineModes [ownerWriteMode, ownerReadMode]) `before` File.ownerGroup f user (userGroup user) `before` File.ownerGroup (takeDirectory f) user (userGroup user) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index f42f55d7..4b3f665a 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -44,6 +44,7 @@ module Propellor.Types , module Propellor.Types.Result , module Propellor.Types.ZFS , TightenTargets(..) + , SingI ) where import Data.Monoid -- cgit v1.2.3 From 57adcf0e445ae31cf9a9db66d3a7f4793c8399a6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 18:45:49 -0400 Subject: avoid cabal warning --- propellor.cabal | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/propellor.cabal b/propellor.cabal index c8c68e48..e47bb2e6 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -36,7 +36,8 @@ Description: Executable propellor Main-Is: wrapper.hs - GHC-Options: -threaded -Wall -fno-warn-tabs -XTypeOperators + GHC-Options: -threaded -Wall -fno-warn-tabs + Extensions: TypeOperators Hs-Source-Dirs: src Build-Depends: -- propellor needs to support the ghc shipped in Debian stable @@ -47,7 +48,8 @@ Executable propellor Executable propellor-config Main-Is: config.hs - GHC-Options: -threaded -Wall -fno-warn-tabs -XTypeOperators + GHC-Options: -threaded -Wall -fno-warn-tabs + Extensions: TypeOperators Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, @@ -55,7 +57,8 @@ Executable propellor-config exceptions (>= 0.6), stm, text, unix Library - GHC-Options: -Wall -fno-warn-tabs -XTypeOperators + GHC-Options: -Wall -fno-warn-tabs + Extensions: TypeOperators Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, -- cgit v1.2.3 From 2962f5c783db7a0f7014a8745768948c15d6a8ea Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 13:50:38 -0400 Subject: fixed type checking of Ssh --- debian/changelog | 12 +++++++++ src/Propellor/Property/Ssh.hs | 61 +++++++++++++++++++++++++------------------ 2 files changed, 48 insertions(+), 25 deletions(-) diff --git a/debian/changelog b/debian/changelog index b27559bd..1bbc1f0e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -25,6 +25,18 @@ propellor (3.0.0) UNRELEASED; urgency=medium "Property Debian" - It's also possible make a property support a set of OS's, for example: "Property (Debian + FreeBSD)" + - Removed `infoProperty` and `simpleProperty` constructors, instead use + `property` to construct a Property. + - Due to the polymorphic type returned by `property`, additional type + signatures tend to be needed when using it. For example, this will + fail to type check, because the type checker cannot guess what type + you intend the intermediate property "go" to have: + foo :: Property UnixLike + foo = go `requires` bar + where + go = property "foo" (return NoChange) + To fix, specify the type of go: + go :: Property UnixLike - `ensureProperty` now needs to be passed information about the property it's used in. change this: foo = property desc $ ... ensureProperty bar diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 12c06919..dc4b7a75 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -155,18 +155,21 @@ type PubKeyText = String -- -- Any host keys that are not in the list are removed from the host. hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + DebianLike) -hostKeys ctx l = propertyList desc $ toProps $ catMaybes $ - map (\(t, pub) -> Just $ hostKey ctx t pub) l ++ [cleanup] +hostKeys ctx l = go `before` cleanup where desc = "ssh host keys configured " ++ typelist (map fst l) + go :: Property (HasInfo + DebianLike) + go = propertyList desc $ toProps $ catMaybes $ + map (\(t, pub) -> Just $ hostKey ctx t pub) l typelist tl = "(" ++ unwords (map fromKeyType tl) ++ ")" alltypes = [minBound..maxBound] staletypes = let have = map fst l in filter (`notElem` have) alltypes - removestale b = map (File.notPresent . flip keyFile b) staletypes - cleanup :: Maybe (Property DebianLike) + removestale :: Bool -> [Property DebianLike] + removestale b = map (tightenTargets . File.notPresent . flip keyFile b) staletypes + cleanup :: Property DebianLike cleanup - | null staletypes || null l = Nothing - | otherwise = Just $ + | null staletypes || null l = tightenTargets doNothing + | otherwise = combineProperties ("any other ssh host keys removed " ++ typelist staletypes) (toProps $ removestale True ++ removestale False) `onChange` restarted @@ -176,23 +179,26 @@ hostKeys ctx l = propertyList desc $ toProps $ catMaybes $ -- The public key is provided to this function; -- the private key comes from the privdata; hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property (HasInfo + DebianLike) -hostKey context keytype pub = combineProperties desc (props - & hostPubKey keytype pub - & installpub - & installpriv - ) `onChange` restarted +hostKey context keytype pub = go `onChange` restarted where + go = combineProperties desc $ props + & hostPubKey keytype pub + & installpub + & installpriv desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")" - install w writer ispub keylines = do - let f = keyFile keytype ispub - ensureProperty w $ writer f (keyFileContent keylines) keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext) ("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey") - installpub = property' desc $ \w -> install w File.hasContent True (lines pub) + installpub :: Property UnixLike + installpub = keywriter File.hasContent True (lines pub) + installpriv :: Property (HasInfo + UnixLike) installpriv = withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey -> property' desc $ \w -> getkey $ - install w File.hasContentProtected False . privDataLines - + ensureProperty w + . keywriter File.hasContentProtected False + . privDataLines + keywriter p ispub keylines = do + let f = keyFile keytype ispub + p f (keyFileContent keylines) -- Make sure that there is a newline at the end; -- ssh requires this for some types of private keys. @@ -207,7 +213,7 @@ keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ -- | Indicates the host key that is used by a Host, but does not actually -- configure the host to use it. Normally this does not need to be used; -- use 'hostKey' instead. -hostPubKey :: SshKeyType -> PubKeyText -> Property (HasInfo + DebianLike) +hostPubKey :: SshKeyType -> PubKeyText -> Property (HasInfo + UnixLike) hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText) @@ -279,13 +285,18 @@ userKeyAt dest user@(User u) context (keytype, pubkeytext) = , dest , Just $ "(" ++ fromKeyType keytype ++ ")" ] - pubkey = property' desc $ \w -> install w File.hasContent ".pub" [pubkeytext] - privkey = withPrivData (SshPrivKey keytype u) context $ \getkey -> - property' desc $ \w -> getkey $ - install w File.hasContentProtected "" . privDataLines - install w writer ext key = do + pubkey :: Property UnixLike + pubkey = property' desc $ \w -> + ensureProperty w =<< installprop File.hasContent ".pub" [pubkeytext] + privkey :: Property (HasInfo + UnixLike) + privkey = withPrivData (SshPrivKey keytype u) context privkey' + privkey' :: ((PrivData -> Propellor Result) -> Propellor Result) -> Property (HasInfo + UnixLike) + privkey' getkey = property' desc $ \w -> getkey $ \k -> + ensureProperty w + =<< installprop File.hasContentProtected "" (privDataLines k) + installprop writer ext key = do f <- liftIO $ keyfile ext - ensureProperty w $ combineProperties desc $ props + return $ combineProperties desc $ props & writer f (keyFileContent key) & File.ownerGroup f user (userGroup user) & File.ownerGroup (takeDirectory f) user (userGroup user) @@ -325,7 +336,7 @@ unknownHost hosts hn user@(User u) = property' desc $ \w -> where desc = u ++ " does not know ssh key for " ++ hn - go w [] = return NoChange + go _ [] = return NoChange go w ls = do f <- liftIO $ dotFile "known_hosts" user ifM (liftIO $ doesFileExist f) -- cgit v1.2.3 From 3218e344d117701066ced6c13927318ea2938ad4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 14:28:38 -0400 Subject: more porting --- src/Propellor/Property/DebianMirror.hs | 20 +++++++++---------- src/Propellor/Property/Dns.hs | 35 ++++++++++++++++++---------------- src/Propellor/Property/DnsSec.hs | 12 +++++++----- src/Propellor/Property/Fail2Ban.hs | 8 ++++---- src/Propellor/Property/File.hs | 10 +++++----- src/Propellor/Property/Firewall.hs | 4 ++-- src/Propellor/Property/FreeBSD/Pkg.hs | 17 ++++++++++------- src/Propellor/Property/Git.hs | 23 +++++++++++----------- src/Propellor/Property/Grub.hs | 32 +++++++++++++++---------------- src/Propellor/Property/Network.hs | 1 - src/Propellor/Property/Parted.hs | 17 ++++++++--------- src/Propellor/Property/Partition.hs | 11 ++++++----- src/Propellor/Property/Rsync.hs | 6 +++--- 13 files changed, 101 insertions(+), 95 deletions(-) diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs index eea7b96f..b86d8e0b 100644 --- a/src/Propellor/Property/DebianMirror.hs +++ b/src/Propellor/Property/DebianMirror.hs @@ -119,19 +119,17 @@ debianMirrorKeyring k m = m { _debianMirrorKeyring = k } debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror debianMirrorRsyncExtra r m = m { _debianMirrorRsyncExtra = r } -mirror :: DebianMirror -> Property NoInfo -mirror mirror' = propertyList - ("Debian mirror " ++ dir) - [ Apt.installed ["debmirror"] - , User.accountFor (User "debmirror") - , File.dirExists dir - , File.ownerGroup dir (User "debmirror") (Group "debmirror") - , check (not . and <$> mapM suitemirrored suites) +mirror :: DebianMirror -> Property DebianLike +mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props + & Apt.installed ["debmirror"] + & User.accountFor (User "debmirror") + & File.dirExists dir + & File.ownerGroup dir (User "debmirror") (Group "debmirror") + & check (not . and <$> mapM suitemirrored suites) (cmdProperty "debmirror" args) `describe` "debmirror setup" - , Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/" $ - unwords ("/usr/bin/debmirror" : args) - ] + & Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/" + (unwords ("/usr/bin/debmirror" : args)) where dir = _debianMirrorDir mirror' suites = _debianMirrorSuites mirror' diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index adc12930..a660a016 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -60,7 +60,7 @@ import Data.List -- -- In either case, the secondary dns server Host should have an ipv4 and/or -- ipv6 property defined. -primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty HasInfo +primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike primary hosts domain soa rs = setup cleanup where setup = setupPrimary zonefile id hosts domain soa rs @@ -70,7 +70,7 @@ primary hosts domain soa rs = setup cleanup zonefile = "/etc/bind/propellor/db." ++ domain -setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property HasInfo +setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property (HasInfo + DebianLike) setupPrimary zonefile mknamedconffile hosts domain soa rs = withwarnings baseprop `requires` servingZones @@ -80,9 +80,10 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs = indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap (partialzone, zonewarnings) = genZone indomain hostmap domain soa - baseprop = infoProperty ("dns primary for " ++ domain) satisfy - (mempty `addInfo` addNamedConf conf) [] - satisfy = do + baseprop = primaryprop + `addInfoProperty` (toInfo (addNamedConf conf)) + primaryprop :: Property DebianLike + primaryprop = property ("dns primary for " ++ domain) $ do sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap) let zone = partialzone { zHosts = zHosts partialzone ++ rs ++ sshfps } @@ -120,11 +121,13 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs = in z /= oldzone || oldserial < sSerial (zSOA zone) -cleanupPrimary :: FilePath -> Domain -> Property NoInfo +cleanupPrimary :: FilePath -> Domain -> Property DebianLike cleanupPrimary zonefile domain = check (doesFileExist zonefile) $ - property ("removed dns primary for " ++ domain) - (makeChange $ removeZoneFile zonefile) - `requires` namedConfWritten + go `requires` namedConfWritten + where + desc = "removed dns primary for " ++ domain + go :: Property DebianLike + go = property desc (makeChange $ removeZoneFile zonefile) -- | Primary dns server for a domain, secured with DNSSEC. -- @@ -152,7 +155,7 @@ cleanupPrimary zonefile domain = check (doesFileExist zonefile) $ -- This is different from the serial number used by 'primary', so if you -- want to later disable DNSSEC you will need to adjust the serial number -- passed to mkSOA to ensure it is larger. -signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty HasInfo +signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike signedPrimary recurrance hosts domain soa rs = setup cleanup where setup = combineProperties ("dns primary for " ++ domain ++ " (signed)") @@ -184,12 +187,12 @@ signedPrimary recurrance hosts domain soa rs = setup cleanup -- -- Note that if a host is declared to be a primary and a secondary dns -- server for the same domain, the primary server config always wins. -secondary :: [Host] -> Domain -> RevertableProperty HasInfo +secondary :: [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain -- | This variant is useful if the primary server does not have its DNS -- configured via propellor. -secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty HasInfo +secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike secondaryFor masters hosts domain = setup cleanup where setup = pureInfoProperty desc (addNamedConf conf) @@ -218,15 +221,15 @@ otherServers wantedtype hosts domain = -- | Rewrites the whole named.conf.local file to serve the zones -- configured by `primary` and `secondary`, and ensures that bind9 is -- running. -servingZones :: Property NoInfo +servingZones :: Property DebianLike servingZones = namedConfWritten `onChange` Service.reloaded "bind9" `requires` Apt.serviceInstalledRunning "bind9" -namedConfWritten :: Property NoInfo -namedConfWritten = property "named.conf configured" $ do +namedConfWritten :: Property DebianLike +namedConfWritten = property' "named.conf configured" $ \w -> do zs <- getNamedConf - ensureProperty $ + ensureProperty w $ hasContent namedConfFile $ concatMap confStanza $ M.elems zs diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs index 1ba459e6..aa58dc60 100644 --- a/src/Propellor/Property/DnsSec.hs +++ b/src/Propellor/Property/DnsSec.hs @@ -7,13 +7,13 @@ import qualified Propellor.Property.File as File -- -- signedPrimary uses this, so this property does not normally need to be -- used directly. -keysInstalled :: Domain -> RevertableProperty HasInfo +keysInstalled :: Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike keysInstalled domain = setup cleanup where - setup = propertyList "DNSSEC keys installed" $ + setup = propertyList "DNSSEC keys installed" $ toProps $ map installkey keys - cleanup = propertyList "DNSSEC keys removed" $ + cleanup = propertyList "DNSSEC keys removed" $ toProps $ map (File.notPresent . keyFn domain) keys installkey k = writer (keysrc k) (keyFn domain k) (Context domain) @@ -37,12 +37,14 @@ keysInstalled domain = setup cleanup -- -- signedPrimary uses this, so this property does not normally need to be -- used directly. -zoneSigned :: Domain -> FilePath -> RevertableProperty HasInfo +zoneSigned :: Domain -> FilePath -> RevertableProperty (HasInfo + UnixLike) UnixLike zoneSigned domain zonefile = setup cleanup where + setup :: Property (HasInfo + UnixLike) setup = check needupdate (forceZoneSigned domain zonefile) `requires` keysInstalled domain + cleanup :: Property UnixLike cleanup = File.notPresent (signedZoneFile zonefile) `before` File.notPresent dssetfile `before` revert (keysInstalled domain) @@ -63,7 +65,7 @@ zoneSigned domain zonefile = setup cleanup t2 <- getModificationTime f return (t2 >= t1) -forceZoneSigned :: Domain -> FilePath -> Property NoInfo +forceZoneSigned :: Domain -> FilePath -> Property UnixLike forceZoneSigned domain zonefile = property ("zone signed for " ++ domain) $ liftIO $ do salt <- take 16 <$> saltSha1 let p = proc "dnssec-signzone" diff --git a/src/Propellor/Property/Fail2Ban.hs b/src/Propellor/Property/Fail2Ban.hs index 716d376f..9f147943 100644 --- a/src/Propellor/Property/Fail2Ban.hs +++ b/src/Propellor/Property/Fail2Ban.hs @@ -5,24 +5,24 @@ import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service import Propellor.Property.ConfFile -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.serviceInstalledRunning "fail2ban" -reloaded :: Property NoInfo +reloaded :: Property DebianLike reloaded = Service.reloaded "fail2ban" type Jail = String -- | By default, fail2ban only enables the ssh jail, but many others -- are available to be enabled, for example "postfix-sasl" -jailEnabled :: Jail -> Property NoInfo +jailEnabled :: Jail -> Property DebianLike jailEnabled name = jailConfigured name "enabled" "true" `onChange` reloaded -- | Configures a jail. For example: -- -- > jailConfigured "sshd" "port" "2222" -jailConfigured :: Jail -> IniKey -> String -> Property NoInfo +jailConfigured :: Jail -> IniKey -> String -> Property UnixLike jailConfigured name key value = jailConfFile name `containsIniSetting` (name, key, value) diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 2a74b5ed..e072fcaa 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -25,25 +25,25 @@ f `hasContentProtected` newcontent = fileProperty' writeFileProtected -- -- The file's permissions are preserved if the file already existed. -- Otherwise, they're set to 600. -hasPrivContent :: IsContext c => FilePath -> c -> Property HasInfo +hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike) hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f -- | Like hasPrivContent, but allows specifying a source -- for PrivData, rather than using PrivDataSourceFile . -hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property HasInfo +hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike) hasPrivContentFrom = hasPrivContent' writeFileProtected -- | Leaves the file at its default or current mode, -- allowing "private" data to be read. -- -- Use with caution! -hasPrivContentExposed :: IsContext c => FilePath -> c -> Property HasInfo +hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike) hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f -hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property HasInfo +hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike) hasPrivContentExposedFrom = hasPrivContent' writeFile -hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property HasInfo +hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike) hasPrivContent' writer source f context = withPrivData source context $ \getcontent -> property' desc $ \o -> getcontent $ \privcontent -> diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index fa1f95d4..ce0befcd 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -26,10 +26,10 @@ import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["iptables"] -rule :: Chain -> Table -> Target -> Rules -> Property NoInfo +rule :: Chain -> Table -> Target -> Rules -> Property Linux rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable where r = Rule c tb tg rs diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs index 6bbd2570..6c775b94 100644 --- a/src/Propellor/Property/FreeBSD/Pkg.hs +++ b/src/Propellor/Property/FreeBSD/Pkg.hs @@ -22,8 +22,8 @@ runPkg cmd args = in lines <$> readProcess p a -pkgCmdProperty :: String -> [String] -> UncheckedProperty NoInfo -pkgCmdProperty cmd args = +pkgCmdProperty :: String -> [String] -> UncheckedProperty FreeBSD +pkgCmdProperty cmd args = tightenTargets $ let (p, a) = pkgCommand cmd args in @@ -44,13 +44,14 @@ instance IsInfo PkgUpdate where pkgUpdated :: PkgUpdate -> Bool pkgUpdated (PkgUpdate _) = True -update :: Property HasInfo +update :: Property (HasInfo + FreeBSD) update = let upd = pkgCmd "update" [] go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange)) in - infoProperty "pkg update has run" go (addInfo mempty (PkgUpdate "")) [] + (property "pkg update has run" go :: Property FreeBSD) + `addInfoProperty` (toInfo (PkgUpdate "")) newtype PkgUpgrade = PkgUpgrade String deriving (Typeable, Monoid, Show) @@ -60,17 +61,19 @@ instance IsInfo PkgUpgrade where pkgUpgraded :: PkgUpgrade -> Bool pkgUpgraded (PkgUpgrade _) = True -upgrade :: Property HasInfo +upgrade :: Property (HasInfo + FreeBSD) upgrade = let upd = pkgCmd "upgrade" [] go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange)) in - infoProperty "pkg upgrade has run" go (addInfo mempty (PkgUpgrade "")) [] `requires` update + (property "pkg upgrade has run" go :: Property FreeBSD) + `addInfoProperty` (toInfo (PkgUpdate "")) + `requires` update type Package = String -installed :: Package -> Property NoInfo +installed :: Package -> Property FreeBSD installed pkg = check (isInstallable pkg) $ pkgCmdProperty "install" [pkg] isInstallable :: Package -> IO Bool diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs index a5ef5ab1..5d7c8b4d 100644 --- a/src/Propellor/Property/Git.hs +++ b/src/Propellor/Property/Git.hs @@ -11,7 +11,7 @@ import Data.List -- using git-daemon, run from inetd. -- -- Note that reverting this property does not remove or stop inetd. -daemonRunning :: FilePath -> RevertableProperty NoInfo +daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike daemonRunning exportdir = setup unsetup where setup = containsLine conf (mkl "tcp4") @@ -47,7 +47,7 @@ daemonRunning exportdir = setup unsetup , exportdir ] -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["git"] type RepoUrl = String @@ -61,8 +61,8 @@ type Branch = String -- it will be recursively deleted first. -- -- A branch can be specified, to check out. -cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo -cloned owner url dir mbranch = check originurl (property desc checkout) +cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike +cloned owner url dir mbranch = check originurl go `requires` installed where desc = "git cloned " ++ url ++ " to " ++ dir @@ -74,12 +74,13 @@ cloned owner url dir mbranch = check originurl (property desc checkout) return (v /= Just url) , return True ) - checkout = do + go :: Property DebianLike + go = property' desc $ \w -> do liftIO $ do whenM (doesDirectoryExist dir) $ removeDirectoryRecursive dir createDirectoryIfMissing True (takeDirectory dir) - ensureProperty $ userScriptProperty owner (catMaybes checkoutcmds) + ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds) `assume` MadeChange checkoutcmds = -- The catchMaybeIO (readProcess "git" ["rev-parse", "--re data GitShared = Shared Group | SharedAll | NotShared -bareRepo :: FilePath -> User -> GitShared -> Property NoInfo -bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ +bareRepo :: FilePath -> User -> GitShared -> Property UnixLike +bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ toProps $ dirExists repo : case gitshared of NotShared -> [ ownerGroup repo user (userGroup user) @@ -121,7 +122,7 @@ bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo']) -- | Set a key value pair in a git repo's configuration. -repoConfigured :: FilePath -> (String, String) -> Property NoInfo +repoConfigured :: FilePath -> (String, String) -> Property UnixLike repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $ userScriptProperty (User "root") [ "cd " ++ repo @@ -141,7 +142,7 @@ getRepoConfig repo key = catchDefaultIO [] $ lines <$> readProcess "git" ["-C", repo, "config", key] -- | Whether a repo accepts non-fast-forward pushes. -repoAcceptsNonFFs :: FilePath -> RevertableProperty NoInfo +repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike repoAcceptsNonFFs repo = accepts refuses where accepts = repoConfigured repo ("receive.denyNonFastForwards", "false") @@ -152,7 +153,7 @@ repoAcceptsNonFFs repo = accepts refuses -- | Sets a bare repository's default branch, which will be checked out -- when cloning it. -bareRepoDefaultBranch :: FilePath -> String -> Property NoInfo +bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike bareRepoDefaultBranch repo branch = userScriptProperty (User "root") [ "cd " ++ repo diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs index 1b7f2a0a..09255587 100644 --- a/src/Propellor/Property/Grub.hs +++ b/src/Propellor/Property/Grub.hs @@ -19,17 +19,17 @@ data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen -- bootloader. -- -- This includes running update-grub. -installed :: BIOS -> Property NoInfo +installed :: BIOS -> Property DebianLike installed bios = installed' bios `onChange` mkConfig -- Run update-grub, to generate the grub boot menu. It will be -- automatically updated when kernel packages are installed. -mkConfig :: Property NoInfo -mkConfig = cmdProperty "update-grub" [] +mkConfig :: Property DebianLike +mkConfig = tightenTargets $ cmdProperty "update-grub" [] `assume` MadeChange -- | Installs grub; does not run update-grub. -installed' :: BIOS -> Property NoInfo +installed' :: BIOS -> Property DebianLike installed' bios = Apt.installed [pkg] `describe` "grub package installed" where pkg = case bios of @@ -48,8 +48,8 @@ installed' bios = Apt.installed [pkg] `describe` "grub package installed" -- on the device; it always does the work to reinstall it. It's a good idea -- to arrange for this property to only run once, by eg making it be run -- onChange after OS.cleanInstallOnce. -boots :: OSDevice -> Property NoInfo -boots dev = cmdProperty "grub-install" [dev] +boots :: OSDevice -> Property Linux +boots dev = tightenTargets $ cmdProperty "grub-install" [dev] `assume` MadeChange `describe` ("grub boots " ++ dev) @@ -61,10 +61,10 @@ boots dev = cmdProperty "grub-install" [dev] -- -- The rootdev should be in the form "hd0", while the bootdev is in the form -- "xen/xvda". -chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property NoInfo -chainPVGrub rootdev bootdev timeout = combineProperties desc - [ File.dirExists "/boot/grub" - , "/boot/grub/menu.lst" `File.hasContent` +chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property DebianLike +chainPVGrub rootdev bootdev timeout = combineProperties desc $ props + & File.dirExists "/boot/grub" + & "/boot/grub/menu.lst" `File.hasContent` [ "default 1" , "timeout " ++ show timeout , "" @@ -73,12 +73,12 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc , "kernel /boot/xen-shim" , "boot" ] - , "/boot/load.cf" `File.hasContent` + & "/boot/load.cf" `File.hasContent` [ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ] - , installed Xen - , flip flagFile "/boot/xen-shim" $ scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"] - `assume` MadeChange - `describe` "/boot-xen-shim" - ] + & installed Xen + & flip flagFile "/boot/xen-shim" xenshim where desc = "chain PV-grub" + xenshim = scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"] + `assume` MadeChange + `describe` "/boot-xen-shim" diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs index 46f5cef3..9ed9e591 100644 --- a/src/Propellor/Property/Network.hs +++ b/src/Propellor/Property/Network.hs @@ -2,7 +2,6 @@ module Propellor.Property.Network where import Propellor.Base import Propellor.Property.File -import Propellor.Types.MetaTypes import Data.Char diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index 5d6afa9c..bc8a256d 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -153,18 +153,17 @@ data Eep = YesReallyDeleteDiskContents -- The FilePath can be a block device (eg, \/dev\/sda), or a disk image file. -- -- This deletes any existing partitions in the disk! Use with EXTREME caution! -partitioned :: Eep -> FilePath -> PartTable -> Property NoInfo -partitioned eep disk (PartTable tabletype parts) = property desc $ do +partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike +partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do isdev <- liftIO $ isBlockDevice <$> getFileStatus disk - ensureProperty $ combineProperties desc - [ parted eep disk partedparams - , if isdev + ensureProperty w $ combineProperties desc $ props + & parted eep disk partedparams + & if isdev then formatl (map (\n -> disk ++ show n) [1 :: Int ..]) else Partition.kpartx disk (formatl . map Partition.partitionLoopDev) - ] where desc = disk ++ " partitioned" - formatl devs = combineProperties desc (map format (zip parts devs)) + formatl devs = combineProperties desc (toProps $ map format (zip parts devs)) partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts [] format (p, dev) = Partition.formatted' (partMkFsOpts p) Partition.YesReallyFormatPartition (partFs p) dev @@ -193,12 +192,12 @@ partitioned eep disk (PartTable tabletype parts) = property desc $ do -- -- Parted is run in script mode, so it will never prompt for input. -- It is asked to use cylinder alignment for the disk. -parted :: Eep -> FilePath -> [String] -> Property NoInfo +parted :: Eep -> FilePath -> [String] -> Property DebianLike parted YesReallyDeleteDiskContents disk ps = p `requires` installed where p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps) `assume` MadeChange -- | Gets parted installed. -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["parted"] diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs index b2f50339..5aff4ba4 100644 --- a/src/Propellor/Property/Partition.hs +++ b/src/Propellor/Property/Partition.hs @@ -16,7 +16,7 @@ data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | Linu data Eep = YesReallyFormatPartition -- | Formats a partition. -formatted :: Eep -> Fs -> FilePath -> Property NoInfo +formatted :: Eep -> Fs -> FilePath -> Property DebianLike formatted = formatted' [] -- | Options passed to a mkfs.* command when making a filesystem. @@ -24,7 +24,7 @@ formatted = formatted' [] -- Eg, ["-m0"] type MkfsOpts = [String] -formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property NoInfo +formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property DebianLike formatted' opts YesReallyFormatPartition fs dev = cmdProperty cmd opts' `assume` MadeChange `requires` Apt.installed [pkg] @@ -64,17 +64,18 @@ isLoopDev' f -- within a disk image file. The resulting loop devices are passed to the -- property, which can operate on them. Always cleans up after itself, -- by removing the device maps after the property is run. -kpartx :: FilePath -> ([LoopDev] -> Property NoInfo) -> Property NoInfo +kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"] where - go = property (propertyDesc (mkprop [])) $ do + go :: Property DebianLike + go = property' (propertyDesc (mkprop [])) $ \w -> do cleanup -- idempotency loopdevs <- liftIO $ kpartxParse <$> readProcess "kpartx" ["-avs", diskimage] bad <- liftIO $ filterM (not <$$> isLoopDev) loopdevs unless (null bad) $ error $ "kpartx output seems to include non-loop-devices (possible parse failure): " ++ show bad - r <- ensureProperty (mkprop loopdevs) + r <- ensureProperty w (mkprop loopdevs) cleanup return r cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage] diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs index 0c77df58..b40396de 100644 --- a/src/Propellor/Property/Rsync.hs +++ b/src/Propellor/Property/Rsync.hs @@ -16,7 +16,7 @@ filesUnder d = Pattern (d ++ "/*") -- | Ensures that the Dest directory exists and has identical contents as -- the Src directory. -syncDir :: Src -> Dest -> Property NoInfo +syncDir :: Src -> Dest -> Property DebianLike syncDir = syncDirFiltered [] data Filter @@ -43,7 +43,7 @@ newtype Pattern = Pattern String -- Rsync checks each name to be transferred against its list of Filter -- rules, and the first matching one is acted on. If no matching rule -- is found, the file is processed. -syncDirFiltered :: [Filter] -> Src -> Dest -> Property NoInfo +syncDirFiltered :: [Filter] -> Src -> Dest -> Property DebianLike syncDirFiltered filters src dest = rsync $ [ "-av" -- Add trailing '/' to get rsync to sync the Dest directory, @@ -56,7 +56,7 @@ syncDirFiltered filters src dest = rsync $ , "--quiet" ] ++ map toRsync filters -rsync :: [String] -> Property NoInfo +rsync :: [String] -> Property DebianLike rsync ps = cmdProperty "rsync" ps `assume` MadeChange `requires` Apt.installed ["rsync"] -- cgit v1.2.3 From 551a7ec8bd7486ea599271c99236ceffa1743e5a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 14:48:24 -0400 Subject: more porting --- src/Propellor/Property/Gpg.hs | 5 +++-- src/Propellor/Property/Group.hs | 2 +- src/Propellor/Property/Kerberos.hs | 29 +++++++++++++++-------------- src/Propellor/Property/LightDM.hs | 6 ++---- src/Propellor/Property/Locale.hs | 38 +++++++++++++++++++++----------------- src/Propellor/Property/Logcheck.hs | 4 ++-- src/Propellor/Property/Nginx.hs | 14 +++++++------- src/Propellor/Property/Obnam.hs | 17 +++++++++-------- 8 files changed, 60 insertions(+), 55 deletions(-) diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs index bd710ca7..74e9df5a 100644 --- a/src/Propellor/Property/Gpg.hs +++ b/src/Propellor/Property/Gpg.hs @@ -6,7 +6,7 @@ import Utility.FileSystemEncoding import System.PosixCompat -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["gnupg"] -- A numeric id, or a description of the key, in a form understood by gpg. @@ -22,11 +22,12 @@ data GpgKeyType = GpgPubKey | GpgPrivKey -- -- Recommend only using this for low-value dedicated role keys. -- No attempt has been made to scrub the key out of memory once it's used. -keyImported :: GpgKeyId -> User -> Property HasInfo +keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike) keyImported key@(GpgKeyId keyid) user@(User u) = prop `requires` installed where desc = u ++ " has gpg key " ++ show keyid + prop :: Property (HasInfo + DebianLike) prop = withPrivData src (Context keyid) $ \getkey -> property desc $ getkey $ \key' -> do let keylines = privDataLines key' diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs index f91ef1c2..58e49a86 100644 --- a/src/Propellor/Property/Group.hs +++ b/src/Propellor/Property/Group.hs @@ -4,7 +4,7 @@ import Propellor.Base type GID = Int -exists :: Group -> Maybe GID -> Property NoInfo +exists :: Group -> Maybe GID -> Property UnixLike exists (Group group') mgid = check test (cmdProperty "addgroup" (args mgid)) `describe` unwords ["group", group'] where diff --git a/src/Propellor/Property/Kerberos.hs b/src/Propellor/Property/Kerberos.hs index cb6e06cc..3c351943 100644 --- a/src/Propellor/Property/Kerberos.hs +++ b/src/Propellor/Property/Kerberos.hs @@ -34,25 +34,25 @@ keyTabPath = maybe defaultKeyTab id principal :: String -> Maybe String -> Maybe Realm -> Principal principal p i r = p ++ maybe "" ("/"++) i ++ maybe "" ("@" ++) r -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["krb5-user"] -kdcInstalled :: Property NoInfo +kdcInstalled :: Property DebianLike kdcInstalled = Apt.serviceInstalledRunning "krb5-kdc" -adminServerInstalled :: Property NoInfo +adminServerInstalled :: Property DebianLike adminServerInstalled = Apt.serviceInstalledRunning "krb5-admin-server" -kpropServerInstalled :: Property HasInfo +kpropServerInstalled :: Property DebianLike kpropServerInstalled = propertyList "kprop server installed" $ props & kdcInstalled & Apt.installed ["openbsd-inetd"] & "/etc/inetd.conf" `File.containsLines` - [ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd" - , "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd" - ] + [ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd" + , "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd" + ] -kpropAcls :: [String] -> Property NoInfo +kpropAcls :: [String] -> Property UnixLike kpropAcls ps = kpropdAclPath `File.hasContent` ps `describe` "kprop server ACLs" k5srvutil :: (Maybe FilePath) -> [String] -> IO String @@ -82,13 +82,14 @@ k5loginPath user = do h <- homedir user return $ h ".k5login" -k5login :: User -> [Principal] -> Property NoInfo -k5login user@(User u) ps = property (u ++ " has k5login") $ do +k5login :: User -> [Principal] -> Property UnixLike +k5login user@(User u) ps = property' desc $ \w -> do f <- liftIO $ k5loginPath user liftIO $ do createDirectoryIfMissing True (takeDirectory f) writeFile f (unlines ps) - ensureProperties - [ File.ownerGroup f user (userGroup user) - , File.ownerGroup (takeDirectory f) user (userGroup user) - ] + ensureProperty w $ combineProperties desc $ props + & File.ownerGroup f user (userGroup user) + & File.ownerGroup (takeDirectory f) user (userGroup user) + where + desc = u ++ " has k5login" diff --git a/src/Propellor/Property/LightDM.hs b/src/Propellor/Property/LightDM.hs index 75e3b19a..339fa9a3 100644 --- a/src/Propellor/Property/LightDM.hs +++ b/src/Propellor/Property/LightDM.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} - -- | Maintainer: Sean Whitton module Propellor.Property.LightDM where @@ -8,11 +6,11 @@ import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.ConfFile as ConfFile -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["lightdm"] -- | Configures LightDM to skip the login screen and autologin as a user. -autoLogin :: User -> Property NoInfo +autoLogin :: User -> Property UnixLike autoLogin (User u) = "/etc/lightdm/lightdm.conf" `ConfFile.containsIniSetting` ("SeatDefaults", "autologin-user", u) `describe` "lightdm autologin" diff --git a/src/Propellor/Property/Locale.hs b/src/Propellor/Property/Locale.hs index 06cd63ad..b7cf242c 100644 --- a/src/Propellor/Property/Locale.hs +++ b/src/Propellor/Property/Locale.hs @@ -21,14 +21,17 @@ type LocaleVariable = String -- -- Note that reverting this property does not make a locale unavailable. That's -- because it might be required for other Locale.selectedFor statements. -selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty NoInfo +selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty DebianLike DebianLike locale `selectedFor` vars = select deselect where - select = check (not <$> isselected) (cmdProperty "update-locale" selectArgs) - `requires` available locale - `describe` (locale ++ " locale selected") - deselect = check isselected (cmdProperty "update-locale" vars) - `describe` (locale ++ " locale deselected") + select = tightenTargets $ + check (not <$> isselected) + (cmdProperty "update-locale" selectArgs) + `requires` available locale + `describe` (locale ++ " locale selected") + deselect = tightenTargets $ + check isselected (cmdProperty "update-locale" vars) + `describe` (locale ++ " locale deselected") selectArgs = zipWith (++) vars (repeat ('=':locale)) isselected = locale `isSelectedFor` vars @@ -46,20 +49,21 @@ locale `isSelectedFor` vars = do -- -- Per Debian bug #684134 we cannot ensure a locale is generated by means of -- Apt.reConfigure. So localeAvailable edits /etc/locale.gen manually. -available :: Locale -> RevertableProperty NoInfo -available locale = (ensureAvailable ensureUnavailable) +available :: Locale -> RevertableProperty DebianLike DebianLike +available locale = ensureAvailable ensureUnavailable where f = "/etc/locale.gen" desc = (locale ++ " locale generated") - ensureAvailable = - property desc $ (lines <$> (liftIO $ readFile f)) - >>= \locales -> - if locale `presentIn` locales - then ensureProperty $ - fileProperty desc (foldr uncomment []) f - `onChange` regenerate - else return FailedChange -- locale unavailable for generation - ensureUnavailable = + ensureAvailable :: Property DebianLike + ensureAvailable = property' desc $ \w -> do + locales <- lines <$> (liftIO $ readFile f) + if locale `presentIn` locales + then ensureProperty w $ + fileProperty desc (foldr uncomment []) f + `onChange` regenerate + else return FailedChange -- locale unavailable for generation + ensureUnavailable :: Property DebianLike + ensureUnavailable = tightenTargets $ fileProperty (locale ++ " locale not generated") (foldr comment []) f `onChange` regenerate diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs index 22621cc2..ced9fce2 100644 --- a/src/Propellor/Property/Logcheck.hs +++ b/src/Propellor/Property/Logcheck.hs @@ -28,9 +28,9 @@ defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ " ignoreFilePath :: ReportLevel -> Service -> FilePath ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) n -ignoreLines :: ReportLevel -> Service -> [String] -> Property NoInfo +ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")") -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["logcheck"] diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs index 8fb5c49b..e40ba657 100644 --- a/src/Propellor/Property/Nginx.hs +++ b/src/Propellor/Property/Nginx.hs @@ -9,7 +9,7 @@ import qualified Propellor.Property.Service as Service type ConfigFile = [String] -siteEnabled :: HostName -> ConfigFile -> RevertableProperty NoInfo +siteEnabled :: HostName -> ConfigFile -> RevertableProperty DebianLike DebianLike siteEnabled hn cf = enable disable where enable = siteVal hn `File.isSymlinkedTo` siteValRelativeCfg hn @@ -22,11 +22,11 @@ siteEnabled hn cf = enable disable `requires` installed `onChange` reloaded -siteAvailable :: HostName -> ConfigFile -> Property NoInfo -siteAvailable hn cf = ("nginx site available " ++ hn) ==> - siteCfg hn `File.hasContent` (comment : cf) +siteAvailable :: HostName -> ConfigFile -> Property DebianLike +siteAvailable hn cf = "nginx site available " ++ hn ==> tightenTargets go where comment = "# deployed with propellor, do not modify" + go = siteCfg hn `File.hasContent` (comment : cf) siteCfg :: HostName -> FilePath siteCfg hn = "/etc/nginx/sites-available/" ++ hn @@ -37,11 +37,11 @@ siteVal hn = "/etc/nginx/sites-enabled/" ++ hn siteValRelativeCfg :: HostName -> File.LinkTarget siteValRelativeCfg hn = File.LinkTarget ("../sites-available/" ++ hn) -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["nginx"] -restarted :: Property NoInfo +restarted :: Property DebianLike restarted = Service.restarted "nginx" -reloaded :: Property NoInfo +reloaded :: Property DebianLike reloaded = Service.reloaded "nginx" diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index 666328ac..6d6f4a7f 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -40,7 +40,7 @@ data NumClients = OnlyClient | MultipleClients -- Since obnam uses a fair amount of system resources, only one obnam -- backup job will be run at a time. Other jobs will wait their turns to -- run. -backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo +backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike backup dir crontimes params numclients = backup' dir crontimes params numclients `requires` restored dir params @@ -50,7 +50,7 @@ backup dir crontimes params numclients = -- -- The gpg secret key will be automatically imported -- into root's keyring using Propellor.Property.Gpg.keyImported -backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property HasInfo +backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property (HasInfo + DebianLike) backupEncrypted dir crontimes params numclients keyid = backup dir crontimes params' numclients `requires` Gpg.keyImported keyid (User "root") @@ -58,7 +58,7 @@ backupEncrypted dir crontimes params numclients keyid = params' = ("--encrypt-with=" ++ Gpg.getGpgKeyId keyid) : params -- | Does a backup, but does not automatically restore. -backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo +backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike backup' dir crontimes params numclients = cronjob `describe` desc where desc = dir ++ " backed up by obnam" @@ -96,11 +96,12 @@ backup' dir crontimes params numclients = cronjob `describe` desc -- -- The restore is performed atomically; restoring to a temp directory -- and then moving it to the directory. -restored :: FilePath -> [ObnamParam] -> Property NoInfo -restored dir params = property (dir ++ " restored by obnam") go - `requires` installed +restored :: FilePath -> [ObnamParam] -> Property DebianLike +restored dir params = go `requires` installed where - go = ifM (liftIO needsRestore) + desc = dir ++ " restored by obnam" + go :: Property DebianLike + go = property desc $ ifM (liftIO needsRestore) ( do warningMessage $ dir ++ " is empty/missing; restoring from backup ..." liftIO restore @@ -152,5 +153,5 @@ keepParam ps = "--keep=" ++ intercalate "," (map go ps) isKeepParam :: ObnamParam -> Bool isKeepParam p = "--keep=" `isPrefixOf` p -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["obnam"] -- cgit v1.2.3 From 341064ea8cfaeb04ec4129239edc096a314de036 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 15:03:56 -0400 Subject: more porting --- debian/changelog | 8 ++++---- src/Propellor/Property/OS.hs | 43 +++++++++++++++++++++++++--------------- src/Propellor/Property/OpenId.hs | 6 +++--- src/Propellor/Property/Reboot.hs | 6 +++--- 4 files changed, 37 insertions(+), 26 deletions(-) diff --git a/debian/changelog b/debian/changelog index 1bbc1f0e..562eccd7 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,11 +5,11 @@ propellor (3.0.0) UNRELEASED; urgency=medium Transition guide for this sweeping API change: - Change "host name & foo & bar" to "host name $ props & foo & bar" - - Similarly, Chroot and Docker need `props` to be used to combine + - Similarly, `propertyList` and `combineProperties` need `props` + to be used to combine together properties; they no longer accept + lists of properties. (If you have such a list, use `toProps`.) + - And similarly, Chroot and Docker need `props` to be used to combine together the properies used inside them. - - And similarly, `propertyList` and `combineProperties` need `props` - to be used to combine together properties; lists of properties will - no longer work. - Change "Property NoInfo" to "Property UnixLike" - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" - Change "RevertableProperty NoInfo" to diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index e5da0921..42504453 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -64,7 +64,7 @@ import Control.Exception (throw) -- > & User.accountFor "joey" -- > & User.hasSomePassword "joey" -- > -- rest of system properties here -cleanInstallOnce :: Confirmation -> Property NoInfo +cleanInstallOnce :: Confirmation -> Property Linux cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ go `requires` confirmed "clean install confirmed" confirmation where @@ -83,12 +83,16 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ `requires` osbootstrapped - osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of - (Just d@(System (Debian _) _)) -> debootstrap d - (Just u@(System (Buntish _) _)) -> debootstrap u + osbootstrapped :: Property Linux + osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \w o -> case o of + (Just d@(System (Debian _) _)) -> ensureProperty w $ + debootstrap d + (Just u@(System (Buntish _) _)) -> ensureProperty w $ + debootstrap u _ -> unsupportedOS - debootstrap targetos = ensureProperty $ + debootstrap :: System -> Property Linux + debootstrap targetos = -- Ignore the os setting, and install debootstrap from -- source, since we don't know what OS we're running in yet. Debootstrap.built' Debootstrap.sourceInstall @@ -100,6 +104,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ -- sync instead? -- This is the fun bit. + flipped :: Property Linux flipped = property (newOSDir ++ " moved into place") $ liftIO $ do -- First, unmount most mount points, lazily, so -- they don't interfere with moving things around. @@ -137,6 +142,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ return MadeChange + propellorbootstrapped :: Property UnixLike propellorbootstrapped = property "propellor re-debootstrapped in new os" $ return NoChange -- re-bootstrap propellor in /usr/local/propellor, @@ -145,6 +151,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ -- be present in /old-os's /usr/local/propellor) -- TODO + finalized :: Property UnixLike finalized = property "clean OS installed" $ do liftIO $ writeFile flagfile "" return MadeChange @@ -179,7 +186,7 @@ massRename = go [] data Confirmation = Confirmed HostName -confirmed :: Desc -> Confirmation -> Property NoInfo +confirmed :: Desc -> Confirmation -> Property UnixLike confirmed desc (Confirmed c) = property desc $ do hostname <- asks hostName if hostname /= c @@ -191,25 +198,26 @@ confirmed desc (Confirmed c) = property desc $ do -- | is configured to bring up the network -- interface that currently has a default route configured, using -- the same (static) IP address. -preserveNetwork :: Property NoInfo +preserveNetwork :: Property DebianLike preserveNetwork = go `requires` Network.cleanInterfacesFile where - go = property "preserve network configuration" $ do + go :: Property DebianLike + go = property' "preserve network configuration" $ \w -> do ls <- liftIO $ lines <$> readProcess "ip" ["route", "list", "scope", "global"] case words <$> headMaybe ls of Just ("default":"via":_:"dev":iface:_) -> - ensureProperty $ Network.static iface + ensureProperty w $ Network.static iface _ -> do warningMessage "did not find any default ipv4 route" return FailedChange -- | is copied from the old OS -preserveResolvConf :: Property NoInfo +preserveResolvConf :: Property Linux preserveResolvConf = check (fileExist oldloc) $ - property (newloc ++ " copied from old OS") $ do + property' (newloc ++ " copied from old OS") $ \w -> do ls <- liftIO $ lines <$> readFile oldloc - ensureProperty $ newloc `File.hasContent` ls + ensureProperty w $ newloc `File.hasContent` ls where newloc = "/etc/resolv.conf" oldloc = oldOSDir ++ newloc @@ -217,20 +225,23 @@ preserveResolvConf = check (fileExist oldloc) $ -- | has added to it any ssh keys that -- were authorized in the old OS. Any other contents of the file are -- retained. -preserveRootSshAuthorized :: Property NoInfo +preserveRootSshAuthorized :: Property UnixLike preserveRootSshAuthorized = check (fileExist oldloc) $ - property (newloc ++ " copied from old OS") $ do + property' desc $ \w -> do ks <- liftIO $ lines <$> readFile oldloc - ensureProperties (map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks) + ensureProperty w $ combineProperties desc $ + toProps $ map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks where + desc = newloc ++ " copied from old OS" newloc = "/root/.ssh/authorized_keys" oldloc = oldOSDir ++ newloc -- Removes the old OS's backup from -oldOSRemoved :: Confirmation -> Property NoInfo +oldOSRemoved :: Confirmation -> Property UnixLike oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $ go `requires` confirmed "old OS backup removal confirmed" confirmation where + go :: Property UnixLike go = property "old OS backup removed" $ do liftIO $ removeDirectoryRecursive oldOSDir return MadeChange diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs index 0f73bfb6..0abf38a6 100644 --- a/src/Propellor/Property/OpenId.hs +++ b/src/Propellor/Property/OpenId.hs @@ -16,7 +16,7 @@ import Data.List -- -- It's probably a good idea to put this property inside a docker or -- systemd-nspawn container. -providerFor :: [User] -> HostName -> Maybe Port -> Property HasInfo +providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike) providerFor users hn mp = propertyList desc $ props & Apt.serviceInstalledRunning "apache2" & apacheconfigured @@ -24,7 +24,7 @@ providerFor users hn mp = propertyList desc $ props `onChange` Apache.restarted & File.fileProperty (desc ++ " configured") (map setbaseurl) "/etc/simpleid/config.inc" - & propertyList desc (map identfile users) + & propertyList desc (toProps $ map identfile users) where baseurl = hn ++ case mp of Nothing -> "" @@ -37,7 +37,7 @@ providerFor users hn mp = propertyList desc $ props | otherwise = l apacheconfigured = case mp of - Nothing -> toProp $ + Nothing -> setupRevertableProperty $ Apache.virtualHost hn (Port 80) "/var/www/html" Just p -> propertyList desc $ props & Apache.listenPorts [p] diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index 26b85840..5b854fa3 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/src/Propellor/Property/Reboot.hs @@ -2,8 +2,8 @@ module Propellor.Property.Reboot where import Propellor.Base -now :: Property NoInfo -now = cmdProperty "reboot" [] +now :: Property Linux +now = tightenTargets $ cmdProperty "reboot" [] `assume` MadeChange `describe` "reboot now" @@ -14,7 +14,7 @@ now = cmdProperty "reboot" [] -- -- The reboot can be forced to run, which bypasses the init system. Useful -- if the init system might not be running for some reason. -atEnd :: Bool -> (Result -> Bool) -> Property NoInfo +atEnd :: Bool -> (Result -> Bool) -> Property Linux atEnd force resultok = property "scheduled reboot at end of propellor run" $ do endAction "rebooting" atend return NoChange -- cgit v1.2.3 From 636c7cf5ba42d3636e06f298feae0b9219be6067 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 15:14:20 -0400 Subject: update docs for new property types --- doc/FreeBSD.mdwn | 6 ++++-- doc/Linux.mdwn | 2 +- doc/haskell_newbie.mdwn | 2 +- doc/writing_properties.mdwn | 10 +++++----- 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/doc/FreeBSD.mdwn b/doc/FreeBSD.mdwn index 2edff223..47b9c65b 100644 --- a/doc/FreeBSD.mdwn +++ b/doc/FreeBSD.mdwn @@ -1,8 +1,10 @@ Propellor is in the early stages of supporting FreeBSD. It should basically work, and there are some modules with FreeBSD-specific properties. -However, many other properties assume they're being run on a -Debian Linux system, and need additional porting to support FreeBSD. +However, many other properties only work on a Debian Linux system, and need +additional porting to support FreeBSD. Such properties have types like +`Property DebianLike`. The type checker will detect and reject attempts +to combine such properties with `Property FreeBSD`. [Sample config file](http://git.joeyh.name/?p=propellor.git;a=blob;f=config-freebsd.hs) which configures a FreeBSD system, as well as a Linux one. diff --git a/doc/Linux.mdwn b/doc/Linux.mdwn index 0434d69d..00276f69 100644 --- a/doc/Linux.mdwn +++ b/doc/Linux.mdwn @@ -6,4 +6,4 @@ Indeed, Propellor has been ported to [[FreeBSD]] now! See [[forum/Supported_OS]] for porting tips. Note that you can run Propellor on a OSX laptop and have it manage Linux -systems. +and other systems. diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn index e92481f9..a150b202 100644 --- a/doc/haskell_newbie.mdwn +++ b/doc/haskell_newbie.mdwn @@ -96,7 +96,7 @@ is.
 config.hs:30:19:
     Couldn't match expected type `RevertableProperty'
-                with actual type `Property NoInfo'
+                with actual type `Property DebianLike'
     In the return type of a call of `Apt.installed'
     In the second argument of `(!)', namely `Apt.installed ["ssh"]'
     In the first argument of `(&)', namely
diff --git a/doc/writing_properties.mdwn b/doc/writing_properties.mdwn
index 2209026f..1b7f046a 100644
--- a/doc/writing_properties.mdwn
+++ b/doc/writing_properties.mdwn
@@ -31,7 +31,7 @@ Propellor makes it very easy to put together a property like this.
 
 Let's start with a property that combines the two properties you mentioned:
 
-	hasLoginShell :: UserName -> FilePath -> Property
+	hasLoginShell :: UserName -> FilePath -> Property UnixLike
 	hasLoginShell user shell = shellSetTo user shell `requires` shellEnabled shell
 
 The shellEnabled property can be easily written using propellor's file
@@ -40,14 +40,14 @@ manipulation properties.
 	-- Need to add an import to the top of the source file.
 	import qualified Propellor.Property.File as File
 
-	shellEnabled :: FilePath -> Property
+	shellEnabled :: FilePath -> Property UnixLike
 	shellEnabled shell = "/etc/shells" `File.containsLine` shell
 
 And then, we want to actually change the user's shell. The `chsh(1)`
 program can do that, so we can simply tell propellor the command line to
 run:
 
-	shellSetTo :: UserName -> FilePath -> Property
+	shellSetTo :: UserName -> FilePath -> Property UnixLike
 	shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
 
 The only remaining problem with this is that shellSetTo runs chsh every
@@ -56,7 +56,7 @@ it runs, even when it didn't really do much. Now, there's an easy way to
 avoid that problem, we could just tell propellor to assume that chsh
 has not made a change:
 	
-	shellSetTo :: UserName -> FilePath -> Property
+	shellSetTo :: UserName -> FilePath -> Property UnixLike
 	shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
 		`assume` NoChange
 
@@ -64,7 +64,7 @@ But, it's not much harder to do this right. Let's make the property
 check if the user's shell is already set to the desired value and avoid
 doing anything in that case.
 
-	shellSetTo :: UserName -> FilePath -> Property
+	shellSetTo :: UserName -> FilePath -> Property UnixLike
 	shellSetTo user shell = check needchangeshell $
 		cmdProperty "chsh" ["--shell", shell, user]
 	  where
-- 
cgit v1.2.3


From e4ac94860bcc4511370e878e14ef9d45b60aeb2a Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 15:35:55 -0400
Subject: remove `os` property

The new properties let the type checker know what the target OS is.
---
 config-freebsd.hs                |  7 +++---
 config-simple.hs                 |  2 +-
 debian/changelog                 |  2 ++
 doc/haskell_newbie.mdwn          |  4 ++--
 src/Propellor/Info.hs            | 51 ++++++++++++++++++++++++++++++++++------
 src/Propellor/Property/Chroot.hs |  2 +-
 src/Propellor/Property/OS.hs     |  2 +-
 7 files changed, 54 insertions(+), 16 deletions(-)

diff --git a/config-freebsd.hs b/config-freebsd.hs
index b6334c31..07aeb391 100644
--- a/config-freebsd.hs
+++ b/config-freebsd.hs
@@ -28,7 +28,7 @@ hosts =
 -- An example freebsd host.
 freebsdbox :: Host
 freebsdbox = host "freebsdbox.example.com"
-	& os (System (FreeBSD (FBSDProduction FBSD102)) "amd64")
+	& osFreeBSD (FBSDProduction FBSD102) "amd64"
 	& Pkg.update
 	& Pkg.upgrade
 	& Poudriere.poudriere poudriereZFS
@@ -44,7 +44,7 @@ poudriereZFS = Poudriere.defaultConfig
 -- An example linux host.
 linuxbox :: Host
 linuxbox = host "linuxbox.example.com"
-	& os (System (Debian Unstable) "amd64")
+	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 	& Apt.unattendedUpgrades
 	& Apt.installed ["etckeeper"]
@@ -59,9 +59,8 @@ linuxbox = host "linuxbox.example.com"
 -- A generic webserver in a Docker container.
 webserverContainer :: Docker.Container
 webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")
-	& os (System (Debian (Stable "jessie")) "amd64")
+	& osDebian (Stable "jessie") "amd64"
 	& Apt.stdSourcesList
 	& Docker.publish "80:80"
 	& Docker.volume "/var/www:/var/www"
 	& Apt.serviceInstalledRunning "apache2"
-
diff --git a/config-simple.hs b/config-simple.hs
index da1580c6..277e2edd 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -25,7 +25,7 @@ hosts =
 -- An example host.
 mybox :: Host
 mybox = host "mybox.example.com" $ props
-	& os (System (Debian Unstable) "amd64")
+	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 	& Apt.unattendedUpgrades
 	& Apt.installed ["etckeeper"]
diff --git a/debian/changelog b/debian/changelog
index 562eccd7..df518753 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -10,6 +10,8 @@ propellor (3.0.0) UNRELEASED; urgency=medium
       lists of properties. (If you have such a list, use `toProps`.)
     - And similarly, Chroot and Docker need `props` to be used to combine
       together the properies used inside them.
+    - The `os` property is removed. Instead use `osDebian`, `osBuntish`,
+      or `osFreeBSD`. These tell the type checker the target OS of a host.
     - Change "Property NoInfo" to "Property UnixLike"
     - Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
     - Change "RevertableProperty NoInfo" to
diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn
index a150b202..bd343cd6 100644
--- a/doc/haskell_newbie.mdwn
+++ b/doc/haskell_newbie.mdwn
@@ -48,12 +48,12 @@ Finally, you need to define the configuration for each host in the list:
 [[!format haskell """
 mylaptop :: Host
 mylaptop = host "mylaptop.example.com"
-	& os (System (Debian Unstable) "amd64")
+	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 
 myserver :: Host
 myserver = host "server.example.com"
-	& os (System (Debian (Stable "jessie")) "amd64")
+	& osDebian (Stable "jessie") "amd64"
 	& Apt.stdSourcesList
 	& Apt.installed ["ssh"]
 """]]
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 071bf4c2..725a02ad 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,6 +1,24 @@
 {-# LANGUAGE PackageImports #-}
 
-module Propellor.Info where
+module Propellor.Info (
+	osDebian,
+	osBuntish,
+	osFreeBSD,
+	pureInfoProperty,
+	pureInfoProperty',
+	askInfo,
+	getOS,
+	ipv4,
+	ipv6,
+	alias,
+	addDNS,
+	hostMap,
+	aliasMap,
+	findHost,
+	findHostNoAlias,
+	getAddresses,
+	hostAddresses,
+) where
 
 import Propellor.Types
 import Propellor.Types.Info
@@ -26,10 +44,32 @@ pureInfoProperty' desc i = addInfoProperty p i
 askInfo :: (IsInfo v) => Propellor v
 askInfo = asks (getInfo . hostInfo)
 
--- | Specifies the operating system of a host.
+-- | Specifies that a host's operating system is Debian,
+-- and further indicates the suite and architecture.
+-- 
+-- This provides info for other Properties, so they can act
+-- conditionally on the details of the OS.
 --
--- This only provides info for other Properties, so they can act
--- conditionally on the os.
+-- It also lets the type checker know that all the properties of the
+-- host must support Debian.
+--
+-- > & osDebian (Stable "jessie") "amd64"
+osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
+osDebian suite arch = tightenTargets $ os (System (Debian suite) arch)
+
+-- | Specifies that a host's operating system is a well-known Debian
+-- derivative founded by a space tourist.
+--
+-- (The actual name of this distribution is not used in Propellor per
+-- )
+osBuntish :: Release -> Architecture -> Property (HasInfo + Buntish)
+osBuntish release arch = tightenTargets $ os (System (Buntish release) arch)
+
+-- | Specifies that a host's operating system is FreeBSD
+-- and further indicates the release and architecture.
+osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
+osFreeBSD release arch = tightenTargets $ os (System (FreeBSD release) arch)
+
 os :: System -> Property (HasInfo + UnixLike)
 os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
 
@@ -105,6 +145,3 @@ getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
 
 hostAddresses :: HostName -> [Host] -> [IPAddr]
 hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
-
-addHostInfo ::IsInfo v => Host -> v -> Host
-addHostInfo h v = h { hostInfo = addInfo (hostInfo h) v }
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index bf6f2083..4480f98d 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -102,7 +102,7 @@ instance ChrootBootstrapper Debootstrapped where
 -- add the `os` property to specify the operating system to bootstrap.
 --
 -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev"
--- >	& os (System (Debian Unstable) "amd64")
+-- >	& osDebian Unstable "amd64"
 -- >	& Apt.installed ["ghc", "haskell-platform"]
 -- >	& ...
 debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 42504453..72753248 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -46,7 +46,7 @@ import Control.Exception (throw)
 -- install succeeds, to bootstrap from the cleanly installed system to
 -- a fully working system. For example:
 --
--- > & os (System (Debian Unstable) "amd64")
+-- > & osDebian Unstable "amd64"
 -- > & cleanInstallOnce (Confirmed "foo.example.com")
 -- >    `onChange` propertyList "fixing up after clean install"
 -- >        [ preserveNetwork
-- 
cgit v1.2.3


From c85c462c617fe31c3fe8c97d85db4bcae838a8b2 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 17:33:43 -0400
Subject: more ported

---
 src/Propellor/Property/FreeBSD/Poudriere.hs        | 21 ++++++-----
 .../Property/HostingProvider/DigitalOcean.hs       | 11 +++---
 src/Propellor/Property/HostingProvider/Linode.hs   |  9 +++--
 src/Propellor/Property/Postfix.hs                  | 35 ++++++++---------
 src/Propellor/Property/PropellorRepo.hs            |  2 +-
 src/Propellor/Property/Prosody.hs                  | 12 +++---
 src/Propellor/Property/SiteSpecific/GitHome.hs     | 11 +++---
 src/Propellor/Property/Sudo.hs                     |  9 +++--
 src/Propellor/Property/Tor.hs                      | 44 +++++++++++-----------
 src/Propellor/Property/Unbound.hs                  |  8 ++--
 src/Propellor/Property/Uwsgi.hs                    | 12 +++---
 src/Propellor/Property/ZFS/Properties.hs           | 12 ++++--
 12 files changed, 99 insertions(+), 87 deletions(-)

diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index 5467c668..fcad9e87 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -26,20 +26,23 @@ instance IsInfo PoudriereConfigured where
 poudriereConfigured :: PoudriereConfigured -> Bool
 poudriereConfigured (PoudriereConfigured _) = True
 
-setConfigured :: Property HasInfo
-setConfigured = pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
+setConfigured :: Property (HasInfo + FreeBSD)
+setConfigured = tightenTargets $ 
+	pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
 
-poudriere :: Poudriere -> Property HasInfo
+poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
 poudriere conf@(Poudriere _ _ _ _ _ _ zfs) = prop
 	`requires` Pkg.installed "poudriere"
 	`before` setConfigured
   where
-	confProp = File.containsLines poudriereConfigPath (toLines conf)
+	confProp :: Property FreeBSD
+	confProp = tightenTargets $
+		File.containsLines poudriereConfigPath (toLines conf)
 	setZfs (PoudriereZFS z p) = ZFS.zfsSetProperties z p `describe` "Configuring Poudriere with ZFS"
-	prop :: CombinedType (Property NoInfo) (Property NoInfo)
+	prop :: Property FreeBSD
 	prop
 		| isJust zfs = ((setZfs $ fromJust zfs) `before` confProp)
-		| otherwise = propertyList "Configuring Poudriere without ZFS" [confProp]
+		| otherwise = confProp `describe` "Configuring Poudriere without ZFS"
 
 poudriereCommand :: String -> [String] -> (String, [String])
 poudriereCommand cmd args = ("poudriere", cmd:args)
@@ -58,8 +61,8 @@ listJails = mapMaybe (headMaybe . take 1 . words)
 jailExists :: Jail -> IO Bool
 jailExists (Jail name _ _) = isInfixOf [name] <$> listJails
 
-jail :: Jail -> Property NoInfo
-jail j@(Jail name version arch) =
+jail :: Jail -> Property FreeBSD
+jail j@(Jail name version arch) = tightenTargets $
 	let
 		chk = do
 			c <- poudriereConfigured <$> askInfo
@@ -70,7 +73,7 @@ jail j@(Jail name version arch) =
 		createJail = cmdProperty cmd args
 	in
 		check chk createJail
-		`describe` unwords ["Create poudriere jail", name]
+			`describe` unwords ["Create poudriere jail", name]
 
 data JailInfo = JailInfo String
 
diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
index f49b86b3..c1e0ffc9 100644
--- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs
+++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
@@ -18,16 +18,15 @@ import Data.List
 -- If the power is cycled, the non-distro kernel still boots up.
 -- So, this property also checks if the running kernel is present in /boot,
 -- and if not, reboots immediately into a distro kernel.
-distroKernel :: Property NoInfo
-distroKernel = propertyList "digital ocean distro kernel hack"
-	[ Apt.installed ["grub-pc", "kexec-tools", "file"]
-	, "/etc/default/kexec" `File.containsLines`
+distroKernel :: Property DebianLike
+distroKernel = propertyList "digital ocean distro kernel hack" $ props
+	& Apt.installed ["grub-pc", "kexec-tools", "file"]
+	& "/etc/default/kexec" `File.containsLines`
 		[ "LOAD_KEXEC=true"
 		, "USE_GRUB_CONFIG=true"
 		] `describe` "kexec configured"
-	, check (not <$> runningInstalledKernel) Reboot.now
+	& check (not <$> runningInstalledKernel) Reboot.now
 		`describe` "running installed kernel"
-	]
 
 runningInstalledKernel :: IO Bool
 runningInstalledKernel = do
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
index 274412a0..71719d87 100644
--- a/src/Propellor/Property/HostingProvider/Linode.hs
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -8,12 +8,13 @@ import Utility.FileMode
 -- | Linode's pv-grub-x86_64 does not currently support booting recent
 -- Debian kernels compressed with xz. This sets up pv-grub chaining to enable
 -- it.
-chainPVGrub :: Grub.TimeoutSecs -> Property NoInfo
+chainPVGrub :: Grub.TimeoutSecs -> Property DebianLike
 chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
 
 -- | Linode disables mlocate's cron job's execute permissions,
 -- presumably to avoid disk IO. This ensures it's executable.
-mlocateEnabled :: Property NoInfo
-mlocateEnabled = "/etc/cron.daily/mlocate"
-	`File.mode` combineModes (readModes ++ executeModes)
+mlocateEnabled :: Property DebianLike
+mlocateEnabled = tightenTargets $
+	"/etc/cron.daily/mlocate"
+		`File.mode` combineModes (readModes ++ executeModes)
 
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index df244061..7d9e7068 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -12,13 +12,13 @@ import qualified Data.Map as M
 import Data.List
 import Data.Char
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.serviceInstalledRunning "postfix"
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "postfix"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "postfix"
 
 -- | Configures postfix as a satellite system, which 
@@ -28,38 +28,39 @@ reloaded = Service.reloaded "postfix"
 -- The smarthost may refuse to relay mail on to other domains, without
 -- further configuration/keys. But this should be enough to get cron job
 -- mail flowing to a place where it will be seen.
-satellite :: Property NoInfo
+satellite :: Property DebianLike
 satellite = check (not <$> mainCfIsSet "relayhost") setup
 	`requires` installed
   where
-	setup = property "postfix satellite system" $ do
+	desc = "postfix satellite system"
+	setup :: Property DebianLike
+	setup = property' desc $ \w -> do
 		hn <- asks hostName
 		let (_, domain) = separate (== '.') hn
-		ensureProperties
-			[ Apt.reConfigure "postfix"
+		ensureProperty w $ combineProperties desc $ props
+			& Apt.reConfigure "postfix"
 				[ ("postfix/main_mailer_type", "select", "Satellite system")
 				, ("postfix/root_address", "string", "root")
 				, ("postfix/destinations", "string", "localhost")
 				, ("postfix/mailname", "string", hn)
 				]
-			, mainCf ("relayhost", "smtp." ++ domain)
+			& mainCf ("relayhost", "smtp." ++ domain)
 				`onChange` reloaded
-			]
 
 -- | Sets up a file by running a property (which the filename is passed
 -- to). If the setup property makes a change, postmap will be run on the
 -- file, and postfix will be reloaded.
 mappedFile
-	:: Combines (Property x) (Property NoInfo)
+	:: Combines (Property x) (Property UnixLike)
 	=> FilePath
 	-> (FilePath -> Property x)
-	-> Property (CInfo x NoInfo)
+	-> CombinedType (Property x) (Property UnixLike)
 mappedFile f setup = setup f
 	`onChange` (cmdProperty "postmap" [f] `assume` MadeChange)
 
 -- | Run newaliases command, which should be done after changing
 -- @/etc/aliases@.
-newaliases :: Property NoInfo
+newaliases :: Property UnixLike
 newaliases = check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
 	(cmdProperty "newaliases" [])
 
@@ -68,9 +69,9 @@ mainCfFile :: FilePath
 mainCfFile = "/etc/postfix/main.cf"
 
 -- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately.
-mainCf :: (String, String) -> Property NoInfo
+mainCf :: (String, String) -> Property UnixLike
 mainCf (name, value) = check notset set
-		`describe` ("postfix main.cf " ++ setting)
+	`describe` ("postfix main.cf " ++ setting)
   where
 	setting = name ++ "=" ++ value
 	notset = (/= Just value) <$> getMainCf name
@@ -105,7 +106,7 @@ mainCfIsSet name = do
 --
 -- Note that multiline configurations that continue onto the next line
 -- are not currently supported.
-dedupMainCf :: Property NoInfo
+dedupMainCf :: Property UnixLike
 dedupMainCf = File.fileProperty "postfix main.cf dedupped" dedupCf mainCfFile
 
 dedupCf :: [String] -> [String]
@@ -252,7 +253,7 @@ parseServiceLine l = Service
 	nws = length ws
 
 -- | Enables a `Service` in postfix's `masterCfFile`.
-service :: Service -> RevertableProperty NoInfo
+service :: Service -> RevertableProperty DebianLike DebianLike
 service s = (enable  disable)
 	`describe` desc
   where
@@ -276,7 +277,7 @@ service s = (enable  disable)
 -- It would be wise to enable fail2ban, for example:
 --
 -- > Fail2Ban.jailEnabled "postfix-sasl"
-saslAuthdInstalled :: Property NoInfo
+saslAuthdInstalled :: Property DebianLike
 saslAuthdInstalled = setupdaemon
 	`requires` Service.running "saslauthd"
 	`requires` postfixgroup
diff --git a/src/Propellor/Property/PropellorRepo.hs b/src/Propellor/Property/PropellorRepo.hs
index d4fc089a..e60e7848 100644
--- a/src/Propellor/Property/PropellorRepo.hs
+++ b/src/Propellor/Property/PropellorRepo.hs
@@ -11,7 +11,7 @@ import Propellor.Git.Config
 --
 -- This property is useful when hosts are being updated without using
 -- --spin, eg when using the `Propellor.Property.Cron.runPropellor` cron job.
-hasOriginUrl :: String -> Property NoInfo
+hasOriginUrl :: String -> Property UnixLike
 hasOriginUrl u = property ("propellor repo url " ++ u) $ do
 	curru <- liftIO getRepoUrl
 	if curru == Just u
diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs
index 47095504..8017be4a 100644
--- a/src/Propellor/Property/Prosody.hs
+++ b/src/Propellor/Property/Prosody.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
 
 type Conf = String
 
-confEnabled :: Conf -> ConfigFile -> RevertableProperty NoInfo
+confEnabled :: Conf -> ConfigFile -> RevertableProperty DebianLike DebianLike
 confEnabled conf cf = enable  disable
   where
 	enable = dir `File.isSymlinkedTo` target
@@ -29,9 +29,9 @@ confEnabled conf cf = enable  disable
 		`requires` installed
 		`onChange` reloaded
 
-confAvailable :: Conf -> ConfigFile -> Property NoInfo
+confAvailable :: Conf -> ConfigFile -> Property DebianLike
 confAvailable conf cf = ("prosody conf available " ++ conf) ==>
-	confAvailPath conf `File.hasContent` (comment : cf)
+	tightenTargets (confAvailPath conf `File.hasContent` (comment : cf))
   where
 	comment = "-- deployed with propellor, do not modify"
 
@@ -41,11 +41,11 @@ confAvailPath conf = "/etc/prosody/conf.avail"  conf <.> "cfg.lua"
 confValPath :: Conf -> FilePath
 confValPath conf = "/etc/prosody/conf.d"  conf <.> "cfg.lua"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["prosody"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "prosody"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "prosody"
diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs
index 83a1a16a..f14b5f12 100644
--- a/src/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/src/Propellor/Property/SiteSpecific/GitHome.hs
@@ -5,14 +5,15 @@ import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.User
 
 -- | Clones Joey Hess's git home directory, and runs its fixups script.
-installedFor :: User -> Property NoInfo
+installedFor :: User -> Property DebianLike
 installedFor user@(User u) = check (not <$> hasGitDir user) $ 
-	property ("githome " ++ u) (go =<< liftIO (homedir user))
-		`requires` Apt.installed ["git"]
+	go `requires` Apt.installed ["git"]
   where
-	go home = do
+	go :: Property DebianLike
+	go = property' ("githome " ++ u) $ \w -> do
+		home <- liftIO (homedir user)
 		let tmpdir = home  "githome"
-		ensureProperty $ combineProperties "githome setup"
+		ensureProperty w $ combineProperties "githome setup" $ toProps
 			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
 				`assume` MadeChange
 			, property "moveout" $ makeChange $ void $
diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs
index ed6ba2d5..45ab8af2 100644
--- a/src/Propellor/Property/Sudo.hs
+++ b/src/Propellor/Property/Sudo.hs
@@ -9,12 +9,13 @@ import Propellor.Property.User
 
 -- | Allows a user to sudo. If the user has a password, sudo is configured
 -- to require it. If not, NOPASSWORD is enabled for the user.
-enabledFor :: User -> Property NoInfo
-enabledFor user@(User u) = property desc go `requires` Apt.installed ["sudo"]
+enabledFor :: User -> Property DebianLike
+enabledFor user@(User u) = go `requires` Apt.installed ["sudo"]
   where
-	go = do
+	go :: Property UnixLike
+	go = property' desc $ \w -> do
 		locked <- liftIO $ isLockedPassword user
-		ensureProperty $
+		ensureProperty w $
 			fileProperty desc
 				(modify locked . filter (wanted locked))
 				"/etc/sudoers"
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 0c040f95..92dbd507 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
 module Propellor.Property.Tor where
 
 import Propellor.Base
@@ -19,7 +21,7 @@ type NodeName = String
 -- | Sets up a tor bridge. (Not a relay or exit node.)
 --
 -- Uses port 443
-isBridge :: Property NoInfo
+isBridge :: Property DebianLike
 isBridge = configured
 	[ ("BridgeRelay", "1")
 	, ("Exitpolicy", "reject *:*")
@@ -31,7 +33,7 @@ isBridge = configured
 -- | Sets up a tor relay.
 --
 -- Uses port 443
-isRelay :: Property NoInfo
+isRelay :: Property DebianLike
 isRelay = configured
 	[ ("BridgeRelay", "0")
 	, ("Exitpolicy", "reject *:*")
@@ -44,21 +46,21 @@ isRelay = configured
 --
 -- This can be moved to a different IP without needing to wait to
 -- accumulate trust.
-named :: NodeName -> Property HasInfo
+named :: NodeName -> Property (HasInfo + DebianLike)
 named n = configured [("Nickname", n')]
 	`describe` ("tor node named " ++ n')
 	`requires` torPrivKey (Context ("tor " ++ n))
   where
 	n' = saneNickname n
 
-torPrivKey :: Context -> Property HasInfo
+torPrivKey :: Context -> Property (HasInfo + DebianLike)
 torPrivKey context = f `File.hasPrivContent` context
 	`onChange` File.ownerGroup f user (userGroup user)
 	`requires` torPrivKeyDirExists
   where
 	f = torPrivKeyDir  "secret_id_key"
 
-torPrivKeyDirExists :: Property NoInfo
+torPrivKeyDirExists :: Property DebianLike
 torPrivKeyDirExists = File.dirExists torPrivKeyDir
 	`onChange` setperms
 	`requires` installed
@@ -71,20 +73,20 @@ torPrivKeyDir = "/var/lib/tor/keys"
 
 -- | A tor server (bridge, relay, or exit)
 -- Don't use if you just want to run tor for personal use.
-server :: Property NoInfo
+server :: Property DebianLike
 server = configured [("SocksPort", "0")]
 	`requires` installed
 	`requires` Apt.installed ["ntp"]
 	`describe` "tor server"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["tor"]
 
 -- | Specifies configuration settings. Any lines in the config file
 -- that set other values for the specified settings will be removed,
 -- while other settings are left as-is. Tor is restarted when
 -- configuration is changed.
-configured :: [(String, String)] -> Property NoInfo
+configured :: [(String, String)] -> Property DebianLike
 configured settings = File.fileProperty "tor configured" go mainConfig
 	`onChange` restarted
   where
@@ -105,19 +107,19 @@ data BwLimit
 --
 -- For example, PerSecond "30 kibibytes" is the minimum limit
 -- for a useful relay.
-bandwidthRate :: BwLimit -> Property NoInfo
+bandwidthRate :: BwLimit -> Property DebianLike
 bandwidthRate (PerSecond s) = bandwidthRate' s 1
 bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
 bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)
 
-bandwidthRate' :: String -> Integer -> Property NoInfo
+bandwidthRate' :: String -> Integer -> Property DebianLike
 bandwidthRate' s divby = case readSize dataUnits s of
 	Just sz -> let v = show (sz `div` divby) ++ " bytes"
 		in configured [("BandwidthRate", v)]
 			`describe` ("tor BandwidthRate " ++ v)
 	Nothing -> property ("unable to parse " ++ s) noChange
 
-hiddenServiceAvailable :: HiddenServiceName -> Int -> Property NoInfo
+hiddenServiceAvailable :: HiddenServiceName -> Int -> Property DebianLike
 hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
   where
 	hiddenServiceHostName p =  adjustPropertySatisfy p $ \satisfy -> do
@@ -126,7 +128,7 @@ hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
 		warningMessage $ unwords ["hidden service hostname:", h]
 		return r
 
-hiddenService :: HiddenServiceName -> Int -> Property NoInfo
+hiddenService :: HiddenServiceName -> Int -> Property DebianLike
 hiddenService hn port = ConfFile.adjustSection
 	(unwords ["hidden service", hn, "available on port", show port])
 	(== oniondir)
@@ -139,18 +141,18 @@ hiddenService hn port = ConfFile.adjustSection
 	oniondir = unwords ["HiddenServiceDir", varLib  hn]
 	onionport = unwords ["HiddenServicePort", show port, "127.0.0.1:" ++ show port]
 
-hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property HasInfo
-hiddenServiceData hn context = combineProperties desc
-	[ installonion "hostname"
-	, installonion "private_key"
-	]
+hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
+hiddenServiceData hn context = combineProperties desc $ props
+	& installonion "hostname"
+	& installonion "private_key"
   where
 	desc = unwords ["hidden service data available in", varLib  hn]
+	installonion :: FilePath -> Property (HasInfo + DebianLike)
 	installonion f = withPrivData (PrivFile $ varLib  hn  f) context $ \getcontent ->
-		property desc $ getcontent $ install $ varLib  hn  f
-	install f privcontent = ifM (liftIO $ doesFileExist f)
+		property' desc $ \w -> getcontent $ install w $ varLib  hn  f
+	install w f privcontent = ifM (liftIO $ doesFileExist f)
 		( noChange
-		, ensureProperties
+		, ensureProperty w $ propertyList desc $ toProps
 			[ property desc $ makeChange $ do
 				createDirectoryIfMissing True (takeDirectory f)
 				writeFileProtected f (unlines (privDataLines privcontent))
@@ -161,7 +163,7 @@ hiddenServiceData hn context = combineProperties desc
 			]
 		)
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "tor"
 
 mainConfig :: FilePath
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index f1280b0e..23a5b30d 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -41,13 +41,13 @@ type UnboundValue = String
 
 type ZoneType = String
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["unbound"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "unbound"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "unbound"
 
 dValue :: BindDomain -> String
@@ -90,7 +90,7 @@ config = "/etc/unbound/unbound.conf.d/propellor.conf"
 -- >      , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
 -- >      , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
 -- >      ]
-cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property NoInfo
+cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property DebianLike
 cachingDnsServer sections zones hosts =
 	config `hasContent` (comment : otherSections ++ serverSection)
 	`onChange` restarted
diff --git a/src/Propellor/Property/Uwsgi.hs b/src/Propellor/Property/Uwsgi.hs
index 8b531c3f..491c77d1 100644
--- a/src/Propellor/Property/Uwsgi.hs
+++ b/src/Propellor/Property/Uwsgi.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
 
 type AppName = String
 
-appEnabled :: AppName -> ConfigFile -> RevertableProperty NoInfo
+appEnabled :: AppName -> ConfigFile -> RevertableProperty DebianLike DebianLike
 appEnabled an cf = enable  disable
   where
 	enable = appVal an `File.isSymlinkedTo` appValRelativeCfg an
@@ -24,9 +24,9 @@ appEnabled an cf = enable  disable
 		`requires` installed
 		`onChange` reloaded
 
-appAvailable :: AppName -> ConfigFile -> Property NoInfo
+appAvailable :: AppName -> ConfigFile -> Property DebianLike
 appAvailable an cf = ("uwsgi app available " ++ an) ==>
-	appCfg an `File.hasContent` (comment : cf)
+	tightenTargets (appCfg an `File.hasContent` (comment : cf))
   where
 	comment = "# deployed with propellor, do not modify"
 
@@ -39,11 +39,11 @@ appVal an = "/etc/uwsgi/apps-enabled/" ++ an
 appValRelativeCfg :: AppName -> File.LinkTarget
 appValRelativeCfg an = File.LinkTarget $ "../apps-available/" ++ an
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["uwsgi"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "uwsgi"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "uwsgi"
diff --git a/src/Propellor/Property/ZFS/Properties.hs b/src/Propellor/Property/ZFS/Properties.hs
index 5ceaf9ba..47d5a9d1 100644
--- a/src/Propellor/Property/ZFS/Properties.hs
+++ b/src/Propellor/Property/ZFS/Properties.hs
@@ -3,6 +3,7 @@
 -- Functions defining zfs Properties.
 
 module Propellor.Property.ZFS.Properties (
+	ZFSOS,
 	zfsExists,
 	zfsSetProperties
 ) where
@@ -11,9 +12,12 @@ import Propellor.Base
 import Data.List (intercalate)
 import qualified Propellor.Property.ZFS.Process as ZP
 
+-- | OS's that support ZFS
+type ZFSOS = Linux + FreeBSD
+
 -- | Will ensure that a ZFS volume exists with the specified mount point.
 -- This requires the pool to exist as well, but we don't create pools yet.
-zfsExists :: ZFS -> Property NoInfo
+zfsExists :: ZFS -> Property ZFSOS
 zfsExists z = check (not <$> ZP.zfsExists z) create
 	`describe` unwords ["Creating", zfsName z]
   where
@@ -21,16 +25,16 @@ zfsExists z = check (not <$> ZP.zfsExists z) create
 	create = cmdProperty p a
 
 -- | Sets the given properties. Returns True if all were successfully changed, False if not.
-zfsSetProperties :: ZFS -> ZFSProperties -> Property NoInfo
+zfsSetProperties :: ZFS -> ZFSProperties -> Property ZFSOS
 zfsSetProperties z setProperties = setall
 	`requires` zfsExists z
   where
 	spcmd :: String -> String -> (String, [String])
 	spcmd p v = ZP.zfsCommand "set" [Just (intercalate "=" [p, v]), Nothing] z
 
-	setprop :: (String, String) -> Property NoInfo
+	setprop :: (String, String) -> Property ZFSOS
 	setprop (p, v) = check (ZP.zfsExists z) $
 		cmdProperty (fst (spcmd p v)) (snd (spcmd p v))
 
 	setall = combineProperties (unwords ["Setting properties on", zfsName z]) $
-		map setprop $ toPropertyList setProperties
+		toProps $ map setprop $ toPropertyList setProperties
-- 
cgit v1.2.3


From 8cbf4c96bdb77350a233c6f0934458b8486ce11e Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 17:47:21 -0400
Subject: more porting

Conductor WIP
---
 src/Propellor/Property/Conductor.hs               | 26 ++++++++++++-----------
 src/Propellor/Property/SiteSpecific/Branchable.hs |  2 +-
 src/Propellor/Property/SiteSpecific/IABak.hs      | 13 ++++++------
 3 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index 0d275b91..d97d0a72 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}
 
 -- | This module adds conductors to propellor. A conductor is a Host that
 -- is responsible for running propellor on other hosts
@@ -83,7 +83,7 @@ import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
 class Conductable c where
-	conducts :: c -> RevertableProperty HasInfo
+	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
 	-- | Conduct the specified host.
@@ -94,9 +94,9 @@ instance Conductable Host where
 -- will be propagated as an overall failure of the property.
 instance Conductable [Host] where
 	conducts hs = 
-		propertyList desc (map (toProp . conducts) hs)
+		propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
 			
-		propertyList desc (map (toProp . revert . conducts) hs)
+		propertyList desc (toProps $ map (undoRevertableProperty . conducts) hs)
 	  where
 		desc = cdesc $ unwords $ map hostName hs
 
@@ -240,9 +240,10 @@ orchestrate' h (Conductor c l)
 -- The host this property is added to becomes the conductor for the
 -- specified Host. Note that `orchestrate` must be used for this property
 -- to have any effect.
-conductorFor :: Host -> Property HasInfo
-conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
-	`requires` toProp (conductorKnownHost h)
+conductorFor :: Host -> Property (HasInfo + UnixLike)
+conductorFor h = property desc go
+	`addInfoProperty` (toInfo (ConductorFor [h]))
+	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
 	desc = cdesc (hostName h)
@@ -262,13 +263,14 @@ conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
 		)
 
 -- Reverts conductorFor.
-notConductorFor :: Host -> Property HasInfo
-notConductorFor h = infoProperty desc (return NoChange) (addInfo mempty (NotConductorFor [h])) []
-	`requires` toProp (revert (conductorKnownHost h))
+notConductorFor :: Host -> Property (HasInfo + UnixLike)
+notConductorFor h = property desc (return NoChange)
+	`addInfoProperty` (toInfo (NotConductorFor [h]))
+	`requires` undoRevertableProperty (conductorKnownHost h)
   where
 	desc = "not " ++ cdesc (hostName h)
 
-conductorKnownHost :: Host -> RevertableProperty NoInfo
+conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
 conductorKnownHost h = 
 	mk Ssh.knownHost
 		
@@ -290,7 +292,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
 	privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h')
 
 -- Use this property to let the specified conductor ssh in and run propellor.
-conductedBy :: Host -> RevertableProperty NoInfo
+conductedBy :: Host -> RevertableProperty DebianLike UnixLike
 conductedBy h = (setup  teardown)
 	`describe` ("conducted by " ++ hostName h)
   where
diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs
index 5c85610b..239bcbeb 100644
--- a/src/Propellor/Property/SiteSpecific/Branchable.hs
+++ b/src/Propellor/Property/SiteSpecific/Branchable.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.Postfix as Postfix
 import qualified Propellor.Property.Gpg as Gpg
 import qualified Propellor.Property.Sudo as Sudo
 
-server :: [Host] -> Property HasInfo
+server :: [Host] -> Property (HasInfo + DebianLike)
 server hosts = propertyList "branchable server" $ props
 	& "/etc/timezone" `File.hasContent` ["Etc/UTC"]
 	& "/etc/locale.gen" `File.containsLines`
diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs
index bb62fba7..b245e444 100644
--- a/src/Propellor/Property/SiteSpecific/IABak.hs
+++ b/src/Propellor/Property/SiteSpecific/IABak.hs
@@ -15,14 +15,14 @@ repo = "https://github.com/ArchiveTeam/IA.BAK/"
 userrepo :: String
 userrepo = "git@gitlab.com:archiveteam/IA.bak.users.git"
 
-publicFace :: Property HasInfo
+publicFace :: Property DebianLike
 publicFace = propertyList "iabak public face" $ props
 	& Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
 	& Apt.serviceInstalledRunning "apache2"
 	& Cron.niceJob "graph-gen" (Cron.Times "*/10 * * * *") (User "root") "/"
 		"/usr/local/IA.BAK/web/graph-gen.sh"
 
-gitServer :: [Host] -> Property HasInfo
+gitServer :: [Host] -> Property (HasInfo + DebianLike)
 gitServer knownhosts = propertyList "iabak git server" $ props
 	& Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
 	& Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master")
@@ -42,7 +42,7 @@ gitServer knownhosts = propertyList "iabak git server" $ props
 		"/usr/local/IA.BAK"
 		"./expireemailer"
 
-registrationServer :: [Host] -> Property HasInfo
+registrationServer :: [Host] -> Property (HasInfo + DebianLike)
 registrationServer knownhosts = propertyList "iabak registration server" $ props
 	& User.accountFor (User "registrar")
 	& Ssh.userKeys (User "registrar") (Context "IA.bak.users.git") sshKeys
@@ -66,7 +66,7 @@ sshKeys =
 	[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCoiE+CPiIQyfWnl/E9iKG3eo4QzlH30vi7xAgKolGaTu6qKy4XPtl+8MNm2Dqn9QEYRVyyOT/XH0yP5dRc6uyReT8dBy03MmLkVbj8Q+nKCz5YOMTxrY3sX6RRXU1zVGjeVd0DtC+rKRT7reoCxef42LAJTm8nCyZu/enAuso5qHqBbqulFz2YXEKfU1SEEXLawtvgGck1KmCyg+pqazeI1eHWXrojQf5isTBKfPQLWVppBkWAf5cA4wP5U1vN9dVirIdw66ds1M8vnGlkTBjxP/HLGBWGYhZHE7QXjXRsk2RIXlHN9q6GdNu8+F3HXS22mst47E4UAeRoiXSMMtF5")
 	]
 
-graphiteServer :: Property HasInfo
+graphiteServer :: Property (HasInfo + DebianLike)
 graphiteServer = propertyList "iabak graphite server" $ props
 	& Apt.serviceInstalledRunning "apache2"
 	& Apt.installed ["libapache2-mod-wsgi", "graphite-carbon", "graphite-web"]
@@ -114,7 +114,8 @@ graphiteServer = propertyList "iabak graphite server" $ props
 		, ""
 		]
   where
+	graphiteCSRF :: Property (HasInfo + DebianLike)
 	graphiteCSRF = withPrivData (Password "csrf-token") (Context "iabak.archiveteam.org") $
-		\gettoken -> property "graphite-web CSRF token" $
-			gettoken $ \token -> ensureProperty $ File.containsLine
+		\gettoken -> property' "graphite-web CSRF token" $ \w ->
+			gettoken $ \token -> ensureProperty w $ File.containsLine
 				"/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ privDataVal token ++"'")
-- 
cgit v1.2.3


From 009cff24bd7a43a5a35300af7a22a99570840195 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 17:56:42 -0400
Subject: finished porting conductor

---
 src/Propellor/Property/Conductor.hs | 26 ++++++++++++++++++--------
 1 file changed, 18 insertions(+), 8 deletions(-)

diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index d97d0a72..ec15281b 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -73,7 +73,7 @@ module Propellor.Property.Conductor (
 	Conductable(..),
 ) where
 
-import Propellor.Base hiding (os)
+import Propellor.Base
 import Propellor.Spin (spin')
 import Propellor.PrivData.Paths
 import Propellor.Types.Info
@@ -83,7 +83,7 @@ import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
 class Conductable c where
-	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
+	conducts :: c -> RevertableProperty (HasInfo + DebianLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
 	-- | Conduct the specified host.
@@ -219,7 +219,8 @@ orchestrate hs = map go hs
 	os = extractOrchestras hs
 
 	removeold h = foldl removeold' h (oldconductorsof h)
-	removeold' h oldconductor = h & revert (conductedBy oldconductor)
+	removeold' h oldconductor = addPropHost h $
+		undoRevertableProperty $ conductedBy oldconductor
 
 	oldconductors = zip hs (map (getInfo . hostInfo) hs)
 	oldconductorsof h = flip mapMaybe oldconductors $ 
@@ -232,23 +233,31 @@ orchestrate' :: Host -> Orchestra -> Host
 orchestrate' h (Conducted _) = h
 orchestrate' h (Conductor c l)
 	| sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l)
-	| any (sameHost h) (map topHost l) = cont $ h & conductedBy c
+	| any (sameHost h) (map topHost l) = cont $ addPropHost h $
+		setupRevertableProperty $ conductedBy c
 	| otherwise = cont h
   where
 	cont h' = foldl orchestrate' h' l
 
+addPropHost :: Host -> Property i -> Host
+addPropHost (Host hn ps i) p = Host hn ps' i'
+  where
+	ps' = ps ++ [toChildProperty p]
+	i' = i <> getInfoRecursive p
+
 -- The host this property is added to becomes the conductor for the
 -- specified Host. Note that `orchestrate` must be used for this property
 -- to have any effect.
-conductorFor :: Host -> Property (HasInfo + UnixLike)
-conductorFor h = property desc go
+conductorFor :: Host -> Property (HasInfo + DebianLike)
+conductorFor h = go
 	`addInfoProperty` (toInfo (ConductorFor [h]))
 	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
 	desc = cdesc (hostName h)
 
-	go = ifM (isOrchestrated <$> askInfo)
+	go :: Property UnixLike
+	go = property desc $ ifM (isOrchestrated <$> askInfo)
 		( do
 			pm <- liftIO $ filterPrivData h
 				<$> readPrivDataFile privDataLocal
@@ -264,8 +273,9 @@ conductorFor h = property desc go
 
 -- Reverts conductorFor.
 notConductorFor :: Host -> Property (HasInfo + UnixLike)
-notConductorFor h = property desc (return NoChange)
+notConductorFor h = doNothing
 	`addInfoProperty` (toInfo (NotConductorFor [h]))
+	`describe` desc
 	`requires` undoRevertableProperty (conductorKnownHost h)
   where
 	desc = "not " ++ cdesc (hostName h)
-- 
cgit v1.2.3


From 42da8445470a6e4950873fc5d6bea88646ec2b63 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 18:54:18 -0400
Subject: got rid of the undefined in privdata

addInfoProperty' is like addInfoProperty but for when the input property
is already known to HasInfo.
---
 src/Propellor/PrivData.hs |  6 +-----
 src/Propellor/Types.hs    | 15 +++++++++++++++
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 5e6e0869..77c7133f 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -127,11 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = Property undefined -- FIXME: should use sing here
-		(propertyDesc p)
-		(getSatisfy p)
-		(propertyInfo p `addInfo` privset)
-		(propertyChildren p)
+	addinfo p = p `addInfoProperty'` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 4b3f665a..ccbfd3e0 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -25,6 +25,8 @@ module Propellor.Types
 	, HasInfo
 	, type (+)
 	, addInfoProperty
+	, addInfoProperty'
+	, addChildrenProperty
 	, adjustPropertySatisfy
 	, propertyInfo
 	, propertyDesc
@@ -159,6 +161,19 @@ addInfoProperty
 addInfoProperty (Property _ d a oldi c) newi =
 	Property sing d a (oldi <> newi) c
 
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty'
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty' (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Adds children to a Property.
+addChildrenProperty :: Property metatypes -> [ChildProperty] -> Property metatypes
+addChildrenProperty (Property t s a i cs) cs' = Property t s a i (cs ++ cs')
+
 -- | Changes the action that is performed to satisfy a property.
 adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
 adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
-- 
cgit v1.2.3


From 36e97137e538de401bd0340b469e10dca5f4b475 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 19:31:23 -0400
Subject: ported propagateContainer

Renamed several utility functions along the way.
---
 debian/changelog                         |  5 ++++
 doc/todo/type_level_OS_requirements.mdwn |  7 ++---
 propellor.cabal                          |  1 +
 src/Propellor/Container.hs               | 46 ++++++++++++++++++++++++++++++
 src/Propellor/Info.hs                    |  6 ++--
 src/Propellor/PrivData.hs                |  4 +--
 src/Propellor/PropAccum.hs               | 33 ----------------------
 src/Propellor/Property/Chroot.hs         | 43 +++++++++++++---------------
 src/Propellor/Property/Concurrent.hs     |  2 +-
 src/Propellor/Property/Conductor.hs      |  8 +++---
 src/Propellor/Property/Dns.hs            | 10 +++----
 src/Propellor/Property/Docker.hs         | 10 +++----
 src/Propellor/Property/List.hs           |  4 +--
 src/Propellor/Property/Partition.hs      |  2 +-
 src/Propellor/Property/Postfix.hs        |  2 +-
 src/Propellor/Property/Scheduled.hs      |  6 ++--
 src/Propellor/Property/Systemd.hs        | 18 ++++++------
 src/Propellor/Spin.hs                    |  4 +--
 src/Propellor/Types.hs                   | 48 +++++++++++++-------------------
 src/Propellor/Types/Info.hs              |  6 ++--
 20 files changed, 134 insertions(+), 131 deletions(-)
 create mode 100644 src/Propellor/Container.hs

diff --git a/debian/changelog b/debian/changelog
index df518753..8a5b67e4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -49,6 +49,11 @@ propellor (3.0.0) UNRELEASED; urgency=medium
       For example:
         upgraded :: Property Debian
         upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
+    - Several utility functions have been renamed:
+      getInfo to fromInfo
+      propertyInfo to getInfo
+      propertyDesc to getDesc
+      propertyChildren to getChildren
   * The new `pickOS` property combinator can be used to combine different
     properties, supporting different OS's, into one Property that chooses
     what to do based on the Host's OS.
diff --git a/doc/todo/type_level_OS_requirements.mdwn b/doc/todo/type_level_OS_requirements.mdwn
index 7c2fb78f..f1c3e59f 100644
--- a/doc/todo/type_level_OS_requirements.mdwn
+++ b/doc/todo/type_level_OS_requirements.mdwn
@@ -21,13 +21,12 @@ withOS.
 
 The `os` property would need to yield a `Property (os:[])`, where the type
 level list contains a type-level eqivilant of the value passed to the
-property. Is that possible to do? reification or something?
-(See: )
-Or, alternatively, could have less polymorphic `debian` etc
+property. Is that possible to do?
+Or, alternatively, could have less polymorphic `osDebian` etc
 properties replace the `os` property.
 
 If a Host's list of properties, when all combined together,
-contains more than one element in its '[OS], that needs to be a type error,
+contains more than one element in its '[OS], that could be a type error,
 the OS of the Host is indeterminite. Which would be fixed by using the `os`
 property to specify.
 
diff --git a/propellor.cabal b/propellor.cabal
index e47bb2e6..4a7739d3 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -141,6 +141,7 @@ Library
     Propellor.PropAccum
     Propellor.Utilities
     Propellor.CmdLine
+    Propellor.Container
     Propellor.Info
     Propellor.Message
     Propellor.Debug
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
new file mode 100644
index 00000000..6e974efd
--- /dev/null
+++ b/src/Propellor/Container.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+module Propellor.Container where
+
+import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Info
+import Propellor.PrivData
+
+class Container c where
+	containerProperties :: c -> [ChildProperty]
+	containerInfo :: c -> Info
+
+instance Container Host where
+	 containerProperties = hostProperties
+	 containerInfo = hostInfo
+
+-- | Adjust the provided Property, adding to its
+-- propertyChidren the properties of the provided container.
+-- 
+-- The Info of the propertyChildren is adjusted to only include 
+-- info that should be propagated out to the Property.
+--
+-- Any PrivInfo that uses HostContext is adjusted to use the name
+-- of the container as its context.
+propagateContainer
+	::
+		-- Since the children being added probably have info,
+		-- require the Property's metatypes to have info.
+		( IncludesInfo metatypes ~ 'True
+		, Container c
+		)
+	=> String
+	-> c
+	-> Property metatypes
+	-> Property metatypes
+propagateContainer containername c prop = prop
+	`addChildren` map convert (containerProperties c)
+  where
+	convert p = 
+		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
+		    n' = n
+		    	`addInfoProperty` mapInfo (forceHostContext containername)
+				(propagatableInfo (getInfo p))
+		   	`addChildren` map convert (getChildren p)
+		in toChildProperty n'
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 725a02ad..ff0b3b5e 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -42,7 +42,7 @@ pureInfoProperty' desc i = addInfoProperty p i
 
 -- | Gets a value from the host's Info.
 askInfo :: (IsInfo v) => Propellor v
-askInfo = asks (getInfo . hostInfo)
+askInfo = asks (fromInfo . hostInfo)
 
 -- | Specifies that a host's operating system is Debian,
 -- and further indicates the suite and architecture.
@@ -129,7 +129,7 @@ hostMap l = M.fromList $ zip (map hostName l) l
 
 aliasMap :: [Host] -> M.Map HostName Host
 aliasMap = M.fromList . concat .
-	map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h)
+	map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ fromInfo $ hostInfo h)
 
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
@@ -141,7 +141,7 @@ findAlias :: [Host] -> HostName -> Maybe Host
 findAlias l hn = M.lookup hn (aliasMap l)
 
 getAddresses :: Info -> [IPAddr]
-getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
+getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . fromInfo
 
 hostAddresses :: HostName -> [Host] -> [IPAddr]
 hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 77c7133f..0bc0c100 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -161,7 +161,7 @@ filterPrivData :: Host -> PrivMap -> PrivMap
 filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
   where
 	used = S.map (\(f, _, c) -> (f, mkHostContext c (hostName host))) $
-		fromPrivInfo $ getInfo $ hostInfo host
+		fromPrivInfo $ fromInfo $ hostInfo host
 
 getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
 getPrivData field context m = do
@@ -245,7 +245,7 @@ mkUsedByMap = M.unionsWith (++) . map (\h -> mkPrivDataMap h $ const [hostName h
 mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a
 mkPrivDataMap host mkv = M.fromList $
 	map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d))
-		(S.toList $ fromPrivInfo $ getInfo $ hostInfo host)
+		(S.toList $ fromPrivInfo $ fromInfo $ hostInfo host)
 
 setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
 setPrivDataTo field context (PrivData value) = do
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 8281b9a1..af362ca7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -12,7 +12,6 @@ module Propellor.PropAccum
 	, (&)
 	, (&^)
 	, (!)
-	--, propagateContainer
 	) where
 
 import Propellor.Types
@@ -82,35 +81,3 @@ Props c &^ p = Props (toChildProperty p : c)
 	-> RevertableProperty (MetaTypes y) (MetaTypes z)
 	-> Props (MetaTypes (Combine x z))
 Props c ! p = Props (c ++ [toChildProperty (revert p)])
-
-{-
-
--- | Adjust the provided Property, adding to its
--- propertyChidren the properties of the provided container.
--- 
--- The Info of the propertyChildren is adjusted to only include 
--- info that should be propagated out to the Property.
---
--- Any PrivInfo that uses HostContext is adjusted to use the name
--- of the container as its context.
-propagateContainer
-	:: (PropAccum container)
-	=> String
-	-> container
-	-> Property metatypes
-	-> Property metatypes
-propagateContainer containername c prop = Property
-	undefined
-	(propertyDesc prop)
-	(getSatisfy prop)
-	(propertyInfo prop)
-	(propertyChildren prop ++ hostprops)
-  where
-	hostprops = map go $ getProperties c
-	go p = 
-		let i = mapInfo (forceHostContext containername)
-			(propagatableInfo (propertyInfo p))
-		    cs = map go (propertyChildren p)
-		in infoProperty (propertyDesc p) (getSatisfy p) i cs
-
--}
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 4480f98d..547e5c94 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -41,23 +41,18 @@ data Chroot where
 	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
 
 chrootSystem :: Chroot -> Maybe System
-chrootSystem (Chroot _ _ h) = fromInfoVal (getInfo (hostInfo h))
+chrootSystem (Chroot _ _ h) = fromInfoVal (fromInfo (hostInfo h))
 
 instance Show Chroot where
 	show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
 
-instance PropAccum Chroot where
-	(Chroot l c h) `addProp` p = Chroot l c (h & p)
-	(Chroot l c h) `addPropFront` p = Chroot l c (h `addPropFront` p)
-	getProperties (Chroot _ _ h) = hostProperties h
-
 -- | Class of things that can do initial bootstrapping of an operating
 -- System in a chroot.
 class ChrootBootstrapper b where
 	-- | Do initial bootstrapping of an operating system in a chroot.
 	-- If the operating System is not supported, return
 	-- Left error message.
-	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property HasInfo)
+	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property (HasInfo + UnixLike))
 
 -- | Use this to bootstrap a chroot by extracting a tarball.
 --
@@ -70,12 +65,11 @@ data ChrootTarball = ChrootTarball FilePath
 instance ChrootBootstrapper ChrootTarball where
 	buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
 
-extractTarball :: FilePath -> FilePath -> Property HasInfo
-extractTarball target src = toProp .
-	check (unpopulated target) $
-		cmdProperty "tar" params
-			`assume` MadeChange
-			`requires` File.dirExists target
+extractTarball :: FilePath -> FilePath -> Property UnixLike
+extractTarball target src = check (unpopulated target) $
+	cmdProperty "tar" params
+		`assume` MadeChange
+		`requires` File.dirExists target
   where
 	params =
 		[ "-C"
@@ -92,14 +86,15 @@ instance ChrootBootstrapper Debootstrapped where
 		(Just s@(System (Debian _) _)) -> Right $ debootstrap s
 		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
 		(Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap."
-		Nothing -> Left "Cannot debootstrap; `os` property not specified"
+		Nothing -> Left "Cannot debootstrap; OS not specified"
 	  where
 		debootstrap s = Debootstrap.built loc s cf
 
 -- | Defines a Chroot at the given location, built with debootstrap.
 --
 -- Properties can be added to configure the Chroot. At a minimum,
--- add the `os` property to specify the operating system to bootstrap.
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
 --
 -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev"
 -- >	& osDebian Unstable "amd64"
@@ -131,25 +126,25 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 	(propertyList (chrootDesc c "removed") [teardown])
   where
 	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
-		`requires` toProp built
+		`requires` built
 
 	built = case buildchroot bootstrapper (chrootSystem c) loc of
 		Right p -> p
 		Left e -> cantbuild e
 
-	cantbuild e = infoProperty (chrootDesc c "built") (error e) mempty []
+	cantbuild e = property (chrootDesc c "built") (error e)
 
 	teardown = check (not <$> unpopulated loc) $
 		property ("removed " ++ loc) $
 			makeChange (removeChroot loc)
 
-propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo
+propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property (HasInfo + UnixLike)
 propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
   where
 	p' = infoProperty
-		(propertyDesc p)
+		(getDesc p)
 		(getSatisfy p)
-		(propertyInfo p <> chrootInfo c)
+		(getInfo p <> chrootInfo c)
 		(propertyChildren p)
 
 chrootInfo :: Chroot -> Info
@@ -157,7 +152,7 @@ chrootInfo (Chroot loc _ h) = mempty `addInfo`
 	mempty { _chroots = M.singleton loc h }
 
 -- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo
+propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
 propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
 	let d = localdir  shimdir c
 	let me = localdir  "propellor"
@@ -205,7 +200,7 @@ chain :: [Host] -> CmdLine -> IO ()
 chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 	case findHostNoAlias hostlist hn of
 		Nothing -> errorMessage ("cannot find host " ++ hn)
-		Just parenthost -> case M.lookup loc (_chroots $ getInfo $ hostInfo parenthost) of
+		Just parenthost -> case M.lookup loc (_chroots $ fromInfo $ hostInfo parenthost) of
 			Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
 			Just h -> go h
   where
@@ -215,7 +210,7 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 		onlyProcess (provisioningLock loc) $ do
 			r <- runPropellor (setInChroot h) $ ensureChildProperties $
 				if systemdonly
-					then [toProp Systemd.installed]
+					then [toChildProperty Systemd.installed]
 					else hostProperties h
 			flushConcurrentOutput
 			putStrLn $ "\n" ++ show r
@@ -257,7 +252,7 @@ chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
 -- This is accomplished by installing a  script
 -- that does not let any daemons be started by packages that use
 -- invoke-rc.d. Reverting the property removes the script.
-noServices :: RevertableProperty NoInfo
+noServices :: RevertableProperty DebianLike DebianLike
 noServices = setup  teardown
   where
 	f = "/usr/sbin/policy-rc.d"
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index a86c839f..ace85a3c 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -78,7 +78,7 @@ concurrently p1 p2 = (combineWith go go p1 p2)
 -- The above example will run foo and bar concurrently, and once either of
 -- those 2 properties finishes, will start running baz.
 concurrentList :: SingI metatypes => IO Int -> Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
-concurrentList getn d (Props ps) = property d go `modifyChildren` (++ ps)
+concurrentList getn d (Props ps) = property d go `addChildren` ps
   where
 	go = do
 		n <- liftIO getn
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ec15281b..8fe607bc 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -126,7 +126,7 @@ mkOrchestra = fromJust . go S.empty
   where
 	go seen h
 		| S.member (hostName h) seen = Nothing -- break loop
-		| otherwise = Just $ case getInfo (hostInfo h) of
+		| otherwise = Just $ case fromInfo (hostInfo h) of
 			ConductorFor [] -> Conducted h
 			ConductorFor l -> 
 				let seen' = S.insert (hostName h) seen
@@ -214,7 +214,7 @@ orchestrate :: [Host] -> [Host]
 orchestrate hs = map go hs
   where
 	go h
-		| isOrchestrated (getInfo (hostInfo h)) = h
+		| isOrchestrated (fromInfo (hostInfo h)) = h
 		| otherwise = foldl orchestrate' (removeold h) (map (deloop h) os)
 	os = extractOrchestras hs
 
@@ -222,7 +222,7 @@ orchestrate hs = map go hs
 	removeold' h oldconductor = addPropHost h $
 		undoRevertableProperty $ conductedBy oldconductor
 
-	oldconductors = zip hs (map (getInfo . hostInfo) hs)
+	oldconductors = zip hs (map (fromInfo . hostInfo) hs)
 	oldconductorsof h = flip mapMaybe oldconductors $ 
 		\(oldconductor, NotConductorFor l) ->
 			if any (sameHost h) l
@@ -299,7 +299,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
 	i = mempty 
 		`addInfo` mconcat (map privinfo hs)
 		`addInfo` Orchestrated (Any True)
-	privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h')
+	privinfo h' = forceHostContext (hostName h') $ fromInfo (hostInfo h')
 
 -- Use this property to let the specified conductor ssh in and run propellor.
 conductedBy :: Host -> RevertableProperty DebianLike UnixLike
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index a660a016..2b5596bd 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -213,7 +213,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
 otherServers wantedtype hosts domain =
 	M.keys $ M.filter wanted $ hostMap hosts
   where
-	wanted h = case M.lookup domain (fromNamedConfMap $ getInfo $ hostInfo h) of
+	wanted h = case M.lookup domain (fromNamedConfMap $ fromInfo $ hostInfo h) of
 		Nothing -> False
 		Just conf -> confDnsServerType conf == wantedtype
 			&& confDomain conf == domain
@@ -468,7 +468,7 @@ genZone inzdomain hostmap zdomain soa =
 	-- So we can just use the IPAddrs.
 	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
 	addcnames h = concatMap gen $ filter (inDomain zdomain) $
-		mapMaybe getCNAME $ S.toList $ fromDnsInfo $ getInfo info
+		mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
 	  where
 		info = hostInfo h
 		gen c = case getAddresses info of
@@ -483,7 +483,7 @@ genZone inzdomain hostmap zdomain soa =
 	  where
 		info = hostInfo h
 		l = zip (repeat $ AbsDomain $ hostName h)
-			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ getInfo info))
+			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ fromInfo info))
 
 	-- Simplifies the list of hosts. Remove duplicate entries.
 	-- Also, filter out any CHAMES where the same domain has an
@@ -518,7 +518,7 @@ addNamedConf conf = NamedConfMap (M.singleton domain conf)
 	domain = confDomain conf
 
 getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks $ fromNamedConfMap . getInfo . hostInfo
+getNamedConf = asks $ fromNamedConfMap . fromInfo . hostInfo
 
 -- | Generates SSHFP records for hosts in the domain (or with CNAMES
 -- in the domain) that have configured ssh public keys.
@@ -531,7 +531,7 @@ genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)
 	gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
 	mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)
 		(AbsDomain hostname : cnames)
-	cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ getInfo info
+	cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
 	hostname = hostName h
 	info = hostInfo h
 
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index d19d15aa..fe1e3b18 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -172,9 +172,9 @@ propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Pr
 propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
   where
 	p' = infoProperty
-		(propertyDesc p)
+		(getDesc p)
 		(getSatisfy p)
-		(propertyInfo p <> dockerinfo)
+		(getInfo p <> dockerinfo)
 		(propertyChildren p)
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
@@ -186,7 +186,7 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
   where
 	runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
 		(_dockerRunParams info)
-	info = getInfo $ hostInfo h'
+	info = fromInfo $ hostInfo h'
 	h' = h
 		-- Restart by default so container comes up on
 		-- boot or when docker is upgraded.
@@ -435,7 +435,7 @@ myContainerSuffix = ".propellor"
 containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
 containerDesc cid p = p `describe` desc
   where
-	desc = "container " ++ fromContainerId cid ++ " " ++ propertyDesc p
+	desc = "container " ++ fromContainerId cid ++ " " ++ getDesc p
 
 runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux
 runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
@@ -574,7 +574,7 @@ chain hostlist hn s = case toContainerId s of
 	Nothing -> errorMessage "bad container id"
 	Just cid -> case findHostNoAlias hostlist hn of
 		Nothing -> errorMessage ("cannot find host " ++ hn)
-		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ getInfo $ hostInfo parenthost) of
+		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ fromInfo $ hostInfo parenthost) of
 			Nothing -> errorMessage ("cannot find container " ++ containerName cid ++ " docked on host " ++ hn)
 			Just h -> go cid h
   where
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 304d0863..a8b8347a 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -35,7 +35,7 @@ toProps ps = Props (map toChildProperty ps)
 propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
 propertyList desc (Props ps) = 
 	property desc (ensureChildProperties cs)
-		`modifyChildren` (++ cs)
+		`addChildren` cs
   where
 	cs = map toChildProperty ps
 
@@ -44,7 +44,7 @@ propertyList desc (Props ps) =
 combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
 combineProperties desc (Props ps) = 
 	property desc (combineSatisfy cs NoChange)
-		`modifyChildren` (++ cs)
+		`addChildren` cs
   where
 	cs = map toChildProperty ps
 
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 5aff4ba4..291d4168 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -68,7 +68,7 @@ kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
 kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
   where
 	go :: Property DebianLike
-	go = property' (propertyDesc (mkprop [])) $ \w -> do
+	go = property' (getDesc (mkprop [])) $ \w -> do
 		cleanup -- idempotency
 		loopdevs <- liftIO $ kpartxParse
 			<$> readProcess "kpartx" ["-avs", diskimage]
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index 7d9e7068..45aa4e42 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -304,7 +304,7 @@ saslAuthdInstalled = setupdaemon
 -- | Uses `saslpasswd2` to set the password for a user in the sasldb2 file.
 --
 -- The password is taken from the privdata.
-saslPasswdSet :: Domain -> User -> Property HasInfo
+saslPasswdSet :: Domain -> User -> Property (HasInfo + UnixLike)
 saslPasswdSet domain (User user) = go `changesFileContent` "/etc/sasldb2"
   where
 	go = withPrivData src ctx $ \getpw ->
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 534e1e88..95e4e362 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -22,18 +22,18 @@ import qualified Data.Map as M
 -- last run.
 period :: (IsProp (Property i)) => Property i -> Recurrance -> Property i
 period prop recurrance = flip describe desc $ adjustPropertySatisfy prop $ \satisfy -> do
-	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+	lasttime <- liftIO $ getLastChecked (getDesc prop)
 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
 	t <- liftIO localNow
 	if Just t >= nexttime
 		then do
 			r <- satisfy
-			liftIO $ setLastChecked t (propertyDesc prop)
+			liftIO $ setLastChecked t (getDesc prop)
 			return r
 		else noChange
   where
 	schedule = Schedule recurrance AnyTime
-	desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
+	desc = getDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
 
 -- | Like period, but parse a human-friendly string.
 periodParse :: (IsProp (Property i)) => Property i -> String -> Property i
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 2234ad5c..d909e4df 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -214,13 +214,13 @@ container name system mkchroot = Container name c h
 --
 -- Reverting this property stops the container, removes the systemd unit,
 -- and deletes the chroot and all its contents.
-nspawned :: Container -> RevertableProperty HasInfo
+nspawned :: Container -> RevertableProperty (HasInfo + UnixLike) UnixLike
 nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 	p `describe` ("nspawned " ++ name)
   where
 	p = enterScript c
 		`before` chrootprovisioned
-		`before` nspawnService c (_chrootCfg $ getInfo $ hostInfo h)
+		`before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
 		`before` containerprovisioned
 
 	-- Chroot provisioning is run in systemd-only mode,
@@ -336,7 +336,7 @@ mungename = replace "/" "_"
 -- When there is no leading dash, "--" is prepended to the parameter.
 --
 -- Reverting the property will remove a parameter, if it's present.
-containerCfg :: String -> RevertableProperty HasInfo
+containerCfg :: String -> RevertableProperty (HasInfo + UnixLike) UnixLike
 containerCfg p = RevertableProperty (mk True) (mk False)
   where
 	mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
@@ -348,18 +348,18 @@ containerCfg p = RevertableProperty (mk True) (mk False)
 -- | Bind mounts  from the host into the container.
 --
 -- This property is enabled by default. Revert it to disable it.
-resolvConfed :: RevertableProperty HasInfo
+resolvConfed :: RevertableProperty (HasInfo + UnixLike) UnixLike
 resolvConfed = containerCfg "bind=/etc/resolv.conf"
 
 -- | Link the container's journal to the host's if possible.
 -- (Only works if the host has persistent journal enabled.)
 --
 -- This property is enabled by default. Revert it to disable it.
-linkJournal :: RevertableProperty HasInfo
+linkJournal :: RevertableProperty (HasInfo + UnixLike) UnixLike
 linkJournal = containerCfg "link-journal=try-guest"
 
 -- | Disconnect networking of the container from the host.
-privateNetwork :: RevertableProperty HasInfo
+privateNetwork :: RevertableProperty (HasInfo + UnixLike) UnixLike
 privateNetwork = containerCfg "private-network"
 
 class Publishable a where
@@ -397,7 +397,7 @@ instance Publishable (Proto, Bound Port) where
 -- >	& Systemd.running Systemd.networkd
 -- >	& Systemd.publish (Port 80 ->- Port 8080)
 -- >	& Apt.installedRunning "apache2"
-publish :: Publishable p => p -> RevertableProperty HasInfo
+publish :: Publishable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
 publish p = containerCfg $ "--port=" ++ toPublish p
 
 class Bindable a where
@@ -410,9 +410,9 @@ instance Bindable (Bound FilePath) where
 	toBind v = hostSide v ++ ":" ++ containerSide v
 
 -- | Bind mount a file or directory from the host into the container.
-bind :: Bindable p => p -> RevertableProperty HasInfo
+bind :: Bindable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
 bind p = containerCfg $ "--bind=" ++ toBind p
 
 -- | Read-only mind mount.
-bindRo :: Bindable p => p -> RevertableProperty HasInfo
+bindRo :: Bindable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
 bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 5f103b8a..944696dd 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -90,7 +90,7 @@ spin' mprivdata relay target hst = do
 		error "remote propellor failed"
   where
 	hn = fromMaybe target relay
-	sys = case getInfo (hostInfo hst) of
+	sys = case fromInfo (hostInfo hst) of
 		InfoVal o -> Just o
 		NoInfoVal -> Nothing
 
@@ -170,7 +170,7 @@ getSshTarget target hst
 					return ip
 
 	configips = map fromIPAddr $ mapMaybe getIPAddr $
-		S.toList $ fromDnsInfo $ getInfo $ hostInfo hst
+		S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst
 
 -- Update the privdata, repo url, and git repo over the ssh
 -- connection, talking to the user's local propellor instance which is
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index ccbfd3e0..2bddfc1a 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -26,11 +26,7 @@ module Propellor.Types
 	, type (+)
 	, addInfoProperty
 	, addInfoProperty'
-	, addChildrenProperty
 	, adjustPropertySatisfy
-	, propertyInfo
-	, propertyDesc
-	, propertyChildren
 	, RevertableProperty(..)
 	, ()
 	, ChildProperty
@@ -124,12 +120,15 @@ type Desc = String
 -- internally, so you needn't worry about them.
 data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
+instance Show (Property metatypes) where
+	show p = "property " ++ show (getDesc p)
+
 -- | Since there are many different types of Properties, they cannot be put
 -- into a list. The simplified ChildProperty can be put into a list.
 data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
 
 instance Show ChildProperty where
-	show (ChildProperty desc _ _ _) = desc
+	show = getDesc
 
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
@@ -170,28 +169,10 @@ addInfoProperty'
 addInfoProperty' (Property t d a oldi c) newi =
 	Property t d a (oldi <> newi) c
 
--- | Adds children to a Property.
-addChildrenProperty :: Property metatypes -> [ChildProperty] -> Property metatypes
-addChildrenProperty (Property t s a i cs) cs' = Property t s a i (cs ++ cs')
-
 -- | Changes the action that is performed to satisfy a property.
 adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
 adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
 
-propertyInfo :: Property metatypes -> Info
-propertyInfo (Property _ _ _ i _) = i
-
-propertyDesc :: Property metatypes -> Desc
-propertyDesc (Property _ d _ _ _) = d
-
-instance Show (Property metatypes) where
-	show p = "property " ++ show (propertyDesc p)
-
--- | A Property can include a list of child properties that it also
--- satisfies. This allows them to be introspected to collect their info, etc.
-propertyChildren :: Property metatypes -> [ChildProperty]
-propertyChildren (Property _ _ _ _ c) = c
-
 -- | A property that can be reverted. The first Property is run
 -- normally and the second is run when it's reverted.
 data RevertableProperty setupmetatypes undometatypes = RevertableProperty
@@ -209,14 +190,16 @@ instance Show (RevertableProperty setupmetatypes undometatypes) where
 	-> RevertableProperty setupmetatypes undometatypes
 setup  undo = RevertableProperty setup undo
 
--- | Class of types that can be used as properties of a host.
 class IsProp p where
 	setDesc :: p -> Desc -> p
 	getDesc :: p -> Desc
-	modifyChildren :: p -> ([ChildProperty] -> [ChildProperty]) -> p
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
 	-- | Gets the info of the property, combined with all info
 	-- of all children properties.
 	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
 	-- | Gets a ChildProperty representing the Property.
 	-- You should not normally need to use this.
 	toChildProperty :: p -> ChildProperty
@@ -227,19 +210,23 @@ class IsProp p where
 
 instance IsProp (Property metatypes) where
 	setDesc (Property t _ a i c) d = Property t d a i c
-	getDesc = propertyDesc
-	modifyChildren (Property t d a i c) f = Property t d a i (f c)
+	getDesc (Property _ d _ _ _) = d
+	getChildren (Property _ _ _ _ c) = c
+	addChildren (Property t d a i c) c' = Property t d a i (c ++ c')
 	getInfoRecursive (Property _ _ _ i c) =
 		i <> mconcat (map getInfoRecursive c)
+	getInfo (Property _ _ _ i _) = i
 	toChildProperty (Property _ d a i c) = ChildProperty d a i c
 	getSatisfy (Property _ _ a _ _) = a
 
 instance IsProp ChildProperty where
 	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
 	getDesc (ChildProperty d _ _ _) = d
-	modifyChildren (ChildProperty d a i c) f = ChildProperty d a i (f c)
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
 	getInfoRecursive (ChildProperty _ _ i c) =
 		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
 	toChildProperty = id
 	getSatisfy (ChildProperty _ a _ _) = a
 
@@ -248,9 +235,12 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	setDesc (RevertableProperty p1 p2) d =
 		RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
 	getDesc (RevertableProperty p1 _) = getDesc p1
-	modifyChildren (RevertableProperty p1 p2) f = RevertableProperty (modifyChildren p1 f) (modifyChildren p2 f)
+	getChildren (RevertableProperty p1 _) = getChildren p1
+	-- | Only add children to the active side.
+	addChildren (RevertableProperty p1 p2) c = RevertableProperty (addChildren p1 c) p2
 	-- | Return the Info of the currently active side.
 	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
+	getInfo (RevertableProperty p1 _p2) = getInfo p1
 	toChildProperty (RevertableProperty p1 _p2) = toChildProperty p1
 	getSatisfy (RevertableProperty p1 _) = getSatisfy p1
 
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index bc1543e2..c7f6b82f 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -5,7 +5,7 @@ module Propellor.Types.Info (
 	IsInfo(..),
 	addInfo,
 	toInfo,
-	getInfo,
+	fromInfo,
 	mapInfo,
 	propagatableInfo,
 	InfoVal(..),
@@ -51,8 +51,8 @@ toInfo :: IsInfo v => v -> Info
 toInfo = addInfo mempty
 
 -- The list is reversed here because addInfo builds it up in reverse order.
-getInfo :: IsInfo v => Info -> v
-getInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
+fromInfo :: IsInfo v => Info -> v
+fromInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
 
 -- | Maps a function over all values stored in the Info that are of the
 -- appropriate type.
-- 
cgit v1.2.3


From 530b0dde35e143df1ba8cb8f4828e0a3bc0b4ffb Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 19:49:03 -0400
Subject: ported Chroot!!

It ended up specialized to Linux for a few reasons, including
inChrootProcess's use of umountLazy which is linux specific.

The ChrootBootstrapper type class is specialized to Linux for no good
reason. Future work: Support other unix's.
---
 src/Propellor/Property/Chroot.hs | 41 +++++++++++++++++++++++-----------------
 1 file changed, 24 insertions(+), 17 deletions(-)

diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 547e5c94..a0f3aca8 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -19,6 +19,7 @@ module Propellor.Property.Chroot (
 ) where
 
 import Propellor.Base
+import Propellor.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
@@ -40,8 +41,12 @@ import System.Console.Concurrent
 data Chroot where
 	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
 
+instance Container Chroot where
+	containerProperties (Chroot _ _ h) = containerProperties h
+	containerInfo (Chroot _ _ h) = containerInfo h
+
 chrootSystem :: Chroot -> Maybe System
-chrootSystem (Chroot _ _ h) = fromInfoVal (fromInfo (hostInfo h))
+chrootSystem = fromInfoVal . fromInfo . containerInfo
 
 instance Show Chroot where
 	show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
@@ -52,7 +57,7 @@ class ChrootBootstrapper b where
 	-- | Do initial bootstrapping of an operating system in a chroot.
 	-- If the operating System is not supported, return
 	-- Left error message.
-	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property (HasInfo + UnixLike))
+	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux)
 
 -- | Use this to bootstrap a chroot by extracting a tarball.
 --
@@ -63,7 +68,8 @@ class ChrootBootstrapper b where
 data ChrootTarball = ChrootTarball FilePath
 
 instance ChrootBootstrapper ChrootTarball where
-	buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
+	buildchroot (ChrootTarball tb) _ loc = Right $
+		tightenTargets $ extractTarball loc tb
 
 extractTarball :: FilePath -> FilePath -> Property UnixLike
 extractTarball target src = check (unpopulated target) $
@@ -116,15 +122,20 @@ bootstrapped bootstrapper location = Chroot location bootstrapper h
 -- Reverting this property removes the chroot. Anything mounted inside it
 -- is first unmounted. Note that it does not ensure that any processes
 -- that might be running inside the chroot are stopped.
-provisioned :: Chroot -> RevertableProperty HasInfo
+provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
 provisioned c = provisioned' (propagateChrootInfo c) c False
 
-provisioned' :: (Property HasInfo -> Property HasInfo) -> Chroot -> Bool -> RevertableProperty HasInfo
+provisioned'
+	:: (Property Linux -> Property (HasInfo + Linux))
+	-> Chroot
+	-> Bool
+	-> RevertableProperty (HasInfo + Linux) Linux
 provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
-	(propigator $ propertyList (chrootDesc c "exists") [setup])
+	(propigator $ setup `describe` chrootDesc c "exists")
 		
-	(propertyList (chrootDesc c "removed") [teardown])
+	(teardown `describe` chrootDesc c "removed")
   where
+	setup :: Property Linux
 	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
 		`requires` built
 
@@ -134,18 +145,14 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 
 	cantbuild e = property (chrootDesc c "built") (error e)
 
+	teardown :: Property Linux
 	teardown = check (not <$> unpopulated loc) $
 		property ("removed " ++ loc) $
 			makeChange (removeChroot loc)
 
-propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property (HasInfo + UnixLike)
-propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
-  where
-	p' = infoProperty
-		(getDesc p)
-		(getSatisfy p)
-		(getInfo p <> chrootInfo c)
-		(propertyChildren p)
+propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
+propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
+	p `addInfoProperty` chrootInfo c
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ h) = mempty `addInfo`
@@ -253,11 +260,11 @@ chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
 -- that does not let any daemons be started by packages that use
 -- invoke-rc.d. Reverting the property removes the script.
 noServices :: RevertableProperty DebianLike DebianLike
-noServices = setup  teardown
+noServices = tightenTargets setup  tightenTargets teardown
   where
 	f = "/usr/sbin/policy-rc.d"
 	script = [ "#!/bin/sh", "exit 101" ]
-	setup = combineProperties "no services started"
+	setup = combineProperties "no services started" $ toProps
 		[ File.hasContent f script
 		, File.mode f (combineModes (readModes ++ executeModes))
 		]
-- 
cgit v1.2.3


From 46fc5467e633a9c1f149cb0cd7ee03af1e9e0aa1 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 21:38:39 -0400
Subject: ported docker

Also, implemented modifyHostProps to add properties to an existing host.
Using it bypasses some type safety. Its use in docker is safe though.

But, in Conductor, the use of it was not really safe, because it was used
with a DebianLike property. Fixed that by making Ssh.installed
target all unix's, although it will fail on non-DebianLike ones.
---
 config-simple.hs                                   |   7 --
 src/Propellor/Container.hs                         |   6 +-
 src/Propellor/PropAccum.hs                         |  18 ++++
 src/Propellor/Property/Chroot.hs                   |   2 +-
 src/Propellor/Property/Conductor.hs                |  21 ++--
 src/Propellor/Property/DiskImage.hs                |  16 +--
 src/Propellor/Property/Docker.hs                   | 111 ++++++++++++---------
 .../Property/HostingProvider/CloudAtCost.hs        |  33 +++---
 src/Propellor/Property/Hostname.hs                 |  21 ++--
 src/Propellor/Property/Ssh.hs                      |   9 +-
 10 files changed, 137 insertions(+), 107 deletions(-)

diff --git a/config-simple.hs b/config-simple.hs
index 277e2edd..42b3d838 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -4,14 +4,8 @@
 import Propellor
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Network as Network
---import qualified Propellor.Property.Ssh as Ssh
 import qualified Propellor.Property.Cron as Cron
-import Propellor.Property.Scheduled
---import qualified Propellor.Property.Sudo as Sudo
 import qualified Propellor.Property.User as User
---import qualified Propellor.Property.Hostname as Hostname
---import qualified Propellor.Property.Tor as Tor
 
 main :: IO ()
 main = defaultMain hosts
@@ -31,6 +25,5 @@ mybox = host "mybox.example.com" $ props
 	& Apt.installed ["etckeeper"]
 	& Apt.installed ["ssh"]
 	& User.hasSomePassword (User "root")
-	& Network.ipv6to4
 	& File.dirExists "/var/www"
 	& Cron.runPropellor (Cron.Times "30 * * * *")
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index 6e974efd..832faf9c 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -7,11 +7,11 @@ import Propellor.Types.MetaTypes
 import Propellor.Types.Info
 import Propellor.PrivData
 
-class Container c where
+class IsContainer c where
 	containerProperties :: c -> [ChildProperty]
 	containerInfo :: c -> Info
 
-instance Container Host where
+instance IsContainer Host where
 	 containerProperties = hostProperties
 	 containerInfo = hostInfo
 
@@ -28,7 +28,7 @@ propagateContainer
 		-- Since the children being added probably have info,
 		-- require the Property's metatypes to have info.
 		( IncludesInfo metatypes ~ 'True
-		, Container c
+		, IsContainer c
 		)
 	=> String
 	-> c
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index af362ca7..1212ef7a 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -12,6 +12,8 @@ module Propellor.PropAccum
 	, (&)
 	, (&^)
 	, (!)
+	, hostProps
+	, modifyHostProps
 	) where
 
 import Propellor.Types
@@ -30,6 +32,16 @@ import Prelude
 host :: HostName -> Props metatypes -> Host
 host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
+-- | Note that the metatype of a Host's properties is not retained,
+-- so this defaults to UnixLike. So, using this with modifyHostProps can
+-- add properties to a Host that conflict with properties already in it.
+-- Use caution when using this.
+hostProps :: Host -> Props UnixLike
+hostProps = Props . hostProperties
+
+modifyHostProps :: Host -> Props metatypes -> Host
+modifyHostProps h ps = host (hostName h) ps
+
 -- | Props is a combination of a list of properties, with their combined 
 -- metatypes.
 data Props metatypes = Props [ChildProperty]
@@ -81,3 +93,9 @@ Props c &^ p = Props (toChildProperty p : c)
 	-> RevertableProperty (MetaTypes y) (MetaTypes z)
 	-> Props (MetaTypes (Combine x z))
 Props c ! p = Props (c ++ [toChildProperty (revert p)])
+
+-- addPropsHost :: Host -> [Prop] -> Host
+-- addPropsHost (Host hn ps i) p = Host hn ps' i'
+--   where
+-- 	ps' = ps ++ [toChildProperty p]
+-- 	i' = i <> getInfoRecursive p
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index a0f3aca8..ddadc763 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -41,7 +41,7 @@ import System.Console.Concurrent
 data Chroot where
 	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
 
-instance Container Chroot where
+instance IsContainer Chroot where
 	containerProperties (Chroot _ _ h) = containerProperties h
 	containerInfo (Chroot _ _ h) = containerInfo h
 
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index 8fe607bc..005fc804 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,7 +83,7 @@ import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
 class Conductable c where
-	conducts :: c -> RevertableProperty (HasInfo + DebianLike) (HasInfo + UnixLike)
+	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
 	-- | Conduct the specified host.
@@ -219,8 +219,8 @@ orchestrate hs = map go hs
 	os = extractOrchestras hs
 
 	removeold h = foldl removeold' h (oldconductorsof h)
-	removeold' h oldconductor = addPropHost h $
-		undoRevertableProperty $ conductedBy oldconductor
+	removeold' h oldconductor = modifyHostProps h $ hostProps h
+		! conductedBy oldconductor
 
 	oldconductors = zip hs (map (fromInfo . hostInfo) hs)
 	oldconductorsof h = flip mapMaybe oldconductors $ 
@@ -233,22 +233,17 @@ orchestrate' :: Host -> Orchestra -> Host
 orchestrate' h (Conducted _) = h
 orchestrate' h (Conductor c l)
 	| sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l)
-	| any (sameHost h) (map topHost l) = cont $ addPropHost h $
-		setupRevertableProperty $ conductedBy c
+	| any (sameHost h) (map topHost l) = cont $
+		modifyHostProps h $ hostProps h
+			& conductedBy c
 	| otherwise = cont h
   where
 	cont h' = foldl orchestrate' h' l
 
-addPropHost :: Host -> Property i -> Host
-addPropHost (Host hn ps i) p = Host hn ps' i'
-  where
-	ps' = ps ++ [toChildProperty p]
-	i' = i <> getInfoRecursive p
-
 -- The host this property is added to becomes the conductor for the
 -- specified Host. Note that `orchestrate` must be used for this property
 -- to have any effect.
-conductorFor :: Host -> Property (HasInfo + DebianLike)
+conductorFor :: Host -> Property (HasInfo + UnixLike)
 conductorFor h = go
 	`addInfoProperty` (toInfo (ConductorFor [h]))
 	`requires` setupRevertableProperty (conductorKnownHost h)
@@ -302,7 +297,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
 	privinfo h' = forceHostContext (hostName h') $ fromInfo (hostInfo h')
 
 -- Use this property to let the specified conductor ssh in and run propellor.
-conductedBy :: Host -> RevertableProperty DebianLike UnixLike
+conductedBy :: Host -> RevertableProperty UnixLike UnixLike
 conductedBy h = (setup  teardown)
 	`describe` ("conducted by " ++ hostName h)
   where
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 6200f856..48df7fab 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -76,16 +76,16 @@ type DiskImage = FilePath
 -- chroot while the disk image is being built, which should prevent any
 -- daemons that are included from being started on the system that is
 -- building the disk image.
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
 imageBuilt = imageBuilt' False
 
 -- | Like 'built', but the chroot is deleted and rebuilt from scratch each
 -- time. This is more expensive, but useful to ensure reproducible results
 -- when the properties of the chroot have been changed.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
 imageRebuilt = imageBuilt' True
 
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
 imageBuilt' rebuild img mkchroot tabletype final partspec = 
 	imageBuiltFrom img chrootdir tabletype final partspec
 		`requires` Chroot.provisioned chroot
@@ -109,7 +109,7 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
 		& Apt.cacheCleaned
 
 -- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty NoInfo
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty Linux Linux
 imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
   where
 	desc = img ++ " built from " ++ chrootdir
@@ -135,7 +135,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
 		imageFinalized final mnts mntopts devs parttable
 	rmimg = File.notPresent img
 
-partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property NoInfo
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
 partitionsPopulated chrootdir mnts mntopts devs = property desc $ mconcat $ zipWith3 go mnts mntopts devs
   where
 	desc = "partitions populated from " ++ chrootdir
@@ -203,7 +203,7 @@ getMountSz szm l (Just mntpt) =
 -- If the file doesn't exist, or is too small, creates a new one, full of 0's.
 --
 -- If the file is too large, truncates it down to the specified size.
-imageExists :: FilePath -> ByteSize -> Property NoInfo
+imageExists :: FilePath -> ByteSize -> Property Linux
 imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
 	ms <- catchMaybeIO $ getFileStatus img
 	case ms of
@@ -226,9 +226,9 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
 -- 
 -- It's ok if the second property leaves additional things mounted
 -- in the partition tree.
-type Finalization = (Property NoInfo, (FilePath -> [LoopDev] -> Property NoInfo))
+type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
 
-imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property NoInfo
+imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
 imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = 
 	property "disk image finalized" $ 
 		withTmpDir "mnt" $ \top -> 
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index fe1e3b18..041e1987 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}
 
 -- | Docker support for propellor
 --
@@ -50,6 +50,7 @@ import Propellor.Types.Docker
 import Propellor.Types.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
+import Propellor.Container
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Cmd as Cmd
@@ -71,11 +72,12 @@ installed = Apt.installed ["docker.io"]
 
 -- | Configures docker with an authentication file, so that images can be
 -- pushed to index.docker.io. Optional.
-configured :: Property DebianLike
+configured :: Property (HasInfo + DebianLike)
 configured = prop `requires` installed
   where
+	prop :: Property (HasInfo + DebianLike)
 	prop = withPrivData src anyContext $ \getcfg ->
-		property "docker configured" $ getcfg $ \cfg -> ensureProperty $
+		property' "docker configured" $ \w -> getcfg $ \cfg -> ensureProperty w $
 			"/root/.dockercfg" `File.hasContent` privDataLines cfg
 	src = PrivDataSourceFileFromCommand DockerAuthentication
 		"/root/.dockercfg" "docker login"
@@ -88,6 +90,10 @@ type ContainerName = String
 -- | A docker container.
 data Container = Container Image Host
 
+instance IsContainer Container where
+	containerProperties (Container _ h) = containerProperties h
+	containerInfo (Container _ h) = containerInfo h
+
 class HasImage a where
 	getImageName :: a -> Image
 
@@ -104,7 +110,7 @@ instance HasImage Container where
 -- >    & publish "80:80"
 -- >    & Apt.installed {"apache2"]
 -- >    & ...
-container :: ContainerName -> Image -> Props -> Container
+container :: ContainerName -> Image -> Props metatypes -> Container
 container cn image (Props ps) = Container image (Host cn ps info)
   where
 	info = dockerInfo mempty <> mconcat (map getInfoRecursive ps)
@@ -119,7 +125,7 @@ container cn image (Props ps) = Container image (Host cn ps info)
 --
 -- Reverting this property ensures that the container is stopped and
 -- removed.
-docked :: Container -> RevertableProperty HasInfo
+docked :: Container -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 docked ctr@(Container _ h) =
 	(propagateContainerInfo ctr (go "docked" setup))
 		
@@ -127,11 +133,12 @@ docked ctr@(Container _ h) =
   where
 	cn = hostName h
 
-	go desc a = property (desc ++ " " ++ cn) $ do
+	go desc a = property' (desc ++ " " ++ cn) $ \w -> do
 		hn <- asks hostName
 		let cid = ContainerId hn cn
-		ensureChildProperties [a cid (mkContainerInfo cid ctr)]
+		ensureProperty w $ a cid (mkContainerInfo cid ctr)
 
+	setup :: ContainerId -> ContainerInfo -> Property Linux
 	setup cid (ContainerInfo image runparams) =
 		provisionContainer cid
 			`requires`
@@ -139,8 +146,9 @@ docked ctr@(Container _ h) =
 			`requires`
 		installed
 
+	teardown :: ContainerId -> ContainerInfo -> Property Linux
 	teardown cid (ContainerInfo image _runparams) =
-		combineProperties ("undocked " ++ fromContainerId cid)
+		combineProperties ("undocked " ++ fromContainerId cid) $ toProps
 			[ stoppedContainer cid
 			, property ("cleaned up " ++ fromContainerId cid) $
 				liftIO $ report <$> mapM id
@@ -151,31 +159,31 @@ docked ctr@(Container _ h) =
 
 -- | Build the image from a directory containing a Dockerfile.
 imageBuilt :: HasImage c => FilePath -> c -> Property Linux
-imageBuilt directory ctr = describe built msg
+imageBuilt directory ctr = built `describe` msg
   where
 	msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory
-	built = Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir
-		`assume` MadeChange
+	built :: Property Linux
+	built = tightenTargets $
+		Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir
+			`assume` MadeChange
 	workDir p = p { cwd = Just directory }
 	image = getImageName ctr
 
 -- | Pull the image from the standard Docker Hub registry.
 imagePulled :: HasImage c => c -> Property Linux
-imagePulled ctr = describe pulled msg
+imagePulled ctr = pulled `describe` msg
   where
 	msg = "docker image " ++ (imageIdentifier image) ++ " pulled"
-	pulled = Cmd.cmdProperty dockercmd ["pull", imageIdentifier image]
-		`assume` MadeChange
+	pulled :: Property Linux
+	pulled = tightenTargets $ 
+		Cmd.cmdProperty dockercmd ["pull", imageIdentifier image]
+			`assume` MadeChange
 	image = getImageName ctr
 
-propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property (HasInfo + Linux)
-propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
+propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
+propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
+	p `addInfoProperty'` dockerinfo
   where
-	p' = infoProperty
-		(getDesc p)
-		(getSatisfy p)
-		(getInfo p <> dockerinfo)
-		(propertyChildren p)
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
 	cn = hostName h
@@ -187,7 +195,7 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
 	runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
 		(_dockerRunParams info)
 	info = fromInfo $ hostInfo h'
-	h' = h
+	h' = modifyHostProps h $ hostProps h
 		-- Restart by default so container comes up on
 		-- boot or when docker is upgraded.
 		&^ restartAlways
@@ -209,8 +217,10 @@ garbageCollected = propertyList "docker garbage collected" $ props
 	& gccontainers
 	& gcimages
   where
+	gccontainers :: Property Linux
 	gccontainers = property "docker containers garbage collected" $
 		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
+	gcimages :: Property Linux
 	gcimages = property "docker images garbage collected" $
 		liftIO $ report <$> (mapM removeImage =<< listImages)
 
@@ -220,7 +230,7 @@ garbageCollected = propertyList "docker garbage collected" $ props
 -- the pam config, to work around 
 -- which affects docker 1.2.0.
 tweaked :: Property Linux
-tweaked = cmdProperty "sh"
+tweaked = tightenTargets $ cmdProperty "sh"
 	[ "-c"
 	, "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"
 	]
@@ -234,9 +244,10 @@ tweaked = cmdProperty "sh"
 --
 -- Only takes effect after reboot. (Not automated.)
 memoryLimited :: Property DebianLike
-memoryLimited = "/etc/default/grub" `File.containsLine` cfg
-	`describe` "docker memory limited"
-	`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
+memoryLimited = tightenTargets $
+	"/etc/default/grub" `File.containsLine` cfg
+		`describe` "docker memory limited"
+		`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
   where
 	cmdline = "cgroup_enable=memory swapaccount=1"
 	cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
@@ -294,15 +305,15 @@ instance ImageIdentifier ImageUID where
 	imageIdentifier (ImageUID uid) = uid
 
 -- | Set custom dns server for container.
-dns :: String -> Property HasInfo
+dns :: String -> Property (HasInfo + Linux)
 dns = runProp "dns"
 
 -- | Set container host name.
-hostname :: String -> Property HasInfo
+hostname :: String -> Property (HasInfo + Linux)
 hostname = runProp "hostname"
 
 -- | Set name of container.
-name :: String -> Property HasInfo
+name :: String -> Property (HasInfo + Linux)
 name = runProp "name"
 
 class Publishable p where
@@ -316,15 +327,15 @@ instance Publishable String where
 	toPublish = id
 
 -- | Publish a container's port to the host
-publish :: Publishable p => p -> Property HasInfo
+publish :: Publishable p => p -> Property (HasInfo + Linux)
 publish = runProp "publish" . toPublish
 
 -- | Expose a container's port without publishing it.
-expose :: String -> Property HasInfo
+expose :: String -> Property (HasInfo + Linux)
 expose = runProp "expose"
 
 -- | Username or UID for container.
-user :: String -> Property HasInfo
+user :: String -> Property (HasInfo + Linux)
 user = runProp "user"
 
 class Mountable p where
@@ -340,17 +351,17 @@ instance Mountable String where
 	toMount = id
 
 -- | Mount a volume
-volume :: Mountable v => v -> Property HasInfo
+volume :: Mountable v => v -> Property (HasInfo + Linux)
 volume = runProp "volume" . toMount
 
 -- | Mount a volume from the specified container into the current
 -- container.
-volumes_from :: ContainerName -> Property HasInfo
+volumes_from :: ContainerName -> Property (HasInfo + Linux)
 volumes_from cn = genProp "volumes-from" $ \hn ->
 	fromContainerId (ContainerId hn cn)
 
 -- | Work dir inside the container.
-workdir :: String -> Property HasInfo
+workdir :: String -> Property (HasInfo + Linux)
 workdir = runProp "workdir"
 
 -- | Memory limit for container.
@@ -358,18 +369,18 @@ workdir = runProp "workdir"
 --
 -- Note: Only takes effect when the host has the memoryLimited property
 -- enabled.
-memory :: String -> Property HasInfo
+memory :: String -> Property (HasInfo + Linux)
 memory = runProp "memory"
 
 -- | CPU shares (relative weight).
 --
 -- By default, all containers run at the same priority, but you can tell
 -- the kernel to give more CPU time to a container using this property.
-cpuShares :: Int -> Property HasInfo
+cpuShares :: Int -> Property (HasInfo + Linux)
 cpuShares = runProp "cpu-shares" . show
 
 -- | Link with another container on the same host.
-link :: ContainerName -> ContainerAlias -> Property HasInfo
+link :: ContainerName -> ContainerAlias -> Property (HasInfo + Linux)
 link linkwith calias = genProp "link" $ \hn ->
 	fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias
 
@@ -381,24 +392,24 @@ type ContainerAlias = String
 -- propellor; as well as keeping badly behaved containers running,
 -- it ensures that containers get started back up after reboot or
 -- after docker is upgraded.
-restartAlways :: Property HasInfo
+restartAlways :: Property (HasInfo + Linux)
 restartAlways = runProp "restart" "always"
 
 -- | Docker will restart the container if it exits nonzero.
 -- If a number is provided, it will be restarted only up to that many
 -- times.
-restartOnFailure :: Maybe Int -> Property HasInfo
+restartOnFailure :: Maybe Int -> Property (HasInfo + Linux)
 restartOnFailure Nothing = runProp "restart" "on-failure"
 restartOnFailure (Just n) = runProp "restart" ("on-failure:" ++ show n)
 
 -- | Makes docker not restart a container when it exits
 -- Note that this includes not restarting it on boot!
-restartNever :: Property HasInfo
+restartNever :: Property (HasInfo + Linux)
 restartNever = runProp "restart" "no"
 
 -- | Set environment variable with a tuple composed by the environment
 -- variable name and its value.
-environment :: (String, String) -> Property HasInfo
+environment :: (String, String) -> Property (HasInfo + Linux)
 environment (k, v) = runProp "env" $ k ++ "=" ++ v
 
 -- | A container is identified by its name, and the host
@@ -501,6 +512,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 				retry (n-1) a
 			_ -> return v
 
+	go :: ImageIdentifier i => i -> Propellor Result
 	go img = liftIO $ do
 		clearProvisionedFlag cid
 		createDirectoryIfMissing True (takeDirectory $ identFile cid)
@@ -592,14 +604,15 @@ startContainer :: ContainerId -> IO Bool
 startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ]
 
 stoppedContainer :: ContainerId -> Property Linux
-stoppedContainer cid = containerDesc cid $ property' desc $ \o ->
+stoppedContainer cid = containerDesc cid $ property' desc $ \w ->
 	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
-		( liftIO cleanup `after` ensureProperty o
-			(property desc $ liftIO $ toResult <$> stopContainer cid)
+		( liftIO cleanup `after` ensureProperty w stop
 		, return NoChange
 		)
   where
 	desc = "stopped"
+	stop :: Property Linux
+	stop = property desc $ liftIO $ toResult <$> stopContainer cid
 	cleanup = do
 		nukeFile $ identFile cid
 		removeDirectoryRecursive $ shimdir cid
@@ -643,14 +656,14 @@ listContainers status =
 listImages :: IO [ImageUID]
 listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
-runProp :: String -> RunParam -> Property HasInfo
-runProp field val = pureInfoProperty (param) $
+runProp :: String -> RunParam -> Property (HasInfo + Linux)
+runProp field val = tightenTargets $ pureInfoProperty (param) $
 	mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] }
   where
 	param = field++"="++val
 
-genProp :: String -> (HostName -> RunParam) -> Property HasInfo
-genProp field mkval = pureInfoProperty field $
+genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux)
+genProp field mkval = tightenTargets $ pureInfoProperty field $
 	mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] }
 
 dockerInfo :: DockerInfo -> Info
diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
index bfe3ae17..5c4788e2 100644
--- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs
+++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
@@ -6,19 +6,24 @@ import qualified Propellor.Property.File as File
 import qualified Propellor.Property.User as User
 
 -- Clean up a system as installed by cloudatcost.com
-decruft :: Property NoInfo
-decruft = propertyList "cloudatcost cleanup"
-	[ Hostname.sane
-	, "worked around grub/lvm boot bug #743126" ==>
+decruft :: Property DebianLike
+decruft = propertyList "cloudatcost cleanup" $ props
+	& Hostname.sane
+	& grubbugfix
+	& nukecruft
+  where
+	grubbugfix :: Property DebianLike
+	grubbugfix = tightenTargets $ 
 		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
-		`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
-		`onChange` (cmdProperty "update-initramfs" ["-u"] `assume` MadeChange)
-	, combineProperties "nuked cloudatcost cruft"
-		[ File.notPresent "/etc/rc.local"
-		, File.notPresent "/etc/init.d/S97-setup.sh"
-		, File.notPresent "/zang-debian.sh"
-		, File.notPresent "/bin/npasswd"
-		, User.nuked (User "user") User.YesReallyDeleteHome
-		]
-	]
+			`describe` "worked around grub/lvm boot bug #743126"
+			`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
+			`onChange` (cmdProperty "update-initramfs" ["-u"] `assume` MadeChange)
+	nukecruft :: Property Linux
+	nukecruft = tightenTargets $
+		combineProperties "nuked cloudatcost cruft" $ props
+			& File.notPresent "/etc/rc.local"
+			& File.notPresent "/etc/init.d/S97-setup.sh"
+			& File.notPresent "/zang-debian.sh"
+			& File.notPresent "/bin/npasswd"
+			& User.nuked (User "user") User.YesReallyDeleteHome
 
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 7ab350ae..e1342d91 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -22,20 +22,20 @@ import Data.List.Utils
 -- Also, the  127.0.0.1 line is set to localhost. Putting any
 -- other hostnames there is not best practices and can lead to annoying
 -- messages from eg, apache.
-sane :: Property NoInfo
+sane :: Property UnixLike
 sane = sane' extractDomain
 
-sane' :: ExtractDomain -> Property NoInfo
-sane' extractdomain = property ("sane hostname") $
-	ensureProperty . setTo' extractdomain =<< asks hostName
+sane' :: ExtractDomain -> Property UnixLike
+sane' extractdomain = property' ("sane hostname") $ \w ->
+	ensureProperty w . setTo' extractdomain =<< asks hostName
 
 -- Like `sane`, but you can specify the hostname to use, instead
 -- of the default hostname of the `Host`.
-setTo :: HostName -> Property NoInfo
+setTo :: HostName -> Property UnixLike
 setTo = setTo' extractDomain
 
-setTo' :: ExtractDomain -> HostName -> Property NoInfo
-setTo' extractdomain hn = combineProperties desc
+setTo' :: ExtractDomain -> HostName -> Property UnixLike
+setTo' extractdomain hn = combineProperties desc $ toProps
 	[ "/etc/hostname" `File.hasContent` [basehost]
 	, hostslines $ catMaybes
 		[ if null domain
@@ -65,11 +65,12 @@ setTo' extractdomain hn = combineProperties desc
 
 -- | Makes  contain search and domain lines for 
 -- the domain that the hostname is in.
-searchDomain :: Property NoInfo
+searchDomain :: Property UnixLike
 searchDomain = searchDomain' extractDomain
 
-searchDomain' :: ExtractDomain -> Property NoInfo
-searchDomain' extractdomain = property desc (ensureProperty . go =<< asks hostName)
+searchDomain' :: ExtractDomain -> Property UnixLike
+searchDomain' extractdomain = property' desc $ \w ->
+	(ensureProperty w . go =<< asks hostName)
   where
 	desc = "resolv.conf search and domain configured"
 	go hn =
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index dc4b7a75..05409593 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -47,8 +47,13 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.List
 
-installed :: Property DebianLike
-installed = Apt.installed ["ssh"]
+installed :: Property UnixLike
+installed = withOS "ssh installed" $ \w o -> 
+	let aptinstall = ensureProperty w $ Apt.installed ["ssh"]
+	in case o of
+		(Just (System (Debian _) _)) -> aptinstall
+		(Just (System (Buntish _) _)) -> aptinstall
+		_ -> unsupportedOS
 
 restarted :: Property DebianLike
 restarted = Service.restarted "ssh"
-- 
cgit v1.2.3


From e2522c851b600f16148509992a98e63a4dd9b4f7 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 21:50:50 -0400
Subject: add back DeriveDataTypeable

needed for ghc 7.6.3
---
 src/Propellor/Types.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 2bddfc1a..5d6a37cc 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 
 module Propellor.Types
 	( Host(..)
-- 
cgit v1.2.3


From 76a8e806102e13669fa4e64342189084099ec306 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 21:51:13 -0400
Subject: more porting

---
 src/Propellor/Property/Journald.hs | 16 ++++++++--------
 src/Propellor/Property/Munin.hs    |  8 ++++----
 src/Propellor/Property/Systemd.hs  | 28 ++++++++++++++--------------
 3 files changed, 26 insertions(+), 26 deletions(-)

diff --git a/src/Propellor/Property/Journald.hs b/src/Propellor/Property/Journald.hs
index 2fbb780e..d0261626 100644
--- a/src/Propellor/Property/Journald.hs
+++ b/src/Propellor/Property/Journald.hs
@@ -5,7 +5,7 @@ import qualified Propellor.Property.Systemd as Systemd
 import Utility.DataUnits
 
 -- | Configures journald, restarting it so the changes take effect.
-configured :: Systemd.Option -> String -> Property NoInfo
+configured :: Systemd.Option -> String -> Property Linux
 configured option value =
 	Systemd.configured "/etc/systemd/journald.conf" option value
 		`onChange` Systemd.restarted "systemd-journald"
@@ -14,28 +14,28 @@ configured option value =
 -- Examples: "100 megabytes" or "0.5tb"
 type DataSize = String
 
-configuredSize :: Systemd.Option -> DataSize -> Property NoInfo
+configuredSize :: Systemd.Option -> DataSize -> Property Linux
 configuredSize option s = case readSize dataUnits s of
 	Just sz -> configured option (systemdSizeUnits sz)
 	Nothing -> property ("unable to parse " ++ option ++ " data size " ++ s) $
 		return FailedChange
 
-systemMaxUse :: DataSize -> Property NoInfo
+systemMaxUse :: DataSize -> Property Linux
 systemMaxUse = configuredSize "SystemMaxUse"
 
-runtimeMaxUse :: DataSize -> Property NoInfo
+runtimeMaxUse :: DataSize -> Property Linux
 runtimeMaxUse = configuredSize "RuntimeMaxUse"
 
-systemKeepFree :: DataSize -> Property NoInfo
+systemKeepFree :: DataSize -> Property Linux
 systemKeepFree = configuredSize "SystemKeepFree"
 
-runtimeKeepFree :: DataSize -> Property NoInfo
+runtimeKeepFree :: DataSize -> Property Linux
 runtimeKeepFree = configuredSize "RuntimeKeepFree"
 
-systemMaxFileSize :: DataSize -> Property NoInfo
+systemMaxFileSize :: DataSize -> Property Linux
 systemMaxFileSize = configuredSize "SystemMaxFileSize"
 
-runtimeMaxFileSize :: DataSize -> Property NoInfo
+runtimeMaxFileSize :: DataSize -> Property Linux
 runtimeMaxFileSize = configuredSize "RuntimeMaxFileSize"
 
 -- Generates size units as used in journald.conf.
diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs
index 2464985a..dd74d91b 100644
--- a/src/Propellor/Property/Munin.hs
+++ b/src/Propellor/Property/Munin.hs
@@ -19,19 +19,19 @@ import qualified Propellor.Property.Service as Service
 nodePort :: Integer
 nodePort = 4949
 
-nodeInstalled :: Property NoInfo
+nodeInstalled :: Property DebianLike
 nodeInstalled = Apt.serviceInstalledRunning "munin-node"
 
-nodeRestarted :: Property NoInfo
+nodeRestarted :: Property DebianLike
 nodeRestarted = Service.restarted "munin-node"
 
 nodeConfPath :: FilePath
 nodeConfPath = "/etc/munin/munin-node.conf"
 
-masterInstalled :: Property NoInfo
+masterInstalled :: Property DebianLike
 masterInstalled = Apt.serviceInstalledRunning "munin"
 
-masterRestarted :: Property NoInfo
+masterRestarted :: Property DebianLike
 masterRestarted = Service.restarted "munin"
 
 masterConfPath :: FilePath
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index d909e4df..7dc1ccd8 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -70,13 +70,13 @@ instance PropAccum Container where
 --
 -- Note that this does not configure systemd to start the service on boot,
 -- it only ensures that the service is currently running.
-started :: ServiceName -> Property NoInfo
+started :: ServiceName -> Property Linux
 started n = cmdProperty "systemctl" ["start", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " started")
 
 -- | Stops a systemd service.
-stopped :: ServiceName -> Property NoInfo
+stopped :: ServiceName -> Property Linux
 stopped n = cmdProperty "systemctl" ["stop", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " stopped")
@@ -85,19 +85,19 @@ stopped n = cmdProperty "systemctl" ["stop", n]
 --
 -- This does not ensure the service is started, it only configures systemd
 -- to start it on boot.
-enabled :: ServiceName -> Property NoInfo
+enabled :: ServiceName -> Property Linux
 enabled n = cmdProperty "systemctl" ["enable", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " enabled")
 
 -- | Disables a systemd service.
-disabled :: ServiceName -> Property NoInfo
+disabled :: ServiceName -> Property Linux
 disabled n = cmdProperty "systemctl" ["disable", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " disabled")
 
 -- | Masks a systemd service.
-masked :: ServiceName -> RevertableProperty NoInfo
+masked :: ServiceName -> RevertableProperty Linux
 masked n = systemdMask  systemdUnmask
   where
 	systemdMask = cmdProperty "systemctl" ["mask", n]
@@ -108,11 +108,11 @@ masked n = systemdMask  systemdUnmask
 		`describe` ("service " ++ n ++ " unmasked")
 
 -- | Ensures that a service is both enabled and started
-running :: ServiceName -> Property NoInfo
+running :: ServiceName -> Property Linux
 running n = started n `requires` enabled n
 
 -- | Restarts a systemd service.
-restarted :: ServiceName -> Property NoInfo
+restarted :: ServiceName -> Property Linux
 restarted n = cmdProperty "systemctl" ["restart", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " restarted")
@@ -126,7 +126,7 @@ journald :: ServiceName
 journald = "systemd-journald"
 
 -- | Enables persistent storage of the journal.
-persistentJournal :: Property NoInfo
+persistentJournal :: Property DebianLike
 persistentJournal = check (not <$> doesDirectoryExist dir) $
 	combineProperties "persistent systemd journal"
 		[ cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
@@ -148,7 +148,7 @@ type Option = String
 -- currently the case for files like journald.conf and system.conf.
 -- And it assumes the file already exists with
 -- the right [Header], so new lines can just be appended to the end.
-configured :: FilePath -> Option -> String -> Property NoInfo
+configured :: FilePath -> Option -> String -> Property Linux
 configured cfgfile option value = combineProperties desc
 	[ File.fileProperty desc (mapMaybe removeother) cfgfile
 	, File.containsLine cfgfile line
@@ -162,18 +162,18 @@ configured cfgfile option value = combineProperties desc
 		| otherwise = Just l
 
 -- | Causes systemd to reload its configuration files.
-daemonReloaded :: Property NoInfo
+daemonReloaded :: Property Linux
 daemonReloaded = cmdProperty "systemctl" ["daemon-reload"]
 	`assume` NoChange
 
 -- | Configures journald, restarting it so the changes take effect.
-journaldConfigured :: Option -> String -> Property NoInfo
+journaldConfigured :: Option -> String -> Property Linux
 journaldConfigured option value =
 	configured "/etc/systemd/journald.conf" option value
 		`onChange` restarted journald
 
 -- | Ensures machined and machinectl are installed
-machined :: Property NoInfo
+machined :: Property Linux
 machined = withOS "machined installed" $ \o ->
 	case o of
 		-- Split into separate debian package since systemd 225.
@@ -239,7 +239,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 
 -- | Sets up the service file for the container, and then starts
 -- it running.
-nspawnService :: Container -> ChrootCfg -> RevertableProperty NoInfo
+nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux
 nspawnService (Container name _ _) cfg = setup  teardown
   where
 	service = nspawnServiceName name
@@ -290,7 +290,7 @@ nspawnServiceParams (SystemdNspawnCfg ps) =
 --
 -- This uses nsenter to enter the container, by looking up the pid of the
 -- container's init process and using its namespace.
-enterScript :: Container -> RevertableProperty NoInfo
+enterScript :: Container -> RevertableProperty Linux
 enterScript c@(Container name _ _) = setup  teardown
   where
 	setup = combineProperties ("generated " ++ enterScriptFile c)
-- 
cgit v1.2.3


From 3deb3a622eec5e12dfaee320faaeb12c70f9c8d0 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 26 Mar 2016 21:52:11 -0400
Subject: old ghc fix

---
 src/Propellor/EnsureProperty.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index c19dc025..f9094c5b 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -14,6 +14,9 @@ import Propellor.Types
 import Propellor.Types.MetaTypes
 import Propellor.Exception
 
+import Data.Monoid
+import Prelude
+
 -- | For when code running in the Propellor monad needs to ensure a
 -- Property.
 --
-- 
cgit v1.2.3


From 448d2c185e8d5d1da95113844f1b6d15d10883f6 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 01:27:42 -0400
Subject: refactor

---
 src/Propellor/Types.hs           |  2 +-
 src/Propellor/Types/MetaTypes.hs | 13 ++++---------
 src/Propellor/Types/OS.hs        | 13 +++++++++++--
 3 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 5d6a37cc..d5959cbb 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -16,7 +16,7 @@ module Propellor.Types
 	, Desc
 	, MetaType(..)
 	, MetaTypes
-	, OS(..)
+	, TargetOS(..)
 	, UnixLike
 	, Linux
 	, DebianLike
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index 6033ec27..ce2b1411 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -2,7 +2,6 @@
 
 module Propellor.Types.MetaTypes (
 	MetaType(..),
-	OS(..),
 	UnixLike,
 	Linux,
 	DebianLike,
@@ -26,15 +25,11 @@ module Propellor.Types.MetaTypes (
 	EqT,
 ) where
 
+import Propellor.Types.OS
+
 data MetaType
-	= Targeting OS -- ^ A target OS of a Property
-	| WithInfo     -- ^ Indicates that a Property has associated Info
-
-data OS
-	= OSDebian
-	| OSBuntish -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per 
-	| OSFreeBSD
-	deriving (Show, Eq)
+	= Targeting TargetOS -- ^ A target OS of a Property
+	| WithInfo           -- ^ Indicates that a Property has associated Info
 
 -- | Any unix-like system
 type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ]
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 94a37936..84c9d87b 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -3,6 +3,7 @@
 module Propellor.Types.OS (
 	System(..),
 	Distribution(..),
+	TargetOS(..),
 	DebianSuite(..),
 	FreeBSDRelease(..),
 	FBSDVersion(..),
@@ -32,6 +33,14 @@ data Distribution
 	| FreeBSD FreeBSDRelease
 	deriving (Show, Eq)
 
+-- | Properties can target one or more OS's; the targets are part
+-- of the type of the property, so need to be kept fairly simple.
+data TargetOS
+	= OSDebian
+	| OSBuntish
+	| OSFreeBSD
+	deriving (Show, Eq)
+
 -- | Debian has several rolling suites, and a number of stable releases,
 -- such as Stable "jessie".
 data DebianSuite = Experimental | Unstable | Testing | Stable Release
@@ -39,10 +48,10 @@ data DebianSuite = Experimental | Unstable | Testing | Stable Release
 
 -- | FreeBSD breaks their releases into "Production" and "Legacy".
 data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion
-  deriving (Show, Eq)
+	deriving (Show, Eq)
 
 data FBSDVersion = FBSD101 | FBSD102 | FBSD093
-  deriving (Eq)
+	deriving (Eq)
 
 instance IsString FBSDVersion where
 	fromString "10.1-RELEASE" = FBSD101
-- 
cgit v1.2.3


From 0b0ea182ab3301ade8b87b1be1cdecc3464cd1da Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 16:10:43 -0400
Subject: ported DiskImage

Unfortunately, DiskImage needs to add properties to the Chroot it's
presented with, and the metatypes are not included in the Chroot, so it
can't guarantee that the properties it's adding match the OS in the Chroot.

I partially worked around this by making the properties that DiskImage adds
check the OS, so they don't assume Debian.

It would be nicer to parameterize the Chroot type with the metatypes of the
inner OS. I worked for several hours on a patch along those lines, but it
doesn't quite compile. Failed at the final hurdle :/ The patch is below
for later..

--- src/Propellor/Property/Chroot.hs	2016-03-27 16:06:44.285464820 -0400
+++ /home/joey/Chroot.hs	2016-03-27 15:32:29.073416143 -0400
@@ -1,9 +1,9 @@
-{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, DataKinds #-}

 module Propellor.Property.Chroot (
 	debootstrapped,
 	bootstrapped,
-	provisioned,
+	--provisioned,
 	Chroot(..),
 	ChrootBootstrapper(..),
 	Debootstrapped(..),
@@ -11,7 +11,7 @@
 	noServices,
 	inChroot,
 	-- * Internal use
-	provisioned',
+	--provisioned',
 	propagateChrootInfo,
 	propellChroot,
 	chain,
@@ -20,6 +20,7 @@

 import Propellor.Base
 import Propellor.Container
+import Propellor.Types.MetaTypes
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
@@ -38,27 +39,29 @@

 -- | Specification of a chroot. Normally you'll use `debootstrapped` or
 -- `bootstrapped` to construct a Chroot value.
-data Chroot where
-	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
-
-instance IsContainer Chroot where
-	containerProperties (Chroot _ _ h) = containerProperties h
-	containerInfo (Chroot _ _ h) = containerInfo h
-	setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
+--
+-- The inner and outer type variables are the metatypes of the inside of
+-- the chroot and the system it runs in.
+data Chroot inner outer where
+	Chroot :: ChrootBootstrapper b inner outer => FilePath -> b -> Host -> (inner, outer) -> Chroot inner outer
+
+instance IsContainer (Chroot inner outer) where
+	containerProperties (Chroot _ _ h _) = containerProperties h
+	containerInfo (Chroot _ _ h _) = containerInfo h

-chrootSystem :: Chroot -> Maybe System
+chrootSystem :: Chroot inner outer -> Maybe System
 chrootSystem = fromInfoVal . fromInfo . containerInfo

-instance Show Chroot where
-	show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
+instance Show (Chroot inner outer) where
+	show c@(Chroot loc _ _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)

 -- | Class of things that can do initial bootstrapping of an operating
 -- System in a chroot.
-class ChrootBootstrapper b where
+class ChrootBootstrapper b inner outer where
 	-- | Do initial bootstrapping of an operating system in a chroot.
 	-- If the operating System is not supported, return
 	-- Left error message.
-	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux)
+	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property outer)

 -- | Use this to bootstrap a chroot by extracting a tarball.
 --
@@ -68,9 +71,8 @@
 -- detect automatically.
 data ChrootTarball = ChrootTarball FilePath

-instance ChrootBootstrapper ChrootTarball where
-	buildchroot (ChrootTarball tb) _ loc = Right $
-		tightenTargets $ extractTarball loc tb
+instance ChrootBootstrapper ChrootTarball UnixLike UnixLike where
+	buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb

 extractTarball :: FilePath -> FilePath -> Property UnixLike
 extractTarball target src = check (unpopulated target) $
@@ -88,7 +90,7 @@
 -- | Use this to bootstrap a chroot with debootstrap.
 data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig

-instance ChrootBootstrapper Debootstrapped where
+instance ChrootBootstrapper Debootstrapped DebianLike Linux where
 	buildchroot (Debootstrapped cf) system loc = case system of
 		(Just s@(System (Debian _) _)) -> Right $ debootstrap s
 		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
@@ -107,13 +109,22 @@
 -- >	& osDebian Unstable "amd64"
 -- >	& Apt.installed ["ghc", "haskell-platform"]
 -- >	& ...
-debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
+-- debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot DebianLike
+debootstrapped
+	:: (SingI inner, SingI outer, ChrootBootstrapper Debootstrapped (MetaTypes inner) (MetaTypes outer))
+	=> Debootstrap.DebootstrapConfig
+	-> FilePath
+	-> Chroot (MetaTypes inner) (MetaTypes outer)
 debootstrapped conf = bootstrapped (Debootstrapped conf)

 -- | Defines a Chroot at the given location, bootstrapped with the
 -- specified ChrootBootstrapper.
-bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Chroot
-bootstrapped bootstrapper location = Chroot location bootstrapper h
+bootstrapped
+	:: (SingI inner, SingI outer, ChrootBootstrapper b (MetaTypes inner) (MetaTypes outer))
+	=> b
+	-> FilePath
+	-> Chroot (MetaTypes inner) (MetaTypes outer)
+bootstrapped bootstrapper location = Chroot location bootstrapper h (sing, sing)
   where
 	h = Host location [] mempty

@@ -123,45 +134,79 @@
 -- Reverting this property removes the chroot. Anything mounted inside it
 -- is first unmounted. Note that it does not ensure that any processes
 -- that might be running inside the chroot are stopped.
-provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
+-- provisioned :: SingI outer => Chroot inner outer -> RevertableProperty (HasInfo + MetaTypes outer) Linux
+provisioned
+	::
+		( SingI outer
+		, SingI metatypes
+		, Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+		, (HasInfo + outer) ~ MetaTypes metatypes
+		, CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer)) ~ Property outer
+		, IncludesInfo (MetaTypes metatypes) ~ 'True)
+	=> Chroot inner outer -> RevertableProperty (HasInfo + outer) Linux
 provisioned c = provisioned' (propagateChrootInfo c) c False

 provisioned'
-	:: (Property Linux -> Property (HasInfo + Linux))
-	-> Chroot
+	::
+		( Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+		, CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer)) ~ Property outer
+		, SingI outer
+		)
+	=> (Property outer -> Property (HasInfo + outer))
+	-> Chroot inner outer
 	-> Bool
-	-> RevertableProperty (HasInfo + Linux) Linux
-provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
-	(propigator $ setup `describe` chrootDesc c "exists")
+	-> RevertableProperty (HasInfo + outer) Linux
+provisioned' propigator c systemdonly =
+	(propigator $ setup c systemdonly `describe` chrootDesc c "exists")
 		
-	(teardown `describe` chrootDesc c "removed")
-  where
-	setup :: Property Linux
-	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
-		`requires` built
-
-	built = case buildchroot bootstrapper (chrootSystem c) loc of
-		Right p -> p
-		Left e -> cantbuild e
-
-	cantbuild e = property (chrootDesc c "built") (error e)
-
-	teardown :: Property Linux
-	teardown = check (not <$> unpopulated loc) $
-		property ("removed " ++ loc) $
-			makeChange (removeChroot loc)
-
-propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
-propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
-	p `addInfoProperty` chrootInfo c
+	(teardown c `describe` chrootDesc c "removed")

-chrootInfo :: Chroot -> Info
-chrootInfo (Chroot loc _ h) = mempty `addInfo`
+-- chroot removal code is currently linux specific..
+teardown :: Chroot inner outer -> Property Linux
+teardown (Chroot loc _ _ _) = check (not <$> unpopulated loc) $
+	property ("removed " ++ loc) $
+		makeChange (removeChroot loc)
+
+setup
+	::
+		( SingI outer
+		, Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+		)
+	=> Chroot inner outer
+	-> Bool
+	-> CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer))
+setup c systemdonly = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
+	`requires` built c
+
+built :: (SingI outer, ChrootBootstrapper b inner outer) => Chroot inner outer -> Property (MetaTypes outer)
+built c@(Chroot loc bootstrapper _ _) =
+	case buildchroot bootstrapper (chrootSystem c) loc of
+		Right p -> error "FOO" -- p
+		Left e -> error "FOO" -- cantbuild c e
+
+cantbuild :: Chroot inner outer -> String -> Property UnixLike
+cantbuild c e = property (chrootDesc c "built") (error e)
+
+propagateChrootInfo
+	::
+		( SingI metatypes
+		, (HasInfo + outer) ~ MetaTypes metatypes
+		, IncludesInfo (MetaTypes metatypes) ~ 'True
+		)
+	=> Chroot inner outer
+	-> Property outer
+	-> Property (MetaTypes metatypes)
+propagateChrootInfo c@(Chroot location _ _ _) p =
+	propagateContainer location c $
+		p `addInfoProperty` chrootInfo c
+
+chrootInfo :: Chroot inner outer -> Info
+chrootInfo (Chroot loc _ h _) = mempty `addInfo`
 	mempty { _chroots = M.singleton loc h }

 -- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
-propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+propellChroot :: SingI outer => Chroot inner outer -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property (MetaTypes outer)
+propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
 	let d = localdir  shimdir c
 	let me = localdir  "propellor"
 	shim <- liftIO $ ifM (doesDirectoryExist d)
@@ -199,8 +244,8 @@
 		liftIO cleanup
 		return r

-toChain :: HostName -> Chroot -> Bool -> IO CmdLine
-toChain parenthost (Chroot loc _ _) systemdonly = do
+toChain :: HostName -> Chroot inner outer -> Bool -> IO CmdLine
+toChain parenthost (Chroot loc _ _ _) systemdonly = do
 	onconsole <- isConsole <$> getMessageHandle
 	return $ ChrootChain parenthost loc systemdonly onconsole

@@ -224,8 +269,8 @@
 			putStrLn $ "\n" ++ show r
 chain _ _ = errorMessage "bad chain command"

-inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
-inChrootProcess keepprocmounted (Chroot loc _ _) cmd = do
+inChrootProcess :: Bool -> Chroot inner outer -> [String] -> IO (CreateProcess, IO ())
+inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do
 	mountproc
 	return (proc "chroot" (loc:cmd), cleanup)
   where
@@ -244,26 +289,24 @@
 provisioningLock :: FilePath -> FilePath
 provisioningLock containerloc = "chroot"  mungeloc containerloc ++ ".lock"

-shimdir :: Chroot -> FilePath
-shimdir (Chroot loc _ _) = "chroot"  mungeloc loc ++ ".shim"
+shimdir :: Chroot inner outer -> FilePath
+shimdir (Chroot loc _ _ _) = "chroot"  mungeloc loc ++ ".shim"

 mungeloc :: FilePath -> String
 mungeloc = replace "/" "_"

-chrootDesc :: Chroot -> String -> String
-chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
+chrootDesc :: Chroot inner outer -> String -> String
+chrootDesc (Chroot loc _ _ _) desc = "chroot " ++ loc ++ " " ++ desc
---
 src/Propellor/Container.hs          | 18 ++++++++-
 src/Propellor/PropAccum.hs          | 12 ------
 src/Propellor/Property.hs           |  2 +-
 src/Propellor/Property/Chroot.hs    | 11 +++--
 src/Propellor/Property/Conductor.hs |  7 ++--
 src/Propellor/Property/DiskImage.hs | 81 ++++++++++++++++++++++---------------
 src/Propellor/Property/Grub.hs      | 11 +++--
 src/Propellor/Property/Ssh.hs       |  2 +-
 src/Propellor/Types/MetaTypes.hs    |  2 +-
 9 files changed, 87 insertions(+), 59 deletions(-)

diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index 832faf9c..4cd46ae5 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -6,14 +6,28 @@ import Propellor.Types
 import Propellor.Types.MetaTypes
 import Propellor.Types.Info
 import Propellor.PrivData
+import Propellor.PropAccum
 
 class IsContainer c where
 	containerProperties :: c -> [ChildProperty]
 	containerInfo :: c -> Info
+	setContainerProperties :: c -> [ChildProperty] -> c
 
 instance IsContainer Host where
-	 containerProperties = hostProperties
-	 containerInfo = hostInfo
+	containerProperties = hostProperties
+	containerInfo = hostInfo
+	setContainerProperties h ps = host (hostName h) (Props ps)
+
+-- | Note that the metatype of a container's properties is not retained,
+-- so this defaults to UnixLike. So, using this with setContainerProps can
+-- add properties to a container that conflict with properties already in it.
+-- Use caution when using this; only add properties that do not have
+-- restricted targets.
+containerProps :: IsContainer c => c -> Props UnixLike
+containerProps = Props . containerProperties
+
+setContainerProps :: IsContainer c => c -> Props metatypes -> c
+setContainerProps c (Props ps) = setContainerProperties c ps
 
 -- | Adjust the provided Property, adding to its
 -- propertyChidren the properties of the provided container.
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 1212ef7a..856f2e8e 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -12,8 +12,6 @@ module Propellor.PropAccum
 	, (&)
 	, (&^)
 	, (!)
-	, hostProps
-	, modifyHostProps
 	) where
 
 import Propellor.Types
@@ -32,16 +30,6 @@ import Prelude
 host :: HostName -> Props metatypes -> Host
 host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Note that the metatype of a Host's properties is not retained,
--- so this defaults to UnixLike. So, using this with modifyHostProps can
--- add properties to a Host that conflict with properties already in it.
--- Use caution when using this.
-hostProps :: Host -> Props UnixLike
-hostProps = Props . hostProperties
-
-modifyHostProps :: Host -> Props metatypes -> Host
-modifyHostProps h ps = host (hostName h) ps
-
 -- | Props is a combination of a list of properties, with their combined 
 -- metatypes.
 data Props metatypes = Props [ChildProperty]
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 9fa29888..70583edc 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -308,7 +308,7 @@ makeChange a = liftIO a >> return MadeChange
 noChange :: Propellor Result
 noChange = return NoChange
 
-doNothing :: Property UnixLike
+doNothing :: SingI t => Property (MetaTypes t)
 doNothing = property "noop property" noChange
 
 -- | Registers an action that should be run at the very end, after
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index ddadc763..b29da7f9 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -44,6 +44,7 @@ data Chroot where
 instance IsContainer Chroot where
 	containerProperties (Chroot _ _ h) = containerProperties h
 	containerInfo (Chroot _ _ h) = containerInfo h
+	setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
 
 chrootSystem :: Chroot -> Maybe System
 chrootSystem = fromInfoVal . fromInfo . containerInfo
@@ -256,11 +257,13 @@ chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
 -- from being started, which is often something you want to prevent when
 -- building a chroot.
 --
--- This is accomplished by installing a  script
--- that does not let any daemons be started by packages that use
+-- On Debian, this is accomplished by installing a 
+-- script that does not let any daemons be started by packages that use
 -- invoke-rc.d. Reverting the property removes the script.
-noServices :: RevertableProperty DebianLike DebianLike
-noServices = tightenTargets setup  tightenTargets teardown
+--
+-- This property has no effect on non-Debian systems.
+noServices :: RevertableProperty UnixLike UnixLike
+noServices = setup  teardown
   where
 	f = "/usr/sbin/policy-rc.d"
 	script = [ "#!/bin/sh", "exit 101" ]
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index 005fc804..ab747acc 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -74,6 +74,7 @@ module Propellor.Property.Conductor (
 ) where
 
 import Propellor.Base
+import Propellor.Container
 import Propellor.Spin (spin')
 import Propellor.PrivData.Paths
 import Propellor.Types.Info
@@ -219,7 +220,7 @@ orchestrate hs = map go hs
 	os = extractOrchestras hs
 
 	removeold h = foldl removeold' h (oldconductorsof h)
-	removeold' h oldconductor = modifyHostProps h $ hostProps h
+	removeold' h oldconductor = setContainerProps h $ containerProps h
 		! conductedBy oldconductor
 
 	oldconductors = zip hs (map (fromInfo . hostInfo) hs)
@@ -234,7 +235,7 @@ orchestrate' h (Conducted _) = h
 orchestrate' h (Conductor c l)
 	| sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l)
 	| any (sameHost h) (map topHost l) = cont $
-		modifyHostProps h $ hostProps h
+		setContainerProps h $ containerProps h
 			& conductedBy c
 	| otherwise = cont h
   where
@@ -268,7 +269,7 @@ conductorFor h = go
 
 -- Reverts conductorFor.
 notConductorFor :: Host -> Property (HasInfo + UnixLike)
-notConductorFor h = doNothing
+notConductorFor h = (doNothing :: Property UnixLike)
 	`addInfoProperty` (toInfo (NotConductorFor [h]))
 	`describe` desc
 	`requires` undoRevertableProperty (conductorKnownHost h)
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 48df7fab..8c027b05 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -2,6 +2,8 @@
 --
 -- This module is designed to be imported unqualified.
 
+{-# LANGUAGE TypeFamilies #-}
+
 module Propellor.Property.DiskImage (
 	-- * Partition specification
 	module Propellor.Property.DiskImage.PartSpec,
@@ -30,6 +32,7 @@ import Propellor.Property.Parted
 import Propellor.Property.Mount
 import Propellor.Property.Partition
 import Propellor.Property.Rsync
+import Propellor.Container
 import Utility.Path
 
 import Data.List (isPrefixOf, isInfixOf, sortBy)
@@ -51,7 +54,8 @@ type DiskImage = FilePath
 --
 -- > import Propellor.Property.DiskImage
 --
--- > let chroot d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d
+-- > let chroot d = Chroot.debootstrapped mempty d
+-- >	& osDebian Unstable "amd64"
 -- >	& Apt.installed ["linux-image-amd64"]
 -- >	& User.hasPassword (User "root")
 -- >	& User.accountFor (User "demo")
@@ -89,31 +93,44 @@ imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finaliz
 imageBuilt' rebuild img mkchroot tabletype final partspec = 
 	imageBuiltFrom img chrootdir tabletype final partspec
 		`requires` Chroot.provisioned chroot
-		`requires` (cleanrebuild  doNothing)
+		`requires` (cleanrebuild  (doNothing :: Property UnixLike))
 		`describe` desc
   where
 	desc = "built disk image " ++ img
+	cleanrebuild :: Property Linux
 	cleanrebuild
 		| rebuild = property desc $ do
 			liftIO $ removeChroot chrootdir
 			return MadeChange
 		| otherwise = doNothing
 	chrootdir = img ++ ".chroot"
-	chroot = mkchroot chrootdir
-		-- Before ensuring any other properties of the chroot, avoid
-		-- starting services. Reverted by imageFinalized.
-		&^ Chroot.noServices
-		-- First stage finalization.
-		& fst final
-		-- Avoid wasting disk image space on the apt cache
-		& Apt.cacheCleaned
+	chroot =
+		let c = mkchroot chrootdir
+		in setContainerProps c $ containerProps c
+			-- Before ensuring any other properties of the chroot,
+			-- avoid starting services. Reverted by imageFinalized.
+			&^ Chroot.noServices
+			-- First stage finalization.
+			& fst final
+			& cachesCleaned
+
+-- | This property is automatically added to the chroot when building a
+-- disk image. It cleans any caches of information that can be omitted;
+-- eg the apt cache on Debian.
+cachesCleaned :: Property UnixLike
+cachesCleaned = withOS "cache cleaned" $ \w o -> 
+	let aptclean = ensureProperty w Apt.cacheCleaned
+	in case o of
+		(Just (System (Debian _) _)) -> aptclean
+		(Just (System (Buntish _) _)) -> aptclean
+		_ -> noChange
 
 -- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty Linux Linux
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
 imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
   where
 	desc = img ++ " built from " ++ chrootdir
-	mkimg = property desc $ do
+	mkimg = property' desc $ \w -> do
 		-- unmount helper filesystems such as proc from the chroot
 		-- before getting sizes
 		liftIO $ unmountBelow chrootdir
@@ -123,7 +140,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
 		-- tie the knot!
 		let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $
 			map (calcsz mnts) mnts
-		ensureProperty $
+		ensureProperty w $
 			imageExists img (partTableSize parttable)
 				`before`
 			partitioned YesReallyDeleteDiskContents img parttable
@@ -136,16 +153,17 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
 	rmimg = File.notPresent img
 
 partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
-partitionsPopulated chrootdir mnts mntopts devs = property desc $ mconcat $ zipWith3 go mnts mntopts devs
+partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w -> 
+	mconcat $ zipWith3 (go w) mnts mntopts devs
   where
 	desc = "partitions populated from " ++ chrootdir
 
-	go Nothing _ _ = noChange
-	go (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
+	go _ Nothing _ _ = noChange
+	go w (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
 		(liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir mntopt)
 		(const $ liftIO $ umountLazy tmpdir)
 		$ \ismounted -> if ismounted
-			then ensureProperty $
+			then ensureProperty w $
 				syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir
 			else return FailedChange
 
@@ -230,15 +248,15 @@ type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
 
 imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
 imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = 
-	property "disk image finalized" $ 
+	property' "disk image finalized" $ \w ->
 		withTmpDir "mnt" $ \top -> 
-			go top `finally` liftIO (unmountall top)
+			go w top `finally` liftIO (unmountall top)
   where
-	go top = do
+	go w top = do
 		liftIO $ mountall top
 		liftIO $ writefstab top
 		liftIO $ allowservices top
-		ensureProperty $ final top devs
+		ensureProperty w $ final top devs
 	
 	-- Ordered lexographically by mount point, so / comes before /usr
 	-- comes before /usr/local
@@ -280,27 +298,26 @@ noFinalization = (doNothing, \_ _ -> doNothing)
 grubBooted :: Grub.BIOS -> Finalization
 grubBooted bios = (Grub.installed' bios, boots)
   where
-	boots mnt loopdevs = combineProperties "disk image boots using grub"
+	boots mnt loopdevs = combineProperties "disk image boots using grub" $ props
 		-- bind mount host /dev so grub can access the loop devices
-		[ bindMount "/dev" (inmnt "/dev")
-		, mounted "proc" "proc" (inmnt "/proc") mempty
-		, mounted "sysfs" "sys" (inmnt "/sys") mempty
+		& bindMount "/dev" (inmnt "/dev")
+		& mounted "proc" "proc" (inmnt "/proc") mempty
+		& mounted "sysfs" "sys" (inmnt "/sys") mempty
 		-- update the initramfs so it gets the uuid of the root partition
-		, inchroot "update-initramfs" ["-u"]
+		& inchroot "update-initramfs" ["-u"]
 			`assume` MadeChange
 		-- work around for http://bugs.debian.org/802717
-		, check haveosprober $ inchroot "chmod" ["-x", osprober]
-		, inchroot "update-grub" []
+		& check haveosprober (inchroot "chmod" ["-x", osprober])
+		& inchroot "update-grub" []
 			`assume` MadeChange
-		, check haveosprober $ inchroot "chmod" ["+x", osprober]
-		, inchroot "grub-install" [wholediskloopdev]
+		& check haveosprober (inchroot "chmod" ["+x", osprober])
+		& inchroot "grub-install" [wholediskloopdev]
 			`assume` MadeChange
 		-- sync all buffered changes out to the disk image
 		-- may not be necessary, but seemed needed sometimes
 		-- when using the disk image right away.
-		, cmdProperty "sync" []
+		& cmdProperty "sync" []
 			`assume` NoChange
-		]
 	  where
 	  	-- cannot use  since the filepath is absolute
 		inmnt f = mnt ++ f
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 09255587..b8dc5f9e 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -29,10 +29,15 @@ mkConfig = tightenTargets $ cmdProperty "update-grub" []
 	`assume` MadeChange
 
 -- | Installs grub; does not run update-grub.
-installed' :: BIOS -> Property DebianLike
-installed' bios = Apt.installed [pkg] `describe` "grub package installed"
+installed' :: BIOS -> Property Linux
+installed' bios = withOS "grub package installed" $ \w o -> 
+	let apt = ensureProperty w (Apt.installed [debpkg])
+	in case o of
+		(Just (System (Debian _) _)) -> apt
+		(Just (System (Buntish _) _)) -> apt
+		_ -> unsupportedOS
   where
-	pkg = case bios of
+	debpkg = case bios of
 		PC -> "grub-pc"
 		EFI64 -> "grub-efi-amd64"
 		EFI32 -> "grub-efi-ia32"
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 05409593..7048de3b 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -173,7 +173,7 @@ hostKeys ctx l = go `before` cleanup
 	removestale b = map (tightenTargets . File.notPresent . flip keyFile b) staletypes
 	cleanup :: Property DebianLike
 	cleanup
-		| null staletypes || null l = tightenTargets doNothing
+		| null staletypes || null l = doNothing
 		| otherwise =
 			combineProperties ("any other ssh host keys removed " ++ typelist staletypes)
 				(toProps $ removestale True ++ removestale False)
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index ce2b1411..3e89e28d 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -36,7 +36,7 @@ type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targe
 -- | Any linux system
 type Linux = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
 -- | Debian and derivatives.
-type DebianLike = Debian + Buntish
+type DebianLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
 type Debian = MetaTypes '[ 'Targeting 'OSDebian ]
 type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ]
 type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ]
-- 
cgit v1.2.3


From 5a04a37a4239c99b7367f796acee0ba6f1216879 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 16:36:05 -0400
Subject: ported Systemd

added mising method in docker
---
 src/Propellor/Property/Docker.hs  |   1 +
 src/Propellor/Property/Systemd.hs | 121 +++++++++++++++++++++-----------------
 2 files changed, 68 insertions(+), 54 deletions(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 041e1987..3cb91fd4 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -93,6 +93,7 @@ data Container = Container Image Host
 instance IsContainer Container where
 	containerProperties (Container _ h) = containerProperties h
 	containerInfo (Container _ h) = containerInfo h
+	setContainerProperties (Container i h) ps = Container i (setContainerProperties h ps)
 
 class HasImage a where
 	getImageName :: a -> Image
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 7dc1ccd8..eaf7df8b 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
 
 module Propellor.Property.Systemd (
 	-- * Services
@@ -43,6 +43,7 @@ module Propellor.Property.Systemd (
 import Propellor.Base
 import Propellor.Types.Chroot
 import Propellor.Types.Container
+import Propellor.Container
 import Propellor.Types.Info
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Apt as Apt
@@ -61,23 +62,23 @@ type MachineName = String
 data Container = Container MachineName Chroot.Chroot Host
 	deriving (Show)
 
-instance PropAccum Container where
-	(Container n c h) `addProp` p = Container n c (h `addProp` p)
-	(Container n c h) `addPropFront` p = Container n c (h `addPropFront` p)
-	getProperties (Container _ _ h) = hostProperties h
+instance IsContainer Container where
+	containerProperties (Container _ _ h) = containerProperties h
+	containerInfo (Container _ _ h) = containerInfo h
+	setContainerProperties (Container n c h) ps = Container n c (setContainerProperties h ps)
 
 -- | Starts a systemd service.
 --
 -- Note that this does not configure systemd to start the service on boot,
 -- it only ensures that the service is currently running.
 started :: ServiceName -> Property Linux
-started n = cmdProperty "systemctl" ["start", n]
+started n = tightenTargets $ cmdProperty "systemctl" ["start", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " started")
 
 -- | Stops a systemd service.
 stopped :: ServiceName -> Property Linux
-stopped n = cmdProperty "systemctl" ["stop", n]
+stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " stopped")
 
@@ -86,24 +87,24 @@ stopped n = cmdProperty "systemctl" ["stop", n]
 -- This does not ensure the service is started, it only configures systemd
 -- to start it on boot.
 enabled :: ServiceName -> Property Linux
-enabled n = cmdProperty "systemctl" ["enable", n]
+enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " enabled")
 
 -- | Disables a systemd service.
 disabled :: ServiceName -> Property Linux
-disabled n = cmdProperty "systemctl" ["disable", n]
+disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " disabled")
 
 -- | Masks a systemd service.
-masked :: ServiceName -> RevertableProperty Linux
+masked :: ServiceName -> RevertableProperty Linux Linux
 masked n = systemdMask  systemdUnmask
   where
-	systemdMask = cmdProperty "systemctl" ["mask", n]
+	systemdMask = tightenTargets $ cmdProperty "systemctl" ["mask", n]
 		`assume` NoChange
 		`describe` ("service " ++ n ++ " masked")
-	systemdUnmask = cmdProperty "systemctl" ["unmask", n]
+	systemdUnmask = tightenTargets $ cmdProperty "systemctl" ["unmask", n]
 		`assume` NoChange
 		`describe` ("service " ++ n ++ " unmasked")
 
@@ -113,7 +114,7 @@ running n = started n `requires` enabled n
 
 -- | Restarts a systemd service.
 restarted :: ServiceName -> Property Linux
-restarted n = cmdProperty "systemctl" ["restart", n]
+restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " restarted")
 
@@ -128,14 +129,13 @@ journald = "systemd-journald"
 -- | Enables persistent storage of the journal.
 persistentJournal :: Property DebianLike
 persistentJournal = check (not <$> doesDirectoryExist dir) $
-	combineProperties "persistent systemd journal"
-		[ cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
+	combineProperties "persistent systemd journal" $ props
+		& cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
 			`assume` MadeChange
-		, cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
+		& Apt.installed ["acl"]
+		& cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
 			`assume` MadeChange
-		, started "systemd-journal-flush"
-		]
-		`requires` Apt.installed ["acl"]
+		& started "systemd-journal-flush"
   where
 	dir = "/var/log/journal"
 
@@ -149,10 +149,9 @@ type Option = String
 -- And it assumes the file already exists with
 -- the right [Header], so new lines can just be appended to the end.
 configured :: FilePath -> Option -> String -> Property Linux
-configured cfgfile option value = combineProperties desc
-	[ File.fileProperty desc (mapMaybe removeother) cfgfile
-	, File.containsLine cfgfile line
-	]
+configured cfgfile option value = tightenTargets $ combineProperties desc $ props
+	& File.fileProperty desc (mapMaybe removeother) cfgfile
+	& File.containsLine cfgfile line
   where
 	setting = option ++ "="
 	line = setting ++ value
@@ -163,7 +162,7 @@ configured cfgfile option value = combineProperties desc
 
 -- | Causes systemd to reload its configuration files.
 daemonReloaded :: Property Linux
-daemonReloaded = cmdProperty "systemctl" ["daemon-reload"]
+daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"]
 	`assume` NoChange
 
 -- | Configures journald, restarting it so the changes take effect.
@@ -174,30 +173,33 @@ journaldConfigured option value =
 
 -- | Ensures machined and machinectl are installed
 machined :: Property Linux
-machined = withOS "machined installed" $ \o ->
+machined = withOS "machined installed" $ \w o ->
 	case o of
 		-- Split into separate debian package since systemd 225.
 		(Just (System (Debian suite) _))
-			| not (isStable suite) -> ensureProperty $
+			| not (isStable suite) -> ensureProperty w $
 				Apt.installed ["systemd-container"]
 		_ -> noChange
 
 -- | Defines a container with a given machine name, and operating system,
 -- and how to create its chroot if not already present.
 --
--- Properties can be added to configure the Container.
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
 --
--- > container "webserver" (System (Debian Unstable) "amd64") (Chroot.debootstrapped mempty)
+-- > container "webserver" (Chroot.debootstrapped mempty)
+-- >	& osDebian Unstable "amd64"
 -- >    & Apt.installedRunning "apache2"
 -- >    & ...
-container :: MachineName -> System -> (FilePath -> Chroot.Chroot) -> Container
-container name system mkchroot = Container name c h
-	& os system
-	& resolvConfed
-	& linkJournal
+container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
+container name mkchroot = 
+	let c = Container name chroot h
+	in setContainerProps c $ containerProps c
+		&^ resolvConfed
+		&^ linkJournal
   where
-	c = mkchroot (containerDir name)
-		& os system
+	chroot = mkchroot (containerDir name)
 	h = Host name [] mempty
 
 -- | Runs a container using systemd-nspawn.
@@ -214,10 +216,11 @@ container name system mkchroot = Container name c h
 --
 -- Reverting this property stops the container, removes the systemd unit,
 -- and deletes the chroot and all its contents.
-nspawned :: Container -> RevertableProperty (HasInfo + UnixLike) UnixLike
+nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
 nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 	p `describe` ("nspawned " ++ name)
   where
+	p :: RevertableProperty (HasInfo + Linux) Linux
 	p = enterScript c
 		`before` chrootprovisioned
 		`before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
@@ -230,8 +233,9 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 
 	-- Use nsenter to enter container and and run propellor to
 	-- finish provisioning.
+	containerprovisioned :: RevertableProperty Linux Linux
 	containerprovisioned =
-		Chroot.propellChroot chroot (enterContainerProcess c) False
+		tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False)
 			
 		doNothing
 
@@ -239,7 +243,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 
 -- | Sets up the service file for the container, and then starts
 -- it running.
-nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux
+nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
 nspawnService (Container name _ _) cfg = setup  teardown
   where
 	service = nspawnServiceName name
@@ -264,10 +268,12 @@ nspawnService (Container name _ _) cfg = setup  teardown
 		<$> servicefilecontent
 		<*> catchDefaultIO "" (readFile servicefile)
 
+	writeservicefile :: Property Linux
 	writeservicefile = property servicefile $ makeChange $ do
 		c <- servicefilecontent
 		File.viaStableTmp (\t -> writeFile t c) servicefile
 
+	setupservicefile :: Property Linux
 	setupservicefile = check (not <$> goodservicefile) $
 		-- if it's running, it has the wrong configuration,
 		-- so stop it
@@ -275,8 +281,12 @@ nspawnService (Container name _ _) cfg = setup  teardown
 			`requires` daemonReloaded
 			`requires` writeservicefile
 
-	setup = started service `requires` setupservicefile `requires` machined
+	setup :: Property Linux
+	setup = started service
+		`requires` setupservicefile
+		`requires` machined
 
+	teardown :: Property Linux
 	teardown = check (doesFileExist servicefile) $
 		disabled service `requires` stopped service
 
@@ -290,11 +300,12 @@ nspawnServiceParams (SystemdNspawnCfg ps) =
 --
 -- This uses nsenter to enter the container, by looking up the pid of the
 -- container's init process and using its namespace.
-enterScript :: Container -> RevertableProperty Linux
-enterScript c@(Container name _ _) = setup  teardown
+enterScript :: Container -> RevertableProperty Linux Linux
+enterScript c@(Container name _ _) =
+	tightenTargets setup  tightenTargets teardown
   where
-	setup = combineProperties ("generated " ++ enterScriptFile c)
-		[ scriptfile `File.hasContent`
+	setup = combineProperties ("generated " ++ enterScriptFile c) $ props
+		& scriptfile `File.hasContent`
 			[ "#!/usr/bin/perl"
 			, "# Generated by propellor"
 			, "my $pid=`machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2`;"
@@ -309,8 +320,7 @@ enterScript c@(Container name _ _) = setup  teardown
 			, "}"
 			, "exit(1);"
 			]
-		, scriptfile `File.mode` combineModes (readModes ++ executeModes)
-		]
+		& scriptfile `File.mode` combineModes (readModes ++ executeModes)
 	teardown = File.notPresent scriptfile
 	scriptfile = enterScriptFile c
 
@@ -336,11 +346,14 @@ mungename = replace "/" "_"
 -- When there is no leading dash, "--" is prepended to the parameter.
 --
 -- Reverting the property will remove a parameter, if it's present.
-containerCfg :: String -> RevertableProperty (HasInfo + UnixLike) UnixLike
+containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 containerCfg p = RevertableProperty (mk True) (mk False)
   where
-	mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
-		mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
+	mk b = tightenTargets $
+		pureInfoProperty desc $
+			mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
+	  where
+		desc = "container configuration " ++ (if b then "" else "without ") ++ p'
 	p' = case p of
 		('-':_) -> p
 		_ -> "--" ++ p
@@ -348,18 +361,18 @@ containerCfg p = RevertableProperty (mk True) (mk False)
 -- | Bind mounts  from the host into the container.
 --
 -- This property is enabled by default. Revert it to disable it.
-resolvConfed :: RevertableProperty (HasInfo + UnixLike) UnixLike
+resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 resolvConfed = containerCfg "bind=/etc/resolv.conf"
 
 -- | Link the container's journal to the host's if possible.
 -- (Only works if the host has persistent journal enabled.)
 --
 -- This property is enabled by default. Revert it to disable it.
-linkJournal :: RevertableProperty (HasInfo + UnixLike) UnixLike
+linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 linkJournal = containerCfg "link-journal=try-guest"
 
 -- | Disconnect networking of the container from the host.
-privateNetwork :: RevertableProperty (HasInfo + UnixLike) UnixLike
+privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 privateNetwork = containerCfg "private-network"
 
 class Publishable a where
@@ -397,7 +410,7 @@ instance Publishable (Proto, Bound Port) where
 -- >	& Systemd.running Systemd.networkd
 -- >	& Systemd.publish (Port 80 ->- Port 8080)
 -- >	& Apt.installedRunning "apache2"
-publish :: Publishable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
+publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 publish p = containerCfg $ "--port=" ++ toPublish p
 
 class Bindable a where
@@ -410,9 +423,9 @@ instance Bindable (Bound FilePath) where
 	toBind v = hostSide v ++ ":" ++ containerSide v
 
 -- | Bind mount a file or directory from the host into the container.
-bind :: Bindable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
+bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 bind p = containerCfg $ "--bind=" ++ toBind p
 
 -- | Read-only mind mount.
-bindRo :: Bindable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
+bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
-- 
cgit v1.2.3


From bc87125af96fa0c19d69883a30f3bc7b240e2940 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 16:55:09 -0400
Subject: ported!

---
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 133 ++++++++++++-----------
 1 file changed, 67 insertions(+), 66 deletions(-)

diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 03f2efcb..0ce64939 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1,6 +1,8 @@
 -- | Specific configuration for Joey Hess's sites. Probably not useful to
 -- others except as an example.
 
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
 module Propellor.Property.SiteSpecific.JoeySites where
 
 import Propellor.Base
@@ -24,7 +26,7 @@ import Data.List
 import System.Posix.Files
 import Data.String.Utils
 
-scrollBox :: Property HasInfo
+scrollBox :: Property (HasInfo + DebianLike)
 scrollBox = propertyList "scroll server" $ props
 	& User.accountFor (User "scroll")
 	& Git.cloned (User "scroll") "git://git.kitenet.net/scroll" (d  "scroll") Nothing
@@ -94,16 +96,12 @@ scrollBox = propertyList "scroll server" $ props
 	s = d  "login.sh"
 	g = d  "game.sh"
 
-oldUseNetServer :: [Host] -> Property HasInfo
+oldUseNetServer :: [Host] -> Property (HasInfo + DebianLike)
 oldUseNetServer hosts = propertyList "olduse.net server" $ props
 	& Apt.installed ["leafnode"]
 	& oldUseNetInstalled "oldusenet-server"
 	& oldUseNetBackup
-	& check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool)
-		(property "olduse.net spool in place" $ makeChange $ do
-			removeDirectoryRecursive newsspool
-			createSymbolicLink (datadir  "news") newsspool
-		)
+	& spoolsymlink
 	& "/etc/news/leafnode/config" `File.hasContent` 
 		[ "# olduse.net configuration (deployed by propellor)"
 		, "expire = 1000000" -- no expiry via texpire
@@ -135,7 +133,15 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
 		, Apache.allowAll
 		, "  "
 		]
+	
+	spoolsymlink :: Property UnixLike
+	spoolsymlink = check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool)
+		(property "olduse.net spool in place" $ makeChange $ do
+			removeDirectoryRecursive newsspool
+			createSymbolicLink (datadir  "news") newsspool
+		)
 
+	oldUseNetBackup :: Property (HasInfo + DebianLike)
 	oldUseNetBackup = Obnam.backup datadir (Cron.Times "33 4 * * *")
 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
 		, "--client-name=spool"
@@ -149,12 +155,12 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
 	keyfile = "/root/.ssh/olduse.net.key"
 
-oldUseNetShellBox :: Property HasInfo
+oldUseNetShellBox :: Property DebianLike
 oldUseNetShellBox = propertyList "olduse.net shellbox" $ props
 	& oldUseNetInstalled "oldusenet"
 	& Service.running "shellinabox"
 
-oldUseNetInstalled :: Apt.Package -> Property HasInfo
+oldUseNetInstalled :: Apt.Package -> Property DebianLike
 oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
 	propertyList ("olduse.net " ++ pkg) $ props
 		& Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
@@ -170,25 +176,25 @@ oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
 			]
 			`assume` MadeChange
 			`describe` "olduse.net built"
-
-kgbServer :: Property HasInfo
+ 
+kgbServer :: Property (HasInfo + Debian)
 kgbServer = propertyList desc $ props
 	& installed
 	& File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
 		`onChange` Service.restarted "kgb-bot"
   where
 	desc = "kgb.kitenet.net setup"
-	installed = withOS desc $ \o -> case o of
+	installed :: Property Debian
+	installed = withOS desc $ \w o -> case o of
 		(Just (System (Debian Unstable) _)) ->
-			ensureProperty $ propertyList desc
-				[ Apt.serviceInstalledRunning "kgb-bot"
-				, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
+			ensureProperty w $ propertyList desc $ props
+				& Apt.serviceInstalledRunning "kgb-bot"
+				& "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
 					`describe` "kgb bot enabled"
 					`onChange` Service.running "kgb-bot"
-				]
 		_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
 
-mumbleServer :: [Host] -> Property HasInfo
+mumbleServer :: [Host] -> Property (HasInfo + DebianLike)
 mumbleServer hosts = combineProperties hn $ props
 	& Apt.serviceInstalledRunning "mumble-server"
 	& Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *")
@@ -209,7 +215,7 @@ mumbleServer hosts = combineProperties hn $ props
 	sshkey = "/root/.ssh/mumble.debian.net.key"
 
 -- git.kitenet.net and git.joeyh.name
-gitServer :: [Host] -> Property HasInfo
+gitServer :: [Host] -> Property (HasInfo + DebianLike)
 gitServer hosts = propertyList "git.kitenet.net setup" $ props
 	& Obnam.backupEncrypted "/srv/git" (Cron.Times "33 3 * * *")
 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"
@@ -266,7 +272,7 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props
 type AnnexUUID = String
 
 -- | A website, with files coming from a git-annex repository.
-annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property HasInfo
+annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property (HasInfo + DebianLike)
 annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex") $ props
 	& Git.cloned (User "joey") origin dir Nothing
 		`onChange` setup
@@ -308,7 +314,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
 		, "  "
 		]
 
-apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty NoInfo
+apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
 apacheSite hn withssl middle = Apache.siteEnabled hn $ apachecfg hn withssl middle
 
 apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
@@ -348,7 +354,7 @@ mainhttpscert True =
 	, "  SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
 	]
 		
-gitAnnexDistributor :: Property HasInfo
+gitAnnexDistributor :: Property (HasInfo + DebianLike)
 gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props
 	& Apt.installed ["rsync"]
 	& File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
@@ -364,19 +370,18 @@ gitAnnexDistributor = combineProperties "git-annex distributor, including rsync
 	-- git-annex distribution signing key
 	& Gpg.keyImported (Gpg.GpgKeyId "89C809CB") (User "joey")
   where
-	endpoint d = combineProperties ("endpoint " ++ d)
-		[ File.dirExists d
-		, File.ownerGroup d (User "joey") (Group "joey")
-		]
+	endpoint d = combineProperties ("endpoint " ++ d) $ props
+		& File.dirExists d
+		& File.ownerGroup d (User "joey") (Group "joey")
 
-downloads :: [Host] -> Property HasInfo
+downloads :: [Host] -> Property (HasInfo + DebianLike)
 downloads hosts = annexWebSite "/srv/git/downloads.git"
 	"downloads.kitenet.net"
 	"840760dc-08f0-11e2-8c61-576b7e66acfd"
 	[("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")]
 	`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "joey")
 	
-tmp :: Property HasInfo
+tmp :: Property (HasInfo + DebianLike)
 tmp = propertyList "tmp.kitenet.net" $ props
 	& annexWebSite "/srv/git/joey/tmp.git"
 		"tmp.kitenet.net"
@@ -386,7 +391,7 @@ tmp = propertyList "tmp.kitenet.net" $ props
 	& pumpRss
 
 -- Twitter, you kill us.
-twitRss :: Property HasInfo
+twitRss :: Property DebianLike
 twitRss = combineProperties "twitter rss" $ props
 	& Git.cloned (User "joey") "git://git.kitenet.net/twitrss.git" dir Nothing
 	& check (not <$> doesFileExist (dir  "twitRss")) compiled
@@ -409,11 +414,11 @@ twitRss = combineProperties "twitter rss" $ props
 			]
 
 -- Work around for expired ssl cert.
-pumpRss :: Property NoInfo
+pumpRss :: Property DebianLike
 pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") (User "joey") "/srv/web/tmp.kitenet.net/"
 	"wget https://rss.io.jpope.org/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom"
 
-ircBouncer :: Property HasInfo
+ircBouncer :: Property (HasInfo + DebianLike)
 ircBouncer = propertyList "IRC bouncer" $ props
 	& Apt.installed ["znc"]
 	& User.accountFor (User "znc")
@@ -428,20 +433,19 @@ ircBouncer = propertyList "IRC bouncer" $ props
   where
 	conf = "/home/znc/.znc/configs/znc.conf"
 
-kiteShellBox :: Property NoInfo
-kiteShellBox = propertyList "kitenet.net shellinabox"
-	[ Apt.installed ["openssl", "shellinabox", "openssh-client"]
-	, File.hasContent "/etc/default/shellinabox"
+kiteShellBox :: Property DebianLike
+kiteShellBox = propertyList "kitenet.net shellinabox" $ props
+	& Apt.installed ["openssl", "shellinabox", "openssh-client"]
+	& File.hasContent "/etc/default/shellinabox"
 		[ "# Deployed by propellor"
 		, "SHELLINABOX_DAEMON_START=1"
 		, "SHELLINABOX_PORT=443"
 		, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net\""
 		]
 		`onChange` Service.restarted "shellinabox"
-	, Service.running "shellinabox"
-	]
+	& Service.running "shellinabox"
 
-githubBackup :: Property HasInfo
+githubBackup :: Property (HasInfo + DebianLike)
 githubBackup = propertyList "github-backup box" $ props
 	& Apt.installed ["github-backup", "moreutils"]
 	& githubKeys
@@ -462,7 +466,7 @@ githubBackup = propertyList "github-backup box" $ props
 		] ++ map gitriddance githubMirrors
 	gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")"
 
-githubKeys :: Property HasInfo
+githubKeys :: Property (HasInfo + UnixLike)
 githubKeys = 
 	let f = "/home/joey/.github-keys"
 	in File.hasPrivContent f anyContext
@@ -482,12 +486,12 @@ githubMirrors =
   where
 	plzuseurl u = "Please submit changes to " ++ u ++ " instead of using github pull requests, which are not part of my workflow. Just open a todo item there and link to a git repository containing your changes. Did you know, git is a distributed system? The git repository doesn't even need to be on github! Please send any complaints to Github; they don't allow turning off pull requests or redirecting them elsewhere.  -- A robot acting on behalf of Joey Hess"
 
-rsyncNetBackup :: [Host] -> Property NoInfo
+rsyncNetBackup :: [Host] -> Property DebianLike
 rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" (Cron.Times "30 5 * * *")
 	(User "joey") "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"
 	`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "joey")
 
-backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property NoInfo
+backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property DebianLike
 backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc
 	(Cron.Times "@reboot") (User "joey") "/" cmd
 	`requires` Ssh.knownHost hosts srchost (User "joey")
@@ -495,9 +499,9 @@ backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc
 	desc = "backups copied from " ++ srchost ++ " on boot"
 	cmd = "sleep 30m && rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir  srchost
 
-obnamRepos :: [String] -> Property NoInfo
-obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
-	(mkbase : map mkrepo rs)
+obnamRepos :: [String] -> Property UnixLike
+obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) $
+	toProps (mkbase : map mkrepo rs)
   where
 	mkbase = mkdir "/home/joey/lib/backup"
 		`requires` mkdir "/home/joey/lib"
@@ -505,13 +509,13 @@ obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
 	mkdir d = File.dirExists d
 		`before` File.ownerGroup d (User "joey") (Group "joey")
 
-podcatcher :: Property NoInfo
+podcatcher :: Property DebianLike
 podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *")
 	(User "joey") "/home/joey/lib/sound/podcasts"
 	"xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
 	`requires` Apt.installed ["git-annex", "myrepos"]
 
-kiteMailServer :: Property HasInfo
+kiteMailServer :: Property (HasInfo + DebianLike)
 kiteMailServer = propertyList "kitenet.net mail server" $ props
 	& Postfix.installed
 	& Apt.installed ["postfix-pcre"]
@@ -710,7 +714,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 
 -- Configures postfix to relay outgoing mail to kitenet.net, with
 -- verification via tls cert.
-postfixClientRelay :: Context -> Property HasInfo
+postfixClientRelay :: Context -> Property (HasInfo + DebianLike)
 postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`
 	-- Using smtps not smtp because more networks firewall smtp
 	[ "relayhost = kitenet.net:smtps"
@@ -727,7 +731,7 @@ postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`
 	`requires` hasPostfixCert ctx
 
 -- Configures postfix to have the dkim milter, and no other milters.
-dkimMilter :: Property HasInfo
+dkimMilter :: Property (HasInfo + DebianLike)
 dkimMilter = Postfix.mainCfFile `File.containsLines`
 	[ "smtpd_milters = inet:localhost:8891"
 	, "non_smtpd_milters = inet:localhost:8891"
@@ -740,7 +744,7 @@ dkimMilter = Postfix.mainCfFile `File.containsLines`
 
 -- This does not configure postfix to use the dkim milter,
 -- nor does it set up domainkey DNS.
-dkimInstalled :: Property HasInfo
+dkimInstalled :: Property (HasInfo + DebianLike)
 dkimInstalled = go `onChange` Service.restarted "opendkim"
   where
 	go = propertyList "opendkim installed" $ props
@@ -763,17 +767,16 @@ dkimInstalled = go `onChange` Service.restarted "opendkim"
 domainKey :: (BindDomain, Record)
 domainKey = (RelDomain "mail._domainkey", TXT "v=DKIM1; k=rsa; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB")
 
-hasJoeyCAChain :: Property HasInfo
+hasJoeyCAChain :: Property (HasInfo + UnixLike)
 hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
 	Context "joeyca.pem"
 
-hasPostfixCert :: Context -> Property HasInfo
-hasPostfixCert ctx = combineProperties "postfix tls cert installed"
-	[ "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
-	, "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
-	]
+hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
+hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props
+	& "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
+	& "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
 
-kitenetHttps :: Property HasInfo
+kitenetHttps :: Property (HasInfo + DebianLike)
 kitenetHttps = propertyList "kitenet.net https certs" $ props
 	& File.hasPrivContent "/etc/ssl/certs/web.pem" ctx
 	& File.hasPrivContent "/etc/ssl/private/web.pem" ctx
@@ -784,7 +787,7 @@ kitenetHttps = propertyList "kitenet.net https certs" $ props
 
 -- Legacy static web sites and redirections from kitenet.net to newer
 -- sites.
-legacyWebSites :: Property HasInfo
+legacyWebSites :: Property (HasInfo + DebianLike)
 legacyWebSites = propertyList "legacy web sites" $ props
 	& Apt.serviceInstalledRunning "apache2"
 	& Apache.modEnabled "rewrite"
@@ -944,7 +947,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		, "rewriterule (.*) http://joeyh.name$1 [r]"
 		]
 
-userDirHtml :: Property NoInfo
+userDirHtml :: Property DebianLike
 userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
 	`onChange` Apache.reloaded
 	`requires` Apache.modEnabled "userdir"
@@ -956,10 +959,9 @@ userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
 -- 
 --
 -- oncalendar example value: "*-*-* 7:30"
-alarmClock :: String -> User -> String -> Property NoInfo
-alarmClock oncalendar (User user) command = combineProperties
-	"goodmorning timer installed"
-	[ "/etc/systemd/system/goodmorning.timer" `File.hasContent`
+alarmClock :: String -> User -> String -> Property DebianLike
+alarmClock oncalendar (User user) command = combineProperties "goodmorning timer installed" $ props
+	& "/etc/systemd/system/goodmorning.timer" `File.hasContent`
 		[ "[Unit]"
 		, "Description=good morning"
 		, ""
@@ -974,7 +976,7 @@ alarmClock oncalendar (User user) command = combineProperties
 		]
 		`onChange` (Systemd.daemonReloaded
 			`before` Systemd.restarted "goodmorning.timer")
-	, "/etc/systemd/system/goodmorning.service" `File.hasContent`
+	& "/etc/systemd/system/goodmorning.service" `File.hasContent`
 		[ "[Unit]"
 		, "Description=good morning"
 		, "RefuseManualStart=true"
@@ -987,8 +989,7 @@ alarmClock oncalendar (User user) command = combineProperties
 		, "ExecStart=/bin/systemd-inhibit --what=handle-lid-switch --why=goodmorning /bin/su " ++ user ++ " -c \"" ++ command ++ "\""
 		]
 		`onChange` Systemd.daemonReloaded
-	, Systemd.enabled "goodmorning.timer"
-	, Systemd.started "goodmorning.timer"
-	, "/etc/systemd/logind.conf" `ConfFile.containsIniSetting`
+	& Systemd.enabled "goodmorning.timer"
+	& Systemd.started "goodmorning.timer"
+	& "/etc/systemd/logind.conf" `ConfFile.containsIniSetting`
 		("Login", "LidSwitchIgnoreInhibited", "no")
-	]
-- 
cgit v1.2.3


From f69e185f99394b658f14f9d62a8fb55f7d179d30 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 17:28:17 -0400
Subject: ported

fixed up chroot to take Props
---
 debian/changelog                                   |   4 +-
 joeyconfig.hs                                      |   8 +-
 src/Propellor/Property/Chroot.hs                   |  10 +-
 .../Property/SiteSpecific/GitAnnexBuilder.hs       | 103 +++++++++++----------
 src/Propellor/Property/Systemd.hs                  |   5 +-
 5 files changed, 66 insertions(+), 64 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 8a5b67e4..fc499c86 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,8 +8,8 @@ propellor (3.0.0) UNRELEASED; urgency=medium
     - Similarly, `propertyList` and `combineProperties` need `props`
       to be used to combine together properties; they no longer accept
       lists of properties. (If you have such a list, use `toProps`.)
-    - And similarly, Chroot and Docker need `props` to be used to combine
-      together the properies used inside them.
+    - And similarly, Chroot, Docker, and Systemd container need `props`
+      to be used to combine together the properies used inside them.
     - The `os` property is removed. Instead use `osDebian`, `osBuntish`,
       or `osFreeBSD`. These tell the type checker the target OS of a host.
     - Change "Property NoInfo" to "Property UnixLike"
diff --git a/joeyconfig.hs b/joeyconfig.hs
index 327c268e..036c7b61 100644
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -190,13 +190,13 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
 
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.standardAutoBuilder
-		(System (Debian Unstable) "amd64") Nothing (Cron.Times "15 * * * *") "2h")
+		Unstable "amd64" Nothing (Cron.Times "15 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.standardAutoBuilder
-		(System (Debian Unstable) "i386") Nothing (Cron.Times "30 * * * *") "2h")
+		Unstable "i386") Nothing (Cron.Times "30 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.stackAutoBuilder
-		(System (Debian (Stable "jessie")) "i386") (Just "ancient") (Cron.Times "45 * * * *") "2h")
+		(Stable "jessie") "i386" (Just "ancient") (Cron.Times "45 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer
 		(Cron.Times "1 1 * * *") "3h")
 
@@ -229,7 +229,7 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"
 
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.armAutoBuilder
-			(System (Debian Unstable) "armel") Nothing Cron.Daily "22h")
+			Unstable "armel" Nothing Cron.Daily "22h")
 
 -- This is not a complete description of kite, since it's a
 -- multiuser system with eg, user passwords that are not deployed
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index b29da7f9..811b5baa 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -103,19 +103,17 @@ instance ChrootBootstrapper Debootstrapped where
 -- add a property such as `osDebian` to specify the operating system
 -- to bootstrap.
 --
--- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev"
+-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props
 -- >	& osDebian Unstable "amd64"
 -- >	& Apt.installed ["ghc", "haskell-platform"]
 -- >	& ...
-debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
+debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
 debootstrapped conf = bootstrapped (Debootstrapped conf)
 
 -- | Defines a Chroot at the given location, bootstrapped with the
 -- specified ChrootBootstrapper.
-bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Chroot
-bootstrapped bootstrapper location = Chroot location bootstrapper h
-  where
-	h = Host location [] mempty
+bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
+bootstrapped bootstrapper location ps = Chroot location bootstrapper (host location ps)
 
 -- | Ensures that the chroot exists and is provisioned according to its
 -- properties.
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 2932baf7..d2c6db3c 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -25,7 +25,7 @@ builddir = gitbuilderdir  "build"
 
 type TimeOut = String -- eg, 5h
 
-autobuilder :: Architecture -> Times -> TimeOut -> Property HasInfo
+autobuilder :: Architecture -> Times -> TimeOut -> Property (HasInfo + DebianLike)
 autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 	& Apt.serviceInstalledRunning "cron"
 	& Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir
@@ -37,6 +37,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 	-- The builduser account does not have a password set,
 	-- instead use the password privdata to hold the rsync server
 	-- password used to upload the built image.
+	rsyncpassword :: Property (HasInfo + DebianLike)
 	rsyncpassword = withPrivData (Password builduser) context $ \getpw ->
 		property "rsync password" $ getpw $ \pw -> do
 			have <- liftIO $ catchDefaultIO "" $
@@ -46,7 +47,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 				then makeChange $ writeFile pwfile want
 				else noChange
 
-tree :: Architecture -> Flavor -> Property HasInfo
+tree :: Architecture -> Flavor -> Property DebianLike
 tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
 	& Apt.installed ["git"]
 	& File.dirExists gitbuilderdir
@@ -66,14 +67,14 @@ tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
 		[ "git clone git://git-annex.branchable.com/ " ++ builddir
 		]
 
-buildDepsApt :: Property HasInfo
+buildDepsApt :: Property DebianLike
 buildDepsApt = combineProperties "gitannexbuilder build deps" $ props
 	& Apt.buildDep ["git-annex"]
 	& buildDepsNoHaskellLibs
 	& Apt.buildDepIn builddir
 		`describe` "git-annex source build deps installed"
 
-buildDepsNoHaskellLibs :: Property NoInfo
+buildDepsNoHaskellLibs :: Property DebianLike
 buildDepsNoHaskellLibs = Apt.installed
 	["git", "rsync", "moreutils", "ca-certificates",
 	"debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt",
@@ -83,8 +84,9 @@ buildDepsNoHaskellLibs = Apt.installed
 	"libmagic-dev", "alex", "happy", "c2hs"
 	]
 
-haskellPkgsInstalled :: String -> Property NoInfo
-haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled")
+haskellPkgsInstalled :: String -> Property DebianLike
+haskellPkgsInstalled dir = tightenTargets $ 
+	flagFile go ("/haskellpkgsinstalled")
   where
 	go = userScriptProperty (User builduser)
 		[ "cd " ++ builddir ++ " && ./standalone/" ++ dir ++ "/install-haskell-packages"
@@ -93,7 +95,7 @@ haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled")
 
 -- Installs current versions of git-annex's deps from cabal, but only
 -- does so once.
-cabalDeps :: Property NoInfo
+cabalDeps :: Property UnixLike
 cabalDeps = flagFile go cabalupdated
 	where
 		go = userScriptProperty (User builduser)
@@ -101,20 +103,20 @@ cabalDeps = flagFile go cabalupdated
 			`assume` MadeChange
 		cabalupdated = homedir  ".cabal"  "packages"  "hackage.haskell.org"  "00-index.cache"
 
-autoBuilderContainer :: (System -> Flavor -> Property HasInfo) -> System -> Flavor -> Times -> TimeOut -> Systemd.Container
-autoBuilderContainer mkprop osver@(System _ arch) flavor crontime timeout =
-	Systemd.container name osver (Chroot.debootstrapped mempty)
-		& mkprop osver flavor
+autoBuilderContainer :: DebianSuite -> Architecture -> Flavor -> Times -> TimeOut -> Systemd.Container
+autoBuilderContainer suite arch flavor crontime timeout =
+	Systemd.container name $ \d -> Chroot.debootstrapped mempty d $ props
+		& osDebian suite arch
 		& autobuilder arch crontime timeout
   where
 	name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
 
 type Flavor = Maybe String
 
-standardAutoBuilder :: System -> Flavor -> Property HasInfo
-standardAutoBuilder osver@(System _ arch) flavor =
+standardAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+standardAutoBuilder suite arch flavor =
 	propertyList "standard git-annex autobuilder" $ props
-		& os osver
+		& osDebian suite arch
 		& buildDepsApt
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
@@ -122,10 +124,10 @@ standardAutoBuilder osver@(System _ arch) flavor =
 		& User.accountFor (User builduser)
 		& tree arch flavor
 
-stackAutoBuilder :: System -> Flavor -> Property HasInfo
-stackAutoBuilder osver@(System _ arch) flavor =
+stackAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+stackAutoBuilder suite arch flavor =
 	propertyList "git-annex autobuilder using stack" $ props
-		& os osver
+		& osDebian suite arch
 		& buildDepsNoHaskellLibs
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
@@ -134,34 +136,34 @@ stackAutoBuilder osver@(System _ arch) flavor =
 		& tree arch flavor
 		& stackInstalled
 
-stackInstalled :: Property NoInfo
-stackInstalled = withOS "stack installed" $ \o ->
+stackInstalled :: Property Linux
+stackInstalled = withOS "stack installed" $ \w o ->
 	case o of
 		(Just (System (Debian (Stable "jessie")) "i386")) ->
-			ensureProperty $ manualinstall "i386"
-		_ -> ensureProperty $ Apt.installed ["haskell-stack"]
+			ensureProperty w $ manualinstall "i386"
+		_ -> ensureProperty w $ Apt.installed ["haskell-stack"]
   where
 	-- Warning: Using a binary downloaded w/o validation.
-	manualinstall arch = check (not <$> doesFileExist binstack) $
-		propertyList "stack installed from upstream tarball"
-			[ cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
+	manualinstall :: Architecture -> Property Linux
+	manualinstall arch = tightenTargets $ check (not <$> doesFileExist binstack) $
+		propertyList "stack installed from upstream tarball" $ props
+			& cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
 				`assume` MadeChange
-			, File.dirExists tmpdir
-			, cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
+			& File.dirExists tmpdir
+			& cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
 				`assume` MadeChange
-			, cmdProperty "mv" [tmpdir  "stack", binstack]
+			& cmdProperty "mv" [tmpdir  "stack", binstack]
 				`assume` MadeChange
-			, cmdProperty "rm" ["-rf", tmpdir, tmptar]
+			& cmdProperty "rm" ["-rf", tmpdir, tmptar]
 				`assume` MadeChange
-			]
 	binstack = "/usr/bin/stack"
 	tmptar = "/root/stack.tar.gz"
 	tmpdir = "/root/stack"
 
-armAutoBuilder :: System -> Flavor -> Property HasInfo
-armAutoBuilder osver flavor = 
+armAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+armAutoBuilder suite arch flavor = 
 	propertyList "arm git-annex autobuilder" $ props
-		& standardAutoBuilder osver flavor
+		& standardAutoBuilder suite arch flavor
 		& buildDepsNoHaskellLibs
 		-- Works around ghc crash with parallel builds on arm.
 		& (homedir  ".cabal"  "config")
@@ -172,26 +174,30 @@ armAutoBuilder osver flavor =
 
 androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
 androidAutoBuilderContainer crontimes timeout =
-	androidContainer "android-git-annex-builder" (tree "android" Nothing) builddir
-		& Apt.unattendedUpgrades
-		& buildDepsNoHaskellLibs
-		& autobuilder "android" crontimes timeout
+	androidAutoBuilderContainer' "android-git-annex-builder"
+		(tree "android" Nothing) builddir crontimes timeout
 
 -- Android is cross-built in a Debian i386 container, using the Android NDK.
-androidContainer
-	:: (IsProp (Property (CInfo NoInfo i)), (Combines (Property NoInfo) (Property i)))
-	=> Systemd.MachineName
-	-> Property i
+androidAutoBuilderContainer'
+	:: Systemd.MachineName
+	-> Property DebianLike
 	-> FilePath
+	-> Times
+	-> TimeOut
 	-> Systemd.Container
-androidContainer name setupgitannexdir gitannexdir = Systemd.container name osver bootstrap
-	& Apt.stdSourcesList
-	& User.accountFor (User builduser)
-	& File.dirExists gitbuilderdir
-	& File.ownerGroup homedir (User builduser) (Group builduser)
-	& flagFile chrootsetup ("/chrootsetup")
-		`requires` setupgitannexdir
-	& haskellPkgsInstalled "android"
+androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout = 
+	Systemd.container name $ \d -> bootstrap d $ props
+		& osDebian (Stable "jessie") "i386"
+		& Apt.stdSourcesList
+		& User.accountFor (User builduser)
+		& File.dirExists gitbuilderdir
+		& File.ownerGroup homedir (User builduser) (Group builduser)
+		& flagFile chrootsetup ("/chrootsetup")
+			`requires` setupgitannexdir
+		& haskellPkgsInstalled "android"
+		& Apt.unattendedUpgrades
+		& buildDepsNoHaskellLibs
+		& autobuilder "android" crontimes timeout
   where
 	-- Use git-annex's android chroot setup script, which will install
 	-- ghc-android and the NDK, all build deps, etc, in the home
@@ -200,5 +206,4 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name osve
 		[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
 		]
 		`assume` MadeChange
-	osver = System (Debian (Stable "jessie")) "i386"
 	bootstrap = Chroot.debootstrapped mempty
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index eaf7df8b..94215593 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -188,19 +188,18 @@ machined = withOS "machined installed" $ \w o ->
 -- add a property such as `osDebian` to specify the operating system
 -- to bootstrap.
 --
--- > container "webserver" (Chroot.debootstrapped mempty)
+-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
 -- >	& osDebian Unstable "amd64"
 -- >    & Apt.installedRunning "apache2"
 -- >    & ...
 container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
 container name mkchroot = 
-	let c = Container name chroot h
+	let c = Container name chroot (host name (containerProps chroot))
 	in setContainerProps c $ containerProps c
 		&^ resolvConfed
 		&^ linkJournal
   where
 	chroot = mkchroot (containerDir name)
-	h = Host name [] mempty
 
 -- | Runs a container using systemd-nspawn.
 --
-- 
cgit v1.2.3


From f6ccfeae4facbbddd1ef6818313700b990306d1b Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 17:29:13 -0400
Subject: fix build

---
 src/Propellor/Property/Docker.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 3cb91fd4..ddefef15 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -196,7 +196,7 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
 	runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
 		(_dockerRunParams info)
 	info = fromInfo $ hostInfo h'
-	h' = modifyHostProps h $ hostProps h
+	h' = setContainerProps h $ containerProps h
 		-- Restart by default so container comes up on
 		-- boot or when docker is upgraded.
 		&^ restartAlways
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 7e76731a0098a6cd47979c86c8a484cc47e0b0d7 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 18:17:28 -0400
Subject: finished the conversion, including my config file!

It builds, but I have not yet tested if it works. Need to verify info
propagation, etc.
---
 config-freebsd.hs                                  |   6 +-
 joeyconfig.hs                                      | 143 +++++++++++----------
 .../Property/SiteSpecific/GitAnnexBuilder.hs       |   6 +-
 src/Propellor/Property/Systemd.hs                  |  17 ++-
 4 files changed, 97 insertions(+), 75 deletions(-)

diff --git a/config-freebsd.hs b/config-freebsd.hs
index 07aeb391..3ee3f27c 100644
--- a/config-freebsd.hs
+++ b/config-freebsd.hs
@@ -27,7 +27,7 @@ hosts =
 
 -- An example freebsd host.
 freebsdbox :: Host
-freebsdbox = host "freebsdbox.example.com"
+freebsdbox = host "freebsdbox.example.com" $ props
 	& osFreeBSD (FBSDProduction FBSD102) "amd64"
 	& Pkg.update
 	& Pkg.upgrade
@@ -43,7 +43,7 @@ poudriereZFS = Poudriere.defaultConfig
 
 -- An example linux host.
 linuxbox :: Host
-linuxbox = host "linuxbox.example.com"
+linuxbox = host "linuxbox.example.com" $ props
 	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 	& Apt.unattendedUpgrades
@@ -58,7 +58,7 @@ linuxbox = host "linuxbox.example.com"
 
 -- A generic webserver in a Docker container.
 webserverContainer :: Docker.Container
-webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")
+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props
 	& osDebian (Stable "jessie") "amd64"
 	& Apt.stdSourcesList
 	& Docker.publish "80:80"
diff --git a/joeyconfig.hs b/joeyconfig.hs
index 036c7b61..3852f14b 100644
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -59,24 +59,26 @@ hosts =                --                  (o)  `
 	] ++ monsters
 
 testvm :: Host
-testvm = host "testvm.kitenet.net"
-	& os (System (Debian Unstable) "amd64")
+testvm = host "testvm.kitenet.net" $ props
+	& osDebian Unstable "amd64"
 	& OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")
-	 	`onChange` propertyList "fixing up after clean install"
-	 		[ OS.preserveRootSshAuthorized
-			, OS.preserveResolvConf
-			, Apt.update
-			, Grub.boots "/dev/sda"
-				`requires` Grub.installed Grub.PC
-	 		]
+	 	`onChange` postinstall
 	& Hostname.sane
 	& Hostname.searchDomain
 	& Apt.installed ["linux-image-amd64"]
 	& Apt.installed ["ssh"]
 	& User.hasPassword (User "root")
+  where
+	postinstall :: Property DebianLike
+	postinstall = propertyList "fixing up after clean install" $ props
+		& OS.preserveRootSshAuthorized
+		& OS.preserveResolvConf
+		& Apt.update
+		& Grub.boots "/dev/sda"
+			`requires` Grub.installed Grub.PC
 
 darkstar :: Host
-darkstar = host "darkstar.kitenet.net"
+darkstar = host "darkstar.kitenet.net" $ props
 	& ipv6 "2001:4830:1600:187::2"
 	& Aiccu.hasConfig "T18376" "JHZ2-SIXXS"
 
@@ -95,22 +97,23 @@ darkstar = host "darkstar.kitenet.net"
 		, swapPartition (MegaBytes 256)
 		]
   where
-	c d = Chroot.debootstrapped mempty d
-		& os (System (Debian Unstable) "amd64")
+	c d = Chroot.debootstrapped mempty d $ props
+		& osDebian Unstable "amd64"
 		& Hostname.setTo "demo"
 		& Apt.installed ["linux-image-amd64"]
 		& User "root" `User.hasInsecurePassword` "root"
 
 gnu :: Host
-gnu = host "gnu.kitenet.net"
+gnu = host "gnu.kitenet.net" $ props
 	& Apt.buildDep ["git-annex"] `period` Daily
 
 	& JoeySites.postfixClientRelay (Context "gnu.kitenet.net")
 	& JoeySites.dkimMilter
 
 clam :: Host
-clam = standardSystem "clam.kitenet.net" Unstable "amd64"
-	[ "Unreliable server. Anything here may be lost at any time!" ]
+clam = host "clam.kitenet.net" $ props
+	& standardSystem Unstable "amd64" 
+		["Unreliable server. Anything here may be lost at any time!" ]
 	& ipv4 "167.88.41.194"
 
 	& CloudAtCost.decruft
@@ -141,8 +144,9 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	& alias "us.scroll.joeyh.name"
 
 mayfly :: Host
-mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"
-	[ "Scratch VM. Contents can change at any time!" ]
+mayfly = host "mayfly.kitenet.net" $ props
+	& standardSystem (Stable "jessie") "amd64"
+		[ "Scratch VM. Contents can change at any time!" ]
 	& ipv4 "167.88.36.193"
 
 	& CloudAtCost.decruft
@@ -156,8 +160,9 @@ mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"
 	& Tor.bandwidthRate (Tor.PerMonth "400 GB")
 
 oyster :: Host
-oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"
-	[ "Unreliable server. Anything here may be lost at any time!" ]
+oyster = host "oyster.kitenet.net" $ props
+	& standardSystem Unstable "amd64"
+		[ "Unreliable server. Anything here may be lost at any time!" ]
 	& ipv4 "104.167.117.109"
 
 	& CloudAtCost.decruft
@@ -179,8 +184,8 @@ oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"
 	& Ssh.listenPort (Port 80)
 
 orca :: Host
-orca = standardSystem "orca.kitenet.net" Unstable "amd64"
-	[ "Main git-annex build box." ]
+orca = host "orca.kitenet.net" $ props
+	& standardSystem Unstable "amd64" [ "Main git-annex build box." ]
 	& ipv4 "138.38.108.179"
 
 	& Apt.unattendedUpgrades
@@ -193,7 +198,7 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
 		Unstable "amd64" Nothing (Cron.Times "15 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.standardAutoBuilder
-		Unstable "i386") Nothing (Cron.Times "30 * * * *") "2h")
+		Unstable "i386" Nothing (Cron.Times "30 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.stackAutoBuilder
 		(Stable "jessie") "i386" (Just "ancient") (Cron.Times "45 * * * *") "2h")
@@ -201,8 +206,8 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
 		(Cron.Times "1 1 * * *") "3h")
 
 honeybee :: Host
-honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"
-	[ "Arm git-annex build box." ]
+honeybee = host "honeybee.kitenet.net" $ props
+	& standardSystem Testing "armhf" [ "Arm git-annex build box." ]
 
 	-- I have to travel to get console access, so no automatic
 	-- upgrades, and try to be robust.
@@ -235,8 +240,8 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"
 -- multiuser system with eg, user passwords that are not deployed
 -- with propellor.
 kite :: Host
-kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
-	[ "Welcome to kite!" ]
+kite = host "kite.kitenet.net" $ props
+	& standardSystemUnhardened Testing "amd64" [ "Welcome to kite!" ]
 	& ipv4 "66.228.36.95"
 	& ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
 	& alias "kitenet.net"
@@ -351,10 +356,11 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
 		]
 
 elephant :: Host
-elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
-	[ "Storage, big data, and backups, omnomnom!"
-	, "(Encrypt all data stored here.)"
-	]
+elephant = host "elephant.kitenet.net" $ props
+	& standardSystem Unstable "amd64"
+		[ "Storage, big data, and backups, omnomnom!"
+		, "(Encrypt all data stored here.)"
+		]
 	& ipv4 "193.234.225.114"
 	& Ssh.hostKeys hostContext
 		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBANxXGWac0Yz58akI3UbLkphAa8VPDCGswTS0CT3D5xWyL9OeArISAi/OKRIvxA4c+9XnWtNXS7nYVFDJmzzg8v3ZMx543AxXK82kXCfvTOc/nAlVz9YKJAA+FmCloxpmOGrdiTx1k36FE+uQgorslGW/QTxnOcO03fDZej/ppJifAAAAFQCnenyJIw6iJB1+zuF/1TSLT8UAeQAAAIEA1WDrI8rKnxnh2rGaQ0nk+lOcVMLEr7AxParnZjgC4wt2mm/BmkF/feI1Fjft2z4D+V1W7MJHOqshliuproxhFUNGgX9fTbstFJf66p7h7OLAlwK8ZkpRk/uV3h5cIUPel6aCwjL5M2gN6/yq+gcCTXeHLq9OPyUTmlN77SBL71UAAACBAJJiCHWxPAGooe7Vv3W7EIBbsDyf7b2kDH3bsIlo+XFcKIN6jysBu4kn9utjFlrlPeHUDzGQHe+DmSqTUQQ0JPCRGcAcuJL8XUqhJi6A6ye51M9hVt51cJMXmERx9TjLOP/adkEuxpv3Fj20FxRUr1HOmvRvewSHrJ1GeA1bjbYL")
@@ -412,7 +418,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
 	& Ssh.listenPort (Port 80)
 
 beaver :: Host
-beaver = host "beaver.kitenet.net"
+beaver = host "beaver.kitenet.net" $ props
 	& ipv6 "2001:4830:1600:195::2"
 	& Apt.serviceInstalledRunning "aiccu"
 	& Apt.installed ["ssh"]
@@ -425,7 +431,7 @@ beaver = host "beaver.kitenet.net"
 
 -- Branchable is not completely deployed with propellor yet.
 pell :: Host
-pell = host "pell.branchable.com"
+pell = host "pell.branchable.com" $ props
 	& alias "branchable.com"
 	& ipv4 "66.228.46.55"
 	& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
@@ -449,10 +455,10 @@ pell = host "pell.branchable.com"
 	& Branchable.server hosts
 
 iabak :: Host
-iabak = host "iabak.archiveteam.org"
+iabak = host "iabak.archiveteam.org" $ props
 	& ipv4 "124.6.40.227"
 	& Hostname.sane
-	& os (System (Debian Testing) "amd64")
+	& osDebian Testing "amd64"
 	& Systemd.persistentJournal
 	& Cron.runPropellor (Cron.Times "30 * * * *")
 	& Apt.stdSourcesList `onChange` Apt.upgrade
@@ -466,7 +472,7 @@ iabak = host "iabak.archiveteam.org"
 	& Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]
 	& User.hasSomePassword (User "root")
 	& propertyList "admin accounts"
-		(map User.accountFor admins ++ map Sudo.enabledFor admins)
+		(toProps $ map User.accountFor admins ++ map Sudo.enabledFor admins)
 	& User.hasSomePassword (User "joey")
 	& GitHome.installedFor (User "joey")
 	& Ssh.authorizedKey (User "db48x") "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel"
@@ -489,14 +495,16 @@ iabak = host "iabak.archiveteam.org"
 
 -- Simple web server, publishing the outside host's /var/www
 webserver :: Systemd.Container
-webserver = standardStableContainer "webserver"
+webserver = Systemd.debContainer "webserver" $ props
+	& standardContainer (Stable "jessie")
 	& Systemd.bind "/var/www"
 	& Apache.installed
 
 -- My own openid provider. Uses php, so containerized for security
 -- and administrative sanity.
 openidProvider :: Systemd.Container
-openidProvider = standardStableContainer "openid-provider"
+openidProvider = Systemd.debContainer "openid-provider" $ props
+	& standardContainer (Stable "jessie")
 	& alias hn
 	& OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))
   where
@@ -504,7 +512,8 @@ openidProvider = standardStableContainer "openid-provider"
 
 -- Exhibit: kite's 90's website on port 1994.
 ancientKitenet :: Systemd.Container
-ancientKitenet = standardStableContainer "ancient-kitenet"
+ancientKitenet = Systemd.debContainer "ancient-kitenet" $ props
+	& standardContainer (Stable "jessie")
 	& alias hn
 	& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"
 		(Just "remotes/origin/old-kitenet.net")
@@ -517,24 +526,27 @@ ancientKitenet = standardStableContainer "ancient-kitenet"
 	hn = "ancient.kitenet.net"
 
 oldusenetShellBox :: Systemd.Container
-oldusenetShellBox = standardStableContainer "oldusenet-shellbox"
+oldusenetShellBox = Systemd.debContainer "oldusenet-shellbox" $ props
+	& standardContainer (Stable "jessie")
 	& alias "shell.olduse.net"
 	& JoeySites.oldUseNetShellBox
 
 kiteShellBox :: Systemd.Container
-kiteShellBox = standardStableContainer "kiteshellbox"
+kiteShellBox = Systemd.debContainer "kiteshellbox" $ props
+	& standardContainer (Stable "jessie")
 	& JoeySites.kiteShellBox
 
 type Motd = [String]
 
 -- This is my standard system setup.
-standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host
-standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd
-	& Ssh.noPasswords
-
-standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host
-standardSystemUnhardened hn suite arch motd = host hn
-	& os (System (Debian suite) arch)
+standardSystem :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
+standardSystem suite arch motd = 
+	standardSystemUnhardened suite arch motd
+		`before` Ssh.noPasswords
+
+standardSystemUnhardened :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
+standardSystemUnhardened suite arch motd = propertyList "standard system" $ props
+	& osDebian suite arch
 	& Hostname.sane
 	& Hostname.searchDomain
 	& File.hasContent "/etc/motd" ("":motd++[""])
@@ -555,32 +567,27 @@ standardSystemUnhardened hn suite arch motd = host hn
 		`onChange` Apt.autoRemove
 
 -- This is my standard container setup, Featuring automatic upgrades.
-standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container
-standardContainer name suite arch =
-	Systemd.container name system (Chroot.debootstrapped mempty)
-		& Apt.stdSourcesList `onChange` Apt.upgrade
-		& Apt.unattendedUpgrades
-		& Apt.cacheCleaned
-  where
-	system = System (Debian suite) arch
-
-standardStableContainer :: Systemd.MachineName -> Systemd.Container
-standardStableContainer name = standardContainer name (Stable "jessie") "amd64"
+standardContainer :: DebianSuite -> Property (HasInfo + Debian)
+standardContainer suite = propertyList "standard container" $ props
+	& osDebian suite "amd64"
+	& Apt.stdSourcesList `onChange` Apt.upgrade
+	& Apt.unattendedUpgrades
+	& Apt.cacheCleaned
 
-myDnsSecondary :: Property HasInfo
+myDnsSecondary :: Property (HasInfo + DebianLike)
 myDnsSecondary = propertyList "dns secondary for all my domains" $ props
 	& Dns.secondary hosts "kitenet.net"
 	& Dns.secondary hosts "joeyh.name"
 	& Dns.secondary hosts "ikiwiki.info"
 	& Dns.secondary hosts "olduse.net"
 
-branchableSecondary :: RevertableProperty HasInfo
+branchableSecondary :: RevertableProperty (HasInfo + DebianLike) DebianLike
 branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
 
 -- Currently using kite (ns4) as primary with secondaries
 -- elephant (ns3) and gandi.
 -- kite handles all mail.
-myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty HasInfo
+myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
 myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain
 	(Dns.mkSOA "ns4.kitenet.net" 100) $
 	[ (RootDomain, NS $ AbsDomain "ns4.kitenet.net")
@@ -594,20 +601,20 @@ myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly No
 
 monsters :: [Host]    -- Systems I don't manage with propellor,
 monsters =            -- but do want to track their public keys etc.
-	[ host "usw-s002.rsync.net"
+	[ host "usw-s002.rsync.net" $ props
 		& Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd"
-	, host "github.com"
+	, host "github.com" $ props
 		& Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
-	, host "gitlab.com"
+	, host "gitlab.com" $ props
 		& Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY="
-	, host "ns6.gandi.net"
+	, host "ns6.gandi.net" $ props
 		& ipv4 "217.70.177.40"
-	, host "turtle.kitenet.net"
+	, host "turtle.kitenet.net" $ props
 		& ipv4 "67.223.19.96"
 		& ipv6 "2001:4978:f:2d9::2"
-	, host "mouse.kitenet.net"
+	, host "mouse.kitenet.net" $ props
 		& ipv6 "2001:4830:1600:492::2"
-	, host "animx"
+	, host "animx" $ props
 		& ipv4 "76.7.162.101"
 		& ipv4 "76.7.162.186"
 	]
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index d2c6db3c..ce89b94a 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -103,10 +103,10 @@ cabalDeps = flagFile go cabalupdated
 			`assume` MadeChange
 		cabalupdated = homedir  ".cabal"  "packages"  "hackage.haskell.org"  "00-index.cache"
 
-autoBuilderContainer :: DebianSuite -> Architecture -> Flavor -> Times -> TimeOut -> Systemd.Container
-autoBuilderContainer suite arch flavor crontime timeout =
+autoBuilderContainer :: (DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)) -> DebianSuite -> Architecture -> Flavor -> Times -> TimeOut -> Systemd.Container
+autoBuilderContainer mkprop suite arch flavor crontime timeout =
 	Systemd.container name $ \d -> Chroot.debootstrapped mempty d $ props
-		& osDebian suite arch
+		& mkprop suite arch flavor
 		& autobuilder arch crontime timeout
   where
 	name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 94215593..e0b7d572 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -25,6 +25,7 @@ module Propellor.Property.Systemd (
 	MachineName,
 	Container,
 	container,
+	debContainer,
 	nspawned,
 	-- * Container configuration
 	containerCfg,
@@ -181,7 +182,7 @@ machined = withOS "machined installed" $ \w o ->
 				Apt.installed ["systemd-container"]
 		_ -> noChange
 
--- | Defines a container with a given machine name, and operating system,
+-- | Defines a container with a given machine name,
 -- and how to create its chroot if not already present.
 --
 -- Properties can be added to configure the Container. At a minimum,
@@ -201,6 +202,20 @@ container name mkchroot =
   where
 	chroot = mkchroot (containerDir name)
 
+-- | Defines a container with a given machine name, with the chroot
+-- created using debootstrap.
+--
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
+--
+-- > debContainer "webserver" $ props
+-- >	& osDebian Unstable "amd64"
+-- >    & Apt.installedRunning "apache2"
+-- >    & ...
+debContainer :: MachineName -> Props metatypes -> Container
+debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
+
 -- | Runs a container using systemd-nspawn.
 --
 -- A systemd unit is set up for the container, so it will automatically
-- 
cgit v1.2.3


From 500635568514bc106597a857c60d268dcf668037 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 18:32:01 -0400
Subject: split out singletons lib

---
 debian/changelog                  |  4 ++--
 propellor.cabal                   |  1 +
 src/Propellor/Types/MetaTypes.hs  | 14 +-------------
 src/Propellor/Types/Singletons.hs | 17 +++++++++++++++++
 4 files changed, 21 insertions(+), 15 deletions(-)
 create mode 100644 src/Propellor/Types/Singletons.hs

diff --git a/debian/changelog b/debian/changelog
index fc499c86..af2f5c2b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -39,10 +39,10 @@ propellor (3.0.0) UNRELEASED; urgency=medium
 		go = property "foo" (return NoChange)
       To fix, specify the type of go:
 	  	go :: Property UnixLike
-    - `ensureProperty` now needs to be passed information about the
+    - `ensureProperty` now needs to be passed a witness to the type of the 
       property it's used in.
       change this:  foo = property desc $ ... ensureProperty bar
-      to this:      foo = property' desc $ \o -> ... ensureProperty o bar
+      to this:      foo = property' desc $ \w -> ... ensureProperty w bar
     - General purpose properties like cmdProperty have type "Property UnixLike".
       When using that to run a command only available on Debian, you can
       tighten the type to only the OS that your more specific property works on.
diff --git a/propellor.cabal b/propellor.cabal
index 4a7739d3..f11d2afe 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -162,6 +162,7 @@ Library
     Propellor.Types.PrivData
     Propellor.Types.Result
     Propellor.Types.ResultCheck
+    Propellor.Types.Singletons
     Propellor.Types.ZFS
   Other-Modules:
     Propellor.Bootstrap
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index 3e89e28d..39d6e725 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -25,6 +25,7 @@ module Propellor.Types.MetaTypes (
 	EqT,
 ) where
 
+import Propellor.Types.Singletons
 import Propellor.Types.OS
 
 data MetaType
@@ -49,13 +50,6 @@ type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l
 
 type MetaTypes = Sing
 
--- | The data family of singleton types.
-data family Sing (x :: k)
-
--- | A class used to pass singleton values implicitly.
-class SingI t where
-	sing :: Sing t
-
 -- This boilerplatw would not be needed if the singletons library were
 -- used. However, we're targeting too old a version of ghc to use it yet.
 data instance Sing (x :: MetaType) where
@@ -68,12 +62,6 @@ instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS
 instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS
 instance SingI 'WithInfo where sing = WithInfoS
 
-data instance Sing (x :: [k]) where
-	Nil :: Sing '[]
-	Cons :: Sing x -> Sing xs -> Sing (x ': xs)
-instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing
-instance SingI '[] where sing = Nil
-
 -- | Convenience type operator to combine two `MetaTypes` lists.
 --
 -- For example:
diff --git a/src/Propellor/Types/Singletons.hs b/src/Propellor/Types/Singletons.hs
new file mode 100644
index 00000000..be777ecb
--- /dev/null
+++ b/src/Propellor/Types/Singletons.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs #-}
+
+module Propellor.Types.Singletons where
+
+-- | The data family of singleton types.
+data family Sing (x :: k)
+
+-- | A class used to pass singleton values implicitly.
+class SingI t where
+	sing :: Sing t
+
+-- Lists of singletons
+data instance Sing (x :: [k]) where
+	Nil :: Sing '[]
+	Cons :: Sing x -> Sing xs -> Sing (x ': xs)
+instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing
+instance SingI '[] where sing = Nil
-- 
cgit v1.2.3


From 3383d008c7df57e6b5dd066fa1dfa80ac39cdd8e Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 18:37:02 -0400
Subject: propellor spin

---
 src/Propellor.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/Propellor.hs b/src/Propellor.hs
index 9c5a85a9..e6a52948 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -14,13 +14,14 @@
 -- > main = defaultMain hosts
 -- > 
 -- > hosts :: [Host]
--- > hosts =
--- >   [ host "example.com"
+-- > hosts = [example]
+-- > 
+-- > example :: Host
+-- > example = host "example.com" $ props
 -- >     & Apt.installed ["mydaemon"]
 -- >     & "/etc/mydaemon.conf" `File.containsLine` "secure=1"
 -- >       `onChange` cmdProperty "service" ["mydaemon", "restart"]
 -- >     ! Apt.installed ["unwantedpackage"]
--- >   ]
 --
 -- See config.hs for a more complete example, and clone Propellor's
 -- git repository for a deployable system using Propellor:
-- 
cgit v1.2.3


From 9d6dc29555b8499d8ae6c73c891b0b5dc19f83e5 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 19:59:20 -0400
Subject: improve haddocks and move code around to make them more clear

---
 propellor.cabal                       |   1 +
 src/Propellor/Container.hs            |   4 +-
 src/Propellor/Engine.hs               |   4 +-
 src/Propellor/EnsureProperty.hs       |   1 +
 src/Propellor/Info.hs                 |  28 +++++-
 src/Propellor/PrivData.hs             |   2 +-
 src/Propellor/PropAccum.hs            |   5 +-
 src/Propellor/Property.hs             |   1 +
 src/Propellor/Property/Chroot.hs      |   3 +-
 src/Propellor/Property/Concurrent.hs  |   2 +
 src/Propellor/Property/Conductor.hs   |  13 +--
 src/Propellor/Property/Dns.hs         |   2 +-
 src/Propellor/Property/Docker.hs      |   3 +-
 src/Propellor/Property/FreeBSD/Pkg.hs |   4 +-
 src/Propellor/Property/List.hs        |   2 +
 src/Propellor/Property/Partition.hs   |   1 +
 src/Propellor/Property/Scheduled.hs   |   1 +
 src/Propellor/Types.hs                | 168 ++++++----------------------------
 src/Propellor/Types/Core.hs           | 106 +++++++++++++++++++++
 src/Propellor/Types/Info.hs           |   5 +
 20 files changed, 196 insertions(+), 160 deletions(-)
 create mode 100644 src/Propellor/Types/Core.hs

diff --git a/propellor.cabal b/propellor.cabal
index f11d2afe..e946f697 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -150,6 +150,7 @@ Library
     Propellor.EnsureProperty
     Propellor.Exception
     Propellor.Types
+    Propellor.Types.Core
     Propellor.Types.Chroot
     Propellor.Types.CmdLine
     Propellor.Types.Container
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index 4cd46ae5..c4d6f864 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -3,8 +3,10 @@
 module Propellor.Container where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Types.Info
+import Propellor.Info
 import Propellor.PrivData
 import Propellor.PropAccum
 
@@ -54,7 +56,7 @@ propagateContainer containername c prop = prop
 	convert p = 
 		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
 		    n' = n
-		    	`addInfoProperty` mapInfo (forceHostContext containername)
+		    	`setInfoProperty` mapInfo (forceHostContext containername)
 				(propagatableInfo (getInfo p))
 		   	`addChildren` map convert (getChildren p)
 		in toChildProperty n'
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 4c37e704..f0035c40 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -4,7 +4,6 @@
 module Propellor.Engine (
 	mainProperties,
 	runPropellor,
-	ensureProperty,
 	ensureChildProperties,
 	fromHost,
 	fromHost',
@@ -23,10 +22,11 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
-import Propellor.Property
 import Utility.Exception
 
 -- | Gets the Properties of a Host, and ensures them all,
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f9094c5b..ce01d436 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -11,6 +11,7 @@ module Propellor.EnsureProperty
 	) where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Exception
 
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index ff0b3b5e..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
 
 module Propellor.Info (
 	osDebian,
 	osBuntish,
 	osFreeBSD,
+	setInfoProperty,
+	addInfoProperty,
 	pureInfoProperty,
 	pureInfoProperty',
 	askInfo,
@@ -22,6 +24,7 @@ module Propellor.Info (
 
 import Propellor.Types
 import Propellor.Types.Info
+import Propellor.Types.MetaTypes
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -31,11 +34,32 @@ import Data.Monoid
 import Control.Applicative
 import Prelude
 
+-- | Adds info to a Property.
+--
+-- The new Property will include HasInfo in its metatypes.
+setInfoProperty
+	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
+	=> Property metatypes
+	-> Info
+	-> Property (MetaTypes metatypes')
+setInfoProperty (Property _ d a oldi c) newi =
+	Property sing d a (oldi <> newi) c
+
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Makes a property that does nothing but set some `Info`.
 pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
 pureInfoProperty desc v = pureInfoProperty' desc (toInfo v)
 
 pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
-pureInfoProperty' desc i = addInfoProperty p i
+pureInfoProperty' desc i = setInfoProperty p i
   where
 	p :: Property UnixLike
 	p = property ("has " ++ desc) (return NoChange)
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 0bc0c100..d3bb3a6d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -127,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = p `addInfoProperty'` (toInfo privset)
+	addinfo p = p `addInfoProperty` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 856f2e8e..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -16,6 +16,7 @@ module Propellor.PropAccum
 
 import Propellor.Types
 import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Property
 
 import Data.Monoid
@@ -30,10 +31,6 @@ import Prelude
 host :: HostName -> Props metatypes -> Host
 host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Props is a combination of a list of properties, with their combined 
--- metatypes.
-data Props metatypes = Props [ChildProperty]
-
 -- | Start accumulating a list of properties.
 --
 -- Properties can be added to it using `(&)` etc.
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 70583edc..29a8ec0f 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -53,6 +53,7 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.ResultCheck
 import Propellor.Types.MetaTypes
 import Propellor.Info
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 811b5baa..09047ce5 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -23,6 +23,7 @@ import Propellor.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
+import Propellor.Types.Core
 import Propellor.Property.Chroot.Util
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
@@ -151,7 +152,7 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 
 propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
 propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
-	p `addInfoProperty` chrootInfo c
+	p `setInfoProperty` chrootInfo c
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ h) = mempty `addInfo`
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index ace85a3c..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
 ) where
 
 import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 
 import Control.Concurrent
 import qualified Control.Concurrent.Async as A
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ab747acc..8aa18d20 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,16 +83,17 @@ import qualified Propellor.Property.Ssh as Ssh
 import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
 class Conductable c where
 	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
-	-- | Conduct the specified host.
 	conducts h = conductorFor h  notConductorFor h
 
--- | Each host in the list will be conducted in turn. Failure to conduct
--- one host does not prevent conducting subsequent hosts in the list, but
--- will be propagated as an overall failure of the property.
 instance Conductable [Host] where
 	conducts hs = 
 		propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
@@ -246,7 +247,7 @@ orchestrate' h (Conductor c l)
 -- to have any effect.
 conductorFor :: Host -> Property (HasInfo + UnixLike)
 conductorFor h = go
-	`addInfoProperty` (toInfo (ConductorFor [h]))
+	`setInfoProperty` (toInfo (ConductorFor [h]))
 	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
@@ -270,7 +271,7 @@ conductorFor h = go
 -- Reverts conductorFor.
 notConductorFor :: Host -> Property (HasInfo + UnixLike)
 notConductorFor h = (doNothing :: Property UnixLike)
-	`addInfoProperty` (toInfo (NotConductorFor [h]))
+	`setInfoProperty` (toInfo (NotConductorFor [h]))
 	`describe` desc
 	`requires` undoRevertableProperty (conductorKnownHost h)
   where
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 2b5596bd..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -81,7 +81,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 
 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
 	baseprop = primaryprop
-		`addInfoProperty` (toInfo (addNamedConf conf))
+		`setInfoProperty` (toInfo (addNamedConf conf))
 	primaryprop :: Property DebianLike
 	primaryprop = property ("dns primary for " ++ domain) $ do
 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ddefef15..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,6 +48,7 @@ module Propellor.Property.Docker (
 import Propellor.Base hiding (init)
 import Propellor.Types.Docker
 import Propellor.Types.Container
+import Propellor.Types.Core
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
 import Propellor.Container
@@ -183,7 +184,7 @@ imagePulled ctr = pulled `describe` msg
 
 propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
 propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
-	p `addInfoProperty'` dockerinfo
+	p `addInfoProperty` dockerinfo
   where
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6c775b94..704c1db9 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -51,7 +51,7 @@ update =
 		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg update has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
 	deriving (Typeable, Monoid, Show)
@@ -68,7 +68,7 @@ upgrade =
 		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg upgrade has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 			`requires` update
 
 type Package = String
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index a8b8347a..0eec04c7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -13,6 +13,8 @@ module Propellor.Property.List (
 ) where
 
 import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 import Propellor.PropAccum
 import Propellor.Engine
 import Propellor.Exception
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 291d4168..2bf5b927 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -3,6 +3,7 @@
 module Propellor.Property.Partition where
 
 import Propellor.Base
+import Propellor.Types.Core
 import qualified Propellor.Property.Apt as Apt
 import Utility.Applicative
 
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 95e4e362..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -10,6 +10,7 @@ module Propellor.Property.Scheduled
 	) where
 
 import Propellor.Base
+import Propellor.Types.Core
 import Utility.Scheduled
 
 import Data.Time.Clock
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index d5959cbb..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -8,15 +7,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
-module Propellor.Types
-	( Host(..)
+module Propellor.Types (
+	-- * Core data types
+	  Host(..)
 	, Property(..)
 	, property
-	, Info
 	, Desc
-	, MetaType(..)
-	, MetaTypes
-	, TargetOS(..)
+	, RevertableProperty(..)
+	, ()
+	, Propellor(..)
+	, LiftPropellor(..)
+	, Info
+	-- * Types of properties
 	, UnixLike
 	, Linux
 	, DebianLike
@@ -25,34 +27,22 @@ module Propellor.Types
 	, FreeBSD
 	, HasInfo
 	, type (+)
-	, addInfoProperty
-	, addInfoProperty'
-	, adjustPropertySatisfy
-	, RevertableProperty(..)
-	, ()
-	, ChildProperty
-	, IsProp(..)
+	, TightenTargets(..)
+	-- * Combining and modifying properties
 	, Combines(..)
 	, CombinedType
 	, ResultCombiner
-	, Propellor(..)
-	, LiftPropellor(..)
-	, EndAction(..)
+	, adjustPropertySatisfy
+	-- * Other included types
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
-	, TightenTargets(..)
-	, SingI
 	) where
 
 import Data.Monoid
-import "mtl" Control.Monad.RWS.Strict
-import Control.Monad.Catch
-import Data.Typeable
-import Control.Applicative
-import Prelude
 
+import Propellor.Types.Core
 import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
@@ -60,89 +50,38 @@ import Propellor.Types.Result
 import Propellor.Types.MetaTypes
 import Propellor.Types.ZFS
 
--- | Everything Propellor knows about a system: Its hostname,
--- properties and their collected info.
-data Host = Host
-	{ hostName :: HostName
-	, hostProperties :: [ChildProperty]
-	, hostInfo :: Info
-	}
-	deriving (Show, Typeable)
-
--- | Propellor's monad provides read-only access to info about the host
--- it's running on, and a writer to accumulate EndActions.
-newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
-	deriving
-		( Monad
-		, Functor
-		, Applicative
-		, MonadReader Host
-		, MonadWriter [EndAction]
-		, MonadIO
-		, MonadCatch
-		, MonadThrow
-		, MonadMask
-		)
-
-class LiftPropellor m where
-	liftPropellor :: m a -> Propellor a
-
-instance LiftPropellor Propellor where
-	liftPropellor = id
-
-instance LiftPropellor IO where
-	liftPropellor = liftIO
-
-instance Monoid (Propellor Result) where
-	mempty = return NoChange
-	-- | The second action is only run if the first action does not fail.
-	mappend x y = do
-		rx <- x
-		case rx of
-			FailedChange -> return FailedChange
-			_ -> do
-				ry <- y
-				return (rx <> ry)
-
--- | An action that Propellor runs at the end, after trying to satisfy all
--- properties. It's passed the combined Result of the entire Propellor run.
-data EndAction = EndAction Desc (Result -> Propellor Result)
-
-type Desc = String
-
 -- | The core data type of Propellor, this represents a property
--- that the system should have, with a descrition, an action to ensure
--- it has the property, and perhaps some Info that can be added to Hosts
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
 -- that have the property.
 --
--- A property has a list of `[MetaType]`, which is part of its type.
+-- There are different types of properties that target different OS's,
+-- and so have different metatypes. 
+-- For example: "Property DebianLike" and "Property FreeBSD".
 --
--- There are many instances and type families, which are mostly used
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
+--
+-- There are many associated type families, which are mostly used
 -- internally, so you needn't worry about them.
 data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
 instance Show (Property metatypes) where
 	show p = "property " ++ show (getDesc p)
 
--- | Since there are many different types of Properties, they cannot be put
--- into a list. The simplified ChildProperty can be put into a list.
-data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
-
-instance Show ChildProperty where
-	show = getDesc
-
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
 --
--- You can specify any metatypes that make sense to indicate what OS
--- the property targets, etc.
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
 --
 -- For example:
 --
 -- > foo :: Property Debian
--- > foo = mkProperty "foo" (...)
---
--- Note that using this needs LANGUAGE PolyKinds.
+-- > foo = property "foo" $ do
+-- >	...
+-- > 	return MadeChange
 property
 	:: SingI metatypes
 	=> Desc
@@ -150,26 +89,6 @@ property
 	-> Property (MetaTypes metatypes)
 property d a = Property sing d a mempty mempty
 
--- | Adds info to a Property.
---
--- The new Property will include HasInfo in its metatypes.
-addInfoProperty
-	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
-	=> Property metatypes
-	-> Info
-	-> Property (MetaTypes metatypes')
-addInfoProperty (Property _ d a oldi c) newi =
-	Property sing d a (oldi <> newi) c
-
--- | Adds more info to a Property that already HasInfo.
-addInfoProperty'
-	:: (IncludesInfo metatypes ~ 'True)
-	=> Property metatypes
-	-> Info
-	-> Property metatypes
-addInfoProperty' (Property t d a oldi c) newi =
-	Property t d a (oldi <> newi) c
-
 -- | Changes the action that is performed to satisfy a property.
 adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
 adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
@@ -191,24 +110,6 @@ instance Show (RevertableProperty setupmetatypes undometatypes) where
 	-> RevertableProperty setupmetatypes undometatypes
 setup  undo = RevertableProperty setup undo
 
-class IsProp p where
-	setDesc :: p -> Desc -> p
-	getDesc :: p -> Desc
-	getChildren :: p -> [ChildProperty]
-	addChildren :: p -> [ChildProperty] -> p
-	-- | Gets the info of the property, combined with all info
-	-- of all children properties.
-	getInfoRecursive :: p -> Info
-	-- | Info, not including info from children.
-	getInfo :: p -> Info
-	-- | Gets a ChildProperty representing the Property.
-	-- You should not normally need to use this.
-	toChildProperty :: p -> ChildProperty
-	-- | Gets the action that can be run to satisfy a Property.
-	-- You should never run this action directly. Use
-	-- 'Propellor.EnsureProperty.ensureProperty` instead.
-	getSatisfy :: p -> Propellor Result
-
 instance IsProp (Property metatypes) where
 	setDesc (Property t _ a i c) d = Property t d a i c
 	getDesc (Property _ d _ _ _) = d
@@ -220,17 +121,6 @@ instance IsProp (Property metatypes) where
 	toChildProperty (Property _ d a i c) = ChildProperty d a i c
 	getSatisfy (Property _ _ a _ _) = a
 
-instance IsProp ChildProperty where
-	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
-	getDesc (ChildProperty d _ _ _) = d
-	getChildren (ChildProperty _ _ _ c) = c
-	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
-	getInfoRecursive (ChildProperty _ _ i c) =
-		i <> mconcat (map getInfoRecursive c)
-	getInfo (ChildProperty _ _ i _) = i
-	toChildProperty = id
-	getSatisfy (ChildProperty _ a _ _) = a
-
 instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	-- | Sets the description of both sides.
 	setDesc (RevertableProperty p1 p2) d =
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..fa939d2b
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+	{ hostName :: HostName
+	, hostProperties :: [ChildProperty]
+	, hostInfo :: Info
+	}
+	deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Host
+		, MonadWriter [EndAction]
+		, MonadIO
+		, MonadCatch
+		, MonadThrow
+		, MonadMask
+		)
+
+class LiftPropellor m where
+	liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+	liftPropellor = id
+
+instance LiftPropellor IO where
+	liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+	mempty = return NoChange
+	-- | The second action is only run if the first action does not fail.
+	mappend x y = do
+		rx <- x
+		case rx of
+			FailedChange -> return FailedChange
+			_ -> do
+				ry <- y
+				return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined 
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+  
+instance Show ChildProperty where
+	show = getDesc
+
+class IsProp p where
+	setDesc :: p -> Desc -> p
+	getDesc :: p -> Desc
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
+	-- | Gets the info of the property, combined with all info
+	-- of all children properties.
+	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
+	-- | Gets a ChildProperty representing the Property.
+	-- You should not normally need to use this.
+	toChildProperty :: p -> ChildProperty
+	-- | Gets the action that can be run to satisfy a Property.
+	-- You should never run this action directly. Use
+	-- 'Propellor.EnsureProperty.ensureProperty` instead.
+	getSatisfy :: p -> Propellor Result
+
+instance IsProp ChildProperty where
+	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+	getDesc (ChildProperty d _ _ _) = d
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+	getInfoRecursive (ChildProperty _ _ i c) =
+		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
+	toChildProperty = id
+	getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index c7f6b82f..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -19,6 +19,9 @@ import Data.Monoid
 import Prelude
 
 -- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
 newtype Info = Info [InfoEntry]
 	deriving (Monoid, Show)
 
@@ -47,6 +50,8 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where
 addInfo :: IsInfo v => Info -> v -> Info
 addInfo (Info l) v = Info (InfoEntry v:l)
 
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
 toInfo :: IsInfo v => v -> Info
 toInfo = addInfo mempty
 
-- 
cgit v1.2.3


From af7b2d61c0c7f9b4fe53d8f5d18b5426a93cbd7b Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sun, 27 Mar 2016 22:10:48 -0400
Subject: add dep on concurrent-output, and re-enable -O0

Using the external concurrent-output library lets it be built with -O2 as
is needed to get good runtime memory use.

Enabling -O0 because ghc is using rather a lot more time and memory due to
the new more complex types.

old master branch:

Linking dist/build/propellor-config/propellor-config ...
24.59user 0.97system 0:25.93elapsed 98%CPU (0avgtext+0avgdata 354612maxresident)k
1544inputs+46064outputs (0major+371244minor)pagefaults 0swaps

this branch before -O0:

Linking dist/build/propellor-config/propellor-config ...
25.56user 0.73system 0:26.61elapsed 98%CPU (0avgtext+0avgdata 345348maxresident)k
0inputs+43480outputs (0major+364163minor)pagefaults 0swaps

this branch with -O0:

Linking dist/build/propellor-config/propellor-config ...
11.91user 0.75system 0:12.97elapsed 97%CPU (0avgtext+0avgdata 237472maxresident)k
16inputs+37264outputs (0major+336166minor)pagefaults 0swaps

Above benchmarks are building all source files needed by config-simple.hs.
The story is rather worse for joeyconfig.hs; building it now needs over 500 mb
even with -O0 :-/
---
 debian/changelog                          |   3 +
 debian/control                            |   2 +
 doc/todo/depend_on_concurrent-output.mdwn |   3 +
 propellor.cabal                           |  34 +-
 src/Propellor/Bootstrap.hs                |   1 +
 src/System/Console/Concurrent.hs          |  44 ---
 src/System/Console/Concurrent/Internal.hs | 556 ------------------------------
 src/System/Process/Concurrent.hs          |  34 --
 8 files changed, 27 insertions(+), 650 deletions(-)
 delete mode 100644 src/System/Console/Concurrent.hs
 delete mode 100644 src/System/Console/Concurrent/Internal.hs
 delete mode 100644 src/System/Process/Concurrent.hs

diff --git a/debian/changelog b/debian/changelog
index af2f5c2b..036b8f34 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -57,6 +57,9 @@ propellor (3.0.0) UNRELEASED; urgency=medium
   * The new `pickOS` property combinator can be used to combine different
     properties, supporting different OS's, into one Property that chooses
     what to do based on the Host's OS.
+  * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
+    these complex new types.
+  * Added dependency on concurrent-output; removed embedded copy.
 
  -- Joey Hess   Thu, 24 Mar 2016 15:02:33 -0400
 
diff --git a/debian/control b/debian/control
index 757462d1..898e558d 100644
--- a/debian/control
+++ b/debian/control
@@ -18,6 +18,7 @@ Build-Depends:
 	libghc-exceptions-dev (>= 0.6),
 	libghc-stm-dev,
 	libghc-text-dev,
+	libghc-concurrent-output-dev,
 Maintainer: Joey Hess 
 Standards-Version: 3.9.6
 Vcs-Git: git://git.joeyh.name/propellor
@@ -41,6 +42,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
 	libghc-exceptions-dev (>= 0.6),
 	libghc-stm-dev,
 	libghc-text-dev,
+	libghc-concurrent-output-dev,
 	git,
 	make,
 Description: property-based host configuration management in haskell
diff --git a/doc/todo/depend_on_concurrent-output.mdwn b/doc/todo/depend_on_concurrent-output.mdwn
index fdc66b04..a104c82b 100644
--- a/doc/todo/depend_on_concurrent-output.mdwn
+++ b/doc/todo/depend_on_concurrent-output.mdwn
@@ -8,3 +8,6 @@ Once this is done, can switch GHC-Options back to -O0 from -O.
 -O0 is better because ghc takes less memory to build propellor.
 
 [[!tag user/joey]]
+
+> [[done]]. Didn't wait for it to hit stable; cabal will be used to install
+> it.
diff --git a/propellor.cabal b/propellor.cabal
index e946f697..06142155 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -36,34 +36,39 @@ Description:
 
 Executable propellor
   Main-Is: wrapper.hs
-  GHC-Options: -threaded -Wall -fno-warn-tabs
+  GHC-Options: -threaded -Wall -fno-warn-tabs -O0
   Extensions: TypeOperators
   Hs-Source-Dirs: src
-  Build-Depends: 
+  Build-Depends:
     -- propellor needs to support the ghc shipped in Debian stable
     base >= 4.5, base < 5,
     MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
-    time, mtl, transformers, exceptions (>= 0.6), stm, text
+    time, mtl, transformers, exceptions (>= 0.6), stm, text,
+    concurrent-output
 
 Executable propellor-config
   Main-Is: config.hs
-  GHC-Options: -threaded -Wall -fno-warn-tabs
+  GHC-Options: -threaded -Wall -fno-warn-tabs -O0
   Extensions: TypeOperators
   Hs-Source-Dirs: src
-  Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
-   IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers (>= 0.5), network, async, time, mtl, transformers,
-   exceptions (>= 0.6), stm, text, unix
+  Build-Depends: 
+    base >= 4.5, base < 5,
+    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+    unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+    time, mtl, transformers, exceptions (>= 0.6), stm, text,
+    concurrent-output
 
 Library
-  GHC-Options: -Wall -fno-warn-tabs
+  GHC-Options: -Wall -fno-warn-tabs -O0
   Extensions: TypeOperators
   Hs-Source-Dirs: src
-  Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
-   IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers (>= 0.5), network, async, time, mtl, transformers,
-   exceptions (>= 0.6), stm, text, unix
+  Build-Depends: 
+    base >= 4.5, base < 5,
+    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+    unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+    time, mtl, transformers, exceptions (>= 0.6), stm, text,
+    concurrent-output
 
   Exposed-Modules:
     Propellor
@@ -201,9 +206,6 @@ Library
     Utility.ThreadScheduler
     Utility.Tmp
     Utility.UserInfo
-    System.Console.Concurrent
-    System.Console.Concurrent.Internal
-    System.Process.Concurrent
 
 source-repository head
   type: git
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 69eee66c..3b4c3106 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -90,6 +90,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "libghc-exceptions-dev"
 		, "libghc-stm-dev"
 		, "libghc-text-dev"
+		, "libghc-concurrent-output-dev"
 		, "make"
 		]
 	fbsddeps =
diff --git a/src/System/Console/Concurrent.hs b/src/System/Console/Concurrent.hs
deleted file mode 100644
index 12447637..00000000
--- a/src/System/Console/Concurrent.hs
+++ /dev/null
@@ -1,44 +0,0 @@
--- | 
--- Copyright: 2015 Joey Hess 
--- License: BSD-2-clause
--- 
--- Concurrent output handling.
---
--- > import Control.Concurrent.Async
--- > import System.Console.Concurrent
--- >
--- > main = withConcurrentOutput $
--- > 	outputConcurrent "washed the car\n"
--- > 		`concurrently`
--- >	outputConcurrent "walked the dog\n"
--- >		`concurrently`
--- > 	createProcessConcurrent (proc "ls" [])
-
-{-# LANGUAGE CPP #-}
-
-module System.Console.Concurrent (
-	-- * Concurrent output
-	withConcurrentOutput,
-	Outputable(..),
-	outputConcurrent,
-	errorConcurrent,
-	ConcurrentProcessHandle,
-#ifndef mingw32_HOST_OS
-	createProcessConcurrent,
-#endif
-	waitForProcessConcurrent,
-	createProcessForeground,
-	flushConcurrentOutput,
-	lockOutput,
-	-- * Low level access to the output buffer
-	OutputBuffer,
-	StdHandle(..),
-	bufferOutputSTM,
-	outputBufferWaiterSTM,
-	waitAnyBuffer,
-	waitCompleteLines,
-	emitOutputBuffer,
-) where
-
-import System.Console.Concurrent.Internal
-
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
deleted file mode 100644
index 5b9cf454..00000000
--- a/src/System/Console/Concurrent/Internal.hs
+++ /dev/null
@@ -1,556 +0,0 @@
-{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances, TupleSections #-}
-{-# LANGUAGE CPP #-}
-
--- | 
--- Copyright: 2015 Joey Hess 
--- License: BSD-2-clause
--- 
--- Concurrent output handling, internals.
---
--- May change at any time.
-
-module System.Console.Concurrent.Internal where
-
-import System.IO
-#ifndef mingw32_HOST_OS
-import System.Posix.IO
-#endif
-import System.Directory
-import System.Exit
-import Control.Monad
-import Control.Monad.IO.Class (liftIO, MonadIO)
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Concurrent.Async
-import Data.Maybe
-import Data.List
-import Data.Monoid
-import qualified System.Process as P
-import qualified Data.Text as T
-import qualified Data.Text.IO as T
-import Control.Applicative
-import Prelude
-import System.Log.Logger
-
-import Utility.Monad
-import Utility.Exception
-
-data OutputHandle = OutputHandle
-	{ outputLock :: TMVar Lock
-	, outputBuffer :: TMVar OutputBuffer
-	, errorBuffer :: TMVar OutputBuffer
-	, outputThreads :: TMVar Integer
-	, processWaiters :: TMVar [Async ()]
-	, waitForProcessLock :: TMVar ()
-	}
-
-data Lock = Locked
-
--- | A shared global variable for the OutputHandle.
-{-# NOINLINE globalOutputHandle #-}
-globalOutputHandle :: OutputHandle
-globalOutputHandle = unsafePerformIO $ OutputHandle
-	<$> newEmptyTMVarIO
-	<*> newTMVarIO (OutputBuffer [])
-	<*> newTMVarIO (OutputBuffer [])
-	<*> newTMVarIO 0
-	<*> newTMVarIO []
-	<*> newEmptyTMVarIO
-
--- | Holds a lock while performing an action. This allows the action to
--- perform its own output to the console, without using functions from this
--- module.
---
--- While this is running, other threads that try to lockOutput will block.
--- Any calls to `outputConcurrent` and `createProcessConcurrent` will not
--- block, but the output will be buffered and displayed only once the
--- action is done.
-lockOutput :: (MonadIO m, MonadMask m) => m a -> m a
-lockOutput = bracket_ (liftIO takeOutputLock) (liftIO dropOutputLock)
-
--- | Blocks until we have the output lock.
-takeOutputLock :: IO ()
-takeOutputLock = void $ takeOutputLock' True
-
--- | Tries to take the output lock, without blocking.
-tryTakeOutputLock :: IO Bool
-tryTakeOutputLock = takeOutputLock' False
-
-withLock :: (TMVar Lock -> STM a) -> IO a
-withLock a = atomically $ a (outputLock globalOutputHandle)
-
-takeOutputLock' :: Bool -> IO Bool
-takeOutputLock' block = do
-	locked <- withLock $ \l -> do
-		v <- tryTakeTMVar l
-		case v of
-			Just Locked
-				| block -> retry
-				| otherwise -> do
-					-- Restore value we took.
-					putTMVar l Locked
-					return False
-			Nothing -> do
-				putTMVar l Locked
-				return True
-	when locked $ do
-		(outbuf, errbuf) <- atomically $ (,)
-			<$> swapTMVar (outputBuffer globalOutputHandle) (OutputBuffer [])
-			<*> swapTMVar (errorBuffer globalOutputHandle) (OutputBuffer [])
-		emitOutputBuffer StdOut outbuf
-		emitOutputBuffer StdErr errbuf
-	return locked
-
--- | Only safe to call after taking the output lock.
-dropOutputLock :: IO ()
-dropOutputLock = withLock $ void . takeTMVar
-
--- | Use this around any actions that use `outputConcurrent`
--- or `createProcessConcurrent`
---
--- This is necessary to ensure that buffered concurrent output actually
--- gets displayed before the program exits.
-withConcurrentOutput :: (MonadIO m, MonadMask m) => m a -> m a
-withConcurrentOutput a = a `finally` liftIO flushConcurrentOutput
-
--- | Blocks until any processes started by `createProcessConcurrent` have
--- finished, and any buffered output is displayed. Also blocks while
--- `lockOutput` is is use.
---
--- `withConcurrentOutput` calls this at the end, so you do not normally
--- need to use this.
-flushConcurrentOutput :: IO ()
-flushConcurrentOutput = do
-	atomically $ do
-		r <- takeTMVar (outputThreads globalOutputHandle)
-		if r <= 0
-			then putTMVar (outputThreads globalOutputHandle) r
-			else retry
-	-- Take output lock to wait for anything else that might be
-	-- currently generating output.
-	lockOutput $ return ()
-
--- | Values that can be output.
-class Outputable v where
-	toOutput :: v -> T.Text
-
-instance Outputable T.Text where
-	toOutput = id
-
-instance Outputable String where
-	toOutput = toOutput . T.pack
-
--- | Displays a value to stdout.
---
--- No newline is appended to the value, so if you want a newline, be sure
--- to include it yourself.
---
--- Uses locking to ensure that the whole output occurs atomically
--- even when other threads are concurrently generating output.
---
--- When something else is writing to the console at the same time, this does
--- not block. It buffers the value, so it will be displayed once the other
--- writer is done.
-outputConcurrent :: Outputable v => v -> IO ()
-outputConcurrent = outputConcurrent' StdOut
-
--- | Like `outputConcurrent`, but displays to stderr.
---
--- (Does not throw an exception.)
-errorConcurrent :: Outputable v => v -> IO ()
-errorConcurrent = outputConcurrent' StdErr
-
-outputConcurrent' :: Outputable v => StdHandle -> v -> IO ()
-outputConcurrent' stdh v = bracket setup cleanup go
-  where
-	setup = tryTakeOutputLock
-	cleanup False = return ()
-	cleanup True = dropOutputLock
-	go True = do
-		T.hPutStr h (toOutput v)
-		hFlush h
-	go False = do
-		oldbuf <- atomically $ takeTMVar bv
-		newbuf <- addOutputBuffer (Output (toOutput v)) oldbuf
-		atomically $ putTMVar bv newbuf
-	h = toHandle stdh
-	bv = bufferFor stdh
-
-newtype ConcurrentProcessHandle = ConcurrentProcessHandle P.ProcessHandle
-
-toConcurrentProcessHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle) -> (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-toConcurrentProcessHandle (i, o, e, h) = (i, o, e, ConcurrentProcessHandle h)
-
--- | Use this to wait for processes started with 
--- `createProcessConcurrent` and `createProcessForeground`, and get their
--- exit status.
---
--- Note that such processes are actually automatically waited for
--- internally, so not calling this explicitly will not result
--- in zombie processes. This behavior differs from `P.waitForProcess`
-waitForProcessConcurrent :: ConcurrentProcessHandle -> IO ExitCode
-waitForProcessConcurrent (ConcurrentProcessHandle h) = 
-	bracket lock unlock checkexit
-  where
-	lck = waitForProcessLock globalOutputHandle
-	lock = atomically $ tryPutTMVar lck ()
-	unlock True = atomically $ takeTMVar lck
-	unlock False = return ()
-	checkexit locked = maybe (waitsome locked) return
-		=<< P.getProcessExitCode h
-	waitsome True = do
-		let v = processWaiters globalOutputHandle
-		l <- atomically $ readTMVar v
-		if null l
-			-- Avoid waitAny [] which blocks forever
-			then P.waitForProcess h
-			else do
-				-- Wait for any of the running
-				-- processes to exit. It may or may not
-				-- be the one corresponding to the
-				-- ProcessHandle. If it is,
-				-- getProcessExitCode will succeed.
-				void $ tryIO $ waitAny l
-				checkexit True
-	waitsome False = do
-		-- Another thread took the lck first. Wait for that thread to
-		-- wait for one of the running processes to exit.
-		atomically $ do
-			putTMVar lck ()
-			takeTMVar lck
-		checkexit False
-
--- Registers an action that waits for a process to exit,
--- adding it to the processWaiters list, and removing it once the action
--- completes.
-asyncProcessWaiter :: IO () -> IO ()
-asyncProcessWaiter waitaction = do
-	regdone <- newEmptyTMVarIO
-	waiter <- async $ do
-		self <- atomically (takeTMVar regdone)
-		waitaction `finally` unregister self
-	register waiter regdone
-  where
-	v = processWaiters globalOutputHandle
-  	register waiter regdone = atomically $ do
-		l <- takeTMVar v
-		putTMVar v (waiter:l)
-		putTMVar regdone waiter
-	unregister waiter = atomically $ do
-		l <- takeTMVar v
-		putTMVar v (filter (/= waiter) l)
-
--- | Wrapper around `System.Process.createProcess` that prevents 
--- multiple processes that are running concurrently from writing
--- to stdout/stderr at the same time.
---
--- If the process does not output to stdout or stderr, it's run
--- by createProcess entirely as usual. Only processes that can generate
--- output are handled specially:
---
--- A process is allowed to write to stdout and stderr in the usual
--- way, assuming it can successfully take the output lock.
---
--- When the output lock is held (ie, by another concurrent process,
--- or because `outputConcurrent` is being called at the same time),
--- the process is instead run with its stdout and stderr
--- redirected to a buffer. The buffered output will be displayed as soon
--- as the output lock becomes free.
---
--- Currently only available on Unix systems, not Windows.
-#ifndef mingw32_HOST_OS
-createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle) 
-createProcessConcurrent p
-	| willOutput (P.std_out p) || willOutput (P.std_err p) =
-		ifM tryTakeOutputLock
-			( fgProcess p
-			, bgProcess p
-			)
-	| otherwise = do
-		r@(_, _, _, h) <- P.createProcess p
-		asyncProcessWaiter $
-			void $ tryIO $ P.waitForProcess h
-		return (toConcurrentProcessHandle r)
-#endif
-
--- | Wrapper around `System.Process.createProcess` that makes sure a process
--- is run in the foreground, with direct access to stdout and stderr.
--- Useful when eg, running an interactive process.
-createProcessForeground :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-createProcessForeground p = do
-	takeOutputLock
-	fgProcess p
-
-fgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-fgProcess p = do
-	r@(_, _, _, h) <- P.createProcess p
-		`onException` dropOutputLock
-	registerOutputThread
-	debug ["fgProcess", showProc p]
-	-- Wait for the process to exit and drop the lock.
-	asyncProcessWaiter $ do
-		void $ tryIO $ P.waitForProcess h
-		unregisterOutputThread
-		dropOutputLock
-		debug ["fgProcess done", showProc p]
-	return (toConcurrentProcessHandle r)
-	
-debug :: [String] -> IO ()
-debug = debugM "concurrent-output" . unwords
-
-showProc :: P.CreateProcess -> String
-showProc = go . P.cmdspec
-  where
-	go (P.ShellCommand s) = s
-	go (P.RawCommand c ps) = show (c, ps)
-
-#ifndef mingw32_HOST_OS
-bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-bgProcess p = do
-	(toouth, fromouth) <- pipe
-	(toerrh, fromerrh) <- pipe
-	debug ["bgProcess", showProc p]
-	let p' = p
-		{ P.std_out = rediroutput (P.std_out p) toouth
-		, P.std_err = rediroutput (P.std_err p) toerrh
-		}
-	registerOutputThread
-	r@(_, _, _, h) <- P.createProcess p'
-		`onException` unregisterOutputThread
-	asyncProcessWaiter $ void $ tryIO $ P.waitForProcess h
-	outbuf <- setupOutputBuffer StdOut toouth (P.std_out p) fromouth
-	errbuf <- setupOutputBuffer StdErr toerrh (P.std_err p) fromerrh
-	void $ async $ bufferWriter [outbuf, errbuf]
-	return (toConcurrentProcessHandle r)
-  where
-	pipe = do
-		(from, to) <- createPipe
-		(,) <$> fdToHandle to <*> fdToHandle from
-	rediroutput ss h
-		| willOutput ss = P.UseHandle h
-		| otherwise = ss
-#endif
-
-willOutput :: P.StdStream -> Bool
-willOutput P.Inherit = True
-willOutput _ = False
-
--- | Buffered output.
-data OutputBuffer = OutputBuffer [OutputBufferedActivity]
-	deriving (Eq)
-
-data StdHandle = StdOut | StdErr
-
-toHandle :: StdHandle -> Handle
-toHandle StdOut = stdout
-toHandle StdErr = stderr
-
-bufferFor :: StdHandle -> TMVar OutputBuffer
-bufferFor StdOut = outputBuffer globalOutputHandle
-bufferFor StdErr = errorBuffer globalOutputHandle
-
-data OutputBufferedActivity
-	= Output T.Text
-	| InTempFile
-		{ tempFile :: FilePath
-		, endsInNewLine :: Bool
-		}
-	deriving (Eq)
-
-data AtEnd = AtEnd
-	deriving Eq
-
-data BufSig = BufSig
-
-setupOutputBuffer :: StdHandle -> Handle -> P.StdStream -> Handle -> IO (StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)
-setupOutputBuffer h toh ss fromh = do
-	hClose toh
-	buf <- newMVar (OutputBuffer [])
-	bufsig <- atomically newEmptyTMVar
-	bufend <- atomically newEmptyTMVar
-	void $ async $ outputDrainer ss fromh buf bufsig bufend
-	return (h, buf, bufsig, bufend)
-
--- Drain output from the handle, and buffer it.
-outputDrainer :: P.StdStream -> Handle -> MVar OutputBuffer -> TMVar BufSig -> TMVar AtEnd -> IO ()
-outputDrainer ss fromh buf bufsig bufend
-	| willOutput ss = go
-	| otherwise = atend
-  where
-	go = do
-		t <- T.hGetChunk fromh
-		if T.null t
-			then atend
-			else do
-				modifyMVar_ buf $ addOutputBuffer (Output t)
-				changed
-				go
-	atend = do
-		atomically $ putTMVar bufend AtEnd
-		hClose fromh
-	changed = atomically $ do
-		void $ tryTakeTMVar bufsig
-		putTMVar bufsig BufSig
-
-registerOutputThread :: IO ()
-registerOutputThread = do
-	let v = outputThreads globalOutputHandle
-	atomically $ putTMVar v . succ =<< takeTMVar v
-	
-unregisterOutputThread :: IO ()
-unregisterOutputThread = do
-	let v = outputThreads globalOutputHandle
-	atomically $ putTMVar v . pred =<< takeTMVar v
-
--- Wait to lock output, and once we can, display everything 
--- that's put into the buffers, until the end.
---
--- If end is reached before lock is taken, instead add the command's
--- buffers to the global outputBuffer and errorBuffer.
-bufferWriter :: [(StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)] -> IO ()
-bufferWriter ts = do
-	activitysig <- atomically newEmptyTMVar
-	worker1 <- async $ lockOutput $
-		ifM (atomically $ tryPutTMVar activitysig ())
-			( void $ mapConcurrently displaybuf ts
-			, noop -- buffers already moved to global
-			)
-	worker2 <- async $ void $ globalbuf activitysig worker1
-	void $ async $ do
-		void $ waitCatch worker1
-		void $ waitCatch worker2
-		unregisterOutputThread
-  where
-	displaybuf v@(outh, buf, bufsig, bufend) = do
-		change <- atomically $
-			(Right <$> takeTMVar bufsig)
-				`orElse`
-			(Left <$> takeTMVar bufend)
-		l <- takeMVar buf
-		putMVar buf (OutputBuffer [])
-		emitOutputBuffer outh l
-		case change of
-			Right BufSig -> displaybuf v
-			Left AtEnd -> return ()
-	globalbuf activitysig worker1 = do
-		ok <- atomically $ do
-			-- signal we're going to handle it
-			-- (returns false if the displaybuf already did)
-			ok <- tryPutTMVar activitysig ()
-			-- wait for end of all buffers
-			when ok $
-				mapM_ (\(_outh, _buf, _bufsig, bufend) -> takeTMVar bufend) ts
-			return ok
-		when ok $ do
-			-- add all of the command's buffered output to the
-			-- global output buffer, atomically
-			bs <- forM ts $ \(outh, buf, _bufsig, _bufend) ->
-				(outh,) <$> takeMVar buf
-			atomically $
-				forM_ bs $ \(outh, b) -> 
-					bufferOutputSTM' outh b
-			-- worker1 might be blocked waiting for the output
-			-- lock, and we've already done its job, so cancel it
-			cancel worker1
-
--- Adds a value to the OutputBuffer. When adding Output to a Handle,
--- it's cheaper to combine it with any already buffered Output to that
--- same Handle.
---
--- When the total buffered Output exceeds 1 mb in size, it's moved out of
--- memory, to a temp file. This should only happen rarely, but is done to
--- avoid some verbose process unexpectedly causing excessive memory use.
-addOutputBuffer :: OutputBufferedActivity -> OutputBuffer -> IO OutputBuffer
-addOutputBuffer (Output t) (OutputBuffer buf)
-	| T.length t' <= 1048576 = return $ OutputBuffer (Output t' : other)
-	| otherwise = do
-		tmpdir <- getTemporaryDirectory
-		(tmp, h) <- openTempFile tmpdir "output.tmp"
-		let !endnl = endsNewLine t'
-		let i = InTempFile
-			{ tempFile = tmp
-			, endsInNewLine = endnl
-			}
-		T.hPutStr h t'
-		hClose h
-		return $ OutputBuffer (i : other)
-  where
-	!t' = T.concat (mapMaybe getOutput this) <> t
-	!(this, other) = partition isOutput buf
-	isOutput v = case v of
-		Output _ -> True
-		_ -> False
-	getOutput v = case v of
-		Output t'' -> Just t''
-		_ -> Nothing
-addOutputBuffer v (OutputBuffer buf) = return $ OutputBuffer (v:buf)
-
--- | Adds a value to the output buffer for later display.
---
--- Note that buffering large quantities of data this way will keep it
--- resident in memory until it can be displayed. While `outputConcurrent`
--- uses temp files if the buffer gets too big, this STM function cannot do
--- so.
-bufferOutputSTM :: Outputable v => StdHandle -> v -> STM ()
-bufferOutputSTM h v = bufferOutputSTM' h (OutputBuffer [Output (toOutput v)])
-
-bufferOutputSTM' :: StdHandle -> OutputBuffer -> STM ()
-bufferOutputSTM' h (OutputBuffer newbuf) = do
-	(OutputBuffer buf) <- takeTMVar bv
-	putTMVar bv (OutputBuffer (newbuf ++ buf))
-  where
-	bv = bufferFor h
-
--- | A STM action that waits for some buffered output to become
--- available, and returns it.
---
--- The function can select a subset of output when only some is desired;
--- the fst part is returned and the snd is left in the buffer.
---
--- This will prevent it from being displayed in the usual way, so you'll
--- need to use `emitOutputBuffer` to display it yourself.
-outputBufferWaiterSTM :: (OutputBuffer -> (OutputBuffer, OutputBuffer)) -> STM (StdHandle, OutputBuffer)
-outputBufferWaiterSTM selector = waitgetbuf StdOut `orElse` waitgetbuf StdErr
-  where
-	waitgetbuf h = do
-		let bv = bufferFor h
-		(selected, rest) <- selector <$> takeTMVar bv
-		when (selected == OutputBuffer [])
-			retry
-		putTMVar bv rest
-		return (h, selected)
-
-waitAnyBuffer :: OutputBuffer -> (OutputBuffer, OutputBuffer)
-waitAnyBuffer b = (b, OutputBuffer [])
-
--- | Use with `outputBufferWaiterSTM` to make it only return buffered
--- output that ends with a newline. Anything buffered without a newline
--- is left in the buffer.
-waitCompleteLines :: OutputBuffer -> (OutputBuffer, OutputBuffer)
-waitCompleteLines (OutputBuffer l) = 
-	let (selected, rest) = span completeline l
-	in (OutputBuffer selected, OutputBuffer rest)
-  where
-	completeline (v@(InTempFile {})) = endsInNewLine v
-	completeline (Output b) = endsNewLine b
-
-endsNewLine :: T.Text -> Bool
-endsNewLine t = not (T.null t) && T.last t == '\n'
-
--- | Emits the content of the OutputBuffer to the Handle
---
--- If you use this, you should use `lockOutput` to ensure you're the only
--- thread writing to the console.
-emitOutputBuffer :: StdHandle -> OutputBuffer -> IO ()
-emitOutputBuffer stdh (OutputBuffer l) = 
-	forM_ (reverse l) $ \ba -> case ba of
-		Output t -> emit t
-		InTempFile tmp _ -> do
-			emit =<< T.readFile tmp
-			void $ tryWhenExists $ removeFile tmp
-  where
-	outh = toHandle stdh
-	emit t = void $ tryIO $ do
-		T.hPutStr outh t
-		hFlush outh
diff --git a/src/System/Process/Concurrent.hs b/src/System/Process/Concurrent.hs
deleted file mode 100644
index 0e00e4fd..00000000
--- a/src/System/Process/Concurrent.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- | 
--- Copyright: 2015 Joey Hess 
--- License: BSD-2-clause
--- 
--- The functions exported by this module are intended to be drop-in
--- replacements for those from System.Process, when converting a whole
--- program to use System.Console.Concurrent.
-
-module System.Process.Concurrent where
-
-import System.Console.Concurrent
-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
-import System.Process hiding (createProcess, waitForProcess)
-import System.IO
-import System.Exit
-
--- | Calls `createProcessConcurrent`
---
--- You should use the waitForProcess in this module on the resulting
--- ProcessHandle. Using System.Process.waitForProcess instead can have
--- mildly unexpected results.
-createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-createProcess p = do
-	(i, o, e, ConcurrentProcessHandle h) <- createProcessConcurrent p
-	return (i, o, e, h)
-
--- | Calls `waitForProcessConcurrent`
---
--- You should only use this on a ProcessHandle obtained by calling
--- createProcess from this module. Using this with a ProcessHandle
--- obtained from System.Process.createProcess etc will have extremely
--- unexpected results; it can wait a very long time before returning.
-waitForProcess :: ProcessHandle -> IO ExitCode
-waitForProcess = waitForProcessConcurrent . ConcurrentProcessHandle
-- 
cgit v1.2.3


From 67f4a35f08caff9efd5ec930943a02217188cc79 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 02:28:08 -0400
Subject: implemented pickOS

Fell down the fromSing rabbit hole, followed by the OMH ghc doesh't work
rabbit hole. Suboptimal.
---
 src/Propellor/Property.hs         | 77 +++++++++++++++++++++++++++++++--------
 src/Propellor/Types/MetaTypes.hs  | 10 ++++-
 src/Propellor/Types/OS.hs         |  8 +++-
 src/Propellor/Types/Singletons.hs | 36 +++++++++++++++++-
 4 files changed, 111 insertions(+), 20 deletions(-)

diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 29a8ec0f..10730710 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,8 +1,11 @@
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE PolyKinds #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Propellor.Property (
 	-- * Property combinators
@@ -24,6 +27,7 @@ module Propellor.Property (
 	, property'
 	, OuterMetaTypesWitness
 	, ensureProperty
+	, pickOS
 	, withOS
 	, unsupportedOS
 	, makeChange
@@ -49,6 +53,7 @@ import Control.Monad.IfElse
 import "mtl" Control.Monad.RWS.Strict
 import System.Posix.Files
 import qualified Data.Hash.MD5 as MD5
+import Data.List
 import Control.Applicative
 import Prelude
 
@@ -56,6 +61,7 @@ import Propellor.Types
 import Propellor.Types.Core
 import Propellor.Types.ResultCheck
 import Propellor.Types.MetaTypes
+import Propellor.Types.Singletons
 import Propellor.Info
 import Propellor.EnsureProperty
 import Utility.Exception
@@ -244,28 +250,60 @@ isNewerThan x y = do
   where
 	mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
 
-{-
-
 -- | Picks one of the two input properties to use,
 -- depending on the targeted OS.
 --
 -- If both input properties support the targeted OS, then the
 -- first will be used.
+--
+-- The resulting property will use the description of the first property
+-- no matter which property is used in the end. So, it's often a good
+-- idea to change the description to something clearer.
+--
+-- For example:
+--
+-- > upgraded :: UnixLike
+-- > upgraded = (Apt.upgraded `pickOS` Pkg.upgraded)
+-- > 	`describe` "OS upgraded"
+--
+-- If neither input property supports the targeted OS, calls
+-- `unsupportedOS`. Using the example above on a Fedora system would
+-- fail that way.
+--
+-- (It would be better if this constrained its return type to the Union
+-- of the targets of the inputs, but that does not seems to currently
+-- be possible with ghc.)
+{- For some reason, ghc does not like this type signature, or indeed the
+ - version of this that it emits. But this does compile! Until a type
+ - signature can be written down, cannot add the Union constraint.
+ - http://stackoverflow.com/questions/36256557/what-is-the-type-of-matches-m-s-m-fromsing-s
 pickOS
 	::
-		( combined ~ Union a b
-		, SingI combined
+		( Union a b ~ c
+		, SingI c
+		, DemoteRep 'KProxy ~ [MetaType]
 		)
 	=> Property (MetaTypes a)
 	-> Property (MetaTypes b)
-	-> Property (MetaTypes combined)
-pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
-  where
-	-- TODO pick with of ioa or iob to use based on final OS of
-	-- system being run on.
-	io = undefined
-
+	-> Property (MetaTypes c)
 -}
+pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
+  where
+	-- This use of getSatisfy is safe, because both a and b
+	-- are added as children, so their info will propigate.
+	--c :: (SingI c, Union a b ~ c) => Property (MetaTypes a) -> Property (MetaTypes b) -> Property (MetaTypes c)
+	c = withOS (getDesc a) $ \_ o ->
+		if matching o a
+			then getSatisfy a
+			else if matching o b
+				then getSatisfy b
+				else unsupportedOS
+	matching Nothing _ = False
+	matching (Just o) p = 
+		Targeting (systemToTargetOS o)
+			`elem`
+		fromSing (proptype p)
+	proptype (Property t _ _ _ _) = t
 
 -- | Makes a property that is satisfied differently depending on specifics
 -- of the host's operating system.
@@ -291,13 +329,20 @@ withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
 	dummyoutermetatypes :: OuterMetaTypesWitness ('[])
 	dummyoutermetatypes = OuterMetaTypesWitness sing
 
+class UnsupportedOS a where
+	unsupportedOS :: a
+
 -- | Throws an error, for use in `withOS` when a property is lacking
 -- support for an OS.
-unsupportedOS :: Propellor a
-unsupportedOS = go =<< getOS
-  where
-	go Nothing = error "Unknown host OS is not supported by this property."
-	go (Just o) = error $ "This property is not implemented for " ++ show o
+instance UnsupportedOS (Propellor a) where
+	unsupportedOS = go =<< getOS
+	  where
+		go Nothing = error "Unknown host OS is not supported by this property."
+		go (Just o) = error $ "This property is not implemented for " ++ show o
+
+-- | A property that always fails with an unsupported OS error.
+instance UnsupportedOS (Property UnixLike) where
+	unsupportedOS = property "unsupportedOS" unsupportedOS
 
 -- | Undoes the effect of a RevertableProperty.
 revert :: RevertableProperty setup undo -> RevertableProperty undo setup
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index 39d6e725..e064d76f 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -23,6 +23,7 @@ module Propellor.Types.MetaTypes (
 	type (&&),
 	Not,
 	EqT,
+	Union,
 ) where
 
 import Propellor.Types.Singletons
@@ -31,6 +32,7 @@ import Propellor.Types.OS
 data MetaType
 	= Targeting TargetOS -- ^ A target OS of a Property
 	| WithInfo           -- ^ Indicates that a Property has associated Info
+	deriving (Show, Eq, Ord)
 
 -- | Any unix-like system
 type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ]
@@ -50,7 +52,7 @@ type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l
 
 type MetaTypes = Sing
 
--- This boilerplatw would not be needed if the singletons library were
+-- This boilerplate would not be needed if the singletons library were
 -- used. However, we're targeting too old a version of ghc to use it yet.
 data instance Sing (x :: MetaType) where
 	OSDebianS :: Sing ('Targeting 'OSDebian)
@@ -61,6 +63,12 @@ instance SingI ('Targeting 'OSDebian) where sing = OSDebianS
 instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS
 instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS
 instance SingI 'WithInfo where sing = WithInfoS
+instance SingKind ('KProxy :: KProxy MetaType) where
+	type DemoteRep ('KProxy :: KProxy MetaType) = MetaType
+	fromSing OSDebianS = Targeting OSDebian
+	fromSing OSBuntishS = Targeting OSBuntish
+	fromSing OSFreeBSDS = Targeting OSFreeBSD
+	fromSing WithInfoS = WithInfo
 
 -- | Convenience type operator to combine two `MetaTypes` lists.
 --
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 84c9d87b..d7df5490 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -17,6 +17,7 @@ module Propellor.Types.OS (
 	userGroup,
 	Port(..),
 	fromPort,
+	systemToTargetOS,
 ) where
 
 import Network.BSD (HostName)
@@ -39,7 +40,12 @@ data TargetOS
 	= OSDebian
 	| OSBuntish
 	| OSFreeBSD
-	deriving (Show, Eq)
+	deriving (Show, Eq, Ord)
+
+systemToTargetOS :: System -> TargetOS
+systemToTargetOS (System (Debian _) _) = OSDebian
+systemToTargetOS (System (Buntish _) _) = OSBuntish
+systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD
 
 -- | Debian has several rolling suites, and a number of stable releases,
 -- such as Stable "jessie".
diff --git a/src/Propellor/Types/Singletons.hs b/src/Propellor/Types/Singletons.hs
index be777ecb..f2089ee8 100644
--- a/src/Propellor/Types/Singletons.hs
+++ b/src/Propellor/Types/Singletons.hs
@@ -1,6 +1,17 @@
-{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs #-}
+{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs, UndecidableInstances #-}
 
-module Propellor.Types.Singletons where
+-- | Simple implementation of singletons, portable back to ghc 7.6.3
+
+module Propellor.Types.Singletons (
+	module Propellor.Types.Singletons,
+	KProxy(..)
+) where
+
+#if __GLASGOW_HASKELL__ > 707
+import Data.Proxy (KProxy(..))
+#else
+data KProxy (a :: *) = KProxy
+#endif
 
 -- | The data family of singleton types.
 data family Sing (x :: k)
@@ -15,3 +26,24 @@ data instance Sing (x :: [k]) where
 	Cons :: Sing x -> Sing xs -> Sing (x ': xs)
 instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing
 instance SingI '[] where sing = Nil
+
+data instance Sing (x :: Bool) where
+	TrueS :: Sing 'True
+	FalseS :: Sing 'False
+instance SingI 'True where sing = TrueS
+instance SingI 'False where sing = FalseS
+
+class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where
+	type DemoteRep kparam :: *
+	-- | From singleton to value.
+	fromSing :: Sing (a :: k) -> DemoteRep kparam
+
+instance SingKind ('KProxy :: KProxy a) => SingKind ('KProxy :: KProxy [a]) where
+	type DemoteRep ('KProxy :: KProxy [a]) = [DemoteRep ('KProxy :: KProxy a)]
+	fromSing Nil = []
+	fromSing (Cons x xs) = fromSing x : fromSing xs
+
+instance SingKind ('KProxy :: KProxy Bool) where
+	type DemoteRep ('KProxy :: KProxy Bool) = Bool
+	fromSing FalseS = False
+	fromSing TrueS = True
-- 
cgit v1.2.3


From d36fd00e1f42ed3adc1892baff6f12fe6ed946fb Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 03:15:06 -0400
Subject: update

---
 src/Propellor.hs          |  2 +-
 src/Propellor/Property.hs | 10 +++-------
 2 files changed, 4 insertions(+), 8 deletions(-)

diff --git a/src/Propellor.hs b/src/Propellor.hs
index e6a52948..a371ea44 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -39,7 +39,6 @@ module Propellor (
 	, (&)
 	, (!)
 	-- * Propertries
-	, describe
 	-- | Properties are often combined together in your propellor
 	-- configuration. For example:
 	--
@@ -48,6 +47,7 @@ module Propellor (
 	, requires
 	, before
 	, onChange
+	, describe
 	, module Propellor.Property
 	-- | Everything you need to build your own properties,
 	-- and useful property combinators
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 10730710..111756ff 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -269,13 +269,9 @@ isNewerThan x y = do
 -- If neither input property supports the targeted OS, calls
 -- `unsupportedOS`. Using the example above on a Fedora system would
 -- fail that way.
---
--- (It would be better if this constrained its return type to the Union
--- of the targets of the inputs, but that does not seems to currently
--- be possible with ghc.)
-{- For some reason, ghc does not like this type signature, or indeed the
- - version of this that it emits. But this does compile! Until a type
- - signature can be written down, cannot add the Union constraint.
+{- I have not yet managed to write down a type signature for this
+ - that ghc will accept. Until a type signature can be written down,
+ - cannot add the Union constraint.
  - http://stackoverflow.com/questions/36256557/what-is-the-type-of-matches-m-s-m-fromsing-s
 pickOS
 	::
-- 
cgit v1.2.3


From fe67b97f939239ad1712d4755c462965ba00c0e2 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 03:46:37 -0400
Subject: slayed the type dragon

---
 src/Propellor/Property.hs | 23 +++++++++++------------
 1 file changed, 11 insertions(+), 12 deletions(-)

diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 111756ff..7878912b 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,11 +1,9 @@
 {-# LANGUAGE PackageImports #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE PolyKinds #-}
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Propellor.Property (
 	-- * Property combinators
@@ -269,25 +267,26 @@ isNewerThan x y = do
 -- If neither input property supports the targeted OS, calls
 -- `unsupportedOS`. Using the example above on a Fedora system would
 -- fail that way.
-{- I have not yet managed to write down a type signature for this
- - that ghc will accept. Until a type signature can be written down,
- - cannot add the Union constraint.
- - http://stackoverflow.com/questions/36256557/what-is-the-type-of-matches-m-s-m-fromsing-s
 pickOS
 	::
-		( Union a b ~ c
+		( SingKind ('KProxy :: KProxy ka)
+		, SingKind ('KProxy :: KProxy kb)
+		, DemoteRep ('KProxy :: KProxy ka) ~ [MetaType]
+		, DemoteRep ('KProxy :: KProxy kb) ~ [MetaType]
 		, SingI c
-		, DemoteRep 'KProxy ~ [MetaType]
+		-- Would be nice to have this constraint, but
+		-- union will not generate metatypes lists with the same
+		-- order of OS's as is used everywhere else. So, 
+		-- would need a type-level sort.
+		--, Union a b ~ c
 		)
-	=> Property (MetaTypes a)
-	-> Property (MetaTypes b)
+	=> Property (MetaTypes (a :: ka))
+	-> Property (MetaTypes (b :: kb))
 	-> Property (MetaTypes c)
--}
 pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
   where
 	-- This use of getSatisfy is safe, because both a and b
 	-- are added as children, so their info will propigate.
-	--c :: (SingI c, Union a b ~ c) => Property (MetaTypes a) -> Property (MetaTypes b) -> Property (MetaTypes c)
 	c = withOS (getDesc a) $ \_ o ->
 		if matching o a
 			then getSatisfy a
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From d725caa03420d5f3b9ffe6124de39ab00979f7cb Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 03:52:30 -0400
Subject: backports are debian only

---
 debian/changelog              | 2 +-
 src/Propellor/Property/Apt.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 036b8f34..e4fbd15e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -56,7 +56,7 @@ propellor (3.0.0) UNRELEASED; urgency=medium
       propertyChildren to getChildren
   * The new `pickOS` property combinator can be used to combine different
     properties, supporting different OS's, into one Property that chooses
-    what to do based on the Host's OS.
+    which to use based on the Host's OS.
   * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
     these complex new types.
   * Added dependency on concurrent-output; removed embedded copy.
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index c8ad92e4..2199d950 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -157,7 +157,7 @@ installed' params ps = robustly $ check (isInstallable ps) go
   where
 	go = runApt (params ++ ["install"] ++ ps)
 
-installedBackport :: [Package] -> Property DebianLike
+installedBackport :: [Package] -> Property Debian
 installedBackport ps = withOS desc $ \w o -> case o of
 	(Just (System (Debian suite) _)) -> case backportSuite suite of
 		Nothing -> unsupportedOS
-- 
cgit v1.2.3


From 67a1bb6d9915a0c36b71d984cf0ef4c89dd59607 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 03:54:28 -0400
Subject: propellor spin

---
 src/Propellor/Property/Grub.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index b8dc5f9e..85d098ed 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -30,13 +30,11 @@ mkConfig = tightenTargets $ cmdProperty "update-grub" []
 
 -- | Installs grub; does not run update-grub.
 installed' :: BIOS -> Property Linux
-installed' bios = withOS "grub package installed" $ \w o -> 
-	let apt = ensureProperty w (Apt.installed [debpkg])
-	in case o of
-		(Just (System (Debian _) _)) -> apt
-		(Just (System (Buntish _) _)) -> apt
-		_ -> unsupportedOS
+installed' bios = (aptinstall `pickOS` aptinstall)
+	`describe` "grub package installed"
   where
+	aptinstall :: Property DebianLike
+	aptinstall = Apt.installed [debpkg]
 	debpkg = case bios of
 		PC -> "grub-pc"
 		EFI64 -> "grub-efi-amd64"
-- 
cgit v1.2.3


From 5f41492d8afe6ac6ee3cc280c3e2f252bcc91817 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 04:46:21 -0400
Subject: propellor spin

---
 src/Propellor/Property.hs             | 18 ++++++++----------
 src/Propellor/Property/Apt.hs         |  6 +++---
 src/Propellor/Property/Debootstrap.hs | 19 +++++--------------
 src/Propellor/Property/Grub.hs        |  2 +-
 src/Propellor/Property/OS.hs          |  2 +-
 src/Propellor/Property/Ssh.hs         |  2 +-
 6 files changed, 19 insertions(+), 30 deletions(-)

diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 7878912b..55c39ee2 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -28,6 +28,7 @@ module Propellor.Property (
 	, pickOS
 	, withOS
 	, unsupportedOS
+	, unsupportedOS'
 	, makeChange
 	, noChange
 	, doNothing
@@ -292,7 +293,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
 			then getSatisfy a
 			else if matching o b
 				then getSatisfy b
-				else unsupportedOS
+				else unsupportedOS'
 	matching Nothing _ = False
 	matching (Just o) p = 
 		Targeting (systemToTargetOS o)
@@ -307,7 +308,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
 -- > myproperty = withOS "foo installed" $ \w o -> case o of
 -- > 	(Just (System (Debian (Stable release)) arch)) -> ensureProperty w ...
 -- > 	(Just (System (Debian suite) arch)) -> ensureProperty w ...
--- >	_ -> unsupportedOS
+-- >	_ -> unsupportedOS'
 --
 -- Note that the operating system specifics may not be declared for all hosts,
 -- which is where Nothing comes in.
@@ -324,21 +325,18 @@ withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
 	dummyoutermetatypes :: OuterMetaTypesWitness ('[])
 	dummyoutermetatypes = OuterMetaTypesWitness sing
 
-class UnsupportedOS a where
-	unsupportedOS :: a
+-- | A property that always fails with an unsupported OS error.
+unsupportedOS :: Property UnixLike
+unsupportedOS = property "unsupportedOS" unsupportedOS'
 
 -- | Throws an error, for use in `withOS` when a property is lacking
 -- support for an OS.
-instance UnsupportedOS (Propellor a) where
-	unsupportedOS = go =<< getOS
+unsupportedOS' :: Propellor Result
+unsupportedOS' = go =<< getOS
 	  where
 		go Nothing = error "Unknown host OS is not supported by this property."
 		go (Just o) = error $ "This property is not implemented for " ++ show o
 
--- | A property that always fails with an unsupported OS error.
-instance UnsupportedOS (Property UnixLike) where
-	unsupportedOS = property "unsupportedOS" unsupportedOS
-
 -- | Undoes the effect of a RevertableProperty.
 revert :: RevertableProperty setup undo -> RevertableProperty undo setup
 revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 2199d950..1a15f72c 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -84,7 +84,7 @@ stdSourcesList :: Property Debian
 stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
 	(Just (System (Debian suite) _)) ->
 		ensureProperty w $ stdSourcesListFor suite
-	_ -> unsupportedOS
+	_ -> unsupportedOS'
 
 stdSourcesListFor :: DebianSuite -> Property Debian
 stdSourcesListFor suite = stdSourcesList' suite []
@@ -160,11 +160,11 @@ installed' params ps = robustly $ check (isInstallable ps) go
 installedBackport :: [Package] -> Property Debian
 installedBackport ps = withOS desc $ \w o -> case o of
 	(Just (System (Debian suite) _)) -> case backportSuite suite of
-		Nothing -> unsupportedOS
+		Nothing -> unsupportedOS'
 		Just bs -> ensureProperty w $
 			runApt (["install", "-t", bs, "-y"] ++ ps)
 				`changesFile` dpkgStatus
-	_ -> unsupportedOS
+	_ -> unsupportedOS'
   where
 	desc = unwords ("apt installed backport":ps)
 
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index fd5f6c96..e0c56966 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -101,21 +101,12 @@ extractSuite (System (FreeBSD _) _) = Nothing
 installed :: RevertableProperty Linux Linux
 installed = install  remove
   where
-	install = withOS "debootstrap installed" $ \w o ->
-		ifM (liftIO $ isJust <$> programPath)
-			( return NoChange
-			, ensureProperty w (installon o)
-			)
-
-	installon (Just (System (Debian _) _)) = aptinstall
-	installon (Just (System (Buntish _) _)) = aptinstall
-	installon _ = sourceInstall
+	install = check (isJust <$> programPath) $
+		(aptinstall `pickOS` sourceInstall)
+			`describe` "debootstrap installed"
 
-	remove = withOS "debootstrap removed" $ \w o -> 
-		ensureProperty w (removefrom o)
-	removefrom (Just (System (Debian _) _)) = aptremove
-	removefrom (Just (System (Buntish _) _)) = aptremove
-	removefrom _ = sourceRemove
+	remove = (aptremove `pickOS` sourceRemove)
+		`describe` "debootstrap removed"
 
 	aptinstall = Apt.installed ["debootstrap"]
 	aptremove = Apt.removed ["debootstrap"]
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 85d098ed..a03fc5a0 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -30,7 +30,7 @@ mkConfig = tightenTargets $ cmdProperty "update-grub" []
 
 -- | Installs grub; does not run update-grub.
 installed' :: BIOS -> Property Linux
-installed' bios = (aptinstall `pickOS` aptinstall)
+installed' bios = (aptinstall `pickOS` unsupportedOS)
 	`describe` "grub package installed"
   where
 	aptinstall :: Property DebianLike
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 72753248..7d0a10ca 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -89,7 +89,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 			debootstrap d
 		(Just u@(System (Buntish _) _)) -> ensureProperty w $
 			debootstrap u
-		_ -> unsupportedOS
+		_ -> unsupportedOS'
 	
 	debootstrap :: System -> Property Linux
 	debootstrap targetos =
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 7048de3b..369999b7 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -53,7 +53,7 @@ installed = withOS "ssh installed" $ \w o ->
 	in case o of
 		(Just (System (Debian _) _)) -> aptinstall
 		(Just (System (Buntish _) _)) -> aptinstall
-		_ -> unsupportedOS
+		_ -> unsupportedOS'
 
 restarted :: Property DebianLike
 restarted = Service.restarted "ssh"
-- 
cgit v1.2.3


From 434b3e8b325be7cd04c4130e80be19dc57f27d0f Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 04:48:06 -0400
Subject: last withOS that can be converted to pickOS is converted

---
 src/Propellor/Property/Ssh.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 369999b7..6e1690d2 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -48,12 +48,10 @@ import qualified Data.Set as S
 import Data.List
 
 installed :: Property UnixLike
-installed = withOS "ssh installed" $ \w o -> 
-	let aptinstall = ensureProperty w $ Apt.installed ["ssh"]
-	in case o of
-		(Just (System (Debian _) _)) -> aptinstall
-		(Just (System (Buntish _) _)) -> aptinstall
-		_ -> unsupportedOS'
+installed = "ssh installed" ==> (aptinstall `pickOS` unsupportedOS)
+  where
+	aptinstall :: Property DebianLike
+	aptinstall = Apt.installed ["ssh"]
 
 restarted :: Property DebianLike
 restarted = Service.restarted "ssh"
-- 
cgit v1.2.3


From 1bd062c5336db6aff3b6128f7821f8ebed6b6ca0 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 04:56:42 -0400
Subject: one more

---
 src/Propellor/Property/DiskImage.hs | 9 +++------
 src/Propellor/Property/OS.hs        | 4 ++--
 2 files changed, 5 insertions(+), 8 deletions(-)

diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 8c027b05..718768c2 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -118,12 +118,9 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
 -- disk image. It cleans any caches of information that can be omitted;
 -- eg the apt cache on Debian.
 cachesCleaned :: Property UnixLike
-cachesCleaned = withOS "cache cleaned" $ \w o -> 
-	let aptclean = ensureProperty w Apt.cacheCleaned
-	in case o of
-		(Just (System (Debian _) _)) -> aptclean
-		(Just (System (Buntish _) _)) -> aptclean
-		_ -> noChange
+cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
+  where
+	skipit = doNothing :: Property UnixLike
 
 -- | Builds a disk image from the contents of a chroot.
 imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 7d0a10ca..5a3ccc70 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -93,8 +93,8 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 	
 	debootstrap :: System -> Property Linux
 	debootstrap targetos =
-		-- Ignore the os setting, and install debootstrap from
-		-- source, since we don't know what OS we're running in yet.
+		-- Install debootstrap from source, since we don't know
+		-- what OS we're currently running in.
 		Debootstrap.built' Debootstrap.sourceInstall
 			newOSDir targetos Debootstrap.DefaultConfig
 		-- debootstrap, I wish it was faster.. 
-- 
cgit v1.2.3


From a1655d24bbb1db9caccdf93eae8110d746389ae2 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 05:53:38 -0400
Subject: type safe targets for properties

  * Property types have been improved to indicate what systems they target.
    This prevents using eg, Property FreeBSD on a Debian system.
    Transition guide for this sweeping API change:
    - Change "host name & foo & bar"
      to     "host name $ props & foo & bar"
    - Similarly, `propertyList` and `combineProperties` need `props`
      to be used to combine together properties; they no longer accept
      lists of properties. (If you have such a list, use `toProps`.)
    - And similarly, Chroot, Docker, and Systemd container need `props`
      to be used to combine together the properies used inside them.
    - The `os` property is removed. Instead use `osDebian`, `osBuntish`,
      or `osFreeBSD`. These tell the type checker the target OS of a host.
    - Change "Property NoInfo" to "Property UnixLike"
    - Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
    - Change "RevertableProperty NoInfo" to
      "RevertableProperty UnixLike UnixLike"
    - Change "RevertableProperty HasInfo" to
      "RevertableProperty (HasInfo + UnixLike) UnixLike"
    - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types.
      This is enabled by default for all modules in propellor.cabal. But
      if you are using propellor as a library, you may need to enable it
      manually.
    - If you know a property only works on a particular OS, like Debian
      or FreeBSD, use that instead of "UnixLike". For example:
      "Property Debian"
    - It's also possible make a property support a set of OS's, for example:
      "Property (Debian + FreeBSD)"
    - Removed `infoProperty` and `simpleProperty` constructors, instead use
      `property` to construct a Property.
    - Due to the polymorphic type returned by `property`, additional type
      signatures tend to be needed when using it. For example, this will
      fail to type check, because the type checker cannot guess what type
      you intend the intermediate property "go" to have:
        foo :: Property UnixLike
        foo = go `requires` bar
	  where
		go = property "foo" (return NoChange)
      To fix, specify the type of go:
	  	go :: Property UnixLike
    - `ensureProperty` now needs to be passed a witness to the type of the
      property it's used in.
      change this:  foo = property desc $ ... ensureProperty bar
      to this:      foo = property' desc $ \w -> ... ensureProperty w bar
    - General purpose properties like cmdProperty have type "Property UnixLike".
      When using that to run a command only available on Debian, you can
      tighten the type to only the OS that your more specific property works on.
      For example:
        upgraded :: Property Debian
        upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
    - Several utility functions have been renamed:
      getInfo to fromInfo
      propertyInfo to getInfo
      propertyDesc to getDesc
      propertyChildren to getChildren
  * The new `pickOS` property combinator can be used to combine different
    properties, supporting different OS's, into one Property that chooses
    which to use based on the Host's OS.
  * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
    these complex new types.
  * Added dependency on concurrent-output; removed embedded copy.
---
 config-freebsd.hs                                  |  13 +-
 config-simple.hs                                   |  23 +-
 debian/changelog                                   |  69 ++-
 debian/control                                     |   2 +
 doc/FreeBSD.mdwn                                   |   6 +-
 doc/Linux.mdwn                                     |   2 +-
 doc/haskell_newbie.mdwn                            |   6 +-
 doc/todo/depend_on_concurrent-output.mdwn          |   3 +
 doc/todo/type_level_OS_requirements.mdwn           |   7 +-
 doc/writing_properties.mdwn                        |  10 +-
 joeyconfig.hs                                      | 149 +++---
 propellor.cabal                                    |  46 +-
 src/Propellor.hs                                   |   9 +-
 src/Propellor/Bootstrap.hs                         |   1 +
 src/Propellor/Container.hs                         |  62 +++
 src/Propellor/Engine.hs                            |  23 +-
 src/Propellor/EnsureProperty.hs                    |  70 +++
 src/Propellor/Info.hs                              | 108 +++-
 src/Propellor/PrivData.hs                          |  45 +-
 src/Propellor/PropAccum.hs                         | 122 +++--
 src/Propellor/Property.hs                          | 126 +++--
 src/Propellor/Property/Aiccu.hs                    |  16 +-
 src/Propellor/Property/Apache.hs                   |  54 +-
 src/Propellor/Property/Apt.hs                      | 119 +++--
 src/Propellor/Property/Chroot.hs                   |  99 ++--
 src/Propellor/Property/Cmd.hs                      |  10 +-
 src/Propellor/Property/Concurrent.hs               |  14 +-
 src/Propellor/Property/Conductor.hs                |  57 ++-
 src/Propellor/Property/ConfFile.hs                 |   8 +-
 src/Propellor/Property/Cron.hs                     |  25 +-
 src/Propellor/Property/DebianMirror.hs             |  20 +-
 src/Propellor/Property/Debootstrap.hs              |  42 +-
 src/Propellor/Property/DiskImage.hs                |  92 ++--
 src/Propellor/Property/Dns.hs                      |  45 +-
 src/Propellor/Property/DnsSec.hs                   |  12 +-
 src/Propellor/Property/Docker.hs                   | 161 +++---
 src/Propellor/Property/Fail2Ban.hs                 |   8 +-
 src/Propellor/Property/File.hs                     |  49 +-
 src/Propellor/Property/Firewall.hs                 |   4 +-
 src/Propellor/Property/FreeBSD/Pkg.hs              |  17 +-
 src/Propellor/Property/FreeBSD/Poudriere.hs        |  21 +-
 src/Propellor/Property/Git.hs                      |  23 +-
 src/Propellor/Property/Gpg.hs                      |   5 +-
 src/Propellor/Property/Group.hs                    |   2 +-
 src/Propellor/Property/Grub.hs                     |  39 +-
 .../Property/HostingProvider/CloudAtCost.hs        |  33 +-
 .../Property/HostingProvider/DigitalOcean.hs       |  11 +-
 src/Propellor/Property/HostingProvider/Linode.hs   |   9 +-
 src/Propellor/Property/Hostname.hs                 |  21 +-
 src/Propellor/Property/Journald.hs                 |  16 +-
 src/Propellor/Property/Kerberos.hs                 |  29 +-
 src/Propellor/Property/LetsEncrypt.hs              |   7 +-
 src/Propellor/Property/LightDM.hs                  |   6 +-
 src/Propellor/Property/List.hs                     | 111 ++--
 src/Propellor/Property/Locale.hs                   |  38 +-
 src/Propellor/Property/Logcheck.hs                 |   4 +-
 src/Propellor/Property/Mount.hs                    |  17 +-
 src/Propellor/Property/Munin.hs                    |   8 +-
 src/Propellor/Property/Network.hs                  |  38 +-
 src/Propellor/Property/Nginx.hs                    |  14 +-
 src/Propellor/Property/OS.hs                       |  51 +-
 src/Propellor/Property/Obnam.hs                    |  17 +-
 src/Propellor/Property/OpenId.hs                   |   6 +-
 src/Propellor/Property/Parted.hs                   |  17 +-
 src/Propellor/Property/Partition.hs                |  12 +-
 src/Propellor/Property/Postfix.hs                  |  37 +-
 src/Propellor/Property/PropellorRepo.hs            |   2 +-
 src/Propellor/Property/Prosody.hs                  |  12 +-
 src/Propellor/Property/Reboot.hs                   |   6 +-
 src/Propellor/Property/Rsync.hs                    |   6 +-
 src/Propellor/Property/Scheduled.hs                |  13 +-
 src/Propellor/Property/Service.hs                  |  10 +-
 src/Propellor/Property/SiteSpecific/Branchable.hs  |   2 +-
 .../Property/SiteSpecific/GitAnnexBuilder.hs       | 103 ++--
 src/Propellor/Property/SiteSpecific/GitHome.hs     |  11 +-
 src/Propellor/Property/SiteSpecific/IABak.hs       |  13 +-
 src/Propellor/Property/SiteSpecific/JoeySites.hs   | 133 ++---
 src/Propellor/Property/Ssh.hs                      | 193 +++----
 src/Propellor/Property/Sudo.hs                     |   9 +-
 src/Propellor/Property/Systemd.hs                  | 163 +++---
 src/Propellor/Property/Systemd/Core.hs             |   2 +-
 src/Propellor/Property/Tor.hs                      |  44 +-
 src/Propellor/Property/Unbound.hs                  |   8 +-
 src/Propellor/Property/User.hs                     |  63 +--
 src/Propellor/Property/Uwsgi.hs                    |  12 +-
 src/Propellor/Property/ZFS/Properties.hs           |  12 +-
 src/Propellor/Spin.hs                              |   4 +-
 src/Propellor/Types.hs                             | 408 +++++----------
 src/Propellor/Types/Core.hs                        | 106 ++++
 src/Propellor/Types/Info.hs                        |  15 +-
 src/Propellor/Types/MetaTypes.hs                   | 213 ++++++++
 src/Propellor/Types/OS.hs                          |  21 +-
 src/Propellor/Types/ResultCheck.hs                 |   3 +
 src/Propellor/Types/Singletons.hs                  |  49 ++
 src/System/Console/Concurrent.hs                   |  44 --
 src/System/Console/Concurrent/Internal.hs          | 556 ---------------------
 src/System/Process/Concurrent.hs                   |  34 --
 97 files changed, 2341 insertions(+), 2275 deletions(-)
 create mode 100644 src/Propellor/Container.hs
 create mode 100644 src/Propellor/EnsureProperty.hs
 create mode 100644 src/Propellor/Types/Core.hs
 create mode 100644 src/Propellor/Types/MetaTypes.hs
 create mode 100644 src/Propellor/Types/Singletons.hs
 delete mode 100644 src/System/Console/Concurrent.hs
 delete mode 100644 src/System/Console/Concurrent/Internal.hs
 delete mode 100644 src/System/Process/Concurrent.hs

diff --git a/config-freebsd.hs b/config-freebsd.hs
index b6334c31..3ee3f27c 100644
--- a/config-freebsd.hs
+++ b/config-freebsd.hs
@@ -27,8 +27,8 @@ hosts =
 
 -- An example freebsd host.
 freebsdbox :: Host
-freebsdbox = host "freebsdbox.example.com"
-	& os (System (FreeBSD (FBSDProduction FBSD102)) "amd64")
+freebsdbox = host "freebsdbox.example.com" $ props
+	& osFreeBSD (FBSDProduction FBSD102) "amd64"
 	& Pkg.update
 	& Pkg.upgrade
 	& Poudriere.poudriere poudriereZFS
@@ -43,8 +43,8 @@ poudriereZFS = Poudriere.defaultConfig
 
 -- An example linux host.
 linuxbox :: Host
-linuxbox = host "linuxbox.example.com"
-	& os (System (Debian Unstable) "amd64")
+linuxbox = host "linuxbox.example.com" $ props
+	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 	& Apt.unattendedUpgrades
 	& Apt.installed ["etckeeper"]
@@ -58,10 +58,9 @@ linuxbox = host "linuxbox.example.com"
 
 -- A generic webserver in a Docker container.
 webserverContainer :: Docker.Container
-webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")
-	& os (System (Debian (Stable "jessie")) "amd64")
+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props
+	& osDebian (Stable "jessie") "amd64"
 	& Apt.stdSourcesList
 	& Docker.publish "80:80"
 	& Docker.volume "/var/www:/var/www"
 	& Apt.serviceInstalledRunning "apache2"
-
diff --git a/config-simple.hs b/config-simple.hs
index 21accd18..42b3d838 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -4,15 +4,8 @@
 import Propellor
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Network as Network
---import qualified Propellor.Property.Ssh as Ssh
 import qualified Propellor.Property.Cron as Cron
-import Propellor.Property.Scheduled
---import qualified Propellor.Property.Sudo as Sudo
 import qualified Propellor.Property.User as User
---import qualified Propellor.Property.Hostname as Hostname
---import qualified Propellor.Property.Tor as Tor
-import qualified Propellor.Property.Docker as Docker
 
 main :: IO ()
 main = defaultMain hosts
@@ -25,24 +18,12 @@ hosts =
 
 -- An example host.
 mybox :: Host
-mybox = host "mybox.example.com"
-	& os (System (Debian Unstable) "amd64")
+mybox = host "mybox.example.com" $ props
+	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 	& Apt.unattendedUpgrades
 	& Apt.installed ["etckeeper"]
 	& Apt.installed ["ssh"]
 	& User.hasSomePassword (User "root")
-	& Network.ipv6to4
 	& File.dirExists "/var/www"
-	& Docker.docked webserverContainer
-	& Docker.garbageCollected `period` Daily
 	& Cron.runPropellor (Cron.Times "30 * * * *")
-
--- A generic webserver in a Docker container.
-webserverContainer :: Docker.Container
-webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")
-	& os (System (Debian (Stable "jessie")) "amd64")
-	& Apt.stdSourcesList
-	& Docker.publish "80:80"
-	& Docker.volume "/var/www:/var/www"
-	& Apt.serviceInstalledRunning "apache2"
diff --git a/debian/changelog b/debian/changelog
index 15587571..0560b15e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,68 @@
+propellor (3.0.0) UNRELEASED; urgency=medium
+
+  * Property types have been improved to indicate what systems they target.
+    This prevents using eg, Property FreeBSD on a Debian system.
+    Transition guide for this sweeping API change:
+    - Change "host name & foo & bar"
+      to     "host name $ props & foo & bar"
+    - Similarly, `propertyList` and `combineProperties` need `props`
+      to be used to combine together properties; they no longer accept
+      lists of properties. (If you have such a list, use `toProps`.)
+    - And similarly, Chroot, Docker, and Systemd container need `props`
+      to be used to combine together the properies used inside them.
+    - The `os` property is removed. Instead use `osDebian`, `osBuntish`,
+      or `osFreeBSD`. These tell the type checker the target OS of a host.
+    - Change "Property NoInfo" to "Property UnixLike"
+    - Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
+    - Change "RevertableProperty NoInfo" to
+      "RevertableProperty UnixLike UnixLike"
+    - Change "RevertableProperty HasInfo" to
+      "RevertableProperty (HasInfo + UnixLike) UnixLike"
+    - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types.
+      This is enabled by default for all modules in propellor.cabal. But
+      if you are using propellor as a library, you may need to enable it
+      manually.
+    - If you know a property only works on a particular OS, like Debian
+      or FreeBSD, use that instead of "UnixLike". For example:
+      "Property Debian"
+    - It's also possible make a property support a set of OS's, for example:
+      "Property (Debian + FreeBSD)"
+    - Removed `infoProperty` and `simpleProperty` constructors, instead use
+      `property` to construct a Property.
+    - Due to the polymorphic type returned by `property`, additional type
+      signatures tend to be needed when using it. For example, this will
+      fail to type check, because the type checker cannot guess what type
+      you intend the intermediate property "go" to have:
+        foo :: Property UnixLike
+        foo = go `requires` bar
+	  where
+		go = property "foo" (return NoChange)
+      To fix, specify the type of go:
+	  	go :: Property UnixLike
+    - `ensureProperty` now needs to be passed a witness to the type of the 
+      property it's used in.
+      change this:  foo = property desc $ ... ensureProperty bar
+      to this:      foo = property' desc $ \w -> ... ensureProperty w bar
+    - General purpose properties like cmdProperty have type "Property UnixLike".
+      When using that to run a command only available on Debian, you can
+      tighten the type to only the OS that your more specific property works on.
+      For example:
+        upgraded :: Property Debian
+        upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
+    - Several utility functions have been renamed:
+      getInfo to fromInfo
+      propertyInfo to getInfo
+      propertyDesc to getDesc
+      propertyChildren to getChildren
+  * The new `pickOS` property combinator can be used to combine different
+    properties, supporting different OS's, into one Property that chooses
+    which to use based on the Host's OS.
+  * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
+    these complex new types.
+  * Added dependency on concurrent-output; removed embedded copy.
+
+ -- Joey Hess   Thu, 24 Mar 2016 15:02:33 -0400
+
 propellor (2.17.1) UNRELEASED; urgency=medium
 
   * Avoid generating excessively long paths to the unix socket file
@@ -481,12 +546,12 @@ propellor (2.0.0) unstable; urgency=medium
     This was done to make sure that ensureProperty is only used on
     properties that do not have Info.
     Transition guide:
-    - Change all "Property" to "Property NoInfo" or "Property WithInfo"
+    - Change all "Property" to "Property NoInfo" or "Property HasInfo"
       (The compiler can tell you if you got it wrong!)
     - To construct a RevertableProperty, it is useful to use the new
       () operator
     - Constructing a list of properties can be problimatic, since
-      Property NoInto and Property WithInfo are different types and cannot
+      Property NoInto and Property HasInfo are different types and cannot
       appear in the same list. To deal with this, "props" has been added,
       and can built up a list of properties of different types,
       using the same (&) and (!) operators that are used to build
diff --git a/debian/control b/debian/control
index 757462d1..898e558d 100644
--- a/debian/control
+++ b/debian/control
@@ -18,6 +18,7 @@ Build-Depends:
 	libghc-exceptions-dev (>= 0.6),
 	libghc-stm-dev,
 	libghc-text-dev,
+	libghc-concurrent-output-dev,
 Maintainer: Joey Hess 
 Standards-Version: 3.9.6
 Vcs-Git: git://git.joeyh.name/propellor
@@ -41,6 +42,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
 	libghc-exceptions-dev (>= 0.6),
 	libghc-stm-dev,
 	libghc-text-dev,
+	libghc-concurrent-output-dev,
 	git,
 	make,
 Description: property-based host configuration management in haskell
diff --git a/doc/FreeBSD.mdwn b/doc/FreeBSD.mdwn
index 2edff223..47b9c65b 100644
--- a/doc/FreeBSD.mdwn
+++ b/doc/FreeBSD.mdwn
@@ -1,8 +1,10 @@
 Propellor is in the early stages of supporting FreeBSD. It should basically
 work, and there are some modules with FreeBSD-specific properties. 
 
-However, many other properties assume they're being run on a
-Debian Linux system, and need additional porting to support FreeBSD.
+However, many other properties only work on a Debian Linux system, and need
+additional porting to support FreeBSD. Such properties have types like 
+`Property DebianLike`. The type checker will detect and reject attempts
+to combine such properties with `Property FreeBSD`.
 
 [Sample config file](http://git.joeyh.name/?p=propellor.git;a=blob;f=config-freebsd.hs)
 which configures a FreeBSD system, as well as a Linux one.
diff --git a/doc/Linux.mdwn b/doc/Linux.mdwn
index 0434d69d..00276f69 100644
--- a/doc/Linux.mdwn
+++ b/doc/Linux.mdwn
@@ -6,4 +6,4 @@ Indeed, Propellor has been ported to [[FreeBSD]] now!
 See [[forum/Supported_OS]] for porting tips.
 
 Note that you can run Propellor on a OSX laptop and have it manage Linux
-systems.
+and other systems.
diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn
index e92481f9..bd343cd6 100644
--- a/doc/haskell_newbie.mdwn
+++ b/doc/haskell_newbie.mdwn
@@ -48,12 +48,12 @@ Finally, you need to define the configuration for each host in the list:
 [[!format haskell """
 mylaptop :: Host
 mylaptop = host "mylaptop.example.com"
-	& os (System (Debian Unstable) "amd64")
+	& osDebian Unstable "amd64"
 	& Apt.stdSourcesList
 
 myserver :: Host
 myserver = host "server.example.com"
-	& os (System (Debian (Stable "jessie")) "amd64")
+	& osDebian (Stable "jessie") "amd64"
 	& Apt.stdSourcesList
 	& Apt.installed ["ssh"]
 """]]
@@ -96,7 +96,7 @@ is.
 
 config.hs:30:19:
     Couldn't match expected type `RevertableProperty'
-                with actual type `Property NoInfo'
+                with actual type `Property DebianLike'
     In the return type of a call of `Apt.installed'
     In the second argument of `(!)', namely `Apt.installed ["ssh"]'
     In the first argument of `(&)', namely
diff --git a/doc/todo/depend_on_concurrent-output.mdwn b/doc/todo/depend_on_concurrent-output.mdwn
index fdc66b04..a104c82b 100644
--- a/doc/todo/depend_on_concurrent-output.mdwn
+++ b/doc/todo/depend_on_concurrent-output.mdwn
@@ -8,3 +8,6 @@ Once this is done, can switch GHC-Options back to -O0 from -O.
 -O0 is better because ghc takes less memory to build propellor.
 
 [[!tag user/joey]]
+
+> [[done]]. Didn't wait for it to hit stable; cabal will be used to install
+> it.
diff --git a/doc/todo/type_level_OS_requirements.mdwn b/doc/todo/type_level_OS_requirements.mdwn
index 7c2fb78f..f1c3e59f 100644
--- a/doc/todo/type_level_OS_requirements.mdwn
+++ b/doc/todo/type_level_OS_requirements.mdwn
@@ -21,13 +21,12 @@ withOS.
 
 The `os` property would need to yield a `Property (os:[])`, where the type
 level list contains a type-level eqivilant of the value passed to the
-property. Is that possible to do? reification or something?
-(See: )
-Or, alternatively, could have less polymorphic `debian` etc
+property. Is that possible to do?
+Or, alternatively, could have less polymorphic `osDebian` etc
 properties replace the `os` property.
 
 If a Host's list of properties, when all combined together,
-contains more than one element in its '[OS], that needs to be a type error,
+contains more than one element in its '[OS], that could be a type error,
 the OS of the Host is indeterminite. Which would be fixed by using the `os`
 property to specify.
 
diff --git a/doc/writing_properties.mdwn b/doc/writing_properties.mdwn
index 2209026f..1b7f046a 100644
--- a/doc/writing_properties.mdwn
+++ b/doc/writing_properties.mdwn
@@ -31,7 +31,7 @@ Propellor makes it very easy to put together a property like this.
 
 Let's start with a property that combines the two properties you mentioned:
 
-	hasLoginShell :: UserName -> FilePath -> Property
+	hasLoginShell :: UserName -> FilePath -> Property UnixLike
 	hasLoginShell user shell = shellSetTo user shell `requires` shellEnabled shell
 
 The shellEnabled property can be easily written using propellor's file
@@ -40,14 +40,14 @@ manipulation properties.
 	-- Need to add an import to the top of the source file.
 	import qualified Propellor.Property.File as File
 
-	shellEnabled :: FilePath -> Property
+	shellEnabled :: FilePath -> Property UnixLike
 	shellEnabled shell = "/etc/shells" `File.containsLine` shell
 
 And then, we want to actually change the user's shell. The `chsh(1)`
 program can do that, so we can simply tell propellor the command line to
 run:
 
-	shellSetTo :: UserName -> FilePath -> Property
+	shellSetTo :: UserName -> FilePath -> Property UnixLike
 	shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
 
 The only remaining problem with this is that shellSetTo runs chsh every
@@ -56,7 +56,7 @@ it runs, even when it didn't really do much. Now, there's an easy way to
 avoid that problem, we could just tell propellor to assume that chsh
 has not made a change:
 	
-	shellSetTo :: UserName -> FilePath -> Property
+	shellSetTo :: UserName -> FilePath -> Property UnixLike
 	shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
 		`assume` NoChange
 
@@ -64,7 +64,7 @@ But, it's not much harder to do this right. Let's make the property
 check if the user's shell is already set to the desired value and avoid
 doing anything in that case.
 
-	shellSetTo :: UserName -> FilePath -> Property
+	shellSetTo :: UserName -> FilePath -> Property UnixLike
 	shellSetTo user shell = check needchangeshell $
 		cmdProperty "chsh" ["--shell", shell, user]
 	  where
diff --git a/joeyconfig.hs b/joeyconfig.hs
index 327c268e..3852f14b 100644
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -59,24 +59,26 @@ hosts =                --                  (o)  `
 	] ++ monsters
 
 testvm :: Host
-testvm = host "testvm.kitenet.net"
-	& os (System (Debian Unstable) "amd64")
+testvm = host "testvm.kitenet.net" $ props
+	& osDebian Unstable "amd64"
 	& OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")
-	 	`onChange` propertyList "fixing up after clean install"
-	 		[ OS.preserveRootSshAuthorized
-			, OS.preserveResolvConf
-			, Apt.update
-			, Grub.boots "/dev/sda"
-				`requires` Grub.installed Grub.PC
-	 		]
+	 	`onChange` postinstall
 	& Hostname.sane
 	& Hostname.searchDomain
 	& Apt.installed ["linux-image-amd64"]
 	& Apt.installed ["ssh"]
 	& User.hasPassword (User "root")
+  where
+	postinstall :: Property DebianLike
+	postinstall = propertyList "fixing up after clean install" $ props
+		& OS.preserveRootSshAuthorized
+		& OS.preserveResolvConf
+		& Apt.update
+		& Grub.boots "/dev/sda"
+			`requires` Grub.installed Grub.PC
 
 darkstar :: Host
-darkstar = host "darkstar.kitenet.net"
+darkstar = host "darkstar.kitenet.net" $ props
 	& ipv6 "2001:4830:1600:187::2"
 	& Aiccu.hasConfig "T18376" "JHZ2-SIXXS"
 
@@ -95,22 +97,23 @@ darkstar = host "darkstar.kitenet.net"
 		, swapPartition (MegaBytes 256)
 		]
   where
-	c d = Chroot.debootstrapped mempty d
-		& os (System (Debian Unstable) "amd64")
+	c d = Chroot.debootstrapped mempty d $ props
+		& osDebian Unstable "amd64"
 		& Hostname.setTo "demo"
 		& Apt.installed ["linux-image-amd64"]
 		& User "root" `User.hasInsecurePassword` "root"
 
 gnu :: Host
-gnu = host "gnu.kitenet.net"
+gnu = host "gnu.kitenet.net" $ props
 	& Apt.buildDep ["git-annex"] `period` Daily
 
 	& JoeySites.postfixClientRelay (Context "gnu.kitenet.net")
 	& JoeySites.dkimMilter
 
 clam :: Host
-clam = standardSystem "clam.kitenet.net" Unstable "amd64"
-	[ "Unreliable server. Anything here may be lost at any time!" ]
+clam = host "clam.kitenet.net" $ props
+	& standardSystem Unstable "amd64" 
+		["Unreliable server. Anything here may be lost at any time!" ]
 	& ipv4 "167.88.41.194"
 
 	& CloudAtCost.decruft
@@ -141,8 +144,9 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	& alias "us.scroll.joeyh.name"
 
 mayfly :: Host
-mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"
-	[ "Scratch VM. Contents can change at any time!" ]
+mayfly = host "mayfly.kitenet.net" $ props
+	& standardSystem (Stable "jessie") "amd64"
+		[ "Scratch VM. Contents can change at any time!" ]
 	& ipv4 "167.88.36.193"
 
 	& CloudAtCost.decruft
@@ -156,8 +160,9 @@ mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"
 	& Tor.bandwidthRate (Tor.PerMonth "400 GB")
 
 oyster :: Host
-oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"
-	[ "Unreliable server. Anything here may be lost at any time!" ]
+oyster = host "oyster.kitenet.net" $ props
+	& standardSystem Unstable "amd64"
+		[ "Unreliable server. Anything here may be lost at any time!" ]
 	& ipv4 "104.167.117.109"
 
 	& CloudAtCost.decruft
@@ -179,8 +184,8 @@ oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"
 	& Ssh.listenPort (Port 80)
 
 orca :: Host
-orca = standardSystem "orca.kitenet.net" Unstable "amd64"
-	[ "Main git-annex build box." ]
+orca = host "orca.kitenet.net" $ props
+	& standardSystem Unstable "amd64" [ "Main git-annex build box." ]
 	& ipv4 "138.38.108.179"
 
 	& Apt.unattendedUpgrades
@@ -190,19 +195,19 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
 
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.standardAutoBuilder
-		(System (Debian Unstable) "amd64") Nothing (Cron.Times "15 * * * *") "2h")
+		Unstable "amd64" Nothing (Cron.Times "15 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.standardAutoBuilder
-		(System (Debian Unstable) "i386") Nothing (Cron.Times "30 * * * *") "2h")
+		Unstable "i386" Nothing (Cron.Times "30 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.stackAutoBuilder
-		(System (Debian (Stable "jessie")) "i386") (Just "ancient") (Cron.Times "45 * * * *") "2h")
+		(Stable "jessie") "i386" (Just "ancient") (Cron.Times "45 * * * *") "2h")
 	& Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer
 		(Cron.Times "1 1 * * *") "3h")
 
 honeybee :: Host
-honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"
-	[ "Arm git-annex build box." ]
+honeybee = host "honeybee.kitenet.net" $ props
+	& standardSystem Testing "armhf" [ "Arm git-annex build box." ]
 
 	-- I have to travel to get console access, so no automatic
 	-- upgrades, and try to be robust.
@@ -229,14 +234,14 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"
 
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.armAutoBuilder
-			(System (Debian Unstable) "armel") Nothing Cron.Daily "22h")
+			Unstable "armel" Nothing Cron.Daily "22h")
 
 -- This is not a complete description of kite, since it's a
 -- multiuser system with eg, user passwords that are not deployed
 -- with propellor.
 kite :: Host
-kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
-	[ "Welcome to kite!" ]
+kite = host "kite.kitenet.net" $ props
+	& standardSystemUnhardened Testing "amd64" [ "Welcome to kite!" ]
 	& ipv4 "66.228.36.95"
 	& ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
 	& alias "kitenet.net"
@@ -351,10 +356,11 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
 		]
 
 elephant :: Host
-elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
-	[ "Storage, big data, and backups, omnomnom!"
-	, "(Encrypt all data stored here.)"
-	]
+elephant = host "elephant.kitenet.net" $ props
+	& standardSystem Unstable "amd64"
+		[ "Storage, big data, and backups, omnomnom!"
+		, "(Encrypt all data stored here.)"
+		]
 	& ipv4 "193.234.225.114"
 	& Ssh.hostKeys hostContext
 		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBANxXGWac0Yz58akI3UbLkphAa8VPDCGswTS0CT3D5xWyL9OeArISAi/OKRIvxA4c+9XnWtNXS7nYVFDJmzzg8v3ZMx543AxXK82kXCfvTOc/nAlVz9YKJAA+FmCloxpmOGrdiTx1k36FE+uQgorslGW/QTxnOcO03fDZej/ppJifAAAAFQCnenyJIw6iJB1+zuF/1TSLT8UAeQAAAIEA1WDrI8rKnxnh2rGaQ0nk+lOcVMLEr7AxParnZjgC4wt2mm/BmkF/feI1Fjft2z4D+V1W7MJHOqshliuproxhFUNGgX9fTbstFJf66p7h7OLAlwK8ZkpRk/uV3h5cIUPel6aCwjL5M2gN6/yq+gcCTXeHLq9OPyUTmlN77SBL71UAAACBAJJiCHWxPAGooe7Vv3W7EIBbsDyf7b2kDH3bsIlo+XFcKIN6jysBu4kn9utjFlrlPeHUDzGQHe+DmSqTUQQ0JPCRGcAcuJL8XUqhJi6A6ye51M9hVt51cJMXmERx9TjLOP/adkEuxpv3Fj20FxRUr1HOmvRvewSHrJ1GeA1bjbYL")
@@ -412,7 +418,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
 	& Ssh.listenPort (Port 80)
 
 beaver :: Host
-beaver = host "beaver.kitenet.net"
+beaver = host "beaver.kitenet.net" $ props
 	& ipv6 "2001:4830:1600:195::2"
 	& Apt.serviceInstalledRunning "aiccu"
 	& Apt.installed ["ssh"]
@@ -425,7 +431,7 @@ beaver = host "beaver.kitenet.net"
 
 -- Branchable is not completely deployed with propellor yet.
 pell :: Host
-pell = host "pell.branchable.com"
+pell = host "pell.branchable.com" $ props
 	& alias "branchable.com"
 	& ipv4 "66.228.46.55"
 	& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
@@ -449,10 +455,10 @@ pell = host "pell.branchable.com"
 	& Branchable.server hosts
 
 iabak :: Host
-iabak = host "iabak.archiveteam.org"
+iabak = host "iabak.archiveteam.org" $ props
 	& ipv4 "124.6.40.227"
 	& Hostname.sane
-	& os (System (Debian Testing) "amd64")
+	& osDebian Testing "amd64"
 	& Systemd.persistentJournal
 	& Cron.runPropellor (Cron.Times "30 * * * *")
 	& Apt.stdSourcesList `onChange` Apt.upgrade
@@ -466,7 +472,7 @@ iabak = host "iabak.archiveteam.org"
 	& Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]
 	& User.hasSomePassword (User "root")
 	& propertyList "admin accounts"
-		(map User.accountFor admins ++ map Sudo.enabledFor admins)
+		(toProps $ map User.accountFor admins ++ map Sudo.enabledFor admins)
 	& User.hasSomePassword (User "joey")
 	& GitHome.installedFor (User "joey")
 	& Ssh.authorizedKey (User "db48x") "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel"
@@ -489,14 +495,16 @@ iabak = host "iabak.archiveteam.org"
 
 -- Simple web server, publishing the outside host's /var/www
 webserver :: Systemd.Container
-webserver = standardStableContainer "webserver"
+webserver = Systemd.debContainer "webserver" $ props
+	& standardContainer (Stable "jessie")
 	& Systemd.bind "/var/www"
 	& Apache.installed
 
 -- My own openid provider. Uses php, so containerized for security
 -- and administrative sanity.
 openidProvider :: Systemd.Container
-openidProvider = standardStableContainer "openid-provider"
+openidProvider = Systemd.debContainer "openid-provider" $ props
+	& standardContainer (Stable "jessie")
 	& alias hn
 	& OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))
   where
@@ -504,7 +512,8 @@ openidProvider = standardStableContainer "openid-provider"
 
 -- Exhibit: kite's 90's website on port 1994.
 ancientKitenet :: Systemd.Container
-ancientKitenet = standardStableContainer "ancient-kitenet"
+ancientKitenet = Systemd.debContainer "ancient-kitenet" $ props
+	& standardContainer (Stable "jessie")
 	& alias hn
 	& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"
 		(Just "remotes/origin/old-kitenet.net")
@@ -517,24 +526,27 @@ ancientKitenet = standardStableContainer "ancient-kitenet"
 	hn = "ancient.kitenet.net"
 
 oldusenetShellBox :: Systemd.Container
-oldusenetShellBox = standardStableContainer "oldusenet-shellbox"
+oldusenetShellBox = Systemd.debContainer "oldusenet-shellbox" $ props
+	& standardContainer (Stable "jessie")
 	& alias "shell.olduse.net"
 	& JoeySites.oldUseNetShellBox
 
 kiteShellBox :: Systemd.Container
-kiteShellBox = standardStableContainer "kiteshellbox"
+kiteShellBox = Systemd.debContainer "kiteshellbox" $ props
+	& standardContainer (Stable "jessie")
 	& JoeySites.kiteShellBox
 
 type Motd = [String]
 
 -- This is my standard system setup.
-standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host
-standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd
-	& Ssh.noPasswords
-
-standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host
-standardSystemUnhardened hn suite arch motd = host hn
-	& os (System (Debian suite) arch)
+standardSystem :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
+standardSystem suite arch motd = 
+	standardSystemUnhardened suite arch motd
+		`before` Ssh.noPasswords
+
+standardSystemUnhardened :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
+standardSystemUnhardened suite arch motd = propertyList "standard system" $ props
+	& osDebian suite arch
 	& Hostname.sane
 	& Hostname.searchDomain
 	& File.hasContent "/etc/motd" ("":motd++[""])
@@ -555,32 +567,27 @@ standardSystemUnhardened hn suite arch motd = host hn
 		`onChange` Apt.autoRemove
 
 -- This is my standard container setup, Featuring automatic upgrades.
-standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container
-standardContainer name suite arch =
-	Systemd.container name system (Chroot.debootstrapped mempty)
-		& Apt.stdSourcesList `onChange` Apt.upgrade
-		& Apt.unattendedUpgrades
-		& Apt.cacheCleaned
-  where
-	system = System (Debian suite) arch
-
-standardStableContainer :: Systemd.MachineName -> Systemd.Container
-standardStableContainer name = standardContainer name (Stable "jessie") "amd64"
+standardContainer :: DebianSuite -> Property (HasInfo + Debian)
+standardContainer suite = propertyList "standard container" $ props
+	& osDebian suite "amd64"
+	& Apt.stdSourcesList `onChange` Apt.upgrade
+	& Apt.unattendedUpgrades
+	& Apt.cacheCleaned
 
-myDnsSecondary :: Property HasInfo
+myDnsSecondary :: Property (HasInfo + DebianLike)
 myDnsSecondary = propertyList "dns secondary for all my domains" $ props
 	& Dns.secondary hosts "kitenet.net"
 	& Dns.secondary hosts "joeyh.name"
 	& Dns.secondary hosts "ikiwiki.info"
 	& Dns.secondary hosts "olduse.net"
 
-branchableSecondary :: RevertableProperty HasInfo
+branchableSecondary :: RevertableProperty (HasInfo + DebianLike) DebianLike
 branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
 
 -- Currently using kite (ns4) as primary with secondaries
 -- elephant (ns3) and gandi.
 -- kite handles all mail.
-myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty HasInfo
+myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
 myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain
 	(Dns.mkSOA "ns4.kitenet.net" 100) $
 	[ (RootDomain, NS $ AbsDomain "ns4.kitenet.net")
@@ -594,20 +601,20 @@ myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly No
 
 monsters :: [Host]    -- Systems I don't manage with propellor,
 monsters =            -- but do want to track their public keys etc.
-	[ host "usw-s002.rsync.net"
+	[ host "usw-s002.rsync.net" $ props
 		& Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd"
-	, host "github.com"
+	, host "github.com" $ props
 		& Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
-	, host "gitlab.com"
+	, host "gitlab.com" $ props
 		& Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY="
-	, host "ns6.gandi.net"
+	, host "ns6.gandi.net" $ props
 		& ipv4 "217.70.177.40"
-	, host "turtle.kitenet.net"
+	, host "turtle.kitenet.net" $ props
 		& ipv4 "67.223.19.96"
 		& ipv6 "2001:4978:f:2d9::2"
-	, host "mouse.kitenet.net"
+	, host "mouse.kitenet.net" $ props
 		& ipv6 "2001:4830:1600:492::2"
-	, host "animx"
+	, host "animx" $ props
 		& ipv4 "76.7.162.101"
 		& ipv4 "76.7.162.186"
 	]
diff --git a/propellor.cabal b/propellor.cabal
index dc322e88..06142155 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 2.17.0
+Version: 3.0.0
 Cabal-Version: >= 1.8
 License: BSD3
 Maintainer: Joey Hess 
@@ -36,31 +36,39 @@ Description:
 
 Executable propellor
   Main-Is: wrapper.hs
-  GHC-Options: -threaded -Wall -fno-warn-tabs
+  GHC-Options: -threaded -Wall -fno-warn-tabs -O0
+  Extensions: TypeOperators
   Hs-Source-Dirs: src
-  Build-Depends: 
+  Build-Depends:
     -- propellor needs to support the ghc shipped in Debian stable
     base >= 4.5, base < 5,
     MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
-    time, mtl, transformers, exceptions (>= 0.6), stm, text
+    time, mtl, transformers, exceptions (>= 0.6), stm, text,
+    concurrent-output
 
 Executable propellor-config
   Main-Is: config.hs
-  GHC-Options: -threaded -Wall -fno-warn-tabs
+  GHC-Options: -threaded -Wall -fno-warn-tabs -O0
+  Extensions: TypeOperators
   Hs-Source-Dirs: src
-  Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
-   IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers (>= 0.5), network, async, time, mtl, transformers,
-   exceptions (>= 0.6), stm, text, unix
+  Build-Depends: 
+    base >= 4.5, base < 5,
+    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+    unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+    time, mtl, transformers, exceptions (>= 0.6), stm, text,
+    concurrent-output
 
 Library
-  GHC-Options: -Wall -fno-warn-tabs
+  GHC-Options: -Wall -fno-warn-tabs -O0
+  Extensions: TypeOperators
   Hs-Source-Dirs: src
-  Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
-   IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
-   containers (>= 0.5), network, async, time, mtl, transformers,
-   exceptions (>= 0.6), stm, text, unix
+  Build-Depends: 
+    base >= 4.5, base < 5,
+    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+    unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+    time, mtl, transformers, exceptions (>= 0.6), stm, text,
+    concurrent-output
 
   Exposed-Modules:
     Propellor
@@ -138,24 +146,29 @@ Library
     Propellor.PropAccum
     Propellor.Utilities
     Propellor.CmdLine
+    Propellor.Container
     Propellor.Info
     Propellor.Message
     Propellor.Debug
     Propellor.PrivData
     Propellor.Engine
+    Propellor.EnsureProperty
     Propellor.Exception
     Propellor.Types
+    Propellor.Types.Core
     Propellor.Types.Chroot
+    Propellor.Types.CmdLine
     Propellor.Types.Container
     Propellor.Types.Docker
     Propellor.Types.Dns
     Propellor.Types.Empty
     Propellor.Types.Info
+    Propellor.Types.MetaTypes
     Propellor.Types.OS
     Propellor.Types.PrivData
     Propellor.Types.Result
     Propellor.Types.ResultCheck
-    Propellor.Types.CmdLine
+    Propellor.Types.Singletons
     Propellor.Types.ZFS
   Other-Modules:
     Propellor.Bootstrap
@@ -193,9 +206,6 @@ Library
     Utility.ThreadScheduler
     Utility.Tmp
     Utility.UserInfo
-    System.Console.Concurrent
-    System.Console.Concurrent.Internal
-    System.Process.Concurrent
 
 source-repository head
   type: git
diff --git a/src/Propellor.hs b/src/Propellor.hs
index 9c5a85a9..a371ea44 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -14,13 +14,14 @@
 -- > main = defaultMain hosts
 -- > 
 -- > hosts :: [Host]
--- > hosts =
--- >   [ host "example.com"
+-- > hosts = [example]
+-- > 
+-- > example :: Host
+-- > example = host "example.com" $ props
 -- >     & Apt.installed ["mydaemon"]
 -- >     & "/etc/mydaemon.conf" `File.containsLine` "secure=1"
 -- >       `onChange` cmdProperty "service" ["mydaemon", "restart"]
 -- >     ! Apt.installed ["unwantedpackage"]
--- >   ]
 --
 -- See config.hs for a more complete example, and clone Propellor's
 -- git repository for a deployable system using Propellor:
@@ -38,7 +39,6 @@ module Propellor (
 	, (&)
 	, (!)
 	-- * Propertries
-	, describe
 	-- | Properties are often combined together in your propellor
 	-- configuration. For example:
 	--
@@ -47,6 +47,7 @@ module Propellor (
 	, requires
 	, before
 	, onChange
+	, describe
 	, module Propellor.Property
 	-- | Everything you need to build your own properties,
 	-- and useful property combinators
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 69eee66c..3b4c3106 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -90,6 +90,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "libghc-exceptions-dev"
 		, "libghc-stm-dev"
 		, "libghc-text-dev"
+		, "libghc-concurrent-output-dev"
 		, "make"
 		]
 	fbsddeps =
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
new file mode 100644
index 00000000..c4d6f864
--- /dev/null
+++ b/src/Propellor/Container.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+module Propellor.Container where
+
+import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
+import Propellor.Types.Info
+import Propellor.Info
+import Propellor.PrivData
+import Propellor.PropAccum
+
+class IsContainer c where
+	containerProperties :: c -> [ChildProperty]
+	containerInfo :: c -> Info
+	setContainerProperties :: c -> [ChildProperty] -> c
+
+instance IsContainer Host where
+	containerProperties = hostProperties
+	containerInfo = hostInfo
+	setContainerProperties h ps = host (hostName h) (Props ps)
+
+-- | Note that the metatype of a container's properties is not retained,
+-- so this defaults to UnixLike. So, using this with setContainerProps can
+-- add properties to a container that conflict with properties already in it.
+-- Use caution when using this; only add properties that do not have
+-- restricted targets.
+containerProps :: IsContainer c => c -> Props UnixLike
+containerProps = Props . containerProperties
+
+setContainerProps :: IsContainer c => c -> Props metatypes -> c
+setContainerProps c (Props ps) = setContainerProperties c ps
+
+-- | Adjust the provided Property, adding to its
+-- propertyChidren the properties of the provided container.
+-- 
+-- The Info of the propertyChildren is adjusted to only include 
+-- info that should be propagated out to the Property.
+--
+-- Any PrivInfo that uses HostContext is adjusted to use the name
+-- of the container as its context.
+propagateContainer
+	::
+		-- Since the children being added probably have info,
+		-- require the Property's metatypes to have info.
+		( IncludesInfo metatypes ~ 'True
+		, IsContainer c
+		)
+	=> String
+	-> c
+	-> Property metatypes
+	-> Property metatypes
+propagateContainer containername c prop = prop
+	`addChildren` map convert (containerProperties c)
+  where
+	convert p = 
+		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
+		    n' = n
+		    	`setInfoProperty` mapInfo (forceHostContext containername)
+				(propagatableInfo (getInfo p))
+		   	`addChildren` map convert (getChildren p)
+		in toChildProperty n'
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 2e914d67..f0035c40 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -1,11 +1,10 @@
 {-# LANGUAGE PackageImports #-}
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
 
 module Propellor.Engine (
 	mainProperties,
 	runPropellor,
-	ensureProperty,
-	ensureProperties,
+	ensureChildProperties,
 	fromHost,
 	fromHost',
 	onlyProcess,
@@ -23,24 +22,26 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
-import Propellor.Property
 import Utility.Exception
 
 -- | Gets the Properties of a Host, and ensures them all,
 -- with nice display of what's being done.
 mainProperties :: Host -> IO ()
 mainProperties host = do
-	ret <- runPropellor host $
-		ensureProperties [ignoreInfo $ infoProperty "overall" (ensureProperties ps) mempty mempty]
+	ret <- runPropellor host $ ensureChildProperties [toChildProperty overall]
 	messagesDone
 	case ret of
 		FailedChange -> exitWith (ExitFailure 1)
 		_ -> exitWith ExitSuccess
   where
-	ps = map ignoreInfo $ hostProperties host
+	overall :: Property (MetaTypes '[])
+	overall = property "overall" $
+		ensureChildProperties (hostProperties host)
 
 -- | Runs a Propellor action with the specified host.
 --
@@ -58,14 +59,14 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
 	(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
 	return ret
 
--- | Ensures a list of Properties, with a display of each as it runs.
-ensureProperties :: [Property NoInfo] -> Propellor Result
-ensureProperties ps = ensure ps NoChange
+-- | Ensures the child properties, with a display of each as it runs.
+ensureChildProperties :: [ChildProperty] -> Propellor Result
+ensureChildProperties ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (p:ls) rs = do
 		hn <- asks hostName
-		r <- actionMessageOn hn (propertyDesc p) (ensureProperty p)
+		r <- actionMessageOn hn (getDesc p) (catchPropellor $ getSatisfy p)
 		ensure ls (r <> rs)
 
 -- | Lifts an action into the context of a different host.
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
new file mode 100644
index 00000000..ce01d436
--- /dev/null
+++ b/src/Propellor/EnsureProperty.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Propellor.EnsureProperty
+	( ensureProperty
+	, property'
+	, OuterMetaTypesWitness(..)
+	) where
+
+import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
+import Propellor.Exception
+
+import Data.Monoid
+import Prelude
+
+-- | For when code running in the Propellor monad needs to ensure a
+-- Property.
+--
+-- Use `property'` to get the `OuterMetaTypesWithness`. For example:
+--
+-- > foo = Property Debian
+-- > foo = property' $ \w -> do
+-- > 	ensureProperty w (aptInstall "foo")
+--
+-- The type checker will prevent using ensureProperty with a property
+-- that does not support the target OSes needed by the OuterMetaTypesWitness.
+-- In the example above, aptInstall must support Debian, since foo
+-- is supposed to support Debian.
+--
+-- The type checker will also prevent using ensureProperty with a property
+-- with HasInfo in its MetaTypes. Doing so would cause the `Info` associated
+-- with the property to be lost.
+ensureProperty
+	::
+		( Cannot_ensureProperty_WithInfo inner ~ 'True
+		, (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
+		)
+	=> OuterMetaTypesWitness outer
+	-> Property (MetaTypes inner)
+	-> Propellor Result
+ensureProperty _ = catchPropellor . getSatisfy
+
+-- The name of this was chosen to make type errors a more understandable.
+type family Cannot_ensureProperty_WithInfo (l :: [a]) :: Bool
+type instance Cannot_ensureProperty_WithInfo '[] = 'True
+type instance Cannot_ensureProperty_WithInfo (t ': ts) =
+	Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts
+
+-- | Constructs a property, like `property`, but provides its
+-- `OuterMetaTypesWitness`.
+property'
+	:: SingI metatypes
+	=> Desc
+	-> (OuterMetaTypesWitness metatypes -> Propellor Result)
+	-> Property (MetaTypes metatypes)
+property' d a =
+	let p = Property sing d (a (outerMetaTypesWitness p)) mempty mempty
+	in p
+
+-- | Used to provide the metatypes of a Property to calls to 
+-- 'ensureProperty` within it.
+newtype OuterMetaTypesWitness metatypes = OuterMetaTypesWitness (MetaTypes metatypes)
+
+outerMetaTypesWitness :: Property (MetaTypes l) -> OuterMetaTypesWitness l
+outerMetaTypesWitness (Property metatypes _ _ _ _) = OuterMetaTypesWitness metatypes
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 7eb7d4a8..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,30 @@
-{-# LANGUAGE PackageImports #-}
-
-module Propellor.Info where
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
+
+module Propellor.Info (
+	osDebian,
+	osBuntish,
+	osFreeBSD,
+	setInfoProperty,
+	addInfoProperty,
+	pureInfoProperty,
+	pureInfoProperty',
+	askInfo,
+	getOS,
+	ipv4,
+	ipv6,
+	alias,
+	addDNS,
+	hostMap,
+	aliasMap,
+	findHost,
+	findHostNoAlias,
+	getAddresses,
+	hostAddresses,
+) where
 
 import Propellor.Types
 import Propellor.Types.Info
+import Propellor.Types.MetaTypes
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -13,21 +34,67 @@ import Data.Monoid
 import Control.Applicative
 import Prelude
 
-pureInfoProperty :: (IsInfo v) => Desc -> v -> Property HasInfo
-pureInfoProperty desc v = pureInfoProperty' desc (addInfo mempty v)
-
-pureInfoProperty' :: Desc -> Info -> Property HasInfo
-pureInfoProperty' desc i = infoProperty ("has " ++ desc) (return NoChange) i mempty
+-- | Adds info to a Property.
+--
+-- The new Property will include HasInfo in its metatypes.
+setInfoProperty
+	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
+	=> Property metatypes
+	-> Info
+	-> Property (MetaTypes metatypes')
+setInfoProperty (Property _ d a oldi c) newi =
+	Property sing d a (oldi <> newi) c
+
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Makes a property that does nothing but set some `Info`.
+pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
+pureInfoProperty desc v = pureInfoProperty' desc (toInfo v)
+
+pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
+pureInfoProperty' desc i = setInfoProperty p i
+  where
+	p :: Property UnixLike
+	p = property ("has " ++ desc) (return NoChange)
 
 -- | Gets a value from the host's Info.
 askInfo :: (IsInfo v) => Propellor v
-askInfo = asks (getInfo . hostInfo)
+askInfo = asks (fromInfo . hostInfo)
+
+-- | Specifies that a host's operating system is Debian,
+-- and further indicates the suite and architecture.
+-- 
+-- This provides info for other Properties, so they can act
+-- conditionally on the details of the OS.
+--
+-- It also lets the type checker know that all the properties of the
+-- host must support Debian.
+--
+-- > & osDebian (Stable "jessie") "amd64"
+osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
+osDebian suite arch = tightenTargets $ os (System (Debian suite) arch)
 
--- | Specifies the operating system of a host.
+-- | Specifies that a host's operating system is a well-known Debian
+-- derivative founded by a space tourist.
 --
--- This only provides info for other Properties, so they can act
--- conditionally on the os.
-os :: System -> Property HasInfo
+-- (The actual name of this distribution is not used in Propellor per
+-- )
+osBuntish :: Release -> Architecture -> Property (HasInfo + Buntish)
+osBuntish release arch = tightenTargets $ os (System (Buntish release) arch)
+
+-- | Specifies that a host's operating system is FreeBSD
+-- and further indicates the release and architecture.
+osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
+osFreeBSD release arch = tightenTargets $ os (System (FreeBSD release) arch)
+
+os :: System -> Property (HasInfo + UnixLike)
 os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
 
 --  Gets the operating system of a host, if it has been specified.
@@ -43,11 +110,11 @@ getOS = fromInfoVal <$> askInfo
 -- When propellor --spin is used to deploy a host, it checks
 -- if the host's IP Property matches the DNS. If the DNS is missing or
 -- out of date, the host will instead be contacted directly by IP address.
-ipv4 :: String -> Property HasInfo
+ipv4 :: String -> Property (HasInfo + UnixLike)
 ipv4 = addDNS . Address . IPv4
 
 -- | Indicate that a host has an AAAA record in the DNS.
-ipv6 :: String -> Property HasInfo
+ipv6 :: String -> Property (HasInfo + UnixLike)
 ipv6 = addDNS . Address . IPv6
 
 -- | Indicates another name for the host in the DNS.
@@ -56,14 +123,14 @@ ipv6 = addDNS . Address . IPv6
 -- to use their address, rather than using a CNAME. This avoids various
 -- problems with CNAMEs, and also means that when multiple hosts have the
 -- same alias, a DNS round-robin is automatically set up.
-alias :: Domain -> Property HasInfo
+alias :: Domain -> Property (HasInfo + UnixLike)
 alias d = pureInfoProperty' ("alias " ++ d) $ mempty
 	`addInfo` toAliasesInfo [d]
 	-- A CNAME is added here, but the DNS setup code converts it to an
 	-- IP address when that makes sense.
 	`addInfo` (toDnsInfo $ S.singleton $ CNAME $ AbsDomain d)
 
-addDNS :: Record -> Property HasInfo
+addDNS :: Record -> Property (HasInfo + UnixLike)
 addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r))
   where
 	rdesc (CNAME d) = unwords ["alias", ddesc d]
@@ -86,7 +153,7 @@ hostMap l = M.fromList $ zip (map hostName l) l
 
 aliasMap :: [Host] -> M.Map HostName Host
 aliasMap = M.fromList . concat .
-	map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h)
+	map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ fromInfo $ hostInfo h)
 
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
@@ -98,10 +165,7 @@ findAlias :: [Host] -> HostName -> Maybe Host
 findAlias l hn = M.lookup hn (aliasMap l)
 
 getAddresses :: Info -> [IPAddr]
-getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
+getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . fromInfo
 
 hostAddresses :: HostName -> [Host] -> [IPAddr]
 hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
-
-addHostInfo ::IsInfo v => Host -> v -> Host
-addHostInfo h v = h { hostInfo = addInfo (hostInfo h) v }
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index bc09f0c6..d3bb3a6d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
 
 module Propellor.PrivData (
 	withPrivData,
@@ -40,6 +42,7 @@ import Prelude
 
 import Propellor.Types
 import Propellor.Types.PrivData
+import Propellor.Types.MetaTypes
 import Propellor.Types.Info
 import Propellor.Message
 import Propellor.Info
@@ -75,29 +78,41 @@ import Utility.FileSystemEncoding
 -- being used, which is necessary to ensure that the privdata is sent to
 -- the remote host by propellor.
 withPrivData
-	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+	::
+		( IsContext c
+		, IsPrivDataSource s
+		, IncludesInfo metatypes ~ 'True
+		)
 	=> s
 	-> c
-	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property i)
-	-> Property HasInfo
+	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property metatypes)
+	-> Property metatypes
 withPrivData s = withPrivData' snd [s]
 
 -- Like withPrivData, but here any one of a list of PrivDataFields can be used.
 withSomePrivData
-	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+	::
+		( IsContext c
+		, IsPrivDataSource s
+		, IncludesInfo metatypes ~ 'True
+		)
 	=> [s]
 	-> c
-	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property i)
-	-> Property HasInfo
+	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property metatypes)
+	-> Property metatypes
 withSomePrivData = withPrivData' id
 
 withPrivData' 
-	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+	::
+		( IsContext c
+		, IsPrivDataSource s
+		, IncludesInfo metatypes ~ 'True
+		)
 	=> ((PrivDataField, PrivData) -> v)
 	-> [s]
 	-> c
-	-> (((v -> Propellor Result) -> Propellor Result) -> Property i)
-	-> Property HasInfo
+	-> (((v -> Propellor Result) -> Propellor Result) -> Property metatypes)
+	-> Property metatypes
 withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 	maybe missing (a . feed) =<< getM get fieldlist
   where
@@ -112,11 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = infoProperty
-		(propertyDesc p)
-		(propertySatisfy p)
-		(propertyInfo p `addInfo` privset)
-		(propertyChildren p)
+	addinfo p = p `addInfoProperty` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
@@ -132,7 +143,7 @@ showSet = concatMap go
 		, Just ""
 		]
 
-addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property HasInfo
+addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike)
 addPrivData v = pureInfoProperty (show v) (PrivInfo (S.singleton v))
 
 {- Gets the requested field's value, in the specified context if it's
@@ -150,7 +161,7 @@ filterPrivData :: Host -> PrivMap -> PrivMap
 filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
   where
 	used = S.map (\(f, _, c) -> (f, mkHostContext c (hostName host))) $
-		fromPrivInfo $ getInfo $ hostInfo host
+		fromPrivInfo $ fromInfo $ hostInfo host
 
 getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
 getPrivData field context m = do
@@ -234,7 +245,7 @@ mkUsedByMap = M.unionsWith (++) . map (\h -> mkPrivDataMap h $ const [hostName h
 mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a
 mkPrivDataMap host mkv = M.fromList $
 	map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d))
-		(S.toList $ fromPrivInfo $ getInfo $ hostInfo host)
+		(S.toList $ fromPrivInfo $ fromInfo $ hostInfo host)
 
 setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
 setPrivDataTo field context (PrivData value) = do
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 85a30af5..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -1,88 +1,86 @@
-{-# LANGUAGE PackageImports, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DataKinds #-}
 
 module Propellor.PropAccum
 	( host
-	, PropAccum(..)
+	, Props(..)
+	, props
 	, (&)
 	, (&^)
 	, (!)
-	, propagateContainer
 	) where
 
-import Data.Monoid
-
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Property
-import Propellor.Types.Info
-import Propellor.PrivData
 
--- | Starts accumulating the properties of a Host.
+import Data.Monoid
+import Prelude
+
+-- | Defines a host and its properties.
 --
--- > host "example.com"
+-- > host "example.com" $ props
 -- > 	& someproperty
 -- > 	! oldproperty
 -- > 	& otherproperty
-host :: HostName -> Host
-host hn = Host hn [] mempty
+host :: HostName -> Props metatypes -> Host
+host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Something that can accumulate properties.
-class PropAccum h where
-	-- | Adds a property.
-	addProp :: IsProp p => h -> p -> h
+-- | Start accumulating a list of properties.
+--
+-- Properties can be added to it using `(&)` etc.
+props :: Props UnixLike
+props = Props []
 
-	-- | Like addProp, but adds the property at the front of the list.
-	addPropFront :: IsProp p => h -> p -> h
+infixl 1 &
+infixl 1 &^
+infixl 1 !
 
-	getProperties :: h -> [Property HasInfo]
+type family GetMetaTypes x
+type instance GetMetaTypes (Property (MetaTypes t)) = MetaTypes t
+type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t
 
--- | Adds a property to a `Host` or other `PropAccum`
+-- | Adds a property to a Props.
 --
 -- Can add Properties and RevertableProperties
-(&) :: (PropAccum h, IsProp p) => h -> p -> h
-(&) = addProp
+(&)
+	::
+		( IsProp p
+		, MetaTypes y ~ GetMetaTypes p
+		, CheckCombinable x y ~ 'CanCombine
+		)
+	=> Props (MetaTypes x)
+	-> p
+	-> Props (MetaTypes (Combine x y))
+Props c & p = Props (c ++ [toChildProperty p])
 
 -- | Adds a property before any other properties.
-(&^) :: (PropAccum h, IsProp p) => h -> p -> h
-(&^) = addPropFront
+(&^)
+	::
+		( IsProp p
+		, MetaTypes y ~ GetMetaTypes p
+		, CheckCombinable x y ~ 'CanCombine
+		)
+	=> Props (MetaTypes x)
+	-> p
+	-> Props (MetaTypes (Combine x y))
+Props c &^ p = Props (toChildProperty p : c)
 
 -- | Adds a property in reverted form.
-(!) :: IsProp (RevertableProperty i) => PropAccum h => h -> RevertableProperty i -> h
-h ! p = h & revert p
+(!)
+	:: (CheckCombinable x z ~ 'CanCombine)
+	=> Props (MetaTypes x)
+	-> RevertableProperty (MetaTypes y) (MetaTypes z)
+	-> Props (MetaTypes (Combine x z))
+Props c ! p = Props (c ++ [toChildProperty (revert p)])
 
-infixl 1 &
-infixl 1 &^
-infixl 1 !
-
-instance PropAccum Host where
-	(Host hn ps is) `addProp`  p = Host hn (ps ++ [toProp p])
-		(is <> getInfoRecursive p)
-	(Host hn ps is) `addPropFront` p = Host hn (toProp p : ps)
-		(getInfoRecursive p <> is)
-	getProperties = hostProperties
-
--- | Adjust the provided Property, adding to its
--- propertyChidren the properties of the provided container.
--- 
--- The Info of the propertyChildren is adjusted to only include 
--- info that should be propagated out to the Property.
---
--- Any PrivInfo that uses HostContext is adjusted to use the name
--- of the container as its context.
-propagateContainer
-	:: (PropAccum container)
-	=> String
-	-> container
-	-> Property HasInfo
-	-> Property HasInfo
-propagateContainer containername c prop = infoProperty
-	(propertyDesc prop)
-	(propertySatisfy prop)
-	(propertyInfo prop)
-	(propertyChildren prop ++ hostprops)
-  where
-	hostprops = map go $ getProperties c
-	go p = 
-		let i = mapInfo (forceHostContext containername)
-			(propagatableInfo (propertyInfo p))
-		    cs = map go (propertyChildren p)
-		in infoProperty (propertyDesc p) (propertySatisfy p) i cs
+-- addPropsHost :: Host -> [Prop] -> Host
+-- addPropsHost (Host hn ps i) p = Host hn ps' i'
+--   where
+-- 	ps' = ps ++ [toChildProperty p]
+-- 	i' = i <> getInfoRecursive p
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index b6b8dc0d..55c39ee2 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
 
 module Propellor.Property (
 	-- * Property combinators
@@ -18,9 +22,13 @@ module Propellor.Property (
 	-- * Constructing properties
 	, Propellor
 	, property
+	, property'
+	, OuterMetaTypesWitness
 	, ensureProperty
+	, pickOS
 	, withOS
 	, unsupportedOS
+	, unsupportedOS'
 	, makeChange
 	, noChange
 	, doNothing
@@ -44,22 +52,21 @@ import Control.Monad.IfElse
 import "mtl" Control.Monad.RWS.Strict
 import System.Posix.Files
 import qualified Data.Hash.MD5 as MD5
+import Data.List
 import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.ResultCheck
+import Propellor.Types.MetaTypes
+import Propellor.Types.Singletons
 import Propellor.Info
-import Propellor.Exception
+import Propellor.EnsureProperty
 import Utility.Exception
 import Utility.Monad
 import Utility.Misc
 
--- | Constructs a Property, from a description and an action to run to
--- ensure the Property is met.
-property :: Desc -> Propellor Result -> Property NoInfo
-property d s = simpleProperty d s mempty
-
 -- | Makes a perhaps non-idempotent Property be idempotent by using a flag
 -- file to indicate whether it has run before.
 -- Use with caution.
@@ -164,13 +171,6 @@ describe = setDesc
 (==>) = flip describe
 infixl 1 ==>
 
--- | For when code running in the Propellor monad needs to ensure a
--- Property.
---
--- This can only be used on a Property that has NoInfo.
-ensureProperty :: Property NoInfo -> Propellor Result
-ensureProperty = catchPropellor . propertySatisfy
-
 -- | Tries the first property, but if it fails to work, instead uses
 -- the second.
 fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2
@@ -249,28 +249,96 @@ isNewerThan x y = do
   where
 	mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
 
--- | Makes a property that is satisfied differently depending on the host's
--- operating system. 
+-- | Picks one of the two input properties to use,
+-- depending on the targeted OS.
+--
+-- If both input properties support the targeted OS, then the
+-- first will be used.
 --
--- Note that the operating system may not be declared for all hosts.
+-- The resulting property will use the description of the first property
+-- no matter which property is used in the end. So, it's often a good
+-- idea to change the description to something clearer.
 --
--- > myproperty = withOS "foo installed" $ \o -> case o of
--- > 	(Just (System (Debian suite) arch)) -> ...
--- > 	(Just (System (Buntish release) arch)) -> ...
--- >	Nothing -> unsupportedOS
-withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
-withOS desc a = property desc $ a =<< getOS
+-- For example:
+--
+-- > upgraded :: UnixLike
+-- > upgraded = (Apt.upgraded `pickOS` Pkg.upgraded)
+-- > 	`describe` "OS upgraded"
+--
+-- If neither input property supports the targeted OS, calls
+-- `unsupportedOS`. Using the example above on a Fedora system would
+-- fail that way.
+pickOS
+	::
+		( SingKind ('KProxy :: KProxy ka)
+		, SingKind ('KProxy :: KProxy kb)
+		, DemoteRep ('KProxy :: KProxy ka) ~ [MetaType]
+		, DemoteRep ('KProxy :: KProxy kb) ~ [MetaType]
+		, SingI c
+		-- Would be nice to have this constraint, but
+		-- union will not generate metatypes lists with the same
+		-- order of OS's as is used everywhere else. So, 
+		-- would need a type-level sort.
+		--, Union a b ~ c
+		)
+	=> Property (MetaTypes (a :: ka))
+	-> Property (MetaTypes (b :: kb))
+	-> Property (MetaTypes c)
+pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
+  where
+	-- This use of getSatisfy is safe, because both a and b
+	-- are added as children, so their info will propigate.
+	c = withOS (getDesc a) $ \_ o ->
+		if matching o a
+			then getSatisfy a
+			else if matching o b
+				then getSatisfy b
+				else unsupportedOS'
+	matching Nothing _ = False
+	matching (Just o) p = 
+		Targeting (systemToTargetOS o)
+			`elem`
+		fromSing (proptype p)
+	proptype (Property t _ _ _ _) = t
+
+-- | Makes a property that is satisfied differently depending on specifics
+-- of the host's operating system.
+--
+-- > myproperty :: Property Debian
+-- > myproperty = withOS "foo installed" $ \w o -> case o of
+-- > 	(Just (System (Debian (Stable release)) arch)) -> ensureProperty w ...
+-- > 	(Just (System (Debian suite) arch)) -> ensureProperty w ...
+-- >	_ -> unsupportedOS'
+--
+-- Note that the operating system specifics may not be declared for all hosts,
+-- which is where Nothing comes in.
+withOS
+	:: (SingI metatypes)
+	=> Desc
+	-> (OuterMetaTypesWitness '[] -> Maybe System -> Propellor Result)
+	-> Property (MetaTypes metatypes)
+withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
+  where
+	-- Using this dummy value allows ensureProperty to be used
+	-- even though the inner property probably doesn't target everything
+	-- that the outer withOS property targets.
+	dummyoutermetatypes :: OuterMetaTypesWitness ('[])
+	dummyoutermetatypes = OuterMetaTypesWitness sing
+
+-- | A property that always fails with an unsupported OS error.
+unsupportedOS :: Property UnixLike
+unsupportedOS = property "unsupportedOS" unsupportedOS'
 
 -- | Throws an error, for use in `withOS` when a property is lacking
 -- support for an OS.
-unsupportedOS :: Propellor a
-unsupportedOS = go =<< getOS
-  where
-	go Nothing = error "Unknown host OS is not supported by this property."
-	go (Just o) = error $ "This property is not implemented for " ++ show o
+unsupportedOS' :: Propellor Result
+unsupportedOS' = go =<< getOS
+	  where
+		go Nothing = error "Unknown host OS is not supported by this property."
+		go (Just o) = error $ "This property is not implemented for " ++ show o
 
 -- | Undoes the effect of a RevertableProperty.
-revert :: RevertableProperty i -> RevertableProperty i
+revert :: RevertableProperty setup undo -> RevertableProperty undo setup
 revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 
 makeChange :: IO () -> Propellor Result
@@ -279,7 +347,7 @@ makeChange a = liftIO a >> return MadeChange
 noChange :: Propellor Result
 noChange = return NoChange
 
-doNothing :: Property NoInfo
+doNothing :: SingI t => Property (MetaTypes t)
 doNothing = property "noop property" noChange
 
 -- | Registers an action that should be run at the very end, after
diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs
index 47841a7b..1b28759c 100644
--- a/src/Propellor/Property/Aiccu.hs
+++ b/src/Propellor/Property/Aiccu.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
 -- | Maintainer: Jelmer Vernooij 
 
 module Propellor.Property.Aiccu (
@@ -14,10 +16,10 @@ import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
 import qualified Propellor.Property.File as File
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["aiccu"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "aiccu"
 
 confPath :: FilePath
@@ -41,12 +43,12 @@ config u t p =
 
 -- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId
 -- and sixx.net UserName.
-hasConfig :: TunnelId -> UserName -> Property HasInfo
-hasConfig t u = prop  `onChange` restarted
+hasConfig :: TunnelId -> UserName -> Property (HasInfo + DebianLike)
+hasConfig t u = prop `onChange` restarted
   where
+  	prop :: Property (HasInfo + UnixLike)
 	prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $
-		property "aiccu configured" . writeConfig
-	writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
-	writeConfig getpassword = getpassword $ ensureProperty . go
+		property' "aiccu configured" . writeConfig
+	writeConfig getpassword w = getpassword $ ensureProperty w . go
 	go (Password u', p) = confPath `File.hasContentProtected` config u' t p
 	go (f, _) = error $ "Unexpected type of privdata: " ++ show f
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index e107cb9f..f321143f 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -6,50 +6,50 @@ import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
 import qualified Propellor.Property.LetsEncrypt as LetsEncrypt
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["apache2"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "apache2"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "apache2"
 
 type ConfigLine = String
 
 type ConfigFile = [ConfigLine]
 
-siteEnabled :: Domain -> ConfigFile -> RevertableProperty NoInfo
+siteEnabled :: Domain -> ConfigFile -> RevertableProperty DebianLike DebianLike
 siteEnabled domain cf = siteEnabled' domain cf  siteDisabled domain
 
-siteEnabled' :: Domain -> ConfigFile -> Property NoInfo
-siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain)
-	[ siteAvailable domain cf
+siteEnabled' :: Domain -> ConfigFile -> Property DebianLike
+siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain) $ props
+	& siteAvailable domain cf
 		`requires` installed
 		`onChange` reloaded
-	, check (not <$> isenabled)
+	& check (not <$> isenabled)
 		(cmdProperty "a2ensite" ["--quiet", domain])
 			`requires` installed
 			`onChange` reloaded
-	]
   where
 	isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param domain]
 
-siteDisabled :: Domain -> Property NoInfo
+siteDisabled :: Domain -> Property DebianLike
 siteDisabled domain = combineProperties
 	("apache site disabled " ++ domain)
-	(map File.notPresent (siteCfg domain))
+	(toProps $ map File.notPresent (siteCfg domain))
 		`onChange` (cmdProperty "a2dissite" ["--quiet", domain] `assume` MadeChange)
 		`requires` installed
 		`onChange` reloaded
 
-siteAvailable :: Domain -> ConfigFile -> Property NoInfo
+siteAvailable :: Domain -> ConfigFile -> Property DebianLike
 siteAvailable domain cf = combineProperties ("apache site available " ++ domain) $
-	map (`File.hasContent` (comment:cf)) (siteCfg domain)
+	toProps $ map tightenTargets $
+		map (`File.hasContent` (comment:cf)) (siteCfg domain)
   where
 	comment = "# deployed with propellor, do not modify"
 
-modEnabled :: String -> RevertableProperty NoInfo
+modEnabled :: String -> RevertableProperty DebianLike DebianLike
 modEnabled modname = enable  disable
   where
 	enable = check (not <$> isenabled)
@@ -68,7 +68,7 @@ modEnabled modname = enable  disable
 --
 -- Note that ports are also specified inside a site's config file,
 -- so that also needs to be changed.
-listenPorts :: [Port] -> Property NoInfo
+listenPorts :: [Port] -> Property DebianLike
 listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps
 	`onChange` restarted
   where
@@ -89,7 +89,7 @@ siteCfg domain =
 --
 -- This was off by default in apache 2.2.22. Newver versions enable
 -- it by default. This property uses the filename used by the old version.
-multiSSL :: Property NoInfo
+multiSSL :: Property DebianLike
 multiSSL = check (doesDirectoryExist "/etc/apache2/conf.d") $
 	"/etc/apache2/conf.d/ssl" `File.hasContent`
 		[ "NameVirtualHost *:443"
@@ -129,11 +129,11 @@ type WebRoot = FilePath
 
 -- | A basic virtual host, publishing a directory, and logging to
 -- the combined apache log file. Not https capable.
-virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty NoInfo
+virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty DebianLike DebianLike
 virtualHost domain port docroot = virtualHost' domain port docroot []
 
 -- | Like `virtualHost` but with additional config lines added.
-virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty NoInfo
+virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
 virtualHost' domain port docroot addedcfg = siteEnabled domain $
 	[ ""
 	, "ServerName " ++ domain ++ ":" ++ fromPort port
@@ -159,11 +159,11 @@ virtualHost' domain port docroot addedcfg = siteEnabled domain $
 --
 -- Note that reverting this property does not remove the certificate from
 -- letsencrypt's cert store.
-httpsVirtualHost :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> RevertableProperty NoInfo
+httpsVirtualHost :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> RevertableProperty DebianLike DebianLike
 httpsVirtualHost domain docroot letos = httpsVirtualHost' domain docroot letos []
 
 -- | Like `httpsVirtualHost` but with additional config lines added.
-httpsVirtualHost' :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> [ConfigLine] -> RevertableProperty NoInfo
+httpsVirtualHost' :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
 httpsVirtualHost' domain docroot letos addedcfg = setup  teardown
   where
 	setup = setuphttp
@@ -185,13 +185,13 @@ httpsVirtualHost' domain docroot letos addedcfg = setup  teardown
 			, "RewriteRule ^/(.*) https://" ++ domain ++ "/$1 [L,R,NE]"
 			]
 	setuphttps = LetsEncrypt.letsEncrypt letos domain docroot
-		`onChange` combineProperties (domain ++ " ssl cert installed")
-			[ File.dirExists (takeDirectory cf)
-			, File.hasContent cf sslvhost
-				`onChange` reloaded
-			-- always reload since the cert has changed
-			, reloaded
-			]
+		`onChange` postsetuphttps
+	postsetuphttps = combineProperties (domain ++ " ssl cert installed") $ props
+		& File.dirExists (takeDirectory cf)
+		& File.hasContent cf sslvhost
+			`onChange` reloaded
+		-- always reload since the cert has changed
+		& reloaded
 	  where
 		cf = sslconffile "letsencrypt"
 		sslvhost = vhost (Port 443)
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 7301a6ae..1a15f72c 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -75,42 +75,41 @@ securityUpdates suite
 		in [l, srcLine l]
 	| otherwise = []
 
--- | Makes sources.list have a standard content using the mirror CDN,
+-- | Makes sources.list have a standard content using the Debian mirror CDN,
 -- with the Debian suite configured by the os.
 --
 -- Since the CDN is sometimes unreliable, also adds backup lines using
 -- kernel.org.
-stdSourcesList :: Property NoInfo
-stdSourcesList = withOS "standard sources.list" $ \o ->
-	case o of
-		(Just (System (Debian suite) _)) ->
-			ensureProperty $ stdSourcesListFor suite
-		_ -> error "os is not declared to be Debian"
-
-stdSourcesListFor :: DebianSuite -> Property NoInfo
+stdSourcesList :: Property Debian
+stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
+	(Just (System (Debian suite) _)) ->
+		ensureProperty w $ stdSourcesListFor suite
+	_ -> unsupportedOS'
+
+stdSourcesListFor :: DebianSuite -> Property Debian
 stdSourcesListFor suite = stdSourcesList' suite []
 
 -- | Adds additional sources.list generators.
 --
 -- Note that if a Property needs to enable an apt source, it's better
 -- to do so via a separate file in 
-stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property NoInfo
-stdSourcesList' suite more = setSourcesList
+stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
+stdSourcesList' suite more = tightenTargets $ setSourcesList
 	(concatMap (\gen -> gen suite) generators)
 	`describe` ("standard sources.list for " ++ show suite)
   where
 	generators = [debCdn, kernelOrg, securityUpdates] ++ more
 
-setSourcesList :: [Line] -> Property NoInfo
+setSourcesList :: [Line] -> Property DebianLike
 setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
 
-setSourcesListD :: [Line] -> FilePath -> Property NoInfo
+setSourcesListD :: [Line] -> FilePath -> Property DebianLike
 setSourcesListD ls basename = f `File.hasContent` ls `onChange` update
   where
 	f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"
 
-runApt :: [String] -> UncheckedProperty NoInfo
-runApt ps = cmdPropertyEnv "apt-get" ps noninteractiveEnv
+runApt :: [String] -> UncheckedProperty DebianLike
+runApt ps = tightenTargets $ cmdPropertyEnv "apt-get" ps noninteractiveEnv
 
 noninteractiveEnv :: [(String, String)]
 noninteractiveEnv =
@@ -118,66 +117,66 @@ noninteractiveEnv =
 		, ("APT_LISTCHANGES_FRONTEND", "none")
 		]
 
-update :: Property NoInfo
+update :: Property DebianLike
 update = runApt ["update"]
 	`assume` MadeChange
 	`describe` "apt update"
 
 -- | Have apt upgrade packages, adding new packages and removing old as
 -- necessary.
-upgrade :: Property NoInfo
+upgrade :: Property DebianLike
 upgrade = upgrade' "dist-upgrade"
 
-upgrade' :: String -> Property NoInfo
-upgrade' p = combineProperties ("apt " ++ p)
-	[ pendingConfigured
-	, runApt ["-y", p]
+upgrade' :: String -> Property DebianLike
+upgrade' p = combineProperties ("apt " ++ p) $ props
+	& pendingConfigured
+	& runApt ["-y", p]
 		`assume` MadeChange
-	]
 
 -- | Have apt upgrade packages, but never add new packages or remove
 -- old packages. Not suitable for upgrading acrocess major versions
 -- of the distribution.
-safeUpgrade :: Property NoInfo
+safeUpgrade :: Property DebianLike
 safeUpgrade = upgrade' "upgrade"
 
 -- | Have dpkg try to configure any packages that are not fully configured.
-pendingConfigured :: Property NoInfo
-pendingConfigured = cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
-	`assume` MadeChange
-	`describe` "dpkg configured pending"
+pendingConfigured :: Property DebianLike
+pendingConfigured = tightenTargets $
+	cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
+		`assume` MadeChange
+		`describe` "dpkg configured pending"
 
 type Package = String
 
-installed :: [Package] -> Property NoInfo
+installed :: [Package] -> Property DebianLike
 installed = installed' ["-y"]
 
-installed' :: [String] -> [Package] -> Property NoInfo
+installed' :: [String] -> [Package] -> Property DebianLike
 installed' params ps = robustly $ check (isInstallable ps) go
 	`describe` unwords ("apt installed":ps)
   where
 	go = runApt (params ++ ["install"] ++ ps)
 
-installedBackport :: [Package] -> Property NoInfo
-installedBackport ps = withOS desc $ \o -> case o of
+installedBackport :: [Package] -> Property Debian
+installedBackport ps = withOS desc $ \w o -> case o of
 	(Just (System (Debian suite) _)) -> case backportSuite suite of
-		Nothing -> unsupportedOS
-		Just bs -> ensureProperty $
+		Nothing -> unsupportedOS'
+		Just bs -> ensureProperty w $
 			runApt (["install", "-t", bs, "-y"] ++ ps)
 				`changesFile` dpkgStatus
-	_ -> unsupportedOS
+	_ -> unsupportedOS'
   where
 	desc = unwords ("apt installed backport":ps)
 
 -- | Minimal install of package, without recommends.
-installedMin :: [Package] -> Property NoInfo
+installedMin :: [Package] -> Property DebianLike
 installedMin = installed' ["--no-install-recommends", "-y"]
 
-removed :: [Package] -> Property NoInfo
+removed :: [Package] -> Property DebianLike
 removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps))
 	`describe` unwords ("apt removed":ps)
 
-buildDep :: [Package] -> Property NoInfo
+buildDep :: [Package] -> Property DebianLike
 buildDep ps = robustly $ go
 	`changesFile` dpkgStatus
 	`describe` unwords ("apt build-dep":ps)
@@ -187,7 +186,7 @@ buildDep ps = robustly $ go
 -- | Installs the build deps for the source package unpacked
 -- in the specifed directory, with a dummy package also
 -- installed so that autoRemove won't remove them.
-buildDepIn :: FilePath -> Property NoInfo
+buildDepIn :: FilePath -> Property DebianLike
 buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
 	`changesFile` dpkgStatus
 	`requires` installedMin ["devscripts", "equivs"]
@@ -196,14 +195,8 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
 
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
-robustly :: (Combines (Property i) (Property NoInfo)) => Property i -> Property i
-robustly p = adjustPropertySatisfy p $ \satisfy -> do
-	r <- satisfy
-	if r == FailedChange
-		-- Safe to use ignoreInfo because we're re-running
-		-- the same property.
-		then ensureProperty $ ignoreInfo $ p `requires` update
-		else return r
+robustly :: Property DebianLike -> Property DebianLike
+robustly p = p `fallback` (update `before` p)
 
 isInstallable :: [Package] -> IO Bool
 isInstallable ps = do
@@ -228,13 +221,13 @@ isInstalled' ps = (mapMaybe parse . lines) <$> policy
 		environ <- addEntry "LANG" "C" <$> getEnvironment
 		readProcessEnv "apt-cache" ("policy":ps) (Just environ)
 
-autoRemove :: Property NoInfo
+autoRemove :: Property DebianLike
 autoRemove = runApt ["-y", "autoremove"]
 	`changesFile` dpkgStatus
 	`describe` "apt autoremove"
 
 -- | Enables unattended upgrades. Revert to disable.
-unattendedUpgrades :: RevertableProperty NoInfo
+unattendedUpgrades :: RevertableProperty DebianLike DebianLike
 unattendedUpgrades = enable  disable
   where
 	enable = setup True
@@ -253,11 +246,12 @@ unattendedUpgrades = enable  disable
 			| enabled = "true"
 			| otherwise = "false"
 
-	configure = withOS "unattended upgrades configured" $ \o ->
+	configure :: Property DebianLike
+	configure = withOS "unattended upgrades configured" $ \w o ->
 		case o of
 			-- the package defaults to only upgrading stable
 			(Just (System (Debian suite) _))
-				| not (isStable suite) -> ensureProperty $
+				| not (isStable suite) -> ensureProperty w $
 					"/etc/apt/apt.conf.d/50unattended-upgrades"
 						`File.containsLine`
 					("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
@@ -269,10 +263,13 @@ type DebconfTemplateValue = String
 
 -- | Preseeds debconf values and reconfigures the package so it takes
 -- effect.
-reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property NoInfo
-reConfigure package vals = reconfigure `requires` setselections
-	`describe` ("reconfigure " ++ package)
+reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
+reConfigure package vals = tightenTargets $ 
+	reconfigure 
+		`requires` setselections
+		`describe` ("reconfigure " ++ package)
   where
+	setselections :: Property DebianLike
 	setselections = property "preseed" $
 		if null vals
 			then noChange
@@ -289,7 +286,7 @@ reConfigure package vals = reconfigure `requires` setselections
 --
 -- Assumes that there is a 1:1 mapping between service names and apt
 -- package names.
-serviceInstalledRunning :: Package -> Property NoInfo
+serviceInstalledRunning :: Package -> Property DebianLike
 serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
 
 data AptKey = AptKey
@@ -297,10 +294,10 @@ data AptKey = AptKey
 	, pubkey :: String
 	}
 
-trustsKey :: AptKey -> RevertableProperty NoInfo
+trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
 trustsKey k = trustsKey' k  untrustKey k
 
-trustsKey' :: AptKey -> Property NoInfo
+trustsKey' :: AptKey -> Property DebianLike
 trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 	withHandle StdinHandle createProcessSuccess
 		(proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
@@ -311,21 +308,21 @@ trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 	desc = "apt trusts key " ++ keyname k
 	f = aptKeyFile k
 
-untrustKey :: AptKey -> Property NoInfo
-untrustKey = File.notPresent . aptKeyFile
+untrustKey :: AptKey -> Property DebianLike
+untrustKey = tightenTargets . File.notPresent . aptKeyFile
 
 aptKeyFile :: AptKey -> FilePath
 aptKeyFile k = "/etc/apt/trusted.gpg.d"  keyname k ++ ".gpg"
 
 -- | Cleans apt's cache of downloaded packages to avoid using up disk
 -- space.
-cacheCleaned :: Property NoInfo
-cacheCleaned = cmdProperty "apt-get" ["clean"]
+cacheCleaned :: Property DebianLike
+cacheCleaned = tightenTargets $ cmdProperty "apt-get" ["clean"]
 	`assume` NoChange
 	`describe` "apt cache cleaned"
 
 -- | Add a foreign architecture to dpkg and apt.
-hasForeignArch :: String -> Property NoInfo
+hasForeignArch :: String -> Property DebianLike
 hasForeignArch arch = check notAdded (add `before` update)
 	`describe` ("dpkg has foreign architecture " ++ arch)
   where
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 378836e8..09047ce5 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -19,9 +19,11 @@ module Propellor.Property.Chroot (
 ) where
 
 import Propellor.Base
+import Propellor.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
+import Propellor.Types.Core
 import Propellor.Property.Chroot.Util
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
@@ -40,24 +42,24 @@ import System.Console.Concurrent
 data Chroot where
 	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
 
+instance IsContainer Chroot where
+	containerProperties (Chroot _ _ h) = containerProperties h
+	containerInfo (Chroot _ _ h) = containerInfo h
+	setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
+
 chrootSystem :: Chroot -> Maybe System
-chrootSystem (Chroot _ _ h) = fromInfoVal (getInfo (hostInfo h))
+chrootSystem = fromInfoVal . fromInfo . containerInfo
 
 instance Show Chroot where
 	show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
 
-instance PropAccum Chroot where
-	(Chroot l c h) `addProp` p = Chroot l c (h & p)
-	(Chroot l c h) `addPropFront` p = Chroot l c (h `addPropFront` p)
-	getProperties (Chroot _ _ h) = hostProperties h
-
 -- | Class of things that can do initial bootstrapping of an operating
 -- System in a chroot.
 class ChrootBootstrapper b where
 	-- | Do initial bootstrapping of an operating system in a chroot.
 	-- If the operating System is not supported, return
 	-- Left error message.
-	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property HasInfo)
+	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux)
 
 -- | Use this to bootstrap a chroot by extracting a tarball.
 --
@@ -68,14 +70,14 @@ class ChrootBootstrapper b where
 data ChrootTarball = ChrootTarball FilePath
 
 instance ChrootBootstrapper ChrootTarball where
-	buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
-
-extractTarball :: FilePath -> FilePath -> Property HasInfo
-extractTarball target src = toProp .
-	check (unpopulated target) $
-		cmdProperty "tar" params
-			`assume` MadeChange
-			`requires` File.dirExists target
+	buildchroot (ChrootTarball tb) _ loc = Right $
+		tightenTargets $ extractTarball loc tb
+
+extractTarball :: FilePath -> FilePath -> Property UnixLike
+extractTarball target src = check (unpopulated target) $
+	cmdProperty "tar" params
+		`assume` MadeChange
+		`requires` File.dirExists target
   where
 	params =
 		[ "-C"
@@ -92,28 +94,27 @@ instance ChrootBootstrapper Debootstrapped where
 		(Just s@(System (Debian _) _)) -> Right $ debootstrap s
 		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
 		(Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap."
-		Nothing -> Left "Cannot debootstrap; `os` property not specified"
+		Nothing -> Left "Cannot debootstrap; OS not specified"
 	  where
 		debootstrap s = Debootstrap.built loc s cf
 
 -- | Defines a Chroot at the given location, built with debootstrap.
 --
 -- Properties can be added to configure the Chroot. At a minimum,
--- add the `os` property to specify the operating system to bootstrap.
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
 --
--- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev"
--- >	& os (System (Debian Unstable) "amd64")
+-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props
+-- >	& osDebian Unstable "amd64"
 -- >	& Apt.installed ["ghc", "haskell-platform"]
 -- >	& ...
-debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
+debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
 debootstrapped conf = bootstrapped (Debootstrapped conf)
 
 -- | Defines a Chroot at the given location, bootstrapped with the
 -- specified ChrootBootstrapper.
-bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Chroot
-bootstrapped bootstrapper location = Chroot location bootstrapper h
-  where
-	h = Host location [] mempty
+bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
+bootstrapped bootstrapper location ps = Chroot location bootstrapper (host location ps)
 
 -- | Ensures that the chroot exists and is provisioned according to its
 -- properties.
@@ -121,43 +122,44 @@ bootstrapped bootstrapper location = Chroot location bootstrapper h
 -- Reverting this property removes the chroot. Anything mounted inside it
 -- is first unmounted. Note that it does not ensure that any processes
 -- that might be running inside the chroot are stopped.
-provisioned :: Chroot -> RevertableProperty HasInfo
+provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
 provisioned c = provisioned' (propagateChrootInfo c) c False
 
-provisioned' :: (Property HasInfo -> Property HasInfo) -> Chroot -> Bool -> RevertableProperty HasInfo
+provisioned'
+	:: (Property Linux -> Property (HasInfo + Linux))
+	-> Chroot
+	-> Bool
+	-> RevertableProperty (HasInfo + Linux) Linux
 provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
-	(propigator $ propertyList (chrootDesc c "exists") [setup])
+	(propigator $ setup `describe` chrootDesc c "exists")
 		
-	(propertyList (chrootDesc c "removed") [teardown])
+	(teardown `describe` chrootDesc c "removed")
   where
+	setup :: Property Linux
 	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
-		`requires` toProp built
+		`requires` built
 
 	built = case buildchroot bootstrapper (chrootSystem c) loc of
 		Right p -> p
 		Left e -> cantbuild e
 
-	cantbuild e = infoProperty (chrootDesc c "built") (error e) mempty []
+	cantbuild e = property (chrootDesc c "built") (error e)
 
+	teardown :: Property Linux
 	teardown = check (not <$> unpopulated loc) $
 		property ("removed " ++ loc) $
 			makeChange (removeChroot loc)
 
-propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo
-propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
-  where
-	p' = infoProperty
-		(propertyDesc p)
-		(propertySatisfy p)
-		(propertyInfo p <> chrootInfo c)
-		(propertyChildren p)
+propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
+propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
+	p `setInfoProperty` chrootInfo c
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ h) = mempty `addInfo`
 	mempty { _chroots = M.singleton loc h }
 
 -- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo
+propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
 propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
 	let d = localdir  shimdir c
 	let me = localdir  "propellor"
@@ -205,7 +207,7 @@ chain :: [Host] -> CmdLine -> IO ()
 chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 	case findHostNoAlias hostlist hn of
 		Nothing -> errorMessage ("cannot find host " ++ hn)
-		Just parenthost -> case M.lookup loc (_chroots $ getInfo $ hostInfo parenthost) of
+		Just parenthost -> case M.lookup loc (_chroots $ fromInfo $ hostInfo parenthost) of
 			Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
 			Just h -> go h
   where
@@ -213,11 +215,10 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 		changeWorkingDirectory localdir
 		when onconsole forceConsole
 		onlyProcess (provisioningLock loc) $ do
-			r <- runPropellor (setInChroot h) $ ensureProperties $
+			r <- runPropellor (setInChroot h) $ ensureChildProperties $
 				if systemdonly
-					then [Systemd.installed]
-					else map ignoreInfo $
-						hostProperties h
+					then [toChildProperty Systemd.installed]
+					else hostProperties h
 			flushConcurrentOutput
 			putStrLn $ "\n" ++ show r
 chain _ _ = errorMessage "bad chain command"
@@ -255,15 +256,17 @@ chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
 -- from being started, which is often something you want to prevent when
 -- building a chroot.
 --
--- This is accomplished by installing a  script
--- that does not let any daemons be started by packages that use
+-- On Debian, this is accomplished by installing a 
+-- script that does not let any daemons be started by packages that use
 -- invoke-rc.d. Reverting the property removes the script.
-noServices :: RevertableProperty NoInfo
+--
+-- This property has no effect on non-Debian systems.
+noServices :: RevertableProperty UnixLike UnixLike
 noServices = setup  teardown
   where
 	f = "/usr/sbin/policy-rc.d"
 	script = [ "#!/bin/sh", "exit 101" ]
-	setup = combineProperties "no services started"
+	setup = combineProperties "no services started" $ toProps
 		[ File.hasContent f script
 		, File.mode f (combineModes (readModes ++ executeModes))
 		]
diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs
index 6da2e643..6b84acb5 100644
--- a/src/Propellor/Property/Cmd.hs
+++ b/src/Propellor/Property/Cmd.hs
@@ -58,10 +58,10 @@ import Utility.Process (createProcess, CreateProcess, waitForProcess)
 -- | A property that can be satisfied by running a command.
 --
 -- The command must exit 0 on success.
-cmdProperty :: String -> [String] -> UncheckedProperty NoInfo
+cmdProperty :: String -> [String] -> UncheckedProperty UnixLike
 cmdProperty cmd params = cmdProperty' cmd params id
 
-cmdProperty' :: String -> [String] -> (CreateProcess -> CreateProcess) -> UncheckedProperty NoInfo
+cmdProperty' :: String -> [String] -> (CreateProcess -> CreateProcess) -> UncheckedProperty UnixLike
 cmdProperty' cmd params mkprocess = unchecked $ property desc $ liftIO $
 	cmdResult <$> boolSystem' cmd (map Param params) mkprocess
   where
@@ -74,7 +74,7 @@ cmdResult True = NoChange
 -- | A property that can be satisfied by running a command,
 -- with added environment variables in addition to the standard
 -- environment.
-cmdPropertyEnv :: String -> [String] -> [(String, String)] -> UncheckedProperty NoInfo
+cmdPropertyEnv :: String -> [String] -> [(String, String)] -> UncheckedProperty UnixLike
 cmdPropertyEnv cmd params env = unchecked $ property desc $ liftIO $ do
 	env' <- addEntries env <$> getEnvironment
 	cmdResult <$> boolSystemEnv cmd (map Param params) (Just env')
@@ -85,14 +85,14 @@ cmdPropertyEnv cmd params env = unchecked $ property desc $ liftIO $ do
 type Script = [String]
 
 -- | A property that can be satisfied by running a script.
-scriptProperty :: Script -> UncheckedProperty NoInfo
+scriptProperty :: Script -> UncheckedProperty UnixLike
 scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
   where
 	shellcmd = intercalate " ; " ("set -e" : script)
 
 -- | A property that can satisfied by running a script
 -- as user (cd'd to their home directory).
-userScriptProperty :: User -> Script -> UncheckedProperty NoInfo
+userScriptProperty :: User -> Script -> UncheckedProperty UnixLike
 userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user]
   where
 	shellcmd = intercalate " ; " ("set -e" : "cd" : script)
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index 74afecc4..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
 ) where
 
 import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 
 import Control.Concurrent
 import qualified Control.Concurrent.Async as A
@@ -77,8 +79,8 @@ concurrently p1 p2 = (combineWith go go p1 p2)
 --
 -- The above example will run foo and bar concurrently, and once either of
 -- those 2 properties finishes, will start running baz.
-concurrentList :: IO Int -> Desc -> PropList -> Property HasInfo
-concurrentList getn d (PropList ps) = infoProperty d go mempty ps
+concurrentList :: SingI metatypes => IO Int -> Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+concurrentList getn d (Props ps) = property d go `addChildren` ps
   where
 	go = do
 		n <- liftIO getn
@@ -97,15 +99,11 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps
 			(p:rest) -> return (rest, Just p)
 		case v of
 			Nothing -> return r
-			-- This use of propertySatisfy does not lose any
-			-- Info asociated with the property, because
-			-- concurrentList sets all the properties as
-			-- children, and so propigates their info.
 			Just p -> do
 				hn <- asks hostName
 				r' <- actionMessageOn hn
-					(propertyDesc p)
-					(propertySatisfy p)
+					(getDesc p)
+					(getSatisfy p)
 				worker q (r <> r')
 
 -- | Run an action with the number of capabiities increased as necessary to
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index 0d275b91..8aa18d20 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}
 
 -- | This module adds conductors to propellor. A conductor is a Host that
 -- is responsible for running propellor on other hosts
@@ -73,7 +73,8 @@ module Propellor.Property.Conductor (
 	Conductable(..),
 ) where
 
-import Propellor.Base hiding (os)
+import Propellor.Base
+import Propellor.Container
 import Propellor.Spin (spin')
 import Propellor.PrivData.Paths
 import Propellor.Types.Info
@@ -82,21 +83,22 @@ import qualified Propellor.Property.Ssh as Ssh
 import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
 class Conductable c where
-	conducts :: c -> RevertableProperty HasInfo
+	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
-	-- | Conduct the specified host.
 	conducts h = conductorFor h  notConductorFor h
 
--- | Each host in the list will be conducted in turn. Failure to conduct
--- one host does not prevent conducting subsequent hosts in the list, but
--- will be propagated as an overall failure of the property.
 instance Conductable [Host] where
 	conducts hs = 
-		propertyList desc (map (toProp . conducts) hs)
+		propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
 			
-		propertyList desc (map (toProp . revert . conducts) hs)
+		propertyList desc (toProps $ map (undoRevertableProperty . conducts) hs)
 	  where
 		desc = cdesc $ unwords $ map hostName hs
 
@@ -126,7 +128,7 @@ mkOrchestra = fromJust . go S.empty
   where
 	go seen h
 		| S.member (hostName h) seen = Nothing -- break loop
-		| otherwise = Just $ case getInfo (hostInfo h) of
+		| otherwise = Just $ case fromInfo (hostInfo h) of
 			ConductorFor [] -> Conducted h
 			ConductorFor l -> 
 				let seen' = S.insert (hostName h) seen
@@ -214,14 +216,15 @@ orchestrate :: [Host] -> [Host]
 orchestrate hs = map go hs
   where
 	go h
-		| isOrchestrated (getInfo (hostInfo h)) = h
+		| isOrchestrated (fromInfo (hostInfo h)) = h
 		| otherwise = foldl orchestrate' (removeold h) (map (deloop h) os)
 	os = extractOrchestras hs
 
 	removeold h = foldl removeold' h (oldconductorsof h)
-	removeold' h oldconductor = h & revert (conductedBy oldconductor)
+	removeold' h oldconductor = setContainerProps h $ containerProps h
+		! conductedBy oldconductor
 
-	oldconductors = zip hs (map (getInfo . hostInfo) hs)
+	oldconductors = zip hs (map (fromInfo . hostInfo) hs)
 	oldconductorsof h = flip mapMaybe oldconductors $ 
 		\(oldconductor, NotConductorFor l) ->
 			if any (sameHost h) l
@@ -232,7 +235,9 @@ orchestrate' :: Host -> Orchestra -> Host
 orchestrate' h (Conducted _) = h
 orchestrate' h (Conductor c l)
 	| sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l)
-	| any (sameHost h) (map topHost l) = cont $ h & conductedBy c
+	| any (sameHost h) (map topHost l) = cont $
+		setContainerProps h $ containerProps h
+			& conductedBy c
 	| otherwise = cont h
   where
 	cont h' = foldl orchestrate' h' l
@@ -240,14 +245,16 @@ orchestrate' h (Conductor c l)
 -- The host this property is added to becomes the conductor for the
 -- specified Host. Note that `orchestrate` must be used for this property
 -- to have any effect.
-conductorFor :: Host -> Property HasInfo
-conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
-	`requires` toProp (conductorKnownHost h)
+conductorFor :: Host -> Property (HasInfo + UnixLike)
+conductorFor h = go
+	`setInfoProperty` (toInfo (ConductorFor [h]))
+	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
 	desc = cdesc (hostName h)
 
-	go = ifM (isOrchestrated <$> askInfo)
+	go :: Property UnixLike
+	go = property desc $ ifM (isOrchestrated <$> askInfo)
 		( do
 			pm <- liftIO $ filterPrivData h
 				<$> readPrivDataFile privDataLocal
@@ -262,13 +269,15 @@ conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
 		)
 
 -- Reverts conductorFor.
-notConductorFor :: Host -> Property HasInfo
-notConductorFor h = infoProperty desc (return NoChange) (addInfo mempty (NotConductorFor [h])) []
-	`requires` toProp (revert (conductorKnownHost h))
+notConductorFor :: Host -> Property (HasInfo + UnixLike)
+notConductorFor h = (doNothing :: Property UnixLike)
+	`setInfoProperty` (toInfo (NotConductorFor [h]))
+	`describe` desc
+	`requires` undoRevertableProperty (conductorKnownHost h)
   where
 	desc = "not " ++ cdesc (hostName h)
 
-conductorKnownHost :: Host -> RevertableProperty NoInfo
+conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
 conductorKnownHost h = 
 	mk Ssh.knownHost
 		
@@ -287,10 +296,10 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
 	i = mempty 
 		`addInfo` mconcat (map privinfo hs)
 		`addInfo` Orchestrated (Any True)
-	privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h')
+	privinfo h' = forceHostContext (hostName h') $ fromInfo (hostInfo h')
 
 -- Use this property to let the specified conductor ssh in and run propellor.
-conductedBy :: Host -> RevertableProperty NoInfo
+conductedBy :: Host -> RevertableProperty UnixLike UnixLike
 conductedBy h = (setup  teardown)
 	`describe` ("conducted by " ++ hostName h)
   where
diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs
index dac4e564..270e04f1 100644
--- a/src/Propellor/Property/ConfFile.hs
+++ b/src/Propellor/Property/ConfFile.hs
@@ -37,7 +37,7 @@ adjustSection
 	-> AdjustSection
 	-> InsertSection
 	-> FilePath
-	-> Property NoInfo
+	-> Property UnixLike
 adjustSection desc start past adjust insert = fileProperty desc go
   where
 	go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls
@@ -68,7 +68,7 @@ adjustIniSection
 	-> AdjustSection
 	-> InsertSection
 	-> FilePath
-	-> Property NoInfo
+	-> Property UnixLike
 adjustIniSection desc header =
 	adjustSection
 	desc
@@ -77,7 +77,7 @@ adjustIniSection desc header =
 
 -- | Ensures that a .ini file exists and contains a section
 -- with a key=value setting.
-containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property NoInfo
+containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
 containsIniSetting f (header, key, value) =
 	adjustIniSection
 	(f ++ " section [" ++ header ++ "] contains " ++ key ++ "=" ++ value)
@@ -93,7 +93,7 @@ containsIniSetting f (header, key, value) =
 	isKeyVal x = (filter (/= ' ') . takeWhile (/= '=')) x `elem` [key, '#':key]
 
 -- | Ensures that a .ini file does not contain the specified section.
-lacksIniSection :: FilePath -> IniSection -> Property NoInfo
+lacksIniSection :: FilePath -> IniSection -> Property UnixLike
 lacksIniSection f header =
 	adjustIniSection
 	(f ++ " lacks section [" ++ header ++ "]")
diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs
index 365e2903..0966a7e5 100644
--- a/src/Propellor/Property/Cron.hs
+++ b/src/Propellor/Property/Cron.hs
@@ -27,9 +27,11 @@ data Times
 -- job file.
 --
 -- The cron job's output will only be emailed if it exits nonzero.
-job :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo
-job desc times (User u) cddir command = combineProperties ("cronned " ++ desc)
-	[ cronjobfile `File.hasContent`
+job :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike
+job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) $ props
+	& Apt.serviceInstalledRunning "cron"
+	& Apt.installed ["util-linux", "moreutils"]
+	& cronjobfile `File.hasContent`
 		[ case times of
 			Times _ -> ""
 			_ -> "#!/bin/sh\nset -e"
@@ -44,22 +46,19 @@ job desc times (User u) cddir command = combineProperties ("cronned " ++ desc)
 				"root" -> "chronic " ++ shellEscape scriptfile
 				_ -> "chronic su " ++ u ++ " -c " ++ shellEscape scriptfile
 		]
-	, case times of
+	& case times of
 		Times _ -> doNothing
 		_ -> cronjobfile `File.mode` combineModes (readModes ++ executeModes)
 	-- Use a separate script because it makes the cron job name
 	-- prettier in emails, and also allows running the job manually.
-	, scriptfile `File.hasContent`
+	& scriptfile `File.hasContent`
 		[ "#!/bin/sh"
 		, "# Generated by propellor"
 		, "set -e"
 		, "flock -n " ++ shellEscape cronjobfile
 			++ " sh -c " ++ shellEscape cmdline
 		]
-	, scriptfile `File.mode` combineModes (readModes ++ executeModes)
-	]
-	`requires` Apt.serviceInstalledRunning "cron"
-	`requires` Apt.installed ["util-linux", "moreutils"]
+	& scriptfile `File.mode` combineModes (readModes ++ executeModes)
   where
 	cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )"
 	cronjobfile = "/etc"  cronjobdir  name
@@ -75,13 +74,13 @@ job desc times (User u) cddir command = combineProperties ("cronned " ++ desc)
 		| otherwise = '_'
 
 -- | Installs a cron job, and runs it niced and ioniced.
-niceJob :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo
+niceJob :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike
 niceJob desc times user cddir command = job desc times user cddir
 	("nice ionice -c 3 sh -c " ++ shellEscape command)
 
 -- | Installs a cron job to run propellor.
-runPropellor :: Times -> Property NoInfo
-runPropellor times = withOS "propellor cron job" $ \o -> 
-	ensureProperty $
+runPropellor :: Times -> Property UnixLike
+runPropellor times = withOS "propellor cron job" $ \w o -> 
+	ensureProperty w $
 		niceJob "propellor" times (User "root") localdir
 			(bootstrapPropellorCommand o ++ "; ./propellor")
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index eea7b96f..b86d8e0b 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -119,19 +119,17 @@ debianMirrorKeyring k m = m { _debianMirrorKeyring = k }
 debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror
 debianMirrorRsyncExtra r m = m { _debianMirrorRsyncExtra = r }
 
-mirror :: DebianMirror -> Property NoInfo
-mirror mirror' = propertyList
-	("Debian mirror " ++ dir)
-	[ Apt.installed ["debmirror"]
-	, User.accountFor (User "debmirror")
-	, File.dirExists dir
-	, File.ownerGroup dir (User "debmirror") (Group "debmirror")
-	, check (not . and <$> mapM suitemirrored suites)
+mirror :: DebianMirror -> Property DebianLike
+mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props
+	& Apt.installed ["debmirror"]
+	& User.accountFor (User "debmirror")
+	& File.dirExists dir
+	& File.ownerGroup dir (User "debmirror") (Group "debmirror")
+	& check (not . and <$> mapM suitemirrored suites)
 		(cmdProperty "debmirror" args)
 			`describe` "debmirror setup"
-	, Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/" $
-		unwords ("/usr/bin/debmirror" : args)
-	]
+	& Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/"
+		(unwords ("/usr/bin/debmirror" : args))
   where
 	dir = _debianMirrorDir mirror'
 	suites = _debianMirrorSuites mirror'
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 5716be38..e0c56966 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE FlexibleContexts #-}
-
 module Propellor.Property.Debootstrap (
 	Url,
 	DebootstrapConfig(..),
@@ -48,14 +46,15 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2
 --
 -- The System can be any OS and architecture that debootstrap
 -- and the kernel support.
-built :: FilePath -> System -> DebootstrapConfig -> Property HasInfo
-built target system config = built' (toProp installed) target system config
+built :: FilePath -> System -> DebootstrapConfig -> Property Linux
+built target system config = built' (setupRevertableProperty installed) target system config
 
-built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)
+built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property Linux
 built' installprop target system@(System _ arch) config =
 	check (unpopulated target <||> ispartial) setupprop
 		`requires` installprop
   where
+	setupprop :: Property Linux
 	setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
 		createDirectoryIfMissing True target
 		-- Don't allow non-root users to see inside the chroot,
@@ -99,39 +98,34 @@ extractSuite (System (FreeBSD _) _) = Nothing
 -- When necessary, falls back to installing debootstrap from source.
 -- Note that installation from source is done by downloading the tarball
 -- from a Debian mirror, with no cryptographic verification.
-installed :: RevertableProperty NoInfo
+installed :: RevertableProperty Linux Linux
 installed = install  remove
   where
-	install = withOS "debootstrap installed" $ \o ->
-		ifM (liftIO $ isJust <$> programPath)
-			( return NoChange
-			, ensureProperty (installon o)
-			)
+	install = check (isJust <$> programPath) $
+		(aptinstall `pickOS` sourceInstall)
+			`describe` "debootstrap installed"
 
-	installon (Just (System (Debian _) _)) = aptinstall
-	installon (Just (System (Buntish _) _)) = aptinstall
-	installon _ = sourceInstall
-
-	remove = withOS "debootstrap removed" $ ensureProperty . removefrom
-	removefrom (Just (System (Debian _) _)) = aptremove
-	removefrom (Just (System (Buntish _) _)) = aptremove
-	removefrom _ = sourceRemove
+	remove = (aptremove `pickOS` sourceRemove)
+		`describe` "debootstrap removed"
 
 	aptinstall = Apt.installed ["debootstrap"]
 	aptremove = Apt.removed ["debootstrap"]
 
-sourceInstall :: Property NoInfo
-sourceInstall = property "debootstrap installed from source" (liftIO sourceInstall')
+sourceInstall :: Property Linux
+sourceInstall = go
 	`requires` perlInstalled
 	`requires` arInstalled
+  where
+	go :: Property Linux
+	go = property "debootstrap installed from source" (liftIO sourceInstall')
 
-perlInstalled :: Property NoInfo
+perlInstalled :: Property Linux
 perlInstalled = check (not <$> inPath "perl") $ property "perl installed" $
 	liftIO $ toResult . isJust <$> firstM id
 		[ yumInstall "perl"
 		]
 
-arInstalled :: Property NoInfo
+arInstalled :: Property Linux
 arInstalled = check (not <$> inPath "ar") $ property "ar installed" $
 	liftIO $ toResult . isJust <$> firstM id
 		[ yumInstall "binutils"
@@ -175,7 +169,7 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
 				return MadeChange
 			_ -> errorMessage "debootstrap tar file did not contain exactly one dirctory"
 
-sourceRemove :: Property NoInfo
+sourceRemove :: Property Linux
 sourceRemove = property "debootstrap not installed from source" $ liftIO $
 	ifM (doesDirectoryExist sourceInstallDir)
 		( do
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 6200f856..718768c2 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -2,6 +2,8 @@
 --
 -- This module is designed to be imported unqualified.
 
+{-# LANGUAGE TypeFamilies #-}
+
 module Propellor.Property.DiskImage (
 	-- * Partition specification
 	module Propellor.Property.DiskImage.PartSpec,
@@ -30,6 +32,7 @@ import Propellor.Property.Parted
 import Propellor.Property.Mount
 import Propellor.Property.Partition
 import Propellor.Property.Rsync
+import Propellor.Container
 import Utility.Path
 
 import Data.List (isPrefixOf, isInfixOf, sortBy)
@@ -51,7 +54,8 @@ type DiskImage = FilePath
 --
 -- > import Propellor.Property.DiskImage
 --
--- > let chroot d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d
+-- > let chroot d = Chroot.debootstrapped mempty d
+-- >	& osDebian Unstable "amd64"
 -- >	& Apt.installed ["linux-image-amd64"]
 -- >	& User.hasPassword (User "root")
 -- >	& User.accountFor (User "demo")
@@ -76,44 +80,54 @@ type DiskImage = FilePath
 -- chroot while the disk image is being built, which should prevent any
 -- daemons that are included from being started on the system that is
 -- building the disk image.
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
 imageBuilt = imageBuilt' False
 
 -- | Like 'built', but the chroot is deleted and rebuilt from scratch each
 -- time. This is more expensive, but useful to ensure reproducible results
 -- when the properties of the chroot have been changed.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
 imageRebuilt = imageBuilt' True
 
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty HasInfo
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
 imageBuilt' rebuild img mkchroot tabletype final partspec = 
 	imageBuiltFrom img chrootdir tabletype final partspec
 		`requires` Chroot.provisioned chroot
-		`requires` (cleanrebuild  doNothing)
+		`requires` (cleanrebuild  (doNothing :: Property UnixLike))
 		`describe` desc
   where
 	desc = "built disk image " ++ img
+	cleanrebuild :: Property Linux
 	cleanrebuild
 		| rebuild = property desc $ do
 			liftIO $ removeChroot chrootdir
 			return MadeChange
 		| otherwise = doNothing
 	chrootdir = img ++ ".chroot"
-	chroot = mkchroot chrootdir
-		-- Before ensuring any other properties of the chroot, avoid
-		-- starting services. Reverted by imageFinalized.
-		&^ Chroot.noServices
-		-- First stage finalization.
-		& fst final
-		-- Avoid wasting disk image space on the apt cache
-		& Apt.cacheCleaned
+	chroot =
+		let c = mkchroot chrootdir
+		in setContainerProps c $ containerProps c
+			-- Before ensuring any other properties of the chroot,
+			-- avoid starting services. Reverted by imageFinalized.
+			&^ Chroot.noServices
+			-- First stage finalization.
+			& fst final
+			& cachesCleaned
+
+-- | This property is automatically added to the chroot when building a
+-- disk image. It cleans any caches of information that can be omitted;
+-- eg the apt cache on Debian.
+cachesCleaned :: Property UnixLike
+cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
+  where
+	skipit = doNothing :: Property UnixLike
 
 -- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty NoInfo
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
 imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
   where
 	desc = img ++ " built from " ++ chrootdir
-	mkimg = property desc $ do
+	mkimg = property' desc $ \w -> do
 		-- unmount helper filesystems such as proc from the chroot
 		-- before getting sizes
 		liftIO $ unmountBelow chrootdir
@@ -123,7 +137,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
 		-- tie the knot!
 		let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $
 			map (calcsz mnts) mnts
-		ensureProperty $
+		ensureProperty w $
 			imageExists img (partTableSize parttable)
 				`before`
 			partitioned YesReallyDeleteDiskContents img parttable
@@ -135,17 +149,18 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg  rmimg
 		imageFinalized final mnts mntopts devs parttable
 	rmimg = File.notPresent img
 
-partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property NoInfo
-partitionsPopulated chrootdir mnts mntopts devs = property desc $ mconcat $ zipWith3 go mnts mntopts devs
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
+partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w -> 
+	mconcat $ zipWith3 (go w) mnts mntopts devs
   where
 	desc = "partitions populated from " ++ chrootdir
 
-	go Nothing _ _ = noChange
-	go (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
+	go _ Nothing _ _ = noChange
+	go w (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
 		(liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir mntopt)
 		(const $ liftIO $ umountLazy tmpdir)
 		$ \ismounted -> if ismounted
-			then ensureProperty $
+			then ensureProperty w $
 				syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir
 			else return FailedChange
 
@@ -203,7 +218,7 @@ getMountSz szm l (Just mntpt) =
 -- If the file doesn't exist, or is too small, creates a new one, full of 0's.
 --
 -- If the file is too large, truncates it down to the specified size.
-imageExists :: FilePath -> ByteSize -> Property NoInfo
+imageExists :: FilePath -> ByteSize -> Property Linux
 imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
 	ms <- catchMaybeIO $ getFileStatus img
 	case ms of
@@ -226,19 +241,19 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
 -- 
 -- It's ok if the second property leaves additional things mounted
 -- in the partition tree.
-type Finalization = (Property NoInfo, (FilePath -> [LoopDev] -> Property NoInfo))
+type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
 
-imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property NoInfo
+imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
 imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = 
-	property "disk image finalized" $ 
+	property' "disk image finalized" $ \w ->
 		withTmpDir "mnt" $ \top -> 
-			go top `finally` liftIO (unmountall top)
+			go w top `finally` liftIO (unmountall top)
   where
-	go top = do
+	go w top = do
 		liftIO $ mountall top
 		liftIO $ writefstab top
 		liftIO $ allowservices top
-		ensureProperty $ final top devs
+		ensureProperty w $ final top devs
 	
 	-- Ordered lexographically by mount point, so / comes before /usr
 	-- comes before /usr/local
@@ -280,27 +295,26 @@ noFinalization = (doNothing, \_ _ -> doNothing)
 grubBooted :: Grub.BIOS -> Finalization
 grubBooted bios = (Grub.installed' bios, boots)
   where
-	boots mnt loopdevs = combineProperties "disk image boots using grub"
+	boots mnt loopdevs = combineProperties "disk image boots using grub" $ props
 		-- bind mount host /dev so grub can access the loop devices
-		[ bindMount "/dev" (inmnt "/dev")
-		, mounted "proc" "proc" (inmnt "/proc") mempty
-		, mounted "sysfs" "sys" (inmnt "/sys") mempty
+		& bindMount "/dev" (inmnt "/dev")
+		& mounted "proc" "proc" (inmnt "/proc") mempty
+		& mounted "sysfs" "sys" (inmnt "/sys") mempty
 		-- update the initramfs so it gets the uuid of the root partition
-		, inchroot "update-initramfs" ["-u"]
+		& inchroot "update-initramfs" ["-u"]
 			`assume` MadeChange
 		-- work around for http://bugs.debian.org/802717
-		, check haveosprober $ inchroot "chmod" ["-x", osprober]
-		, inchroot "update-grub" []
+		& check haveosprober (inchroot "chmod" ["-x", osprober])
+		& inchroot "update-grub" []
 			`assume` MadeChange
-		, check haveosprober $ inchroot "chmod" ["+x", osprober]
-		, inchroot "grub-install" [wholediskloopdev]
+		& check haveosprober (inchroot "chmod" ["+x", osprober])
+		& inchroot "grub-install" [wholediskloopdev]
 			`assume` MadeChange
 		-- sync all buffered changes out to the disk image
 		-- may not be necessary, but seemed needed sometimes
 		-- when using the disk image right away.
-		, cmdProperty "sync" []
+		& cmdProperty "sync" []
 			`assume` NoChange
-		]
 	  where
 	  	-- cannot use  since the filepath is absolute
 		inmnt f = mnt ++ f
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index adc12930..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -60,7 +60,7 @@ import Data.List
 --
 -- In either case, the secondary dns server Host should have an ipv4 and/or
 -- ipv6 property defined.
-primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty HasInfo
+primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
 primary hosts domain soa rs = setup  cleanup
   where
 	setup = setupPrimary zonefile id hosts domain soa rs
@@ -70,7 +70,7 @@ primary hosts domain soa rs = setup  cleanup
 
 	zonefile = "/etc/bind/propellor/db." ++ domain
 
-setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property HasInfo
+setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property (HasInfo + DebianLike)
 setupPrimary zonefile mknamedconffile hosts domain soa rs =
 	withwarnings baseprop
 		`requires` servingZones
@@ -80,9 +80,10 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 	indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
 
 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
-	baseprop = infoProperty ("dns primary for " ++ domain) satisfy
-		(mempty `addInfo` addNamedConf conf) []
-	satisfy = do
+	baseprop = primaryprop
+		`setInfoProperty` (toInfo (addNamedConf conf))
+	primaryprop :: Property DebianLike
+	primaryprop = property ("dns primary for " ++ domain) $ do
 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
 		let zone = partialzone
 			{ zHosts = zHosts partialzone ++ rs ++ sshfps }
@@ -120,11 +121,13 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 				in z /= oldzone || oldserial < sSerial (zSOA zone)
 
 
-cleanupPrimary :: FilePath -> Domain -> Property NoInfo
+cleanupPrimary :: FilePath -> Domain -> Property DebianLike
 cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
-	property ("removed dns primary for " ++ domain)
-		(makeChange $ removeZoneFile zonefile)
-		`requires` namedConfWritten
+	go `requires` namedConfWritten
+  where
+	desc = "removed dns primary for " ++ domain
+	go :: Property DebianLike
+	go = property desc (makeChange $ removeZoneFile zonefile)
 
 -- | Primary dns server for a domain, secured with DNSSEC.
 --
@@ -152,7 +155,7 @@ cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
 -- This is different from the serial number used by 'primary', so if you
 -- want to later disable DNSSEC you will need to adjust the serial number
 -- passed to mkSOA to ensure it is larger.
-signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty HasInfo
+signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
 signedPrimary recurrance hosts domain soa rs = setup  cleanup
   where
 	setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
@@ -184,12 +187,12 @@ signedPrimary recurrance hosts domain soa rs = setup  cleanup
 --
 -- Note that if a host is declared to be a primary and a secondary dns
 -- server for the same domain, the primary server config always wins.
-secondary :: [Host] -> Domain -> RevertableProperty HasInfo
+secondary :: [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
 secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
 
 -- | This variant is useful if the primary server does not have its DNS
 -- configured via propellor.
-secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty HasInfo
+secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
 secondaryFor masters hosts domain = setup  cleanup
   where
 	setup = pureInfoProperty desc (addNamedConf conf)
@@ -210,7 +213,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
 otherServers wantedtype hosts domain =
 	M.keys $ M.filter wanted $ hostMap hosts
   where
-	wanted h = case M.lookup domain (fromNamedConfMap $ getInfo $ hostInfo h) of
+	wanted h = case M.lookup domain (fromNamedConfMap $ fromInfo $ hostInfo h) of
 		Nothing -> False
 		Just conf -> confDnsServerType conf == wantedtype
 			&& confDomain conf == domain
@@ -218,15 +221,15 @@ otherServers wantedtype hosts domain =
 -- | Rewrites the whole named.conf.local file to serve the zones
 -- configured by `primary` and `secondary`, and ensures that bind9 is
 -- running.
-servingZones :: Property NoInfo
+servingZones :: Property DebianLike
 servingZones = namedConfWritten
 	`onChange` Service.reloaded "bind9"
 	`requires` Apt.serviceInstalledRunning "bind9"
 
-namedConfWritten :: Property NoInfo
-namedConfWritten = property "named.conf configured" $ do
+namedConfWritten :: Property DebianLike
+namedConfWritten = property' "named.conf configured" $ \w -> do
 	zs <- getNamedConf
-	ensureProperty $
+	ensureProperty w $
 		hasContent namedConfFile $
 			concatMap confStanza $ M.elems zs
 
@@ -465,7 +468,7 @@ genZone inzdomain hostmap zdomain soa =
 	-- So we can just use the IPAddrs.
 	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
 	addcnames h = concatMap gen $ filter (inDomain zdomain) $
-		mapMaybe getCNAME $ S.toList $ fromDnsInfo $ getInfo info
+		mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
 	  where
 		info = hostInfo h
 		gen c = case getAddresses info of
@@ -480,7 +483,7 @@ genZone inzdomain hostmap zdomain soa =
 	  where
 		info = hostInfo h
 		l = zip (repeat $ AbsDomain $ hostName h)
-			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ getInfo info))
+			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ fromInfo info))
 
 	-- Simplifies the list of hosts. Remove duplicate entries.
 	-- Also, filter out any CHAMES where the same domain has an
@@ -515,7 +518,7 @@ addNamedConf conf = NamedConfMap (M.singleton domain conf)
 	domain = confDomain conf
 
 getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks $ fromNamedConfMap . getInfo . hostInfo
+getNamedConf = asks $ fromNamedConfMap . fromInfo . hostInfo
 
 -- | Generates SSHFP records for hosts in the domain (or with CNAMES
 -- in the domain) that have configured ssh public keys.
@@ -528,7 +531,7 @@ genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)
 	gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
 	mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)
 		(AbsDomain hostname : cnames)
-	cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ getInfo info
+	cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
 	hostname = hostName h
 	info = hostInfo h
 
diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs
index 1ba459e6..aa58dc60 100644
--- a/src/Propellor/Property/DnsSec.hs
+++ b/src/Propellor/Property/DnsSec.hs
@@ -7,13 +7,13 @@ import qualified Propellor.Property.File as File
 --
 -- signedPrimary uses this, so this property does not normally need to be
 -- used directly.
-keysInstalled :: Domain -> RevertableProperty HasInfo
+keysInstalled :: Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
 keysInstalled domain = setup  cleanup
   where
-	setup = propertyList "DNSSEC keys installed" $
+	setup = propertyList "DNSSEC keys installed" $ toProps $
 		map installkey keys
 
-	cleanup = propertyList "DNSSEC keys removed" $
+	cleanup = propertyList "DNSSEC keys removed" $ toProps $
 		map (File.notPresent . keyFn domain) keys
 
 	installkey k = writer (keysrc k) (keyFn domain k) (Context domain)
@@ -37,12 +37,14 @@ keysInstalled domain = setup  cleanup
 --
 -- signedPrimary uses this, so this property does not normally need to be
 -- used directly.
-zoneSigned :: Domain -> FilePath -> RevertableProperty HasInfo
+zoneSigned :: Domain -> FilePath -> RevertableProperty (HasInfo + UnixLike) UnixLike
 zoneSigned domain zonefile = setup  cleanup
   where
+	setup :: Property (HasInfo + UnixLike)
 	setup = check needupdate (forceZoneSigned domain zonefile)
 		`requires` keysInstalled domain
 	
+	cleanup :: Property UnixLike
 	cleanup = File.notPresent (signedZoneFile zonefile)
 		`before` File.notPresent dssetfile
 		`before` revert (keysInstalled domain)
@@ -63,7 +65,7 @@ zoneSigned domain zonefile = setup  cleanup
 		t2 <- getModificationTime f
 		return (t2 >= t1)
 
-forceZoneSigned :: Domain -> FilePath -> Property NoInfo
+forceZoneSigned :: Domain -> FilePath -> Property UnixLike
 forceZoneSigned domain zonefile = property ("zone signed for " ++ domain) $ liftIO $ do
 	salt <- take 16 <$> saltSha1
  	let p = proc "dnssec-signzone"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ebc0b301..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}
 
 -- | Docker support for propellor
 --
@@ -48,8 +48,10 @@ module Propellor.Property.Docker (
 import Propellor.Base hiding (init)
 import Propellor.Types.Docker
 import Propellor.Types.Container
+import Propellor.Types.Core
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
+import Propellor.Container
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Cmd as Cmd
@@ -66,16 +68,17 @@ import Data.List.Utils
 import qualified Data.Map as M
 import System.Console.Concurrent
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["docker.io"]
 
 -- | Configures docker with an authentication file, so that images can be
 -- pushed to index.docker.io. Optional.
-configured :: Property HasInfo
+configured :: Property (HasInfo + DebianLike)
 configured = prop `requires` installed
   where
+	prop :: Property (HasInfo + DebianLike)
 	prop = withPrivData src anyContext $ \getcfg ->
-		property "docker configured" $ getcfg $ \cfg -> ensureProperty $
+		property' "docker configured" $ \w -> getcfg $ \cfg -> ensureProperty w $
 			"/root/.dockercfg" `File.hasContent` privDataLines cfg
 	src = PrivDataSourceFileFromCommand DockerAuthentication
 		"/root/.dockercfg" "docker login"
@@ -88,6 +91,11 @@ type ContainerName = String
 -- | A docker container.
 data Container = Container Image Host
 
+instance IsContainer Container where
+	containerProperties (Container _ h) = containerProperties h
+	containerInfo (Container _ h) = containerInfo h
+	setContainerProperties (Container i h) ps = Container i (setContainerProperties h ps)
+
 class HasImage a where
 	getImageName :: a -> Image
 
@@ -97,22 +105,17 @@ instance HasImage Image where
 instance HasImage Container where
 	getImageName (Container i _) = i
 
-instance PropAccum Container where
-	(Container i h) `addProp` p = Container i (h `addProp` p)
-	(Container i h) `addPropFront` p = Container i (h `addPropFront` p)
-	getProperties (Container _ h) = hostProperties h
-
 -- | Defines a Container with a given name, image, and properties.
--- Properties can be added to configure the Container.
+-- Add properties to configure the Container.
 --
--- > container "web-server" "debian"
+-- > container "web-server" (latestImage "debian") $ props
 -- >    & publish "80:80"
 -- >    & Apt.installed {"apache2"]
 -- >    & ...
-container :: ContainerName -> Image -> Container
-container cn image = Container image (Host cn [] info)
+container :: ContainerName -> Image -> Props metatypes -> Container
+container cn image (Props ps) = Container image (Host cn ps info)
   where
-	info = dockerInfo mempty
+	info = dockerInfo mempty <> mconcat (map getInfoRecursive ps)
 
 -- | Ensures that a docker container is set up and running.
 --
@@ -124,7 +127,7 @@ container cn image = Container image (Host cn [] info)
 --
 -- Reverting this property ensures that the container is stopped and
 -- removed.
-docked :: Container -> RevertableProperty HasInfo
+docked :: Container -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 docked ctr@(Container _ h) =
 	(propagateContainerInfo ctr (go "docked" setup))
 		
@@ -132,11 +135,12 @@ docked ctr@(Container _ h) =
   where
 	cn = hostName h
 
-	go desc a = property (desc ++ " " ++ cn) $ do
+	go desc a = property' (desc ++ " " ++ cn) $ \w -> do
 		hn <- asks hostName
 		let cid = ContainerId hn cn
-		ensureProperties [a cid (mkContainerInfo cid ctr)]
+		ensureProperty w $ a cid (mkContainerInfo cid ctr)
 
+	setup :: ContainerId -> ContainerInfo -> Property Linux
 	setup cid (ContainerInfo image runparams) =
 		provisionContainer cid
 			`requires`
@@ -144,8 +148,9 @@ docked ctr@(Container _ h) =
 			`requires`
 		installed
 
+	teardown :: ContainerId -> ContainerInfo -> Property Linux
 	teardown cid (ContainerInfo image _runparams) =
-		combineProperties ("undocked " ++ fromContainerId cid)
+		combineProperties ("undocked " ++ fromContainerId cid) $ toProps
 			[ stoppedContainer cid
 			, property ("cleaned up " ++ fromContainerId cid) $
 				liftIO $ report <$> mapM id
@@ -155,32 +160,32 @@ docked ctr@(Container _ h) =
 			]
 
 -- | Build the image from a directory containing a Dockerfile.
-imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo
-imageBuilt directory ctr = describe built msg
+imageBuilt :: HasImage c => FilePath -> c -> Property Linux
+imageBuilt directory ctr = built `describe` msg
   where
 	msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory
-	built = Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir
-		`assume` MadeChange
+	built :: Property Linux
+	built = tightenTargets $
+		Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir
+			`assume` MadeChange
 	workDir p = p { cwd = Just directory }
 	image = getImageName ctr
 
 -- | Pull the image from the standard Docker Hub registry.
-imagePulled :: HasImage c => c -> Property NoInfo
-imagePulled ctr = describe pulled msg
+imagePulled :: HasImage c => c -> Property Linux
+imagePulled ctr = pulled `describe` msg
   where
 	msg = "docker image " ++ (imageIdentifier image) ++ " pulled"
-	pulled = Cmd.cmdProperty dockercmd ["pull", imageIdentifier image]
-		`assume` MadeChange
+	pulled :: Property Linux
+	pulled = tightenTargets $ 
+		Cmd.cmdProperty dockercmd ["pull", imageIdentifier image]
+			`assume` MadeChange
 	image = getImageName ctr
 
-propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo
-propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
+propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
+propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
+	p `addInfoProperty` dockerinfo
   where
-	p' = infoProperty
-		(propertyDesc p)
-		(propertySatisfy p)
-		(propertyInfo p <> dockerinfo)
-		(propertyChildren p)
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
 	cn = hostName h
@@ -191,8 +196,8 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
   where
 	runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
 		(_dockerRunParams info)
-	info = getInfo $ hostInfo h'
-	h' = h
+	info = fromInfo $ hostInfo h'
+	h' = setContainerProps h $ containerProps h
 		-- Restart by default so container comes up on
 		-- boot or when docker is upgraded.
 		&^ restartAlways
@@ -209,14 +214,15 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
 -- that were not set up using propellor.
 --
 -- Generally, should come after the properties for the desired containers.
-garbageCollected :: Property NoInfo
-garbageCollected = propertyList "docker garbage collected"
-	[ gccontainers
-	, gcimages
-	]
+garbageCollected :: Property Linux
+garbageCollected = propertyList "docker garbage collected" $ props
+	& gccontainers
+	& gcimages
   where
+	gccontainers :: Property Linux
 	gccontainers = property "docker containers garbage collected" $
 		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
+	gcimages :: Property Linux
 	gcimages = property "docker images garbage collected" $
 		liftIO $ report <$> (mapM removeImage =<< listImages)
 
@@ -225,8 +231,8 @@ garbageCollected = propertyList "docker garbage collected"
 -- Currently, this consists of making pam_loginuid lines optional in
 -- the pam config, to work around 
 -- which affects docker 1.2.0.
-tweaked :: Property NoInfo
-tweaked = cmdProperty "sh"
+tweaked :: Property Linux
+tweaked = tightenTargets $ cmdProperty "sh"
 	[ "-c"
 	, "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"
 	]
@@ -239,10 +245,11 @@ tweaked = cmdProperty "sh"
 -- other GRUB_CMDLINE_LINUX_DEFAULT settings.
 --
 -- Only takes effect after reboot. (Not automated.)
-memoryLimited :: Property NoInfo
-memoryLimited = "/etc/default/grub" `File.containsLine` cfg
-	`describe` "docker memory limited"
-	`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
+memoryLimited :: Property DebianLike
+memoryLimited = tightenTargets $
+	"/etc/default/grub" `File.containsLine` cfg
+		`describe` "docker memory limited"
+		`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
   where
 	cmdline = "cgroup_enable=memory swapaccount=1"
 	cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
@@ -300,15 +307,15 @@ instance ImageIdentifier ImageUID where
 	imageIdentifier (ImageUID uid) = uid
 
 -- | Set custom dns server for container.
-dns :: String -> Property HasInfo
+dns :: String -> Property (HasInfo + Linux)
 dns = runProp "dns"
 
 -- | Set container host name.
-hostname :: String -> Property HasInfo
+hostname :: String -> Property (HasInfo + Linux)
 hostname = runProp "hostname"
 
 -- | Set name of container.
-name :: String -> Property HasInfo
+name :: String -> Property (HasInfo + Linux)
 name = runProp "name"
 
 class Publishable p where
@@ -322,15 +329,15 @@ instance Publishable String where
 	toPublish = id
 
 -- | Publish a container's port to the host
-publish :: Publishable p => p -> Property HasInfo
+publish :: Publishable p => p -> Property (HasInfo + Linux)
 publish = runProp "publish" . toPublish
 
 -- | Expose a container's port without publishing it.
-expose :: String -> Property HasInfo
+expose :: String -> Property (HasInfo + Linux)
 expose = runProp "expose"
 
 -- | Username or UID for container.
-user :: String -> Property HasInfo
+user :: String -> Property (HasInfo + Linux)
 user = runProp "user"
 
 class Mountable p where
@@ -346,17 +353,17 @@ instance Mountable String where
 	toMount = id
 
 -- | Mount a volume
-volume :: Mountable v => v -> Property HasInfo
+volume :: Mountable v => v -> Property (HasInfo + Linux)
 volume = runProp "volume" . toMount
 
 -- | Mount a volume from the specified container into the current
 -- container.
-volumes_from :: ContainerName -> Property HasInfo
+volumes_from :: ContainerName -> Property (HasInfo + Linux)
 volumes_from cn = genProp "volumes-from" $ \hn ->
 	fromContainerId (ContainerId hn cn)
 
 -- | Work dir inside the container.
-workdir :: String -> Property HasInfo
+workdir :: String -> Property (HasInfo + Linux)
 workdir = runProp "workdir"
 
 -- | Memory limit for container.
@@ -364,18 +371,18 @@ workdir = runProp "workdir"
 --
 -- Note: Only takes effect when the host has the memoryLimited property
 -- enabled.
-memory :: String -> Property HasInfo
+memory :: String -> Property (HasInfo + Linux)
 memory = runProp "memory"
 
 -- | CPU shares (relative weight).
 --
 -- By default, all containers run at the same priority, but you can tell
 -- the kernel to give more CPU time to a container using this property.
-cpuShares :: Int -> Property HasInfo
+cpuShares :: Int -> Property (HasInfo + Linux)
 cpuShares = runProp "cpu-shares" . show
 
 -- | Link with another container on the same host.
-link :: ContainerName -> ContainerAlias -> Property HasInfo
+link :: ContainerName -> ContainerAlias -> Property (HasInfo + Linux)
 link linkwith calias = genProp "link" $ \hn ->
 	fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias
 
@@ -387,24 +394,24 @@ type ContainerAlias = String
 -- propellor; as well as keeping badly behaved containers running,
 -- it ensures that containers get started back up after reboot or
 -- after docker is upgraded.
-restartAlways :: Property HasInfo
+restartAlways :: Property (HasInfo + Linux)
 restartAlways = runProp "restart" "always"
 
 -- | Docker will restart the container if it exits nonzero.
 -- If a number is provided, it will be restarted only up to that many
 -- times.
-restartOnFailure :: Maybe Int -> Property HasInfo
+restartOnFailure :: Maybe Int -> Property (HasInfo + Linux)
 restartOnFailure Nothing = runProp "restart" "on-failure"
 restartOnFailure (Just n) = runProp "restart" ("on-failure:" ++ show n)
 
 -- | Makes docker not restart a container when it exits
 -- Note that this includes not restarting it on boot!
-restartNever :: Property HasInfo
+restartNever :: Property (HasInfo + Linux)
 restartNever = runProp "restart" "no"
 
 -- | Set environment variable with a tuple composed by the environment
 -- variable name and its value.
-environment :: (String, String) -> Property HasInfo
+environment :: (String, String) -> Property (HasInfo + Linux)
 environment (k, v) = runProp "env" $ k ++ "=" ++ v
 
 -- | A container is identified by its name, and the host
@@ -441,9 +448,9 @@ myContainerSuffix = ".propellor"
 containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
 containerDesc cid p = p `describe` desc
   where
-	desc = "container " ++ fromContainerId cid ++ " " ++ propertyDesc p
+	desc = "container " ++ fromContainerId cid ++ " " ++ getDesc p
 
-runningContainer :: ContainerId -> Image -> [RunParam] -> Property NoInfo
+runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux
 runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
 	l <- liftIO $ listContainers RunningContainers
 	if cid `elem` l
@@ -507,6 +514,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 				retry (n-1) a
 			_ -> return v
 
+	go :: ImageIdentifier i => i -> Propellor Result
 	go img = liftIO $ do
 		clearProvisionedFlag cid
 		createDirectoryIfMissing True (takeDirectory $ identFile cid)
@@ -558,7 +566,7 @@ init s = case toContainerId s of
 
 -- | Once a container is running, propellor can be run inside
 -- it to provision it.
-provisionContainer :: ContainerId -> Property NoInfo
+provisionContainer :: ContainerId -> Property Linux
 provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
 	let shim = Shim.file (localdir  "propellor") (localdir  shimdir cid)
 	let params = ["--continue", show $ toChain cid]
@@ -580,16 +588,14 @@ chain hostlist hn s = case toContainerId s of
 	Nothing -> errorMessage "bad container id"
 	Just cid -> case findHostNoAlias hostlist hn of
 		Nothing -> errorMessage ("cannot find host " ++ hn)
-		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ getInfo $ hostInfo parenthost) of
+		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ fromInfo $ hostInfo parenthost) of
 			Nothing -> errorMessage ("cannot find container " ++ containerName cid ++ " docked on host " ++ hn)
 			Just h -> go cid h
   where
 	go cid h = do
 		changeWorkingDirectory localdir
 		onlyProcess (provisioningLock cid) $ do
-			r <- runPropellor h $ ensureProperties $
-				map ignoreInfo $
-					hostProperties h
+			r <- runPropellor h $ ensureChildProperties $ hostProperties h
 			flushConcurrentOutput
 			putStrLn $ "\n" ++ show r
 
@@ -599,15 +605,16 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
 startContainer :: ContainerId -> IO Bool
 startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ]
 
-stoppedContainer :: ContainerId -> Property NoInfo
-stoppedContainer cid = containerDesc cid $ property desc $
+stoppedContainer :: ContainerId -> Property Linux
+stoppedContainer cid = containerDesc cid $ property' desc $ \w ->
 	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
-		( liftIO cleanup `after` ensureProperty
-			(property desc $ liftIO $ toResult <$> stopContainer cid)
+		( liftIO cleanup `after` ensureProperty w stop
 		, return NoChange
 		)
   where
 	desc = "stopped"
+	stop :: Property Linux
+	stop = property desc $ liftIO $ toResult <$> stopContainer cid
 	cleanup = do
 		nukeFile $ identFile cid
 		removeDirectoryRecursive $ shimdir cid
@@ -651,14 +658,14 @@ listContainers status =
 listImages :: IO [ImageUID]
 listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
-runProp :: String -> RunParam -> Property HasInfo
-runProp field val = pureInfoProperty (param) $
+runProp :: String -> RunParam -> Property (HasInfo + Linux)
+runProp field val = tightenTargets $ pureInfoProperty (param) $
 	mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] }
   where
 	param = field++"="++val
 
-genProp :: String -> (HostName -> RunParam) -> Property HasInfo
-genProp field mkval = pureInfoProperty field $
+genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux)
+genProp field mkval = tightenTargets $ pureInfoProperty field $
 	mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] }
 
 dockerInfo :: DockerInfo -> Info
diff --git a/src/Propellor/Property/Fail2Ban.hs b/src/Propellor/Property/Fail2Ban.hs
index 716d376f..9f147943 100644
--- a/src/Propellor/Property/Fail2Ban.hs
+++ b/src/Propellor/Property/Fail2Ban.hs
@@ -5,24 +5,24 @@ import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
 import Propellor.Property.ConfFile
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.serviceInstalledRunning "fail2ban"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "fail2ban"
 
 type Jail = String
 
 -- | By default, fail2ban only enables the ssh jail, but many others
 -- are available to be enabled, for example "postfix-sasl"
-jailEnabled :: Jail -> Property NoInfo
+jailEnabled :: Jail -> Property DebianLike
 jailEnabled name = jailConfigured name "enabled" "true"
 	`onChange` reloaded
 
 -- | Configures a jail. For example:
 --
 -- > jailConfigured "sshd" "port" "2222"
-jailConfigured :: Jail -> IniKey -> String -> Property NoInfo
+jailConfigured :: Jail -> IniKey -> String -> Property UnixLike
 jailConfigured name key value = 
 	jailConfFile name `containsIniSetting` (name, key, value)
 
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 3021617c..e072fcaa 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -9,14 +9,14 @@ import System.Exit
 type Line = String
 
 -- | Replaces all the content of a file.
-hasContent :: FilePath -> [Line] -> Property NoInfo
+hasContent :: FilePath -> [Line] -> Property UnixLike
 f `hasContent` newcontent = fileProperty
 	("replace " ++ f)
 	(\_oldcontent -> newcontent) f
 
 -- | Replaces all the content of a file, ensuring that its modes do not
 -- allow it to be read or written by anyone other than the current user
-hasContentProtected :: FilePath -> [Line] -> Property NoInfo
+hasContentProtected :: FilePath -> [Line] -> Property UnixLike
 f `hasContentProtected` newcontent = fileProperty' writeFileProtected 
 	("replace " ++ f)
 	(\_oldcontent -> newcontent) f
@@ -25,38 +25,38 @@ f `hasContentProtected` newcontent = fileProperty' writeFileProtected
 --
 -- The file's permissions are preserved if the file already existed.
 -- Otherwise, they're set to 600.
-hasPrivContent :: IsContext c => FilePath -> c -> Property HasInfo
+hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
 hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f
 
 -- | Like hasPrivContent, but allows specifying a source
 -- for PrivData, rather than using PrivDataSourceFile .
-hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property HasInfo
+hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
 hasPrivContentFrom = hasPrivContent' writeFileProtected
 
 -- | Leaves the file at its default or current mode,
 -- allowing "private" data to be read.
 --
 -- Use with caution!
-hasPrivContentExposed :: IsContext c => FilePath -> c -> Property HasInfo
+hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
 hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f
 
-hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property HasInfo
+hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
 hasPrivContentExposedFrom = hasPrivContent' writeFile
 
-hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property HasInfo
+hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
 hasPrivContent' writer source f context = 
 	withPrivData source context $ \getcontent -> 
-		property desc $ getcontent $ \privcontent -> 
-			ensureProperty $ fileProperty' writer desc
+		property' desc $ \o -> getcontent $ \privcontent -> 
+			ensureProperty o $ fileProperty' writer desc
 				(\_oldcontent -> privDataLines privcontent) f
   where
 	desc = "privcontent " ++ f
 
 -- | Ensures that a line is present in a file, adding it to the end if not.
-containsLine :: FilePath -> Line -> Property NoInfo
+containsLine :: FilePath -> Line -> Property UnixLike
 f `containsLine` l = f `containsLines` [l]
 
-containsLines :: FilePath -> [Line] -> Property NoInfo
+containsLines :: FilePath -> [Line] -> Property UnixLike
 f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
   where
 	go content = content ++ filter (`notElem` content) ls
@@ -64,27 +64,28 @@ f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
 -- | Ensures that a line is not present in a file.
 -- Note that the file is ensured to exist, so if it doesn't, an empty
 -- file will be written.
-lacksLine :: FilePath -> Line -> Property NoInfo
+lacksLine :: FilePath -> Line -> Property UnixLike
 f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
 
-lacksLines :: FilePath -> [Line] -> Property NoInfo
+lacksLines :: FilePath -> [Line] -> Property UnixLike
 f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
 
 -- | Replaces the content of a file with the transformed content of another file
-basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property NoInfo
-f `basedOn` (f', a) = property desc $ go =<< (liftIO $ readFile f')
+basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike
+f `basedOn` (f', a) = property' desc $ \o -> do
+	tmpl <- liftIO $ readFile f'
+	ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f
   where
 	desc = "replace " ++ f
-	go tmpl = ensureProperty $ fileProperty desc (\_ -> a $ lines $ tmpl) f
 
 -- | Removes a file. Does not remove symlinks or non-plain-files.
-notPresent :: FilePath -> Property NoInfo
+notPresent :: FilePath -> Property UnixLike
 notPresent f = check (doesFileExist f) $ property (f ++ " not present") $ 
 	makeChange $ nukeFile f
 
-fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property NoInfo
+fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
 fileProperty = fileProperty' writeFile
-fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property NoInfo
+fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
 fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
   where
 	go True = do
@@ -103,7 +104,7 @@ fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
 		setOwnerAndGroup f' (fileOwner s) (fileGroup s)
 
 -- | Ensures a directory exists.
-dirExists :: FilePath -> Property NoInfo
+dirExists :: FilePath -> Property UnixLike
 dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
 	makeChange $ createDirectoryIfMissing True d
 
@@ -113,7 +114,7 @@ newtype LinkTarget = LinkTarget FilePath
 -- | Creates or atomically updates a symbolic link.
 --
 -- Does not overwrite regular files or directories.
-isSymlinkedTo :: FilePath -> LinkTarget -> Property NoInfo
+isSymlinkedTo :: FilePath -> LinkTarget -> Property UnixLike
 link `isSymlinkedTo` (LinkTarget target) = property desc $
 	go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link)
   where
@@ -135,7 +136,7 @@ link `isSymlinkedTo` (LinkTarget target) = property desc $
 	updateLink = createSymbolicLink target `viaStableTmp` link
 
 -- | Ensures that a file is a copy of another (regular) file.
-isCopyOf :: FilePath -> FilePath -> Property NoInfo
+isCopyOf :: FilePath -> FilePath -> Property UnixLike
 f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f')
   where
 	desc = f ++ " is copy of " ++ f'
@@ -156,7 +157,7 @@ f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f')
 		[Param "--preserve=all", Param "--", File src, File dest]
 
 -- | Ensures that a file/dir has the specified owner and group.
-ownerGroup :: FilePath -> User -> Group -> Property NoInfo
+ownerGroup :: FilePath -> User -> Group -> Property UnixLike
 ownerGroup f (User owner) (Group group) = p `describe` (f ++ " owner " ++ og)
   where
 	p = cmdProperty "chown" [og, f]
@@ -164,7 +165,7 @@ ownerGroup f (User owner) (Group group) = p `describe` (f ++ " owner " ++ og)
 	og = owner ++ ":" ++ group
 
 -- | Ensures that a file/dir has the specfied mode.
-mode :: FilePath -> FileMode -> Property NoInfo
+mode :: FilePath -> FileMode -> Property UnixLike
 mode f v = p `changesFile` f
   where
 	p = property (f ++ " mode " ++ show v) $ do
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index fa1f95d4..ce0befcd 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -26,10 +26,10 @@ import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Network as Network
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["iptables"]
 
-rule :: Chain -> Table -> Target -> Rules -> Property NoInfo
+rule :: Chain -> Table -> Target -> Rules -> Property Linux
 rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable
   where
 	r = Rule c tb tg rs
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6bbd2570..704c1db9 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -22,8 +22,8 @@ runPkg cmd args =
 	in
 		lines <$> readProcess p a
 
-pkgCmdProperty :: String -> [String] -> UncheckedProperty NoInfo
-pkgCmdProperty cmd args =
+pkgCmdProperty :: String -> [String] -> UncheckedProperty FreeBSD
+pkgCmdProperty cmd args = tightenTargets $ 
 	let
 		(p, a) = pkgCommand cmd args
 	in
@@ -44,13 +44,14 @@ instance IsInfo PkgUpdate where
 pkgUpdated :: PkgUpdate -> Bool
 pkgUpdated (PkgUpdate _) = True
 
-update :: Property HasInfo
+update :: Property (HasInfo + FreeBSD)
 update =
 	let
 		upd = pkgCmd "update" []
 		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
-		infoProperty "pkg update has run" go (addInfo mempty (PkgUpdate "")) []
+		(property "pkg update has run" go :: Property FreeBSD)
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
 	deriving (Typeable, Monoid, Show)
@@ -60,17 +61,19 @@ instance IsInfo PkgUpgrade where
 pkgUpgraded :: PkgUpgrade -> Bool
 pkgUpgraded (PkgUpgrade _) = True
 
-upgrade :: Property HasInfo
+upgrade :: Property (HasInfo + FreeBSD)
 upgrade =
 	let
 		upd = pkgCmd "upgrade" []
 		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
-		infoProperty "pkg upgrade has run" go (addInfo mempty (PkgUpgrade "")) [] `requires` update
+		(property "pkg upgrade has run" go :: Property FreeBSD)
+			`setInfoProperty` (toInfo (PkgUpdate ""))
+			`requires` update
 
 type Package = String
 
-installed :: Package -> Property NoInfo
+installed :: Package -> Property FreeBSD
 installed pkg = check (isInstallable pkg) $ pkgCmdProperty "install" [pkg]
 
 isInstallable :: Package -> IO Bool
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index 5467c668..fcad9e87 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -26,20 +26,23 @@ instance IsInfo PoudriereConfigured where
 poudriereConfigured :: PoudriereConfigured -> Bool
 poudriereConfigured (PoudriereConfigured _) = True
 
-setConfigured :: Property HasInfo
-setConfigured = pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
+setConfigured :: Property (HasInfo + FreeBSD)
+setConfigured = tightenTargets $ 
+	pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
 
-poudriere :: Poudriere -> Property HasInfo
+poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
 poudriere conf@(Poudriere _ _ _ _ _ _ zfs) = prop
 	`requires` Pkg.installed "poudriere"
 	`before` setConfigured
   where
-	confProp = File.containsLines poudriereConfigPath (toLines conf)
+	confProp :: Property FreeBSD
+	confProp = tightenTargets $
+		File.containsLines poudriereConfigPath (toLines conf)
 	setZfs (PoudriereZFS z p) = ZFS.zfsSetProperties z p `describe` "Configuring Poudriere with ZFS"
-	prop :: CombinedType (Property NoInfo) (Property NoInfo)
+	prop :: Property FreeBSD
 	prop
 		| isJust zfs = ((setZfs $ fromJust zfs) `before` confProp)
-		| otherwise = propertyList "Configuring Poudriere without ZFS" [confProp]
+		| otherwise = confProp `describe` "Configuring Poudriere without ZFS"
 
 poudriereCommand :: String -> [String] -> (String, [String])
 poudriereCommand cmd args = ("poudriere", cmd:args)
@@ -58,8 +61,8 @@ listJails = mapMaybe (headMaybe . take 1 . words)
 jailExists :: Jail -> IO Bool
 jailExists (Jail name _ _) = isInfixOf [name] <$> listJails
 
-jail :: Jail -> Property NoInfo
-jail j@(Jail name version arch) =
+jail :: Jail -> Property FreeBSD
+jail j@(Jail name version arch) = tightenTargets $
 	let
 		chk = do
 			c <- poudriereConfigured <$> askInfo
@@ -70,7 +73,7 @@ jail j@(Jail name version arch) =
 		createJail = cmdProperty cmd args
 	in
 		check chk createJail
-		`describe` unwords ["Create poudriere jail", name]
+			`describe` unwords ["Create poudriere jail", name]
 
 data JailInfo = JailInfo String
 
diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs
index a5ef5ab1..5d7c8b4d 100644
--- a/src/Propellor/Property/Git.hs
+++ b/src/Propellor/Property/Git.hs
@@ -11,7 +11,7 @@ import Data.List
 -- using git-daemon, run from inetd.
 --
 -- Note that reverting this property does not remove or stop inetd.
-daemonRunning :: FilePath -> RevertableProperty NoInfo
+daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike
 daemonRunning exportdir = setup  unsetup
   where
 	setup = containsLine conf (mkl "tcp4")
@@ -47,7 +47,7 @@ daemonRunning exportdir = setup  unsetup
 		, exportdir
 		]
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["git"]
 
 type RepoUrl = String
@@ -61,8 +61,8 @@ type Branch = String
 -- it will be recursively deleted first.
 --
 -- A branch can be specified, to check out.
-cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo
-cloned owner url dir mbranch = check originurl (property desc checkout)
+cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
+cloned owner url dir mbranch = check originurl go
 	`requires` installed
   where
 	desc = "git cloned " ++ url ++ " to " ++ dir
@@ -74,12 +74,13 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
 			return (v /= Just url)
 		, return True
 		)
-	checkout = do
+	go :: Property DebianLike
+	go = property' desc $ \w -> do
 		liftIO $ do
 			whenM (doesDirectoryExist dir) $
 				removeDirectoryRecursive dir
 			createDirectoryIfMissing True (takeDirectory dir)
-		ensureProperty $ userScriptProperty owner (catMaybes checkoutcmds)
+		ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds)
 			`assume` MadeChange
 	checkoutcmds = 
 		-- The  catchMaybeIO (readProcess "git" ["rev-parse", "--re
 
 data GitShared = Shared Group | SharedAll | NotShared
 
-bareRepo :: FilePath -> User -> GitShared -> Property NoInfo
-bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $
+bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
+bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ toProps $
 	dirExists repo : case gitshared of
 		NotShared ->
 			[ ownerGroup repo user (userGroup user)
@@ -121,7 +122,7 @@ bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: "
 	isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo'])
 
 -- | Set a key value pair in a git repo's configuration.
-repoConfigured :: FilePath -> (String, String) -> Property NoInfo
+repoConfigured :: FilePath -> (String, String) -> Property UnixLike
 repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $
 	userScriptProperty (User "root")
 		[ "cd " ++ repo
@@ -141,7 +142,7 @@ getRepoConfig repo key = catchDefaultIO [] $
 	lines <$> readProcess "git" ["-C", repo, "config", key]
 
 -- | Whether a repo accepts non-fast-forward pushes.
-repoAcceptsNonFFs :: FilePath -> RevertableProperty NoInfo
+repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
 repoAcceptsNonFFs repo = accepts  refuses
   where
 	accepts = repoConfigured repo ("receive.denyNonFastForwards", "false")
@@ -152,7 +153,7 @@ repoAcceptsNonFFs repo = accepts  refuses
 
 -- | Sets a bare repository's default branch, which will be checked out
 -- when cloning it.
-bareRepoDefaultBranch :: FilePath -> String -> Property NoInfo
+bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike
 bareRepoDefaultBranch repo branch =
 	userScriptProperty (User "root")
 		[ "cd " ++ repo
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index bd710ca7..74e9df5a 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -6,7 +6,7 @@ import Utility.FileSystemEncoding
 
 import System.PosixCompat
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["gnupg"]
 
 -- A numeric id, or a description of the key, in a form understood by gpg.
@@ -22,11 +22,12 @@ data GpgKeyType = GpgPubKey | GpgPrivKey
 --
 -- Recommend only using this for low-value dedicated role keys.
 -- No attempt has been made to scrub the key out of memory once it's used.
-keyImported :: GpgKeyId -> User -> Property HasInfo
+keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
 keyImported key@(GpgKeyId keyid) user@(User u) = prop
 	`requires` installed
   where
 	desc = u ++ " has gpg key " ++ show keyid
+	prop :: Property (HasInfo + DebianLike)
 	prop = withPrivData src (Context keyid) $ \getkey ->
 		property desc $ getkey $ \key' -> do
 			let keylines = privDataLines key'
diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs
index f91ef1c2..58e49a86 100644
--- a/src/Propellor/Property/Group.hs
+++ b/src/Propellor/Property/Group.hs
@@ -4,7 +4,7 @@ import Propellor.Base
 
 type GID = Int
 
-exists :: Group -> Maybe GID -> Property NoInfo
+exists :: Group -> Maybe GID -> Property UnixLike
 exists (Group group') mgid = check test (cmdProperty "addgroup" (args mgid))
 	`describe` unwords ["group", group']
   where
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 1b7f2a0a..a03fc5a0 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -19,20 +19,23 @@ data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen
 -- bootloader.
 --
 -- This includes running update-grub.
-installed :: BIOS -> Property NoInfo
+installed :: BIOS -> Property DebianLike
 installed bios = installed' bios `onChange` mkConfig
 
 -- Run update-grub, to generate the grub boot menu. It will be
 -- automatically updated when kernel packages are installed.
-mkConfig :: Property NoInfo
-mkConfig = cmdProperty "update-grub" []
+mkConfig :: Property DebianLike
+mkConfig = tightenTargets $ cmdProperty "update-grub" []
 	`assume` MadeChange
 
 -- | Installs grub; does not run update-grub.
-installed' :: BIOS -> Property NoInfo
-installed' bios = Apt.installed [pkg] `describe` "grub package installed"
+installed' :: BIOS -> Property Linux
+installed' bios = (aptinstall `pickOS` unsupportedOS)
+	`describe` "grub package installed"
   where
-	pkg = case bios of
+	aptinstall :: Property DebianLike
+	aptinstall = Apt.installed [debpkg]
+	debpkg = case bios of
 		PC -> "grub-pc"
 		EFI64 -> "grub-efi-amd64"
 		EFI32 -> "grub-efi-ia32"
@@ -48,8 +51,8 @@ installed' bios = Apt.installed [pkg] `describe` "grub package installed"
 -- on the device; it always does the work to reinstall it. It's a good idea
 -- to arrange for this property to only run once, by eg making it be run
 -- onChange after OS.cleanInstallOnce.
-boots :: OSDevice -> Property NoInfo
-boots dev = cmdProperty "grub-install" [dev]
+boots :: OSDevice -> Property Linux
+boots dev = tightenTargets $ cmdProperty "grub-install" [dev]
 	`assume` MadeChange
 	`describe` ("grub boots " ++ dev)
 
@@ -61,10 +64,10 @@ boots dev = cmdProperty "grub-install" [dev]
 --
 -- The rootdev should be in the form "hd0", while the bootdev is in the form
 -- "xen/xvda".
-chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property NoInfo
-chainPVGrub rootdev bootdev timeout = combineProperties desc
-	[ File.dirExists "/boot/grub"
-	, "/boot/grub/menu.lst" `File.hasContent`
+chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property DebianLike
+chainPVGrub rootdev bootdev timeout = combineProperties desc $ props
+	& File.dirExists "/boot/grub"
+	& "/boot/grub/menu.lst" `File.hasContent`
 		[ "default 1" 
 		, "timeout " ++ show timeout
 		, ""
@@ -73,12 +76,12 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc
 		, "kernel /boot/xen-shim"
 		, "boot"
 		]
-	, "/boot/load.cf" `File.hasContent`
+	& "/boot/load.cf" `File.hasContent`
 		[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
-	, installed Xen
-	, flip flagFile "/boot/xen-shim" $ scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]
-		`assume` MadeChange
-		`describe` "/boot-xen-shim"
-	]
+	& installed Xen
+	& flip flagFile "/boot/xen-shim" xenshim
   where
 	desc = "chain PV-grub"
+	xenshim = scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]
+		`assume` MadeChange
+		`describe` "/boot-xen-shim"
diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
index bfe3ae17..5c4788e2 100644
--- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs
+++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
@@ -6,19 +6,24 @@ import qualified Propellor.Property.File as File
 import qualified Propellor.Property.User as User
 
 -- Clean up a system as installed by cloudatcost.com
-decruft :: Property NoInfo
-decruft = propertyList "cloudatcost cleanup"
-	[ Hostname.sane
-	, "worked around grub/lvm boot bug #743126" ==>
+decruft :: Property DebianLike
+decruft = propertyList "cloudatcost cleanup" $ props
+	& Hostname.sane
+	& grubbugfix
+	& nukecruft
+  where
+	grubbugfix :: Property DebianLike
+	grubbugfix = tightenTargets $ 
 		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
-		`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
-		`onChange` (cmdProperty "update-initramfs" ["-u"] `assume` MadeChange)
-	, combineProperties "nuked cloudatcost cruft"
-		[ File.notPresent "/etc/rc.local"
-		, File.notPresent "/etc/init.d/S97-setup.sh"
-		, File.notPresent "/zang-debian.sh"
-		, File.notPresent "/bin/npasswd"
-		, User.nuked (User "user") User.YesReallyDeleteHome
-		]
-	]
+			`describe` "worked around grub/lvm boot bug #743126"
+			`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
+			`onChange` (cmdProperty "update-initramfs" ["-u"] `assume` MadeChange)
+	nukecruft :: Property Linux
+	nukecruft = tightenTargets $
+		combineProperties "nuked cloudatcost cruft" $ props
+			& File.notPresent "/etc/rc.local"
+			& File.notPresent "/etc/init.d/S97-setup.sh"
+			& File.notPresent "/zang-debian.sh"
+			& File.notPresent "/bin/npasswd"
+			& User.nuked (User "user") User.YesReallyDeleteHome
 
diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
index f49b86b3..c1e0ffc9 100644
--- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs
+++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
@@ -18,16 +18,15 @@ import Data.List
 -- If the power is cycled, the non-distro kernel still boots up.
 -- So, this property also checks if the running kernel is present in /boot,
 -- and if not, reboots immediately into a distro kernel.
-distroKernel :: Property NoInfo
-distroKernel = propertyList "digital ocean distro kernel hack"
-	[ Apt.installed ["grub-pc", "kexec-tools", "file"]
-	, "/etc/default/kexec" `File.containsLines`
+distroKernel :: Property DebianLike
+distroKernel = propertyList "digital ocean distro kernel hack" $ props
+	& Apt.installed ["grub-pc", "kexec-tools", "file"]
+	& "/etc/default/kexec" `File.containsLines`
 		[ "LOAD_KEXEC=true"
 		, "USE_GRUB_CONFIG=true"
 		] `describe` "kexec configured"
-	, check (not <$> runningInstalledKernel) Reboot.now
+	& check (not <$> runningInstalledKernel) Reboot.now
 		`describe` "running installed kernel"
-	]
 
 runningInstalledKernel :: IO Bool
 runningInstalledKernel = do
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
index 274412a0..71719d87 100644
--- a/src/Propellor/Property/HostingProvider/Linode.hs
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -8,12 +8,13 @@ import Utility.FileMode
 -- | Linode's pv-grub-x86_64 does not currently support booting recent
 -- Debian kernels compressed with xz. This sets up pv-grub chaining to enable
 -- it.
-chainPVGrub :: Grub.TimeoutSecs -> Property NoInfo
+chainPVGrub :: Grub.TimeoutSecs -> Property DebianLike
 chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
 
 -- | Linode disables mlocate's cron job's execute permissions,
 -- presumably to avoid disk IO. This ensures it's executable.
-mlocateEnabled :: Property NoInfo
-mlocateEnabled = "/etc/cron.daily/mlocate"
-	`File.mode` combineModes (readModes ++ executeModes)
+mlocateEnabled :: Property DebianLike
+mlocateEnabled = tightenTargets $
+	"/etc/cron.daily/mlocate"
+		`File.mode` combineModes (readModes ++ executeModes)
 
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 7ab350ae..e1342d91 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -22,20 +22,20 @@ import Data.List.Utils
 -- Also, the  127.0.0.1 line is set to localhost. Putting any
 -- other hostnames there is not best practices and can lead to annoying
 -- messages from eg, apache.
-sane :: Property NoInfo
+sane :: Property UnixLike
 sane = sane' extractDomain
 
-sane' :: ExtractDomain -> Property NoInfo
-sane' extractdomain = property ("sane hostname") $
-	ensureProperty . setTo' extractdomain =<< asks hostName
+sane' :: ExtractDomain -> Property UnixLike
+sane' extractdomain = property' ("sane hostname") $ \w ->
+	ensureProperty w . setTo' extractdomain =<< asks hostName
 
 -- Like `sane`, but you can specify the hostname to use, instead
 -- of the default hostname of the `Host`.
-setTo :: HostName -> Property NoInfo
+setTo :: HostName -> Property UnixLike
 setTo = setTo' extractDomain
 
-setTo' :: ExtractDomain -> HostName -> Property NoInfo
-setTo' extractdomain hn = combineProperties desc
+setTo' :: ExtractDomain -> HostName -> Property UnixLike
+setTo' extractdomain hn = combineProperties desc $ toProps
 	[ "/etc/hostname" `File.hasContent` [basehost]
 	, hostslines $ catMaybes
 		[ if null domain
@@ -65,11 +65,12 @@ setTo' extractdomain hn = combineProperties desc
 
 -- | Makes  contain search and domain lines for 
 -- the domain that the hostname is in.
-searchDomain :: Property NoInfo
+searchDomain :: Property UnixLike
 searchDomain = searchDomain' extractDomain
 
-searchDomain' :: ExtractDomain -> Property NoInfo
-searchDomain' extractdomain = property desc (ensureProperty . go =<< asks hostName)
+searchDomain' :: ExtractDomain -> Property UnixLike
+searchDomain' extractdomain = property' desc $ \w ->
+	(ensureProperty w . go =<< asks hostName)
   where
 	desc = "resolv.conf search and domain configured"
 	go hn =
diff --git a/src/Propellor/Property/Journald.hs b/src/Propellor/Property/Journald.hs
index 2fbb780e..d0261626 100644
--- a/src/Propellor/Property/Journald.hs
+++ b/src/Propellor/Property/Journald.hs
@@ -5,7 +5,7 @@ import qualified Propellor.Property.Systemd as Systemd
 import Utility.DataUnits
 
 -- | Configures journald, restarting it so the changes take effect.
-configured :: Systemd.Option -> String -> Property NoInfo
+configured :: Systemd.Option -> String -> Property Linux
 configured option value =
 	Systemd.configured "/etc/systemd/journald.conf" option value
 		`onChange` Systemd.restarted "systemd-journald"
@@ -14,28 +14,28 @@ configured option value =
 -- Examples: "100 megabytes" or "0.5tb"
 type DataSize = String
 
-configuredSize :: Systemd.Option -> DataSize -> Property NoInfo
+configuredSize :: Systemd.Option -> DataSize -> Property Linux
 configuredSize option s = case readSize dataUnits s of
 	Just sz -> configured option (systemdSizeUnits sz)
 	Nothing -> property ("unable to parse " ++ option ++ " data size " ++ s) $
 		return FailedChange
 
-systemMaxUse :: DataSize -> Property NoInfo
+systemMaxUse :: DataSize -> Property Linux
 systemMaxUse = configuredSize "SystemMaxUse"
 
-runtimeMaxUse :: DataSize -> Property NoInfo
+runtimeMaxUse :: DataSize -> Property Linux
 runtimeMaxUse = configuredSize "RuntimeMaxUse"
 
-systemKeepFree :: DataSize -> Property NoInfo
+systemKeepFree :: DataSize -> Property Linux
 systemKeepFree = configuredSize "SystemKeepFree"
 
-runtimeKeepFree :: DataSize -> Property NoInfo
+runtimeKeepFree :: DataSize -> Property Linux
 runtimeKeepFree = configuredSize "RuntimeKeepFree"
 
-systemMaxFileSize :: DataSize -> Property NoInfo
+systemMaxFileSize :: DataSize -> Property Linux
 systemMaxFileSize = configuredSize "SystemMaxFileSize"
 
-runtimeMaxFileSize :: DataSize -> Property NoInfo
+runtimeMaxFileSize :: DataSize -> Property Linux
 runtimeMaxFileSize = configuredSize "RuntimeMaxFileSize"
 
 -- Generates size units as used in journald.conf.
diff --git a/src/Propellor/Property/Kerberos.hs b/src/Propellor/Property/Kerberos.hs
index cb6e06cc..3c351943 100644
--- a/src/Propellor/Property/Kerberos.hs
+++ b/src/Propellor/Property/Kerberos.hs
@@ -34,25 +34,25 @@ keyTabPath = maybe defaultKeyTab id
 principal :: String -> Maybe String -> Maybe Realm -> Principal
 principal p i r = p ++ maybe "" ("/"++) i ++ maybe "" ("@" ++) r
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["krb5-user"]
 
-kdcInstalled :: Property NoInfo
+kdcInstalled :: Property DebianLike
 kdcInstalled = Apt.serviceInstalledRunning "krb5-kdc"
 
-adminServerInstalled :: Property NoInfo
+adminServerInstalled :: Property DebianLike
 adminServerInstalled = Apt.serviceInstalledRunning "krb5-admin-server"
 
-kpropServerInstalled :: Property HasInfo
+kpropServerInstalled :: Property DebianLike
 kpropServerInstalled = propertyList "kprop server installed" $ props
 	& kdcInstalled
 	& Apt.installed ["openbsd-inetd"]
 	& "/etc/inetd.conf" `File.containsLines`
-	[ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"
-	, "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"
-	]
+		[ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"
+		, "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"
+		]
 
-kpropAcls :: [String] -> Property NoInfo
+kpropAcls :: [String] -> Property UnixLike
 kpropAcls ps = kpropdAclPath `File.hasContent` ps `describe` "kprop server ACLs"
 
 k5srvutil :: (Maybe FilePath) -> [String] -> IO String
@@ -82,13 +82,14 @@ k5loginPath user = do
 	h <- homedir user
 	return $ h  ".k5login"
 
-k5login :: User -> [Principal] -> Property NoInfo
-k5login user@(User u) ps = property (u ++ " has k5login") $ do
+k5login :: User -> [Principal] -> Property UnixLike
+k5login user@(User u) ps = property' desc $ \w -> do
 	f <- liftIO $ k5loginPath user
 	liftIO $ do
 		createDirectoryIfMissing True (takeDirectory f)
 		writeFile f (unlines ps)
-	ensureProperties
-		[ File.ownerGroup f user (userGroup user)
-		, File.ownerGroup (takeDirectory f) user (userGroup user)
-		]
+	ensureProperty w $ combineProperties desc $ props
+		& File.ownerGroup f user (userGroup user)
+		& File.ownerGroup (takeDirectory f) user (userGroup user)
+  where
+	desc = u ++ " has k5login"
diff --git a/src/Propellor/Property/LetsEncrypt.hs b/src/Propellor/Property/LetsEncrypt.hs
index d5528c64..bf38046b 100644
--- a/src/Propellor/Property/LetsEncrypt.hs
+++ b/src/Propellor/Property/LetsEncrypt.hs
@@ -7,7 +7,7 @@ import qualified Propellor.Property.Apt as Apt
 
 import System.Posix.Files
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["letsencrypt"]
 
 -- | Tell the letsencrypt client that you agree with the Let's Encrypt
@@ -39,15 +39,16 @@ type WebRoot = FilePath
 --
 -- See `Propellor.Property.Apache.httpsVirtualHost` for a more complete
 -- integration of apache with letsencrypt, that's built on top of this.
-letsEncrypt :: AgreeTOS -> Domain -> WebRoot -> Property NoInfo
+letsEncrypt :: AgreeTOS -> Domain -> WebRoot -> Property DebianLike
 letsEncrypt tos domain = letsEncrypt' tos domain []
 
 -- | Like `letsEncrypt`, but the certificate can be obtained for multiple
 -- domains.
-letsEncrypt' :: AgreeTOS -> Domain -> [Domain] -> WebRoot -> Property NoInfo
+letsEncrypt' :: AgreeTOS -> Domain -> [Domain] -> WebRoot -> Property DebianLike
 letsEncrypt' (AgreeTOS memail) domain domains webroot =
 	prop `requires` installed
   where
+	prop :: Property UnixLike
 	prop = property desc $ do
 		startstats <- liftIO getstats
 		(transcript, ok) <- liftIO $
diff --git a/src/Propellor/Property/LightDM.hs b/src/Propellor/Property/LightDM.hs
index 75e3b19a..339fa9a3 100644
--- a/src/Propellor/Property/LightDM.hs
+++ b/src/Propellor/Property/LightDM.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE FlexibleInstances #-}
-
 -- | Maintainer: Sean Whitton 
 
 module Propellor.Property.LightDM where
@@ -8,11 +6,11 @@ import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.ConfFile as ConfFile
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["lightdm"]
 
 -- | Configures LightDM to skip the login screen and autologin as a user.
-autoLogin :: User -> Property NoInfo
+autoLogin :: User -> Property UnixLike
 autoLogin (User u) = "/etc/lightdm/lightdm.conf" `ConfFile.containsIniSetting`
 	("SeatDefaults", "autologin-user", u)
 	`describe` "lightdm autologin"
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 74aa6ca6..0eec04c7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -1,86 +1,59 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Propellor.Property.List (
 	props,
-	PropertyList(..),
-	PropertyListType,
-	PropList(..),
+	Props,
+	toProps,
+	propertyList,
+	combineProperties,
 ) where
 
 import Propellor.Types
-import Propellor.Engine
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 import Propellor.PropAccum
+import Propellor.Engine
+import Propellor.Exception
 
 import Data.Monoid
 
--- | Starts accumulating a list of properties.
+toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
+toProps ps = Props (map toChildProperty ps)
+
+-- | Combines a list of properties, resulting in a single property
+-- that when run will run each property in the list in turn,
+-- and print out the description of each as it's run. Does not stop
+-- on failure; does propagate overall success/failure.
+--
+-- For example:
 --
 -- > propertyList "foo" $ props
--- > 	& someproperty
--- > 	! oldproperty
--- > 	& otherproperty
-props :: PropList
-props = PropList []
-
-data PropList = PropList [Property HasInfo]
-
-instance PropAccum PropList where
-	PropList l `addProp` p = PropList (toProp p : l)
-	PropList l `addPropFront` p = PropList (l ++ [toProp p])
-	getProperties (PropList l) = reverse l
-
-class PropertyList l where
-	-- | Combines a list of properties, resulting in a single property
-	-- that when run will run each property in the list in turn,
-	-- and print out the description of each as it's run. Does not stop
-	-- on failure; does propagate overall success/failure.
-	--
-	-- Note that Property HasInfo and Property NoInfo are not the same
-	-- type, and so cannot be mixed in a list. To make a list of
-	-- mixed types, which can also include RevertableProperty,
-	-- use `props`
-	propertyList :: Desc -> l -> Property (PropertyListType l)
-
-	-- | Combines a list of properties, resulting in one property that
-	-- ensures each in turn. Stops if a property fails.
-	combineProperties :: Desc -> l -> Property (PropertyListType l)
-
--- | Type level function to calculate whether a PropertyList has Info.
-type family PropertyListType t
-type instance PropertyListType [Property HasInfo] = HasInfo
-type instance PropertyListType [Property NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty HasInfo] = HasInfo
-type instance PropertyListType PropList = HasInfo
-
-instance PropertyList [Property NoInfo] where
-	propertyList desc ps = simpleProperty desc (ensureProperties ps) ps
-	combineProperties desc ps = simpleProperty desc (combineSatisfy ps NoChange) ps
-
-instance PropertyList [Property HasInfo] where
-	-- It's ok to use ignoreInfo here, because the ps are made the
-	-- child properties of the property, and so their info is visible
-	-- that way.
-	propertyList desc ps = infoProperty desc (ensureProperties $ map ignoreInfo ps) mempty ps
-	combineProperties desc ps = infoProperty desc (combineSatisfy ps NoChange) mempty ps
-
-instance PropertyList [RevertableProperty HasInfo] where
-	propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
-	combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList [RevertableProperty NoInfo] where
-	propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
-	combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList PropList where
-	propertyList desc = propertyList desc . getProperties
-	combineProperties desc = combineProperties desc . getProperties
-
-combineSatisfy :: [Property i] -> Result -> Propellor Result
+-- > 	& bar
+-- > 	& baz
+propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+propertyList desc (Props ps) = 
+	property desc (ensureChildProperties cs)
+		`addChildren` cs
+  where
+	cs = map toChildProperty ps
+
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn. Stops if a property fails.
+combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+combineProperties desc (Props ps) = 
+	property desc (combineSatisfy cs NoChange)
+		`addChildren` cs
+  where
+	cs = map toChildProperty ps
+
+combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
 combineSatisfy [] rs = return rs
-combineSatisfy (l:ls) rs = do
-	r <- ensureProperty $ ignoreInfo l
+combineSatisfy (p:ps) rs = do
+	r <- catchPropellor $ getSatisfy p
 	case r of
 		FailedChange -> return FailedChange
-		_ -> combineSatisfy ls (r <> rs)
+		_ -> combineSatisfy ps (r <> rs)
diff --git a/src/Propellor/Property/Locale.hs b/src/Propellor/Property/Locale.hs
index 06cd63ad..b7cf242c 100644
--- a/src/Propellor/Property/Locale.hs
+++ b/src/Propellor/Property/Locale.hs
@@ -21,14 +21,17 @@ type LocaleVariable = String
 --
 -- Note that reverting this property does not make a locale unavailable.  That's
 -- because it might be required for other Locale.selectedFor statements.
-selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty NoInfo
+selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty DebianLike DebianLike
 locale `selectedFor` vars = select  deselect
   where
-	select = check (not <$> isselected) (cmdProperty "update-locale" selectArgs)
-		`requires` available locale
-		`describe` (locale ++ " locale selected")
-	deselect = check isselected (cmdProperty "update-locale" vars)
-		`describe` (locale ++ " locale deselected")
+	select = tightenTargets $ 
+		check (not <$> isselected) 
+			(cmdProperty "update-locale" selectArgs)
+			`requires` available locale
+			`describe` (locale ++ " locale selected")
+	deselect = tightenTargets $
+		check isselected (cmdProperty "update-locale" vars)
+			`describe` (locale ++ " locale deselected")
 	selectArgs = zipWith (++) vars (repeat ('=':locale))
 	isselected = locale `isSelectedFor` vars
 
@@ -46,20 +49,21 @@ locale `isSelectedFor` vars = do
 --
 -- Per Debian bug #684134 we cannot ensure a locale is generated by means of
 -- Apt.reConfigure.  So localeAvailable edits /etc/locale.gen manually.
-available :: Locale -> RevertableProperty NoInfo
-available locale = (ensureAvailable  ensureUnavailable)
+available :: Locale -> RevertableProperty DebianLike DebianLike
+available locale = ensureAvailable  ensureUnavailable
   where
 	f = "/etc/locale.gen"
 	desc = (locale ++ " locale generated")
-	ensureAvailable =
-		property desc $ (lines <$> (liftIO $ readFile f))
-			>>= \locales ->
-					if locale `presentIn` locales
-					then ensureProperty $
-						fileProperty desc (foldr uncomment []) f
-							`onChange` regenerate
-					else return FailedChange -- locale unavailable for generation
-	ensureUnavailable =
+	ensureAvailable :: Property DebianLike
+	ensureAvailable = property' desc $ \w -> do
+		locales <- lines <$> (liftIO $ readFile f)
+		if locale `presentIn` locales
+			then ensureProperty w $
+				fileProperty desc (foldr uncomment []) f
+					`onChange` regenerate
+			else return FailedChange -- locale unavailable for generation
+	ensureUnavailable :: Property DebianLike
+	ensureUnavailable = tightenTargets $ 
 		fileProperty (locale ++ " locale not generated") (foldr comment []) f
 		`onChange` regenerate
 
diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs
index 22621cc2..ced9fce2 100644
--- a/src/Propellor/Property/Logcheck.hs
+++ b/src/Propellor/Property/Logcheck.hs
@@ -28,9 +28,9 @@ defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ "
 ignoreFilePath :: ReportLevel -> Service -> FilePath
 ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t)  n
 
-ignoreLines :: ReportLevel -> Service -> [String] -> Property NoInfo
+ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike
 ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls
 	`describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")")
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["logcheck"]
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 590cede9..5921755c 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -37,16 +37,17 @@ formatMountOpts (MountOpts []) = "defaults"
 formatMountOpts (MountOpts l) = intercalate "," l
 
 -- | Mounts a device.
-mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property NoInfo
+mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
 mounted fs src mnt opts = property (mnt ++ " mounted") $ 
 	toResult <$> liftIO (mount fs src mnt opts)
 
 -- | Bind mounts the first directory so its contents also appear
 -- in the second directory.
-bindMount :: FilePath -> FilePath -> Property NoInfo
-bindMount src dest = cmdProperty "mount" ["--bind", src, dest]
-	`assume` MadeChange
-	`describe` ("bind mounted " ++ src ++ " to " ++ dest)
+bindMount :: FilePath -> FilePath -> Property Linux
+bindMount src dest = tightenTargets $
+	cmdProperty "mount" ["--bind", src, dest]
+		`assume` MadeChange
+		`describe` ("bind mounted " ++ src ++ " to " ++ dest)
 
 mount :: FsType -> Source -> MountPoint -> MountOpts -> IO Bool
 mount fs src mnt opts = boolSystem "mount" $
@@ -66,10 +67,10 @@ newtype SwapPartition = SwapPartition FilePath
 -- and its mount options are all automatically probed.
 --
 -- The SwapPartitions are also included in the generated fstab.
-fstabbed :: [MountPoint] -> [SwapPartition] -> Property NoInfo
-fstabbed mnts swaps = property "fstabbed" $ do
+fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux
+fstabbed mnts swaps = property' "fstabbed" $ \o -> do
 	fstab <- liftIO $ genFstab mnts swaps id
-	ensureProperty $ 
+	ensureProperty o $ 
 		"/etc/fstab" `File.hasContent` fstab
 
 genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]
diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs
index 2464985a..dd74d91b 100644
--- a/src/Propellor/Property/Munin.hs
+++ b/src/Propellor/Property/Munin.hs
@@ -19,19 +19,19 @@ import qualified Propellor.Property.Service as Service
 nodePort :: Integer
 nodePort = 4949
 
-nodeInstalled :: Property NoInfo
+nodeInstalled :: Property DebianLike
 nodeInstalled = Apt.serviceInstalledRunning "munin-node"
 
-nodeRestarted :: Property NoInfo
+nodeRestarted :: Property DebianLike
 nodeRestarted = Service.restarted "munin-node"
 
 nodeConfPath :: FilePath
 nodeConfPath = "/etc/munin/munin-node.conf"
 
-masterInstalled :: Property NoInfo
+masterInstalled :: Property DebianLike
 masterInstalled = Apt.serviceInstalledRunning "munin"
 
-masterRestarted :: Property NoInfo
+masterRestarted :: Property DebianLike
 masterRestarted = Service.restarted "munin"
 
 masterConfPath :: FilePath
diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs
index 382f5d9d..9ed9e591 100644
--- a/src/Propellor/Property/Network.hs
+++ b/src/Propellor/Property/Network.hs
@@ -7,8 +7,8 @@ import Data.Char
 
 type Interface = String
 
-ifUp :: Interface -> Property NoInfo
-ifUp iface = cmdProperty "ifup" [iface]
+ifUp :: Interface -> Property DebianLike
+ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
 	`assume` MadeChange
 
 -- | Resets /etc/network/interfaces to a clean and empty state,
@@ -18,8 +18,8 @@ ifUp iface = cmdProperty "ifup" [iface]
 -- This can be used as a starting point to defining other interfaces.
 --
 -- No interfaces are brought up or down by this property.
-cleanInterfacesFile :: Property NoInfo
-cleanInterfacesFile = hasContent interfacesFile
+cleanInterfacesFile :: Property DebianLike
+cleanInterfacesFile = tightenTargets $ hasContent interfacesFile
 	[ "# Deployed by propellor, do not edit."
 	, ""
 	, "source-directory interfaces.d"
@@ -31,8 +31,8 @@ cleanInterfacesFile = hasContent interfacesFile
 	`describe` ("clean " ++ interfacesFile)
 
 -- | Configures an interface to get its address via dhcp.
-dhcp :: Interface -> Property NoInfo
-dhcp iface = hasContent (interfaceDFile iface)
+dhcp :: Interface -> Property DebianLike
+dhcp iface = tightenTargets $ hasContent (interfaceDFile iface)
 	[ "auto " ++ iface
 	, "iface " ++ iface ++ " inet dhcp"
 	]
@@ -50,18 +50,20 @@ dhcp iface = hasContent (interfaceDFile iface)
 --
 -- (ipv6 addresses are not included because it's assumed they come up
 -- automatically in most situations.)
-static :: Interface -> Property NoInfo
-static iface = check (not <$> doesFileExist f) setup
-	`describe` desc
-	`requires` interfacesDEnabled
+static :: Interface -> Property DebianLike
+static iface = tightenTargets $ 
+	check (not <$> doesFileExist f) setup
+		`describe` desc
+		`requires` interfacesDEnabled
   where
 	f = interfaceDFile iface
 	desc = "static " ++ iface
-	setup = property desc $ do
+	setup :: Property DebianLike
+	setup = property' desc $ \o -> do
 		ls <- liftIO $ lines <$> readProcess "ip"
 			["-o", "addr", "show", iface, "scope", "global"]
 		stanzas <- liftIO $ concat <$> mapM mkstanza ls
-		ensureProperty $ hasContent f $ ("auto " ++ iface) : stanzas
+		ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
 	mkstanza ipline = case words ipline of
 		-- Note that the IP address is written CIDR style, so
 		-- the netmask does not need to be specified separately.
@@ -81,8 +83,8 @@ static iface = check (not <$> doesFileExist f) setup
 			_ -> Nothing
 
 -- | 6to4 ipv6 connection, should work anywhere
-ipv6to4 :: Property NoInfo
-ipv6to4 = hasContent (interfaceDFile "sit0")
+ipv6to4 :: Property DebianLike
+ipv6to4 = tightenTargets $ hasContent (interfaceDFile "sit0")
 	[ "# Deployed by propellor, do not edit."
 	, "iface sit0 inet6 static"
 	, "\taddress 2002:5044:5531::1"
@@ -107,6 +109,8 @@ escapeInterfaceDName :: Interface -> FilePath
 escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))
 
 -- | Ensures that files in the the interfaces.d directory are used.
-interfacesDEnabled :: Property NoInfo
-interfacesDEnabled = containsLine interfacesFile "source-directory interfaces.d"
-	`describe` "interfaces.d directory enabled"
+-- interfacesDEnabled :: Property DebianLike
+interfacesDEnabled :: Property DebianLike
+interfacesDEnabled = tightenTargets $
+	containsLine interfacesFile "source-directory interfaces.d"
+		`describe` "interfaces.d directory enabled"
diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs
index 8fb5c49b..e40ba657 100644
--- a/src/Propellor/Property/Nginx.hs
+++ b/src/Propellor/Property/Nginx.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.Service as Service
 
 type ConfigFile = [String]
 
-siteEnabled :: HostName -> ConfigFile -> RevertableProperty NoInfo
+siteEnabled :: HostName -> ConfigFile -> RevertableProperty DebianLike DebianLike
 siteEnabled hn cf = enable  disable
   where
 	enable = siteVal hn `File.isSymlinkedTo` siteValRelativeCfg hn
@@ -22,11 +22,11 @@ siteEnabled hn cf = enable  disable
 		`requires` installed
 		`onChange` reloaded
 
-siteAvailable :: HostName -> ConfigFile -> Property NoInfo
-siteAvailable hn cf = ("nginx site available " ++ hn) ==>
-	siteCfg hn `File.hasContent` (comment : cf)
+siteAvailable :: HostName -> ConfigFile -> Property DebianLike
+siteAvailable hn cf = "nginx site available " ++ hn ==> tightenTargets go
   where
 	comment = "# deployed with propellor, do not modify"
+	go = siteCfg hn `File.hasContent` (comment : cf)
 
 siteCfg :: HostName -> FilePath
 siteCfg hn = "/etc/nginx/sites-available/" ++ hn
@@ -37,11 +37,11 @@ siteVal hn = "/etc/nginx/sites-enabled/" ++ hn
 siteValRelativeCfg :: HostName -> File.LinkTarget
 siteValRelativeCfg hn = File.LinkTarget ("../sites-available/" ++ hn)
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["nginx"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "nginx"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "nginx"
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index e5da0921..5a3ccc70 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -46,7 +46,7 @@ import Control.Exception (throw)
 -- install succeeds, to bootstrap from the cleanly installed system to
 -- a fully working system. For example:
 --
--- > & os (System (Debian Unstable) "amd64")
+-- > & osDebian Unstable "amd64"
 -- > & cleanInstallOnce (Confirmed "foo.example.com")
 -- >    `onChange` propertyList "fixing up after clean install"
 -- >        [ preserveNetwork
@@ -64,7 +64,7 @@ import Control.Exception (throw)
 -- > & User.accountFor "joey"
 -- > & User.hasSomePassword "joey"
 -- > -- rest of system properties here
-cleanInstallOnce :: Confirmation -> Property NoInfo
+cleanInstallOnce :: Confirmation -> Property Linux
 cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 	go `requires` confirmed "clean install confirmed" confirmation
   where
@@ -83,14 +83,18 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 			`requires`
 		osbootstrapped
 
-	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of
-		(Just d@(System (Debian _) _)) -> debootstrap d
-		(Just u@(System (Buntish _) _)) -> debootstrap u
-		_ -> unsupportedOS
+	osbootstrapped :: Property Linux
+	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \w o -> case o of
+		(Just d@(System (Debian _) _)) -> ensureProperty w $
+			debootstrap d
+		(Just u@(System (Buntish _) _)) -> ensureProperty w $
+			debootstrap u
+		_ -> unsupportedOS'
 	
-	debootstrap targetos = ensureProperty $
-		-- Ignore the os setting, and install debootstrap from
-		-- source, since we don't know what OS we're running in yet.
+	debootstrap :: System -> Property Linux
+	debootstrap targetos =
+		-- Install debootstrap from source, since we don't know
+		-- what OS we're currently running in.
 		Debootstrap.built' Debootstrap.sourceInstall
 			newOSDir targetos Debootstrap.DefaultConfig
 		-- debootstrap, I wish it was faster.. 
@@ -100,6 +104,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 		-- sync instead?
 
 	-- This is the fun bit.
+	flipped :: Property Linux
 	flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
 		-- First, unmount most mount points, lazily, so
 		-- they don't interfere with moving things around.
@@ -137,6 +142,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 
 		return MadeChange
 
+	propellorbootstrapped :: Property UnixLike
 	propellorbootstrapped = property "propellor re-debootstrapped in new os" $
 		return NoChange
 		-- re-bootstrap propellor in /usr/local/propellor,
@@ -145,6 +151,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 		--   be present in /old-os's /usr/local/propellor)
 		-- TODO
 	
+	finalized :: Property UnixLike
 	finalized = property "clean OS installed" $ do
 		liftIO $ writeFile flagfile ""
 		return MadeChange
@@ -179,7 +186,7 @@ massRename = go []
 
 data Confirmation = Confirmed HostName
 
-confirmed :: Desc -> Confirmation -> Property NoInfo
+confirmed :: Desc -> Confirmation -> Property UnixLike
 confirmed desc (Confirmed c) = property desc $ do
 	hostname <- asks hostName
 	if hostname /= c
@@ -191,25 +198,26 @@ confirmed desc (Confirmed c) = property desc $ do
 -- |  is configured to bring up the network 
 -- interface that currently has a default route configured, using
 -- the same (static) IP address.
-preserveNetwork :: Property NoInfo
+preserveNetwork :: Property DebianLike
 preserveNetwork = go `requires` Network.cleanInterfacesFile
   where
-	go = property "preserve network configuration" $ do
+	go :: Property DebianLike
+	go = property' "preserve network configuration" $ \w -> do
 		ls <- liftIO $ lines <$> readProcess "ip"
 			["route", "list", "scope", "global"]
 		case words <$> headMaybe ls of
 			Just ("default":"via":_:"dev":iface:_) ->
-				ensureProperty $ Network.static iface
+				ensureProperty w $ Network.static iface
 			_ -> do
 				warningMessage "did not find any default ipv4 route"
 				return FailedChange 
 
 -- |  is copied from the old OS
-preserveResolvConf :: Property NoInfo
+preserveResolvConf :: Property Linux
 preserveResolvConf = check (fileExist oldloc) $
-	property (newloc ++ " copied from old OS") $ do
+	property' (newloc ++ " copied from old OS") $ \w -> do
 		ls <- liftIO $ lines <$> readFile oldloc
-		ensureProperty $ newloc `File.hasContent` ls
+		ensureProperty w $ newloc `File.hasContent` ls
   where
 	newloc = "/etc/resolv.conf"
 	oldloc = oldOSDir ++ newloc
@@ -217,20 +225,23 @@ preserveResolvConf = check (fileExist oldloc) $
 -- |  has added to it any ssh keys that
 -- were authorized in the old OS. Any other contents of the file are
 -- retained.
-preserveRootSshAuthorized :: Property NoInfo
+preserveRootSshAuthorized :: Property UnixLike
 preserveRootSshAuthorized = check (fileExist oldloc) $
-	property (newloc ++ " copied from old OS") $ do
+	property' desc $ \w -> do
 		ks <- liftIO $ lines <$> readFile oldloc
-		ensureProperties (map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks)
+		ensureProperty w $ combineProperties desc $
+			toProps $ map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks
   where
+	desc = newloc ++ " copied from old OS"
 	newloc = "/root/.ssh/authorized_keys"
 	oldloc = oldOSDir ++ newloc
 
 -- Removes the old OS's backup from 
-oldOSRemoved :: Confirmation -> Property NoInfo
+oldOSRemoved :: Confirmation -> Property UnixLike
 oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $
 	go `requires` confirmed "old OS backup removal confirmed" confirmation
   where
+	go :: Property UnixLike
 	go = property "old OS backup removed" $ do
 		liftIO $ removeDirectoryRecursive oldOSDir
 		return MadeChange
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 666328ac..6d6f4a7f 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -40,7 +40,7 @@ data NumClients = OnlyClient | MultipleClients
 -- Since obnam uses a fair amount of system resources, only one obnam
 -- backup job will be run at a time. Other jobs will wait their turns to
 -- run.
-backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo
+backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
 backup dir crontimes params numclients =
 	backup' dir crontimes params numclients
 		`requires` restored dir params
@@ -50,7 +50,7 @@ backup dir crontimes params numclients =
 --
 -- The gpg secret key will be automatically imported
 -- into root's keyring using Propellor.Property.Gpg.keyImported
-backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property HasInfo
+backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property (HasInfo + DebianLike)
 backupEncrypted dir crontimes params numclients keyid =
 	backup dir crontimes params' numclients
 		`requires` Gpg.keyImported keyid (User "root")
@@ -58,7 +58,7 @@ backupEncrypted dir crontimes params numclients keyid =
 	params' = ("--encrypt-with=" ++ Gpg.getGpgKeyId keyid) : params
 
 -- | Does a backup, but does not automatically restore.
-backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo
+backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
 backup' dir crontimes params numclients = cronjob `describe` desc
   where
 	desc = dir ++ " backed up by obnam"
@@ -96,11 +96,12 @@ backup' dir crontimes params numclients = cronjob `describe` desc
 --
 -- The restore is performed atomically; restoring to a temp directory
 -- and then moving it to the directory.
-restored :: FilePath -> [ObnamParam] -> Property NoInfo
-restored dir params = property (dir ++ " restored by obnam") go
-	`requires` installed
+restored :: FilePath -> [ObnamParam] -> Property DebianLike
+restored dir params = go `requires` installed
   where
-	go = ifM (liftIO needsRestore)
+	desc = dir ++ " restored by obnam"
+	go :: Property DebianLike
+	go = property desc $ ifM (liftIO needsRestore)
 		( do
 			warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
 			liftIO restore
@@ -152,5 +153,5 @@ keepParam ps = "--keep=" ++ intercalate "," (map go ps)
 isKeepParam :: ObnamParam -> Bool
 isKeepParam p = "--keep=" `isPrefixOf` p
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["obnam"]
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 0f73bfb6..0abf38a6 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -16,7 +16,7 @@ import Data.List
 --
 -- It's probably a good idea to put this property inside a docker or
 -- systemd-nspawn container.
-providerFor :: [User] -> HostName -> Maybe Port -> Property HasInfo
+providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike)
 providerFor users hn mp = propertyList desc $ props
 	& Apt.serviceInstalledRunning "apache2"
 	& apacheconfigured
@@ -24,7 +24,7 @@ providerFor users hn mp = propertyList desc $ props
 		`onChange` Apache.restarted
 	& File.fileProperty (desc ++ " configured")
 		(map setbaseurl) "/etc/simpleid/config.inc"
-	& propertyList desc (map identfile users)
+	& propertyList desc (toProps $ map identfile users)
   where
 	baseurl = hn ++ case mp of
 		Nothing -> ""
@@ -37,7 +37,7 @@ providerFor users hn mp = propertyList desc $ props
 		| otherwise = l
 
 	apacheconfigured = case mp of
-		Nothing -> toProp $
+		Nothing -> setupRevertableProperty $
 			Apache.virtualHost hn (Port 80) "/var/www/html"
 		Just p -> propertyList desc $ props
 			& Apache.listenPorts [p]
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index 5d6afa9c..bc8a256d 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -153,18 +153,17 @@ data Eep = YesReallyDeleteDiskContents
 -- The FilePath can be a block device (eg, \/dev\/sda), or a disk image file.
 --
 -- This deletes any existing partitions in the disk! Use with EXTREME caution!
-partitioned :: Eep -> FilePath -> PartTable -> Property NoInfo
-partitioned eep disk (PartTable tabletype parts) = property desc $ do
+partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike
+partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
 	isdev <- liftIO $ isBlockDevice <$> getFileStatus disk
-	ensureProperty $ combineProperties desc
-		[ parted eep disk partedparams
-		, if isdev
+	ensureProperty w $ combineProperties desc $ props
+		& parted eep disk partedparams
+		& if isdev
 			then formatl (map (\n -> disk ++ show n) [1 :: Int ..])
 			else Partition.kpartx disk (formatl . map Partition.partitionLoopDev)
-		]
   where
 	desc = disk ++ " partitioned"
-	formatl devs = combineProperties desc (map format (zip parts devs))
+	formatl devs = combineProperties desc (toProps $ map format (zip parts devs))
 	partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts []
 	format (p, dev) = Partition.formatted' (partMkFsOpts p)
 		Partition.YesReallyFormatPartition (partFs p) dev
@@ -193,12 +192,12 @@ partitioned eep disk (PartTable tabletype parts) = property desc $ do
 --
 -- Parted is run in script mode, so it will never prompt for input.
 -- It is asked to use cylinder alignment for the disk.
-parted :: Eep -> FilePath -> [String] -> Property NoInfo
+parted :: Eep -> FilePath -> [String] -> Property DebianLike
 parted YesReallyDeleteDiskContents disk ps = p `requires` installed
   where
 	p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
 		`assume` MadeChange
 
 -- | Gets parted installed.
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["parted"]
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index b2f50339..2bf5b927 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -3,6 +3,7 @@
 module Propellor.Property.Partition where
 
 import Propellor.Base
+import Propellor.Types.Core
 import qualified Propellor.Property.Apt as Apt
 import Utility.Applicative
 
@@ -16,7 +17,7 @@ data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | Linu
 data Eep = YesReallyFormatPartition
 
 -- | Formats a partition.
-formatted :: Eep -> Fs -> FilePath -> Property NoInfo
+formatted :: Eep -> Fs -> FilePath -> Property DebianLike
 formatted = formatted' []
 
 -- | Options passed to a mkfs.* command when making a filesystem.
@@ -24,7 +25,7 @@ formatted = formatted' []
 -- Eg, ["-m0"]
 type MkfsOpts = [String]
 
-formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property NoInfo
+formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property DebianLike
 formatted' opts YesReallyFormatPartition fs dev = cmdProperty cmd opts'
 	`assume` MadeChange
 	`requires` Apt.installed [pkg]
@@ -64,17 +65,18 @@ isLoopDev' f
 -- within a disk image file. The resulting loop devices are passed to the
 -- property, which can operate on them. Always cleans up after itself,
 -- by removing the device maps after the property is run.
-kpartx :: FilePath -> ([LoopDev] -> Property NoInfo) -> Property NoInfo
+kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
 kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
   where
-	go = property (propertyDesc (mkprop [])) $ do
+	go :: Property DebianLike
+	go = property' (getDesc (mkprop [])) $ \w -> do
 		cleanup -- idempotency
 		loopdevs <- liftIO $ kpartxParse
 			<$> readProcess "kpartx" ["-avs", diskimage]
 		bad <- liftIO $ filterM (not <$$> isLoopDev) loopdevs
 		unless (null bad) $
 			error $ "kpartx output seems to include non-loop-devices (possible parse failure): " ++ show bad
-		r <- ensureProperty (mkprop loopdevs)
+		r <- ensureProperty w (mkprop loopdevs)
 		cleanup
 		return r
 	cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index df244061..45aa4e42 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -12,13 +12,13 @@ import qualified Data.Map as M
 import Data.List
 import Data.Char
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.serviceInstalledRunning "postfix"
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "postfix"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "postfix"
 
 -- | Configures postfix as a satellite system, which 
@@ -28,38 +28,39 @@ reloaded = Service.reloaded "postfix"
 -- The smarthost may refuse to relay mail on to other domains, without
 -- further configuration/keys. But this should be enough to get cron job
 -- mail flowing to a place where it will be seen.
-satellite :: Property NoInfo
+satellite :: Property DebianLike
 satellite = check (not <$> mainCfIsSet "relayhost") setup
 	`requires` installed
   where
-	setup = property "postfix satellite system" $ do
+	desc = "postfix satellite system"
+	setup :: Property DebianLike
+	setup = property' desc $ \w -> do
 		hn <- asks hostName
 		let (_, domain) = separate (== '.') hn
-		ensureProperties
-			[ Apt.reConfigure "postfix"
+		ensureProperty w $ combineProperties desc $ props
+			& Apt.reConfigure "postfix"
 				[ ("postfix/main_mailer_type", "select", "Satellite system")
 				, ("postfix/root_address", "string", "root")
 				, ("postfix/destinations", "string", "localhost")
 				, ("postfix/mailname", "string", hn)
 				]
-			, mainCf ("relayhost", "smtp." ++ domain)
+			& mainCf ("relayhost", "smtp." ++ domain)
 				`onChange` reloaded
-			]
 
 -- | Sets up a file by running a property (which the filename is passed
 -- to). If the setup property makes a change, postmap will be run on the
 -- file, and postfix will be reloaded.
 mappedFile
-	:: Combines (Property x) (Property NoInfo)
+	:: Combines (Property x) (Property UnixLike)
 	=> FilePath
 	-> (FilePath -> Property x)
-	-> Property (CInfo x NoInfo)
+	-> CombinedType (Property x) (Property UnixLike)
 mappedFile f setup = setup f
 	`onChange` (cmdProperty "postmap" [f] `assume` MadeChange)
 
 -- | Run newaliases command, which should be done after changing
 -- @/etc/aliases@.
-newaliases :: Property NoInfo
+newaliases :: Property UnixLike
 newaliases = check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
 	(cmdProperty "newaliases" [])
 
@@ -68,9 +69,9 @@ mainCfFile :: FilePath
 mainCfFile = "/etc/postfix/main.cf"
 
 -- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately.
-mainCf :: (String, String) -> Property NoInfo
+mainCf :: (String, String) -> Property UnixLike
 mainCf (name, value) = check notset set
-		`describe` ("postfix main.cf " ++ setting)
+	`describe` ("postfix main.cf " ++ setting)
   where
 	setting = name ++ "=" ++ value
 	notset = (/= Just value) <$> getMainCf name
@@ -105,7 +106,7 @@ mainCfIsSet name = do
 --
 -- Note that multiline configurations that continue onto the next line
 -- are not currently supported.
-dedupMainCf :: Property NoInfo
+dedupMainCf :: Property UnixLike
 dedupMainCf = File.fileProperty "postfix main.cf dedupped" dedupCf mainCfFile
 
 dedupCf :: [String] -> [String]
@@ -252,7 +253,7 @@ parseServiceLine l = Service
 	nws = length ws
 
 -- | Enables a `Service` in postfix's `masterCfFile`.
-service :: Service -> RevertableProperty NoInfo
+service :: Service -> RevertableProperty DebianLike DebianLike
 service s = (enable  disable)
 	`describe` desc
   where
@@ -276,7 +277,7 @@ service s = (enable  disable)
 -- It would be wise to enable fail2ban, for example:
 --
 -- > Fail2Ban.jailEnabled "postfix-sasl"
-saslAuthdInstalled :: Property NoInfo
+saslAuthdInstalled :: Property DebianLike
 saslAuthdInstalled = setupdaemon
 	`requires` Service.running "saslauthd"
 	`requires` postfixgroup
@@ -303,7 +304,7 @@ saslAuthdInstalled = setupdaemon
 -- | Uses `saslpasswd2` to set the password for a user in the sasldb2 file.
 --
 -- The password is taken from the privdata.
-saslPasswdSet :: Domain -> User -> Property HasInfo
+saslPasswdSet :: Domain -> User -> Property (HasInfo + UnixLike)
 saslPasswdSet domain (User user) = go `changesFileContent` "/etc/sasldb2"
   where
 	go = withPrivData src ctx $ \getpw ->
diff --git a/src/Propellor/Property/PropellorRepo.hs b/src/Propellor/Property/PropellorRepo.hs
index d4fc089a..e60e7848 100644
--- a/src/Propellor/Property/PropellorRepo.hs
+++ b/src/Propellor/Property/PropellorRepo.hs
@@ -11,7 +11,7 @@ import Propellor.Git.Config
 --
 -- This property is useful when hosts are being updated without using
 -- --spin, eg when using the `Propellor.Property.Cron.runPropellor` cron job.
-hasOriginUrl :: String -> Property NoInfo
+hasOriginUrl :: String -> Property UnixLike
 hasOriginUrl u = property ("propellor repo url " ++ u) $ do
 	curru <- liftIO getRepoUrl
 	if curru == Just u
diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs
index 47095504..8017be4a 100644
--- a/src/Propellor/Property/Prosody.hs
+++ b/src/Propellor/Property/Prosody.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
 
 type Conf = String
 
-confEnabled :: Conf -> ConfigFile -> RevertableProperty NoInfo
+confEnabled :: Conf -> ConfigFile -> RevertableProperty DebianLike DebianLike
 confEnabled conf cf = enable  disable
   where
 	enable = dir `File.isSymlinkedTo` target
@@ -29,9 +29,9 @@ confEnabled conf cf = enable  disable
 		`requires` installed
 		`onChange` reloaded
 
-confAvailable :: Conf -> ConfigFile -> Property NoInfo
+confAvailable :: Conf -> ConfigFile -> Property DebianLike
 confAvailable conf cf = ("prosody conf available " ++ conf) ==>
-	confAvailPath conf `File.hasContent` (comment : cf)
+	tightenTargets (confAvailPath conf `File.hasContent` (comment : cf))
   where
 	comment = "-- deployed with propellor, do not modify"
 
@@ -41,11 +41,11 @@ confAvailPath conf = "/etc/prosody/conf.avail"  conf <.> "cfg.lua"
 confValPath :: Conf -> FilePath
 confValPath conf = "/etc/prosody/conf.d"  conf <.> "cfg.lua"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["prosody"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "prosody"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "prosody"
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 26b85840..5b854fa3 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -2,8 +2,8 @@ module Propellor.Property.Reboot where
 
 import Propellor.Base
 
-now :: Property NoInfo
-now = cmdProperty "reboot" []
+now :: Property Linux
+now = tightenTargets $ cmdProperty "reboot" []
 	`assume` MadeChange
 	`describe` "reboot now"
 
@@ -14,7 +14,7 @@ now = cmdProperty "reboot" []
 --
 -- The reboot can be forced to run, which bypasses the init system. Useful
 -- if the init system might not be running for some reason.
-atEnd :: Bool -> (Result -> Bool) -> Property NoInfo
+atEnd :: Bool -> (Result -> Bool) -> Property Linux
 atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
 	endAction "rebooting" atend
 	return NoChange
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
index 0c77df58..b40396de 100644
--- a/src/Propellor/Property/Rsync.hs
+++ b/src/Propellor/Property/Rsync.hs
@@ -16,7 +16,7 @@ filesUnder d = Pattern (d ++ "/*")
 
 -- | Ensures that the Dest directory exists and has identical contents as
 -- the Src directory.
-syncDir :: Src -> Dest -> Property NoInfo
+syncDir :: Src -> Dest -> Property DebianLike
 syncDir = syncDirFiltered []
 
 data Filter 
@@ -43,7 +43,7 @@ newtype Pattern = Pattern String
 -- Rsync checks each name to be transferred against its list of Filter
 -- rules, and the first matching one is acted on. If no matching rule
 -- is found, the file is processed.
-syncDirFiltered :: [Filter] -> Src -> Dest -> Property NoInfo
+syncDirFiltered :: [Filter] -> Src -> Dest -> Property DebianLike
 syncDirFiltered filters src dest = rsync $
 	[ "-av"
 	-- Add trailing '/' to get rsync to sync the Dest directory,
@@ -56,7 +56,7 @@ syncDirFiltered filters src dest = rsync $
 	, "--quiet"
 	] ++ map toRsync filters
 
-rsync :: [String] -> Property NoInfo
+rsync :: [String] -> Property DebianLike
 rsync ps = cmdProperty "rsync" ps
 	`assume` MadeChange
 	`requires` Apt.installed ["rsync"]
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 64a530bc..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
 
 module Propellor.Property.Scheduled
 	( period
@@ -10,6 +10,7 @@ module Propellor.Property.Scheduled
 	) where
 
 import Propellor.Base
+import Propellor.Types.Core
 import Utility.Scheduled
 
 import Data.Time.Clock
@@ -22,24 +23,24 @@ import qualified Data.Map as M
 -- last run.
 period :: (IsProp (Property i)) => Property i -> Recurrance -> Property i
 period prop recurrance = flip describe desc $ adjustPropertySatisfy prop $ \satisfy -> do
-	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+	lasttime <- liftIO $ getLastChecked (getDesc prop)
 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
 	t <- liftIO localNow
 	if Just t >= nexttime
 		then do
 			r <- satisfy
-			liftIO $ setLastChecked t (propertyDesc prop)
+			liftIO $ setLastChecked t (getDesc prop)
 			return r
 		else noChange
   where
 	schedule = Schedule recurrance AnyTime
-	desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
+	desc = getDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
 
 -- | Like period, but parse a human-friendly string.
-periodParse :: Property NoInfo -> String -> Property NoInfo
+periodParse :: (IsProp (Property i)) => Property i -> String -> Property i
 periodParse prop s = case toRecurrance s of
 	Just recurrance -> period prop recurrance
-	Nothing -> property "periodParse" $ do
+	Nothing -> adjustPropertySatisfy prop $ \_ -> do
 		liftIO $ warningMessage $ "failed periodParse: " ++ s
 		noChange
 
diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs
index 0e96ed4c..46f9e8ef 100644
--- a/src/Propellor/Property/Service.hs
+++ b/src/Propellor/Property/Service.hs
@@ -11,17 +11,17 @@ type ServiceName = String
 -- Note that due to the general poor state of init scripts, the best
 -- we can do is try to start the service, and if it fails, assume
 -- this means it's already running.
-running :: ServiceName -> Property NoInfo
+running :: ServiceName -> Property DebianLike
 running = signaled "start" "running"
 
-restarted :: ServiceName -> Property NoInfo
+restarted :: ServiceName -> Property DebianLike
 restarted = signaled "restart" "restarted"
 
-reloaded :: ServiceName -> Property NoInfo
+reloaded :: ServiceName -> Property DebianLike
 reloaded = signaled "reload" "reloaded"
 
-signaled :: String -> Desc -> ServiceName -> Property NoInfo
-signaled cmd desc svc = p `describe` (desc ++ " " ++ svc)
+signaled :: String -> Desc -> ServiceName -> Property DebianLike
+signaled cmd desc svc = tightenTargets $ p `describe` (desc ++ " " ++ svc)
   where
 	p = scriptProperty ["service " ++ shellEscape svc ++ " " ++ cmd ++ " >/dev/null 2>&1 || true"]
 		`assume` NoChange
diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs
index 5c85610b..239bcbeb 100644
--- a/src/Propellor/Property/SiteSpecific/Branchable.hs
+++ b/src/Propellor/Property/SiteSpecific/Branchable.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.Postfix as Postfix
 import qualified Propellor.Property.Gpg as Gpg
 import qualified Propellor.Property.Sudo as Sudo
 
-server :: [Host] -> Property HasInfo
+server :: [Host] -> Property (HasInfo + DebianLike)
 server hosts = propertyList "branchable server" $ props
 	& "/etc/timezone" `File.hasContent` ["Etc/UTC"]
 	& "/etc/locale.gen" `File.containsLines`
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 2932baf7..ce89b94a 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -25,7 +25,7 @@ builddir = gitbuilderdir  "build"
 
 type TimeOut = String -- eg, 5h
 
-autobuilder :: Architecture -> Times -> TimeOut -> Property HasInfo
+autobuilder :: Architecture -> Times -> TimeOut -> Property (HasInfo + DebianLike)
 autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 	& Apt.serviceInstalledRunning "cron"
 	& Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir
@@ -37,6 +37,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 	-- The builduser account does not have a password set,
 	-- instead use the password privdata to hold the rsync server
 	-- password used to upload the built image.
+	rsyncpassword :: Property (HasInfo + DebianLike)
 	rsyncpassword = withPrivData (Password builduser) context $ \getpw ->
 		property "rsync password" $ getpw $ \pw -> do
 			have <- liftIO $ catchDefaultIO "" $
@@ -46,7 +47,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 				then makeChange $ writeFile pwfile want
 				else noChange
 
-tree :: Architecture -> Flavor -> Property HasInfo
+tree :: Architecture -> Flavor -> Property DebianLike
 tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
 	& Apt.installed ["git"]
 	& File.dirExists gitbuilderdir
@@ -66,14 +67,14 @@ tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
 		[ "git clone git://git-annex.branchable.com/ " ++ builddir
 		]
 
-buildDepsApt :: Property HasInfo
+buildDepsApt :: Property DebianLike
 buildDepsApt = combineProperties "gitannexbuilder build deps" $ props
 	& Apt.buildDep ["git-annex"]
 	& buildDepsNoHaskellLibs
 	& Apt.buildDepIn builddir
 		`describe` "git-annex source build deps installed"
 
-buildDepsNoHaskellLibs :: Property NoInfo
+buildDepsNoHaskellLibs :: Property DebianLike
 buildDepsNoHaskellLibs = Apt.installed
 	["git", "rsync", "moreutils", "ca-certificates",
 	"debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt",
@@ -83,8 +84,9 @@ buildDepsNoHaskellLibs = Apt.installed
 	"libmagic-dev", "alex", "happy", "c2hs"
 	]
 
-haskellPkgsInstalled :: String -> Property NoInfo
-haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled")
+haskellPkgsInstalled :: String -> Property DebianLike
+haskellPkgsInstalled dir = tightenTargets $ 
+	flagFile go ("/haskellpkgsinstalled")
   where
 	go = userScriptProperty (User builduser)
 		[ "cd " ++ builddir ++ " && ./standalone/" ++ dir ++ "/install-haskell-packages"
@@ -93,7 +95,7 @@ haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled")
 
 -- Installs current versions of git-annex's deps from cabal, but only
 -- does so once.
-cabalDeps :: Property NoInfo
+cabalDeps :: Property UnixLike
 cabalDeps = flagFile go cabalupdated
 	where
 		go = userScriptProperty (User builduser)
@@ -101,20 +103,20 @@ cabalDeps = flagFile go cabalupdated
 			`assume` MadeChange
 		cabalupdated = homedir  ".cabal"  "packages"  "hackage.haskell.org"  "00-index.cache"
 
-autoBuilderContainer :: (System -> Flavor -> Property HasInfo) -> System -> Flavor -> Times -> TimeOut -> Systemd.Container
-autoBuilderContainer mkprop osver@(System _ arch) flavor crontime timeout =
-	Systemd.container name osver (Chroot.debootstrapped mempty)
-		& mkprop osver flavor
+autoBuilderContainer :: (DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)) -> DebianSuite -> Architecture -> Flavor -> Times -> TimeOut -> Systemd.Container
+autoBuilderContainer mkprop suite arch flavor crontime timeout =
+	Systemd.container name $ \d -> Chroot.debootstrapped mempty d $ props
+		& mkprop suite arch flavor
 		& autobuilder arch crontime timeout
   where
 	name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
 
 type Flavor = Maybe String
 
-standardAutoBuilder :: System -> Flavor -> Property HasInfo
-standardAutoBuilder osver@(System _ arch) flavor =
+standardAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+standardAutoBuilder suite arch flavor =
 	propertyList "standard git-annex autobuilder" $ props
-		& os osver
+		& osDebian suite arch
 		& buildDepsApt
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
@@ -122,10 +124,10 @@ standardAutoBuilder osver@(System _ arch) flavor =
 		& User.accountFor (User builduser)
 		& tree arch flavor
 
-stackAutoBuilder :: System -> Flavor -> Property HasInfo
-stackAutoBuilder osver@(System _ arch) flavor =
+stackAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+stackAutoBuilder suite arch flavor =
 	propertyList "git-annex autobuilder using stack" $ props
-		& os osver
+		& osDebian suite arch
 		& buildDepsNoHaskellLibs
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
@@ -134,34 +136,34 @@ stackAutoBuilder osver@(System _ arch) flavor =
 		& tree arch flavor
 		& stackInstalled
 
-stackInstalled :: Property NoInfo
-stackInstalled = withOS "stack installed" $ \o ->
+stackInstalled :: Property Linux
+stackInstalled = withOS "stack installed" $ \w o ->
 	case o of
 		(Just (System (Debian (Stable "jessie")) "i386")) ->
-			ensureProperty $ manualinstall "i386"
-		_ -> ensureProperty $ Apt.installed ["haskell-stack"]
+			ensureProperty w $ manualinstall "i386"
+		_ -> ensureProperty w $ Apt.installed ["haskell-stack"]
   where
 	-- Warning: Using a binary downloaded w/o validation.
-	manualinstall arch = check (not <$> doesFileExist binstack) $
-		propertyList "stack installed from upstream tarball"
-			[ cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
+	manualinstall :: Architecture -> Property Linux
+	manualinstall arch = tightenTargets $ check (not <$> doesFileExist binstack) $
+		propertyList "stack installed from upstream tarball" $ props
+			& cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
 				`assume` MadeChange
-			, File.dirExists tmpdir
-			, cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
+			& File.dirExists tmpdir
+			& cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
 				`assume` MadeChange
-			, cmdProperty "mv" [tmpdir  "stack", binstack]
+			& cmdProperty "mv" [tmpdir  "stack", binstack]
 				`assume` MadeChange
-			, cmdProperty "rm" ["-rf", tmpdir, tmptar]
+			& cmdProperty "rm" ["-rf", tmpdir, tmptar]
 				`assume` MadeChange
-			]
 	binstack = "/usr/bin/stack"
 	tmptar = "/root/stack.tar.gz"
 	tmpdir = "/root/stack"
 
-armAutoBuilder :: System -> Flavor -> Property HasInfo
-armAutoBuilder osver flavor = 
+armAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+armAutoBuilder suite arch flavor = 
 	propertyList "arm git-annex autobuilder" $ props
-		& standardAutoBuilder osver flavor
+		& standardAutoBuilder suite arch flavor
 		& buildDepsNoHaskellLibs
 		-- Works around ghc crash with parallel builds on arm.
 		& (homedir  ".cabal"  "config")
@@ -172,26 +174,30 @@ armAutoBuilder osver flavor =
 
 androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
 androidAutoBuilderContainer crontimes timeout =
-	androidContainer "android-git-annex-builder" (tree "android" Nothing) builddir
-		& Apt.unattendedUpgrades
-		& buildDepsNoHaskellLibs
-		& autobuilder "android" crontimes timeout
+	androidAutoBuilderContainer' "android-git-annex-builder"
+		(tree "android" Nothing) builddir crontimes timeout
 
 -- Android is cross-built in a Debian i386 container, using the Android NDK.
-androidContainer
-	:: (IsProp (Property (CInfo NoInfo i)), (Combines (Property NoInfo) (Property i)))
-	=> Systemd.MachineName
-	-> Property i
+androidAutoBuilderContainer'
+	:: Systemd.MachineName
+	-> Property DebianLike
 	-> FilePath
+	-> Times
+	-> TimeOut
 	-> Systemd.Container
-androidContainer name setupgitannexdir gitannexdir = Systemd.container name osver bootstrap
-	& Apt.stdSourcesList
-	& User.accountFor (User builduser)
-	& File.dirExists gitbuilderdir
-	& File.ownerGroup homedir (User builduser) (Group builduser)
-	& flagFile chrootsetup ("/chrootsetup")
-		`requires` setupgitannexdir
-	& haskellPkgsInstalled "android"
+androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout = 
+	Systemd.container name $ \d -> bootstrap d $ props
+		& osDebian (Stable "jessie") "i386"
+		& Apt.stdSourcesList
+		& User.accountFor (User builduser)
+		& File.dirExists gitbuilderdir
+		& File.ownerGroup homedir (User builduser) (Group builduser)
+		& flagFile chrootsetup ("/chrootsetup")
+			`requires` setupgitannexdir
+		& haskellPkgsInstalled "android"
+		& Apt.unattendedUpgrades
+		& buildDepsNoHaskellLibs
+		& autobuilder "android" crontimes timeout
   where
 	-- Use git-annex's android chroot setup script, which will install
 	-- ghc-android and the NDK, all build deps, etc, in the home
@@ -200,5 +206,4 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name osve
 		[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
 		]
 		`assume` MadeChange
-	osver = System (Debian (Stable "jessie")) "i386"
 	bootstrap = Chroot.debootstrapped mempty
diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs
index 83a1a16a..f14b5f12 100644
--- a/src/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/src/Propellor/Property/SiteSpecific/GitHome.hs
@@ -5,14 +5,15 @@ import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.User
 
 -- | Clones Joey Hess's git home directory, and runs its fixups script.
-installedFor :: User -> Property NoInfo
+installedFor :: User -> Property DebianLike
 installedFor user@(User u) = check (not <$> hasGitDir user) $ 
-	property ("githome " ++ u) (go =<< liftIO (homedir user))
-		`requires` Apt.installed ["git"]
+	go `requires` Apt.installed ["git"]
   where
-	go home = do
+	go :: Property DebianLike
+	go = property' ("githome " ++ u) $ \w -> do
+		home <- liftIO (homedir user)
 		let tmpdir = home  "githome"
-		ensureProperty $ combineProperties "githome setup"
+		ensureProperty w $ combineProperties "githome setup" $ toProps
 			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
 				`assume` MadeChange
 			, property "moveout" $ makeChange $ void $
diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs
index bb62fba7..b245e444 100644
--- a/src/Propellor/Property/SiteSpecific/IABak.hs
+++ b/src/Propellor/Property/SiteSpecific/IABak.hs
@@ -15,14 +15,14 @@ repo = "https://github.com/ArchiveTeam/IA.BAK/"
 userrepo :: String
 userrepo = "git@gitlab.com:archiveteam/IA.bak.users.git"
 
-publicFace :: Property HasInfo
+publicFace :: Property DebianLike
 publicFace = propertyList "iabak public face" $ props
 	& Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
 	& Apt.serviceInstalledRunning "apache2"
 	& Cron.niceJob "graph-gen" (Cron.Times "*/10 * * * *") (User "root") "/"
 		"/usr/local/IA.BAK/web/graph-gen.sh"
 
-gitServer :: [Host] -> Property HasInfo
+gitServer :: [Host] -> Property (HasInfo + DebianLike)
 gitServer knownhosts = propertyList "iabak git server" $ props
 	& Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
 	& Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master")
@@ -42,7 +42,7 @@ gitServer knownhosts = propertyList "iabak git server" $ props
 		"/usr/local/IA.BAK"
 		"./expireemailer"
 
-registrationServer :: [Host] -> Property HasInfo
+registrationServer :: [Host] -> Property (HasInfo + DebianLike)
 registrationServer knownhosts = propertyList "iabak registration server" $ props
 	& User.accountFor (User "registrar")
 	& Ssh.userKeys (User "registrar") (Context "IA.bak.users.git") sshKeys
@@ -66,7 +66,7 @@ sshKeys =
 	[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCoiE+CPiIQyfWnl/E9iKG3eo4QzlH30vi7xAgKolGaTu6qKy4XPtl+8MNm2Dqn9QEYRVyyOT/XH0yP5dRc6uyReT8dBy03MmLkVbj8Q+nKCz5YOMTxrY3sX6RRXU1zVGjeVd0DtC+rKRT7reoCxef42LAJTm8nCyZu/enAuso5qHqBbqulFz2YXEKfU1SEEXLawtvgGck1KmCyg+pqazeI1eHWXrojQf5isTBKfPQLWVppBkWAf5cA4wP5U1vN9dVirIdw66ds1M8vnGlkTBjxP/HLGBWGYhZHE7QXjXRsk2RIXlHN9q6GdNu8+F3HXS22mst47E4UAeRoiXSMMtF5")
 	]
 
-graphiteServer :: Property HasInfo
+graphiteServer :: Property (HasInfo + DebianLike)
 graphiteServer = propertyList "iabak graphite server" $ props
 	& Apt.serviceInstalledRunning "apache2"
 	& Apt.installed ["libapache2-mod-wsgi", "graphite-carbon", "graphite-web"]
@@ -114,7 +114,8 @@ graphiteServer = propertyList "iabak graphite server" $ props
 		, ""
 		]
   where
+	graphiteCSRF :: Property (HasInfo + DebianLike)
 	graphiteCSRF = withPrivData (Password "csrf-token") (Context "iabak.archiveteam.org") $
-		\gettoken -> property "graphite-web CSRF token" $
-			gettoken $ \token -> ensureProperty $ File.containsLine
+		\gettoken -> property' "graphite-web CSRF token" $ \w ->
+			gettoken $ \token -> ensureProperty w $ File.containsLine
 				"/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ privDataVal token ++"'")
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 03f2efcb..0ce64939 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1,6 +1,8 @@
 -- | Specific configuration for Joey Hess's sites. Probably not useful to
 -- others except as an example.
 
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
 module Propellor.Property.SiteSpecific.JoeySites where
 
 import Propellor.Base
@@ -24,7 +26,7 @@ import Data.List
 import System.Posix.Files
 import Data.String.Utils
 
-scrollBox :: Property HasInfo
+scrollBox :: Property (HasInfo + DebianLike)
 scrollBox = propertyList "scroll server" $ props
 	& User.accountFor (User "scroll")
 	& Git.cloned (User "scroll") "git://git.kitenet.net/scroll" (d  "scroll") Nothing
@@ -94,16 +96,12 @@ scrollBox = propertyList "scroll server" $ props
 	s = d  "login.sh"
 	g = d  "game.sh"
 
-oldUseNetServer :: [Host] -> Property HasInfo
+oldUseNetServer :: [Host] -> Property (HasInfo + DebianLike)
 oldUseNetServer hosts = propertyList "olduse.net server" $ props
 	& Apt.installed ["leafnode"]
 	& oldUseNetInstalled "oldusenet-server"
 	& oldUseNetBackup
-	& check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool)
-		(property "olduse.net spool in place" $ makeChange $ do
-			removeDirectoryRecursive newsspool
-			createSymbolicLink (datadir  "news") newsspool
-		)
+	& spoolsymlink
 	& "/etc/news/leafnode/config" `File.hasContent` 
 		[ "# olduse.net configuration (deployed by propellor)"
 		, "expire = 1000000" -- no expiry via texpire
@@ -135,7 +133,15 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
 		, Apache.allowAll
 		, "  "
 		]
+	
+	spoolsymlink :: Property UnixLike
+	spoolsymlink = check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool)
+		(property "olduse.net spool in place" $ makeChange $ do
+			removeDirectoryRecursive newsspool
+			createSymbolicLink (datadir  "news") newsspool
+		)
 
+	oldUseNetBackup :: Property (HasInfo + DebianLike)
 	oldUseNetBackup = Obnam.backup datadir (Cron.Times "33 4 * * *")
 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
 		, "--client-name=spool"
@@ -149,12 +155,12 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
 	keyfile = "/root/.ssh/olduse.net.key"
 
-oldUseNetShellBox :: Property HasInfo
+oldUseNetShellBox :: Property DebianLike
 oldUseNetShellBox = propertyList "olduse.net shellbox" $ props
 	& oldUseNetInstalled "oldusenet"
 	& Service.running "shellinabox"
 
-oldUseNetInstalled :: Apt.Package -> Property HasInfo
+oldUseNetInstalled :: Apt.Package -> Property DebianLike
 oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
 	propertyList ("olduse.net " ++ pkg) $ props
 		& Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
@@ -170,25 +176,25 @@ oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
 			]
 			`assume` MadeChange
 			`describe` "olduse.net built"
-
-kgbServer :: Property HasInfo
+ 
+kgbServer :: Property (HasInfo + Debian)
 kgbServer = propertyList desc $ props
 	& installed
 	& File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
 		`onChange` Service.restarted "kgb-bot"
   where
 	desc = "kgb.kitenet.net setup"
-	installed = withOS desc $ \o -> case o of
+	installed :: Property Debian
+	installed = withOS desc $ \w o -> case o of
 		(Just (System (Debian Unstable) _)) ->
-			ensureProperty $ propertyList desc
-				[ Apt.serviceInstalledRunning "kgb-bot"
-				, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
+			ensureProperty w $ propertyList desc $ props
+				& Apt.serviceInstalledRunning "kgb-bot"
+				& "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
 					`describe` "kgb bot enabled"
 					`onChange` Service.running "kgb-bot"
-				]
 		_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
 
-mumbleServer :: [Host] -> Property HasInfo
+mumbleServer :: [Host] -> Property (HasInfo + DebianLike)
 mumbleServer hosts = combineProperties hn $ props
 	& Apt.serviceInstalledRunning "mumble-server"
 	& Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *")
@@ -209,7 +215,7 @@ mumbleServer hosts = combineProperties hn $ props
 	sshkey = "/root/.ssh/mumble.debian.net.key"
 
 -- git.kitenet.net and git.joeyh.name
-gitServer :: [Host] -> Property HasInfo
+gitServer :: [Host] -> Property (HasInfo + DebianLike)
 gitServer hosts = propertyList "git.kitenet.net setup" $ props
 	& Obnam.backupEncrypted "/srv/git" (Cron.Times "33 3 * * *")
 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"
@@ -266,7 +272,7 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props
 type AnnexUUID = String
 
 -- | A website, with files coming from a git-annex repository.
-annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property HasInfo
+annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property (HasInfo + DebianLike)
 annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex") $ props
 	& Git.cloned (User "joey") origin dir Nothing
 		`onChange` setup
@@ -308,7 +314,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
 		, "  "
 		]
 
-apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty NoInfo
+apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
 apacheSite hn withssl middle = Apache.siteEnabled hn $ apachecfg hn withssl middle
 
 apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
@@ -348,7 +354,7 @@ mainhttpscert True =
 	, "  SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
 	]
 		
-gitAnnexDistributor :: Property HasInfo
+gitAnnexDistributor :: Property (HasInfo + DebianLike)
 gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props
 	& Apt.installed ["rsync"]
 	& File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
@@ -364,19 +370,18 @@ gitAnnexDistributor = combineProperties "git-annex distributor, including rsync
 	-- git-annex distribution signing key
 	& Gpg.keyImported (Gpg.GpgKeyId "89C809CB") (User "joey")
   where
-	endpoint d = combineProperties ("endpoint " ++ d)
-		[ File.dirExists d
-		, File.ownerGroup d (User "joey") (Group "joey")
-		]
+	endpoint d = combineProperties ("endpoint " ++ d) $ props
+		& File.dirExists d
+		& File.ownerGroup d (User "joey") (Group "joey")
 
-downloads :: [Host] -> Property HasInfo
+downloads :: [Host] -> Property (HasInfo + DebianLike)
 downloads hosts = annexWebSite "/srv/git/downloads.git"
 	"downloads.kitenet.net"
 	"840760dc-08f0-11e2-8c61-576b7e66acfd"
 	[("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")]
 	`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "joey")
 	
-tmp :: Property HasInfo
+tmp :: Property (HasInfo + DebianLike)
 tmp = propertyList "tmp.kitenet.net" $ props
 	& annexWebSite "/srv/git/joey/tmp.git"
 		"tmp.kitenet.net"
@@ -386,7 +391,7 @@ tmp = propertyList "tmp.kitenet.net" $ props
 	& pumpRss
 
 -- Twitter, you kill us.
-twitRss :: Property HasInfo
+twitRss :: Property DebianLike
 twitRss = combineProperties "twitter rss" $ props
 	& Git.cloned (User "joey") "git://git.kitenet.net/twitrss.git" dir Nothing
 	& check (not <$> doesFileExist (dir  "twitRss")) compiled
@@ -409,11 +414,11 @@ twitRss = combineProperties "twitter rss" $ props
 			]
 
 -- Work around for expired ssl cert.
-pumpRss :: Property NoInfo
+pumpRss :: Property DebianLike
 pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") (User "joey") "/srv/web/tmp.kitenet.net/"
 	"wget https://rss.io.jpope.org/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom"
 
-ircBouncer :: Property HasInfo
+ircBouncer :: Property (HasInfo + DebianLike)
 ircBouncer = propertyList "IRC bouncer" $ props
 	& Apt.installed ["znc"]
 	& User.accountFor (User "znc")
@@ -428,20 +433,19 @@ ircBouncer = propertyList "IRC bouncer" $ props
   where
 	conf = "/home/znc/.znc/configs/znc.conf"
 
-kiteShellBox :: Property NoInfo
-kiteShellBox = propertyList "kitenet.net shellinabox"
-	[ Apt.installed ["openssl", "shellinabox", "openssh-client"]
-	, File.hasContent "/etc/default/shellinabox"
+kiteShellBox :: Property DebianLike
+kiteShellBox = propertyList "kitenet.net shellinabox" $ props
+	& Apt.installed ["openssl", "shellinabox", "openssh-client"]
+	& File.hasContent "/etc/default/shellinabox"
 		[ "# Deployed by propellor"
 		, "SHELLINABOX_DAEMON_START=1"
 		, "SHELLINABOX_PORT=443"
 		, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net\""
 		]
 		`onChange` Service.restarted "shellinabox"
-	, Service.running "shellinabox"
-	]
+	& Service.running "shellinabox"
 
-githubBackup :: Property HasInfo
+githubBackup :: Property (HasInfo + DebianLike)
 githubBackup = propertyList "github-backup box" $ props
 	& Apt.installed ["github-backup", "moreutils"]
 	& githubKeys
@@ -462,7 +466,7 @@ githubBackup = propertyList "github-backup box" $ props
 		] ++ map gitriddance githubMirrors
 	gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")"
 
-githubKeys :: Property HasInfo
+githubKeys :: Property (HasInfo + UnixLike)
 githubKeys = 
 	let f = "/home/joey/.github-keys"
 	in File.hasPrivContent f anyContext
@@ -482,12 +486,12 @@ githubMirrors =
   where
 	plzuseurl u = "Please submit changes to " ++ u ++ " instead of using github pull requests, which are not part of my workflow. Just open a todo item there and link to a git repository containing your changes. Did you know, git is a distributed system? The git repository doesn't even need to be on github! Please send any complaints to Github; they don't allow turning off pull requests or redirecting them elsewhere.  -- A robot acting on behalf of Joey Hess"
 
-rsyncNetBackup :: [Host] -> Property NoInfo
+rsyncNetBackup :: [Host] -> Property DebianLike
 rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" (Cron.Times "30 5 * * *")
 	(User "joey") "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"
 	`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "joey")
 
-backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property NoInfo
+backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property DebianLike
 backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc
 	(Cron.Times "@reboot") (User "joey") "/" cmd
 	`requires` Ssh.knownHost hosts srchost (User "joey")
@@ -495,9 +499,9 @@ backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc
 	desc = "backups copied from " ++ srchost ++ " on boot"
 	cmd = "sleep 30m && rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir  srchost
 
-obnamRepos :: [String] -> Property NoInfo
-obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
-	(mkbase : map mkrepo rs)
+obnamRepos :: [String] -> Property UnixLike
+obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) $
+	toProps (mkbase : map mkrepo rs)
   where
 	mkbase = mkdir "/home/joey/lib/backup"
 		`requires` mkdir "/home/joey/lib"
@@ -505,13 +509,13 @@ obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
 	mkdir d = File.dirExists d
 		`before` File.ownerGroup d (User "joey") (Group "joey")
 
-podcatcher :: Property NoInfo
+podcatcher :: Property DebianLike
 podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *")
 	(User "joey") "/home/joey/lib/sound/podcasts"
 	"xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
 	`requires` Apt.installed ["git-annex", "myrepos"]
 
-kiteMailServer :: Property HasInfo
+kiteMailServer :: Property (HasInfo + DebianLike)
 kiteMailServer = propertyList "kitenet.net mail server" $ props
 	& Postfix.installed
 	& Apt.installed ["postfix-pcre"]
@@ -710,7 +714,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 
 -- Configures postfix to relay outgoing mail to kitenet.net, with
 -- verification via tls cert.
-postfixClientRelay :: Context -> Property HasInfo
+postfixClientRelay :: Context -> Property (HasInfo + DebianLike)
 postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`
 	-- Using smtps not smtp because more networks firewall smtp
 	[ "relayhost = kitenet.net:smtps"
@@ -727,7 +731,7 @@ postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`
 	`requires` hasPostfixCert ctx
 
 -- Configures postfix to have the dkim milter, and no other milters.
-dkimMilter :: Property HasInfo
+dkimMilter :: Property (HasInfo + DebianLike)
 dkimMilter = Postfix.mainCfFile `File.containsLines`
 	[ "smtpd_milters = inet:localhost:8891"
 	, "non_smtpd_milters = inet:localhost:8891"
@@ -740,7 +744,7 @@ dkimMilter = Postfix.mainCfFile `File.containsLines`
 
 -- This does not configure postfix to use the dkim milter,
 -- nor does it set up domainkey DNS.
-dkimInstalled :: Property HasInfo
+dkimInstalled :: Property (HasInfo + DebianLike)
 dkimInstalled = go `onChange` Service.restarted "opendkim"
   where
 	go = propertyList "opendkim installed" $ props
@@ -763,17 +767,16 @@ dkimInstalled = go `onChange` Service.restarted "opendkim"
 domainKey :: (BindDomain, Record)
 domainKey = (RelDomain "mail._domainkey", TXT "v=DKIM1; k=rsa; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB")
 
-hasJoeyCAChain :: Property HasInfo
+hasJoeyCAChain :: Property (HasInfo + UnixLike)
 hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
 	Context "joeyca.pem"
 
-hasPostfixCert :: Context -> Property HasInfo
-hasPostfixCert ctx = combineProperties "postfix tls cert installed"
-	[ "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
-	, "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
-	]
+hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
+hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props
+	& "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
+	& "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
 
-kitenetHttps :: Property HasInfo
+kitenetHttps :: Property (HasInfo + DebianLike)
 kitenetHttps = propertyList "kitenet.net https certs" $ props
 	& File.hasPrivContent "/etc/ssl/certs/web.pem" ctx
 	& File.hasPrivContent "/etc/ssl/private/web.pem" ctx
@@ -784,7 +787,7 @@ kitenetHttps = propertyList "kitenet.net https certs" $ props
 
 -- Legacy static web sites and redirections from kitenet.net to newer
 -- sites.
-legacyWebSites :: Property HasInfo
+legacyWebSites :: Property (HasInfo + DebianLike)
 legacyWebSites = propertyList "legacy web sites" $ props
 	& Apt.serviceInstalledRunning "apache2"
 	& Apache.modEnabled "rewrite"
@@ -944,7 +947,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		, "rewriterule (.*) http://joeyh.name$1 [r]"
 		]
 
-userDirHtml :: Property NoInfo
+userDirHtml :: Property DebianLike
 userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
 	`onChange` Apache.reloaded
 	`requires` Apache.modEnabled "userdir"
@@ -956,10 +959,9 @@ userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
 -- 
 --
 -- oncalendar example value: "*-*-* 7:30"
-alarmClock :: String -> User -> String -> Property NoInfo
-alarmClock oncalendar (User user) command = combineProperties
-	"goodmorning timer installed"
-	[ "/etc/systemd/system/goodmorning.timer" `File.hasContent`
+alarmClock :: String -> User -> String -> Property DebianLike
+alarmClock oncalendar (User user) command = combineProperties "goodmorning timer installed" $ props
+	& "/etc/systemd/system/goodmorning.timer" `File.hasContent`
 		[ "[Unit]"
 		, "Description=good morning"
 		, ""
@@ -974,7 +976,7 @@ alarmClock oncalendar (User user) command = combineProperties
 		]
 		`onChange` (Systemd.daemonReloaded
 			`before` Systemd.restarted "goodmorning.timer")
-	, "/etc/systemd/system/goodmorning.service" `File.hasContent`
+	& "/etc/systemd/system/goodmorning.service" `File.hasContent`
 		[ "[Unit]"
 		, "Description=good morning"
 		, "RefuseManualStart=true"
@@ -987,8 +989,7 @@ alarmClock oncalendar (User user) command = combineProperties
 		, "ExecStart=/bin/systemd-inhibit --what=handle-lid-switch --why=goodmorning /bin/su " ++ user ++ " -c \"" ++ command ++ "\""
 		]
 		`onChange` Systemd.daemonReloaded
-	, Systemd.enabled "goodmorning.timer"
-	, Systemd.started "goodmorning.timer"
-	, "/etc/systemd/logind.conf" `ConfFile.containsIniSetting`
+	& Systemd.enabled "goodmorning.timer"
+	& Systemd.started "goodmorning.timer"
+	& "/etc/systemd/logind.conf" `ConfFile.containsIniSetting`
 		("Login", "LidSwitchIgnoreInhibited", "no")
-	]
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 26cdbeb7..6e1690d2 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-}
 
 module Propellor.Property.Ssh (
 	installed,
@@ -47,10 +47,13 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.List
 
-installed :: Property NoInfo
-installed = Apt.installed ["ssh"]
+installed :: Property UnixLike
+installed = "ssh installed" ==> (aptinstall `pickOS` unsupportedOS)
+  where
+	aptinstall :: Property DebianLike
+	aptinstall = Apt.installed ["ssh"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "ssh"
 
 sshBool :: Bool -> String
@@ -62,10 +65,10 @@ sshdConfig = "/etc/ssh/sshd_config"
 
 type ConfigKeyword = String
 
-setSshdConfigBool :: ConfigKeyword -> Bool -> Property NoInfo
+setSshdConfigBool :: ConfigKeyword -> Bool -> Property DebianLike
 setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed)
 
-setSshdConfig :: ConfigKeyword -> String -> Property NoInfo
+setSshdConfig :: ConfigKeyword -> String -> Property DebianLike
 setSshdConfig setting val = File.fileProperty desc f sshdConfig
 	`onChange` restarted
   where
@@ -84,19 +87,19 @@ data RootLogin
 	| WithoutPassword -- ^ disable password authentication for root, while allowing other authentication methods
 	| ForcedCommandsOnly -- ^ allow root login with public-key authentication, but only if a forced command has been specified for the public key
 
-permitRootLogin :: RootLogin -> Property NoInfo
+permitRootLogin :: RootLogin -> Property DebianLike
 permitRootLogin (RootLogin b) = setSshdConfigBool "PermitRootLogin" b
 permitRootLogin WithoutPassword = setSshdConfig "PermitRootLogin" "without-password"
 permitRootLogin ForcedCommandsOnly = setSshdConfig "PermitRootLogin" "forced-commands-only"
 
-passwordAuthentication :: Bool -> Property NoInfo
+passwordAuthentication :: Bool -> Property DebianLike
 passwordAuthentication = setSshdConfigBool "PasswordAuthentication"
 
 -- | Configure ssh to not allow password logins.
 --
 -- To prevent lock-out, this is done only once root's
 -- authorized_keys is in place.
-noPasswords :: Property NoInfo
+noPasswords :: Property DebianLike
 noPasswords = check (hasAuthorizedKeys (User "root")) $
 	passwordAuthentication False
 
@@ -114,7 +117,7 @@ dotFile f user = do
 -- ports it is configured to listen on.
 --
 -- Revert to prevent it listening on a particular port.
-listenPort :: Port -> RevertableProperty NoInfo
+listenPort :: Port -> RevertableProperty DebianLike DebianLike
 listenPort port = enable  disable
   where
 	portline = "Port " ++ fromPort port
@@ -133,16 +136,17 @@ hasAuthorizedKeys = go <=< dotFile "authorized_keys"
 -- | Blows away existing host keys and make new ones.
 -- Useful for systems installed from an image that might reuse host keys.
 -- A flag file is used to only ever do this once.
-randomHostKeys :: Property NoInfo
+randomHostKeys :: Property DebianLike
 randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 	`onChange` restarted
   where
-	prop = property "ssh random host keys" $ do
+	prop :: Property UnixLike
+	prop = property' "ssh random host keys" $ \w -> do
 		void $ liftIO $ boolSystem "sh"
 			[ Param "-c"
 			, Param "rm -f /etc/ssh/ssh_host_*"
 			]
-		ensureProperty $ scriptProperty [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
+		ensureProperty w $ scriptProperty [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
 			`assume` MadeChange
 
 -- | The text of a ssh public key, for example, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI"
@@ -153,43 +157,51 @@ type PubKeyText = String
 -- The corresponding private keys come from the privdata.
 --
 -- Any host keys that are not in the list are removed from the host.
-hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property HasInfo
-hostKeys ctx l = propertyList desc $ catMaybes $
-	map (\(t, pub) -> Just $ hostKey ctx t pub) l ++ [cleanup]
+hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + DebianLike)
+hostKeys ctx l = go `before` cleanup
   where
 	desc = "ssh host keys configured " ++ typelist (map fst l)
+	go :: Property (HasInfo + DebianLike)
+	go = propertyList desc $ toProps $ catMaybes $
+		map (\(t, pub) -> Just $ hostKey ctx t pub) l
 	typelist tl = "(" ++ unwords (map fromKeyType tl) ++ ")"
 	alltypes = [minBound..maxBound]
 	staletypes = let have = map fst l in filter (`notElem` have) alltypes
-	removestale b = map (File.notPresent . flip keyFile b) staletypes
+	removestale :: Bool -> [Property DebianLike]
+	removestale b = map (tightenTargets . File.notPresent . flip keyFile b) staletypes
+	cleanup :: Property DebianLike
 	cleanup
-		| null staletypes || null l = Nothing
-		| otherwise = Just $ toProp $
-			property ("any other ssh host keys removed " ++ typelist staletypes) $
-				ensureProperty $
-					combineProperties desc (removestale True ++ removestale False)
-					`onChange` restarted
+		| null staletypes || null l = doNothing
+		| otherwise =
+			combineProperties ("any other ssh host keys removed " ++ typelist staletypes)
+				(toProps $ removestale True ++ removestale False)
+				`onChange` restarted
 
 -- | Installs a single ssh host key of a particular type.
 --
 -- The public key is provided to this function;
 -- the private key comes from the privdata;
-hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo
-hostKey context keytype pub = combineProperties desc
-	[ hostPubKey keytype pub
-	, toProp $ property desc $ install File.hasContent True (lines pub)
-	, withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey ->
-		property desc $ getkey $
-			install File.hasContentProtected False . privDataLines
-	]
-	`onChange` restarted
+hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property (HasInfo + DebianLike)
+hostKey context keytype pub = go `onChange` restarted
   where
+	go = combineProperties desc $ props
+		& hostPubKey keytype pub
+		& installpub
+		& installpriv
 	desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"
-	install writer ispub keylines = do
-		let f = keyFile keytype ispub
-		ensureProperty $ writer f (keyFileContent keylines)
 	keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
 		("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
+	installpub :: Property UnixLike
+	installpub = keywriter File.hasContent True (lines pub)
+	installpriv :: Property (HasInfo + UnixLike)
+	installpriv = withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey ->
+		property' desc $ \w -> getkey $
+			ensureProperty w
+				. keywriter File.hasContentProtected False
+				. privDataLines
+	keywriter p ispub keylines = do
+		let f = keyFile keytype ispub
+		p f (keyFileContent keylines)
 
 -- Make sure that there is a newline at the end;
 -- ssh requires this for some types of private keys.
@@ -204,7 +216,7 @@ keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++
 -- | Indicates the host key that is used by a Host, but does not actually
 -- configure the host to use it. Normally this does not need to be used;
 -- use 'hostKey' instead.
-hostPubKey :: SshKeyType -> PubKeyText -> Property HasInfo
+hostPubKey :: SshKeyType -> PubKeyText -> Property (HasInfo + UnixLike)
 hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t
 
 getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText)
@@ -224,7 +236,7 @@ instance Monoid HostKeyInfo where
 		-- parameter when there is a duplicate key
 		HostKeyInfo (new `M.union` old)
 
-userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property HasInfo
+userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike)
 userPubKeys u@(User n) l = pureInfoProperty ("ssh pubkey for " ++ n) $
 	UserKeyInfo (M.singleton u (S.fromList l))
 
@@ -248,8 +260,8 @@ instance Monoid UserKeyInfo where
 --
 -- The public keys are added to the Info, so other properties like
 -- `authorizedKeysFrom` can use them.
-userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo
-userKeys user@(User name) context ks = combineProperties desc $
+userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike)
+userKeys user@(User name) context ks = combineProperties desc $ toProps $
 	userPubKeys user ks : map (userKeyAt Nothing user context) ks
   where
 	desc = unwords
@@ -264,7 +276,7 @@ userKeys user@(User name) context ks = combineProperties desc $
 -- A file can be specified to write the key to somewhere other than
 -- the default locations. Allows a user to have multiple keys for
 -- different roles.
-userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property HasInfo
+userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property (HasInfo + UnixLike)
 userKeyAt dest user@(User u) context (keytype, pubkeytext) =
 	combineProperties desc $ props
 		& pubkey
@@ -276,17 +288,21 @@ userKeyAt dest user@(User u) context (keytype, pubkeytext) =
 		, dest
 		, Just $ "(" ++ fromKeyType keytype ++ ")"
 		]
-	pubkey = property desc $ install File.hasContent ".pub" [pubkeytext]
-	privkey = withPrivData (SshPrivKey keytype u) context $ \getkey ->
-		property desc $ getkey $
-			install File.hasContentProtected "" . privDataLines
-	install writer ext key = do
+	pubkey :: Property UnixLike
+	pubkey = property' desc $ \w -> 
+		ensureProperty w =<< installprop File.hasContent ".pub" [pubkeytext]
+	privkey :: Property (HasInfo + UnixLike)
+	privkey = withPrivData (SshPrivKey keytype u) context privkey'
+	privkey' :: ((PrivData -> Propellor Result) -> Propellor Result) -> Property (HasInfo + UnixLike)
+	privkey' getkey = property' desc $ \w -> getkey $ \k ->
+		ensureProperty w
+			=<< installprop File.hasContentProtected "" (privDataLines k)
+	installprop writer ext key = do
 		f <- liftIO $ keyfile ext
-		ensureProperty $ combineProperties desc
-			[ writer f (keyFileContent key)
-			, File.ownerGroup f user (userGroup user)
-			, File.ownerGroup (takeDirectory f) user (userGroup user)
-			]
+		return $ combineProperties desc $ props
+			& writer f (keyFileContent key)
+			& File.ownerGroup f user (userGroup user)
+			& File.ownerGroup (takeDirectory f) user (userGroup user)
 	keyfile ext = case dest of
 		Nothing -> do
 			home <- homeDirectory <$> getUserEntryForName u
@@ -301,33 +317,34 @@ fromKeyType SshEd25519 = "ed25519"
 
 -- | Puts some host's ssh public key(s), as set using `hostPubKey`
 -- or `hostKey` into the known_hosts file for a user.
-knownHost :: [Host] -> HostName -> User -> Property NoInfo
-knownHost hosts hn user@(User u) = property desc $
-	go =<< knownHostLines hosts hn
+knownHost :: [Host] -> HostName -> User -> Property UnixLike
+knownHost hosts hn user@(User u) = property' desc $ \w ->
+	go w =<< knownHostLines hosts hn
   where
 	desc = u ++ " knows ssh key for " ++ hn
 
-	go [] = do
+	go _ [] = do
 		warningMessage $ "no configured ssh host keys for " ++ hn
 		return FailedChange
-	go ls = do
+	go w ls = do
 		f <- liftIO $ dotFile "known_hosts" user
-		modKnownHost user f $
+		ensureProperty w $ modKnownHost user f $
 			f `File.containsLines` ls
 				`requires` File.dirExists (takeDirectory f)
 
 -- | Reverts `knownHost`
-unknownHost :: [Host] -> HostName -> User -> Property NoInfo
-unknownHost hosts hn user@(User u) = property desc $
-	go =<< knownHostLines hosts hn
+unknownHost :: [Host] -> HostName -> User -> Property UnixLike
+unknownHost hosts hn user@(User u) = property' desc $ \w ->
+	go w =<< knownHostLines hosts hn
   where
 	desc = u ++ " does not know ssh key for " ++ hn
 
-	go [] = return NoChange
-	go ls = do
+	go _ [] = return NoChange
+	go w ls = do
 		f <- liftIO $ dotFile "known_hosts" user
 		ifM (liftIO $ doesFileExist f)
-			( modKnownHost user f $ f `File.lacksLines` ls
+			( ensureProperty w $ modKnownHost user f $
+				f `File.lacksLines` ls
 			, return NoChange
 			)
 
@@ -337,8 +354,8 @@ knownHostLines hosts hn = keylines <$> fromHost hosts hn getHostPubKey
 	keylines (Just m) = map (\k -> hn ++ " " ++ k) (M.elems m)
 	keylines Nothing = []
 
-modKnownHost :: User -> FilePath -> Property NoInfo -> Propellor Result
-modKnownHost user f p = ensureProperty $ p
+modKnownHost :: User -> FilePath -> Property UnixLike -> Property UnixLike
+modKnownHost user f p = p
 	`requires` File.ownerGroup f user (userGroup user)
 	`requires` File.ownerGroup (takeDirectory f) user (userGroup user)
 
@@ -348,30 +365,30 @@ modKnownHost user f p = ensureProperty $ p
 -- The ssh keys of the remote user can be set using `keysImported`
 --
 -- Any other lines in the authorized_keys file are preserved as-is.
-authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo
+authorizedKeysFrom :: User -> (User, Host) -> Property UnixLike
 localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) =
-	property desc (go =<< authorizedKeyLines remoteuser remotehost)
+	property' desc (\w -> go w =<< authorizedKeyLines remoteuser remotehost)
   where
 	remote = rn ++ "@" ++ hostName remotehost
 	desc = ln ++ " authorized_keys from " ++ remote
 
-	go [] = do
+	go _ [] = do
 		warningMessage $ "no configured ssh user keys for " ++ remote
 		return FailedChange
-	go ls = ensureProperty $ combineProperties desc $
-		map (authorizedKey localuser) ls
+	go w ls = ensureProperty w $ combineProperties desc $ toProps $
+		map (setupRevertableProperty . authorizedKey localuser) ls
 
 -- | Reverts `authorizedKeysFrom`
-unauthorizedKeysFrom :: User -> (User, Host) -> Property NoInfo
+unauthorizedKeysFrom :: User -> (User, Host) -> Property UnixLike
 localuser@(User ln) `unauthorizedKeysFrom` (remoteuser@(User rn), remotehost) =
-	property desc (go =<< authorizedKeyLines remoteuser remotehost)
+	property' desc (\w -> go w =<< authorizedKeyLines remoteuser remotehost)
   where
 	remote = rn ++ "@" ++ hostName remotehost
 	desc = ln ++ " unauthorized_keys from " ++ remote
 
-	go [] = return NoChange
-	go ls = ensureProperty $ combineProperties desc $
-		map (revert . authorizedKey localuser) ls
+	go _ [] = return NoChange
+	go w ls = ensureProperty w $ combineProperties desc $ toProps $
+		map (undoRevertableProperty . authorizedKey localuser) ls
 
 authorizedKeyLines :: User -> Host -> Propellor [File.Line]
 authorizedKeyLines remoteuser remotehost =
@@ -380,37 +397,37 @@ authorizedKeyLines remoteuser remotehost =
 -- | Makes a user have authorized_keys from the PrivData
 --
 -- This removes any other lines from the file.
-authorizedKeys :: IsContext c => User -> c -> Property HasInfo
+authorizedKeys :: IsContext c => User -> c -> Property (HasInfo + UnixLike)
 authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get ->
-	property desc $ get $ \v -> do
+	property' desc $ \w -> get $ \v -> do
 		f <- liftIO $ dotFile "authorized_keys" user
-		ensureProperty $ combineProperties desc
-			[ File.hasContentProtected f (keyFileContent (privDataLines v))
-			, File.ownerGroup f user (userGroup user)
-			, File.ownerGroup (takeDirectory f) user (userGroup user)
-			]
+		ensureProperty w $ combineProperties desc $ props
+			& File.hasContentProtected f (keyFileContent (privDataLines v))
+			& File.ownerGroup f user (userGroup user)
+			& File.ownerGroup (takeDirectory f) user (userGroup user)
   where
 	desc = u ++ " has authorized_keys"
 
 -- | Ensures that a user's authorized_keys contains a line.
 -- Any other lines in the file are preserved as-is.
-authorizedKey :: User -> String -> RevertableProperty NoInfo
+authorizedKey :: User -> String -> RevertableProperty UnixLike UnixLike
 authorizedKey user@(User u) l = add  remove
   where
-	add = property (u ++ " has authorized_keys") $ do
+	add = property' (u ++ " has authorized_keys") $ \w -> do
 		f <- liftIO $ dotFile "authorized_keys" user
-		modAuthorizedKey f user $
+		ensureProperty w $ modAuthorizedKey f user $
 			f `File.containsLine` l
 				`requires` File.dirExists (takeDirectory f)
-	remove = property (u ++ " lacks authorized_keys") $ do
+	remove = property' (u ++ " lacks authorized_keys") $ \w -> do
 		f <- liftIO $ dotFile "authorized_keys" user
 		ifM (liftIO $ doesFileExist f)
-			( modAuthorizedKey f user $ f `File.lacksLine` l
+			( ensureProperty w $ modAuthorizedKey f user $
+				f `File.lacksLine` l
 			, return NoChange
 			)
 
-modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result
-modAuthorizedKey f user p = ensureProperty $ p
+modAuthorizedKey :: FilePath -> User -> Property UnixLike -> Property UnixLike
+modAuthorizedKey f user p = p
 	`before` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
 	`before` File.ownerGroup f user (userGroup user)
 	`before` File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs
index ed6ba2d5..45ab8af2 100644
--- a/src/Propellor/Property/Sudo.hs
+++ b/src/Propellor/Property/Sudo.hs
@@ -9,12 +9,13 @@ import Propellor.Property.User
 
 -- | Allows a user to sudo. If the user has a password, sudo is configured
 -- to require it. If not, NOPASSWORD is enabled for the user.
-enabledFor :: User -> Property NoInfo
-enabledFor user@(User u) = property desc go `requires` Apt.installed ["sudo"]
+enabledFor :: User -> Property DebianLike
+enabledFor user@(User u) = go `requires` Apt.installed ["sudo"]
   where
-	go = do
+	go :: Property UnixLike
+	go = property' desc $ \w -> do
 		locked <- liftIO $ isLockedPassword user
-		ensureProperty $
+		ensureProperty w $
 			fileProperty desc
 				(modify locked . filter (wanted locked))
 				"/etc/sudoers"
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 2234ad5c..e0b7d572 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
 
 module Propellor.Property.Systemd (
 	-- * Services
@@ -25,6 +25,7 @@ module Propellor.Property.Systemd (
 	MachineName,
 	Container,
 	container,
+	debContainer,
 	nspawned,
 	-- * Container configuration
 	containerCfg,
@@ -43,6 +44,7 @@ module Propellor.Property.Systemd (
 import Propellor.Base
 import Propellor.Types.Chroot
 import Propellor.Types.Container
+import Propellor.Container
 import Propellor.Types.Info
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Apt as Apt
@@ -61,23 +63,23 @@ type MachineName = String
 data Container = Container MachineName Chroot.Chroot Host
 	deriving (Show)
 
-instance PropAccum Container where
-	(Container n c h) `addProp` p = Container n c (h `addProp` p)
-	(Container n c h) `addPropFront` p = Container n c (h `addPropFront` p)
-	getProperties (Container _ _ h) = hostProperties h
+instance IsContainer Container where
+	containerProperties (Container _ _ h) = containerProperties h
+	containerInfo (Container _ _ h) = containerInfo h
+	setContainerProperties (Container n c h) ps = Container n c (setContainerProperties h ps)
 
 -- | Starts a systemd service.
 --
 -- Note that this does not configure systemd to start the service on boot,
 -- it only ensures that the service is currently running.
-started :: ServiceName -> Property NoInfo
-started n = cmdProperty "systemctl" ["start", n]
+started :: ServiceName -> Property Linux
+started n = tightenTargets $ cmdProperty "systemctl" ["start", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " started")
 
 -- | Stops a systemd service.
-stopped :: ServiceName -> Property NoInfo
-stopped n = cmdProperty "systemctl" ["stop", n]
+stopped :: ServiceName -> Property Linux
+stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " stopped")
 
@@ -85,35 +87,35 @@ stopped n = cmdProperty "systemctl" ["stop", n]
 --
 -- This does not ensure the service is started, it only configures systemd
 -- to start it on boot.
-enabled :: ServiceName -> Property NoInfo
-enabled n = cmdProperty "systemctl" ["enable", n]
+enabled :: ServiceName -> Property Linux
+enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " enabled")
 
 -- | Disables a systemd service.
-disabled :: ServiceName -> Property NoInfo
-disabled n = cmdProperty "systemctl" ["disable", n]
+disabled :: ServiceName -> Property Linux
+disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " disabled")
 
 -- | Masks a systemd service.
-masked :: ServiceName -> RevertableProperty NoInfo
+masked :: ServiceName -> RevertableProperty Linux Linux
 masked n = systemdMask  systemdUnmask
   where
-	systemdMask = cmdProperty "systemctl" ["mask", n]
+	systemdMask = tightenTargets $ cmdProperty "systemctl" ["mask", n]
 		`assume` NoChange
 		`describe` ("service " ++ n ++ " masked")
-	systemdUnmask = cmdProperty "systemctl" ["unmask", n]
+	systemdUnmask = tightenTargets $ cmdProperty "systemctl" ["unmask", n]
 		`assume` NoChange
 		`describe` ("service " ++ n ++ " unmasked")
 
 -- | Ensures that a service is both enabled and started
-running :: ServiceName -> Property NoInfo
+running :: ServiceName -> Property Linux
 running n = started n `requires` enabled n
 
 -- | Restarts a systemd service.
-restarted :: ServiceName -> Property NoInfo
-restarted n = cmdProperty "systemctl" ["restart", n]
+restarted :: ServiceName -> Property Linux
+restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n]
 	`assume` NoChange
 	`describe` ("service " ++ n ++ " restarted")
 
@@ -126,16 +128,15 @@ journald :: ServiceName
 journald = "systemd-journald"
 
 -- | Enables persistent storage of the journal.
-persistentJournal :: Property NoInfo
+persistentJournal :: Property DebianLike
 persistentJournal = check (not <$> doesDirectoryExist dir) $
-	combineProperties "persistent systemd journal"
-		[ cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
+	combineProperties "persistent systemd journal" $ props
+		& cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
 			`assume` MadeChange
-		, cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
+		& Apt.installed ["acl"]
+		& cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
 			`assume` MadeChange
-		, started "systemd-journal-flush"
-		]
-		`requires` Apt.installed ["acl"]
+		& started "systemd-journal-flush"
   where
 	dir = "/var/log/journal"
 
@@ -148,11 +149,10 @@ type Option = String
 -- currently the case for files like journald.conf and system.conf.
 -- And it assumes the file already exists with
 -- the right [Header], so new lines can just be appended to the end.
-configured :: FilePath -> Option -> String -> Property NoInfo
-configured cfgfile option value = combineProperties desc
-	[ File.fileProperty desc (mapMaybe removeother) cfgfile
-	, File.containsLine cfgfile line
-	]
+configured :: FilePath -> Option -> String -> Property Linux
+configured cfgfile option value = tightenTargets $ combineProperties desc $ props
+	& File.fileProperty desc (mapMaybe removeother) cfgfile
+	& File.containsLine cfgfile line
   where
 	setting = option ++ "="
 	line = setting ++ value
@@ -162,43 +162,59 @@ configured cfgfile option value = combineProperties desc
 		| otherwise = Just l
 
 -- | Causes systemd to reload its configuration files.
-daemonReloaded :: Property NoInfo
-daemonReloaded = cmdProperty "systemctl" ["daemon-reload"]
+daemonReloaded :: Property Linux
+daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"]
 	`assume` NoChange
 
 -- | Configures journald, restarting it so the changes take effect.
-journaldConfigured :: Option -> String -> Property NoInfo
+journaldConfigured :: Option -> String -> Property Linux
 journaldConfigured option value =
 	configured "/etc/systemd/journald.conf" option value
 		`onChange` restarted journald
 
 -- | Ensures machined and machinectl are installed
-machined :: Property NoInfo
-machined = withOS "machined installed" $ \o ->
+machined :: Property Linux
+machined = withOS "machined installed" $ \w o ->
 	case o of
 		-- Split into separate debian package since systemd 225.
 		(Just (System (Debian suite) _))
-			| not (isStable suite) -> ensureProperty $
+			| not (isStable suite) -> ensureProperty w $
 				Apt.installed ["systemd-container"]
 		_ -> noChange
 
--- | Defines a container with a given machine name, and operating system,
+-- | Defines a container with a given machine name,
 -- and how to create its chroot if not already present.
 --
--- Properties can be added to configure the Container.
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
 --
--- > container "webserver" (System (Debian Unstable) "amd64") (Chroot.debootstrapped mempty)
+-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
+-- >	& osDebian Unstable "amd64"
 -- >    & Apt.installedRunning "apache2"
 -- >    & ...
-container :: MachineName -> System -> (FilePath -> Chroot.Chroot) -> Container
-container name system mkchroot = Container name c h
-	& os system
-	& resolvConfed
-	& linkJournal
+container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
+container name mkchroot = 
+	let c = Container name chroot (host name (containerProps chroot))
+	in setContainerProps c $ containerProps c
+		&^ resolvConfed
+		&^ linkJournal
   where
-	c = mkchroot (containerDir name)
-		& os system
-	h = Host name [] mempty
+	chroot = mkchroot (containerDir name)
+
+-- | Defines a container with a given machine name, with the chroot
+-- created using debootstrap.
+--
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
+--
+-- > debContainer "webserver" $ props
+-- >	& osDebian Unstable "amd64"
+-- >    & Apt.installedRunning "apache2"
+-- >    & ...
+debContainer :: MachineName -> Props metatypes -> Container
+debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
 
 -- | Runs a container using systemd-nspawn.
 --
@@ -214,13 +230,14 @@ container name system mkchroot = Container name c h
 --
 -- Reverting this property stops the container, removes the systemd unit,
 -- and deletes the chroot and all its contents.
-nspawned :: Container -> RevertableProperty HasInfo
+nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
 nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 	p `describe` ("nspawned " ++ name)
   where
+	p :: RevertableProperty (HasInfo + Linux) Linux
 	p = enterScript c
 		`before` chrootprovisioned
-		`before` nspawnService c (_chrootCfg $ getInfo $ hostInfo h)
+		`before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
 		`before` containerprovisioned
 
 	-- Chroot provisioning is run in systemd-only mode,
@@ -230,8 +247,9 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 
 	-- Use nsenter to enter container and and run propellor to
 	-- finish provisioning.
+	containerprovisioned :: RevertableProperty Linux Linux
 	containerprovisioned =
-		Chroot.propellChroot chroot (enterContainerProcess c) False
+		tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False)
 			
 		doNothing
 
@@ -239,7 +257,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 
 -- | Sets up the service file for the container, and then starts
 -- it running.
-nspawnService :: Container -> ChrootCfg -> RevertableProperty NoInfo
+nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
 nspawnService (Container name _ _) cfg = setup  teardown
   where
 	service = nspawnServiceName name
@@ -264,10 +282,12 @@ nspawnService (Container name _ _) cfg = setup  teardown
 		<$> servicefilecontent
 		<*> catchDefaultIO "" (readFile servicefile)
 
+	writeservicefile :: Property Linux
 	writeservicefile = property servicefile $ makeChange $ do
 		c <- servicefilecontent
 		File.viaStableTmp (\t -> writeFile t c) servicefile
 
+	setupservicefile :: Property Linux
 	setupservicefile = check (not <$> goodservicefile) $
 		-- if it's running, it has the wrong configuration,
 		-- so stop it
@@ -275,8 +295,12 @@ nspawnService (Container name _ _) cfg = setup  teardown
 			`requires` daemonReloaded
 			`requires` writeservicefile
 
-	setup = started service `requires` setupservicefile `requires` machined
+	setup :: Property Linux
+	setup = started service
+		`requires` setupservicefile
+		`requires` machined
 
+	teardown :: Property Linux
 	teardown = check (doesFileExist servicefile) $
 		disabled service `requires` stopped service
 
@@ -290,11 +314,12 @@ nspawnServiceParams (SystemdNspawnCfg ps) =
 --
 -- This uses nsenter to enter the container, by looking up the pid of the
 -- container's init process and using its namespace.
-enterScript :: Container -> RevertableProperty NoInfo
-enterScript c@(Container name _ _) = setup  teardown
+enterScript :: Container -> RevertableProperty Linux Linux
+enterScript c@(Container name _ _) =
+	tightenTargets setup  tightenTargets teardown
   where
-	setup = combineProperties ("generated " ++ enterScriptFile c)
-		[ scriptfile `File.hasContent`
+	setup = combineProperties ("generated " ++ enterScriptFile c) $ props
+		& scriptfile `File.hasContent`
 			[ "#!/usr/bin/perl"
 			, "# Generated by propellor"
 			, "my $pid=`machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2`;"
@@ -309,8 +334,7 @@ enterScript c@(Container name _ _) = setup  teardown
 			, "}"
 			, "exit(1);"
 			]
-		, scriptfile `File.mode` combineModes (readModes ++ executeModes)
-		]
+		& scriptfile `File.mode` combineModes (readModes ++ executeModes)
 	teardown = File.notPresent scriptfile
 	scriptfile = enterScriptFile c
 
@@ -336,11 +360,14 @@ mungename = replace "/" "_"
 -- When there is no leading dash, "--" is prepended to the parameter.
 --
 -- Reverting the property will remove a parameter, if it's present.
-containerCfg :: String -> RevertableProperty HasInfo
+containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 containerCfg p = RevertableProperty (mk True) (mk False)
   where
-	mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
-		mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
+	mk b = tightenTargets $
+		pureInfoProperty desc $
+			mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
+	  where
+		desc = "container configuration " ++ (if b then "" else "without ") ++ p'
 	p' = case p of
 		('-':_) -> p
 		_ -> "--" ++ p
@@ -348,18 +375,18 @@ containerCfg p = RevertableProperty (mk True) (mk False)
 -- | Bind mounts  from the host into the container.
 --
 -- This property is enabled by default. Revert it to disable it.
-resolvConfed :: RevertableProperty HasInfo
+resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 resolvConfed = containerCfg "bind=/etc/resolv.conf"
 
 -- | Link the container's journal to the host's if possible.
 -- (Only works if the host has persistent journal enabled.)
 --
 -- This property is enabled by default. Revert it to disable it.
-linkJournal :: RevertableProperty HasInfo
+linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 linkJournal = containerCfg "link-journal=try-guest"
 
 -- | Disconnect networking of the container from the host.
-privateNetwork :: RevertableProperty HasInfo
+privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 privateNetwork = containerCfg "private-network"
 
 class Publishable a where
@@ -397,7 +424,7 @@ instance Publishable (Proto, Bound Port) where
 -- >	& Systemd.running Systemd.networkd
 -- >	& Systemd.publish (Port 80 ->- Port 8080)
 -- >	& Apt.installedRunning "apache2"
-publish :: Publishable p => p -> RevertableProperty HasInfo
+publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 publish p = containerCfg $ "--port=" ++ toPublish p
 
 class Bindable a where
@@ -410,9 +437,9 @@ instance Bindable (Bound FilePath) where
 	toBind v = hostSide v ++ ":" ++ containerSide v
 
 -- | Bind mount a file or directory from the host into the container.
-bind :: Bindable p => p -> RevertableProperty HasInfo
+bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 bind p = containerCfg $ "--bind=" ++ toBind p
 
 -- | Read-only mind mount.
-bindRo :: Bindable p => p -> RevertableProperty HasInfo
+bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
 bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
diff --git a/src/Propellor/Property/Systemd/Core.hs b/src/Propellor/Property/Systemd/Core.hs
index 7842f177..0290bce5 100644
--- a/src/Propellor/Property/Systemd/Core.hs
+++ b/src/Propellor/Property/Systemd/Core.hs
@@ -6,5 +6,5 @@ import qualified Propellor.Property.Apt as Apt
 -- dbus is only a Recommends of systemd, but is needed for communication
 -- from the systemd inside a container to the one outside, so make sure it
 -- gets installed.
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["systemd", "dbus"]
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 0c040f95..92dbd507 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
 module Propellor.Property.Tor where
 
 import Propellor.Base
@@ -19,7 +21,7 @@ type NodeName = String
 -- | Sets up a tor bridge. (Not a relay or exit node.)
 --
 -- Uses port 443
-isBridge :: Property NoInfo
+isBridge :: Property DebianLike
 isBridge = configured
 	[ ("BridgeRelay", "1")
 	, ("Exitpolicy", "reject *:*")
@@ -31,7 +33,7 @@ isBridge = configured
 -- | Sets up a tor relay.
 --
 -- Uses port 443
-isRelay :: Property NoInfo
+isRelay :: Property DebianLike
 isRelay = configured
 	[ ("BridgeRelay", "0")
 	, ("Exitpolicy", "reject *:*")
@@ -44,21 +46,21 @@ isRelay = configured
 --
 -- This can be moved to a different IP without needing to wait to
 -- accumulate trust.
-named :: NodeName -> Property HasInfo
+named :: NodeName -> Property (HasInfo + DebianLike)
 named n = configured [("Nickname", n')]
 	`describe` ("tor node named " ++ n')
 	`requires` torPrivKey (Context ("tor " ++ n))
   where
 	n' = saneNickname n
 
-torPrivKey :: Context -> Property HasInfo
+torPrivKey :: Context -> Property (HasInfo + DebianLike)
 torPrivKey context = f `File.hasPrivContent` context
 	`onChange` File.ownerGroup f user (userGroup user)
 	`requires` torPrivKeyDirExists
   where
 	f = torPrivKeyDir  "secret_id_key"
 
-torPrivKeyDirExists :: Property NoInfo
+torPrivKeyDirExists :: Property DebianLike
 torPrivKeyDirExists = File.dirExists torPrivKeyDir
 	`onChange` setperms
 	`requires` installed
@@ -71,20 +73,20 @@ torPrivKeyDir = "/var/lib/tor/keys"
 
 -- | A tor server (bridge, relay, or exit)
 -- Don't use if you just want to run tor for personal use.
-server :: Property NoInfo
+server :: Property DebianLike
 server = configured [("SocksPort", "0")]
 	`requires` installed
 	`requires` Apt.installed ["ntp"]
 	`describe` "tor server"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["tor"]
 
 -- | Specifies configuration settings. Any lines in the config file
 -- that set other values for the specified settings will be removed,
 -- while other settings are left as-is. Tor is restarted when
 -- configuration is changed.
-configured :: [(String, String)] -> Property NoInfo
+configured :: [(String, String)] -> Property DebianLike
 configured settings = File.fileProperty "tor configured" go mainConfig
 	`onChange` restarted
   where
@@ -105,19 +107,19 @@ data BwLimit
 --
 -- For example, PerSecond "30 kibibytes" is the minimum limit
 -- for a useful relay.
-bandwidthRate :: BwLimit -> Property NoInfo
+bandwidthRate :: BwLimit -> Property DebianLike
 bandwidthRate (PerSecond s) = bandwidthRate' s 1
 bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
 bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)
 
-bandwidthRate' :: String -> Integer -> Property NoInfo
+bandwidthRate' :: String -> Integer -> Property DebianLike
 bandwidthRate' s divby = case readSize dataUnits s of
 	Just sz -> let v = show (sz `div` divby) ++ " bytes"
 		in configured [("BandwidthRate", v)]
 			`describe` ("tor BandwidthRate " ++ v)
 	Nothing -> property ("unable to parse " ++ s) noChange
 
-hiddenServiceAvailable :: HiddenServiceName -> Int -> Property NoInfo
+hiddenServiceAvailable :: HiddenServiceName -> Int -> Property DebianLike
 hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
   where
 	hiddenServiceHostName p =  adjustPropertySatisfy p $ \satisfy -> do
@@ -126,7 +128,7 @@ hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
 		warningMessage $ unwords ["hidden service hostname:", h]
 		return r
 
-hiddenService :: HiddenServiceName -> Int -> Property NoInfo
+hiddenService :: HiddenServiceName -> Int -> Property DebianLike
 hiddenService hn port = ConfFile.adjustSection
 	(unwords ["hidden service", hn, "available on port", show port])
 	(== oniondir)
@@ -139,18 +141,18 @@ hiddenService hn port = ConfFile.adjustSection
 	oniondir = unwords ["HiddenServiceDir", varLib  hn]
 	onionport = unwords ["HiddenServicePort", show port, "127.0.0.1:" ++ show port]
 
-hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property HasInfo
-hiddenServiceData hn context = combineProperties desc
-	[ installonion "hostname"
-	, installonion "private_key"
-	]
+hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
+hiddenServiceData hn context = combineProperties desc $ props
+	& installonion "hostname"
+	& installonion "private_key"
   where
 	desc = unwords ["hidden service data available in", varLib  hn]
+	installonion :: FilePath -> Property (HasInfo + DebianLike)
 	installonion f = withPrivData (PrivFile $ varLib  hn  f) context $ \getcontent ->
-		property desc $ getcontent $ install $ varLib  hn  f
-	install f privcontent = ifM (liftIO $ doesFileExist f)
+		property' desc $ \w -> getcontent $ install w $ varLib  hn  f
+	install w f privcontent = ifM (liftIO $ doesFileExist f)
 		( noChange
-		, ensureProperties
+		, ensureProperty w $ propertyList desc $ toProps
 			[ property desc $ makeChange $ do
 				createDirectoryIfMissing True (takeDirectory f)
 				writeFileProtected f (unlines (privDataLines privcontent))
@@ -161,7 +163,7 @@ hiddenServiceData hn context = combineProperties desc
 			]
 		)
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "tor"
 
 mainConfig :: FilePath
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index f1280b0e..23a5b30d 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -41,13 +41,13 @@ type UnboundValue = String
 
 type ZoneType = String
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["unbound"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "unbound"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "unbound"
 
 dValue :: BindDomain -> String
@@ -90,7 +90,7 @@ config = "/etc/unbound/unbound.conf.d/propellor.conf"
 -- >      , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
 -- >      , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
 -- >      ]
-cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property NoInfo
+cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property DebianLike
 cachingDnsServer sections zones hosts =
 	config `hasContent` (comment : otherSections ++ serverSection)
 	`onChange` restarted
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index c9c91a77..76eae647 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -7,8 +7,8 @@ import qualified Propellor.Property.File as File
 
 data Eep = YesReallyDeleteHome
 
-accountFor :: User -> Property NoInfo
-accountFor user@(User u) = check nohomedir go
+accountFor :: User -> Property DebianLike
+accountFor user@(User u) = tightenTargets $ check nohomedir go
 	`describe` ("account for " ++ u)
   where
 	nohomedir = isNothing <$> catchMaybeIO (homedir user)
@@ -18,11 +18,11 @@ accountFor user@(User u) = check nohomedir go
 		, u
 		]
 
-systemAccountFor :: User -> Property NoInfo
+systemAccountFor :: User -> Property DebianLike
 systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u))
 
-systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property NoInfo
-systemAccountFor' (User u) mhome mgroup = check nouser go
+systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike
+systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go
 	`describe` ("system account for " ++ u)
   where
 	nouser = isNothing <$> catchMaybeIO (getUserEntryForName u)
@@ -43,8 +43,8 @@ systemAccountFor' (User u) mhome mgroup = check nouser go
 		]
 
 -- | Removes user home directory!! Use with caution.
-nuked :: User -> Eep -> Property NoInfo
-nuked user@(User u) _ = check hashomedir go
+nuked :: User -> Eep -> Property DebianLike
+nuked user@(User u) _ = tightenTargets $ check hashomedir go
 	`describe` ("nuked user " ++ u)
   where
 	hashomedir = isJust <$> catchMaybeIO (homedir user)
@@ -55,13 +55,13 @@ nuked user@(User u) _ = check hashomedir go
 
 -- | Only ensures that the user has some password set. It may or may
 -- not be a password from the PrivData.
-hasSomePassword :: User -> Property HasInfo
+hasSomePassword :: User -> Property (HasInfo + DebianLike)
 hasSomePassword user = hasSomePassword' user hostContext
 
 -- | While hasSomePassword uses the name of the host as context,
 -- this allows specifying a different context. This is useful when
 -- you want to use the same password on multiple hosts, for example.
-hasSomePassword' :: IsContext c => User -> c -> Property HasInfo
+hasSomePassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike)
 hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $
 	hasPassword' user context
 
@@ -71,12 +71,14 @@ hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus us
 -- A user's password can be stored in the PrivData in either of two forms;
 -- the full cleartext  or a  hash. The latter
 -- is obviously more secure.
-hasPassword :: User -> Property HasInfo
+hasPassword :: User -> Property (HasInfo + DebianLike)
 hasPassword user = hasPassword' user hostContext
 
-hasPassword' :: IsContext c => User -> c -> Property HasInfo
-hasPassword' (User u) context = go `requires` shadowConfig True
+hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike)
+hasPassword' (User u) context = go
+	`requires` shadowConfig True
   where
+	go :: Property (HasInfo + UnixLike)
 	go = withSomePrivData srcs context $
 		property (u ++ " has password") . setPassword
 	srcs =
@@ -94,7 +96,7 @@ setPassword getpassword = getpassword $ go
 
 -- | Makes a user's password be the passed String. Highly insecure:
 -- The password is right there in your config file for anyone to see!
-hasInsecurePassword :: User -> String -> Property NoInfo
+hasInsecurePassword :: User -> String -> Property DebianLike
 hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $
 	chpasswd u p []
 
@@ -104,9 +106,10 @@ chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuc
 		hPutStrLn h $ user ++ ":" ++ v
 		hClose h
 
-lockedPassword :: User -> Property NoInfo
-lockedPassword user@(User u) = check (not <$> isLockedPassword user) go
-	`describe` ("locked " ++ u ++ " password")
+lockedPassword :: User -> Property DebianLike
+lockedPassword user@(User u) = tightenTargets $ 
+	check (not <$> isLockedPassword user) go
+		`describe` ("locked " ++ u ++ " password")
   where
 	go = cmdProperty "passwd"
 		[ "--lock"
@@ -130,8 +133,8 @@ isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
 homedir :: User -> IO FilePath
 homedir (User user) = homeDirectory <$> getUserEntryForName user
 
-hasGroup :: User -> Group -> Property NoInfo
-hasGroup (User user) (Group group') = check test go
+hasGroup :: User -> Group -> Property DebianLike
+hasGroup (User user) (Group group') = tightenTargets $ check test go
 	`describe` unwords ["user", user, "in group", group']
   where
 	test = not . elem group' . words <$> readProcess "groups" [user]
@@ -145,12 +148,13 @@ hasGroup (User user) (Group group') = check test go
 --
 -- Note that some groups may only exit after installation of other
 -- software. When a group does not exist yet, the user won't be added to it.
-hasDesktopGroups :: User -> Property NoInfo
-hasDesktopGroups user@(User u) = property desc $ do
+hasDesktopGroups :: User -> Property DebianLike
+hasDesktopGroups user@(User u) = property' desc $ \o -> do
 	existinggroups <- map (fst . break (== ':')) . lines
 		<$> liftIO (readFile "/etc/group")
 	let toadd = filter (`elem` existinggroups) desktopgroups
-	ensureProperty $ propertyList desc $ map (hasGroup user . Group) toadd
+	ensureProperty o $ propertyList desc $ toProps $
+		map (hasGroup user . Group) toadd
   where
 	desc = "user " ++ u ++ " is in standard desktop groups"
 	-- This list comes from user-setup's debconf
@@ -170,11 +174,11 @@ hasDesktopGroups user@(User u) = property desc $ do
 		]
 
 -- | Controls whether shadow passwords are enabled or not.
-shadowConfig :: Bool -> Property NoInfo
-shadowConfig True = check (not <$> shadowExists)
+shadowConfig :: Bool -> Property DebianLike
+shadowConfig True = tightenTargets $ check (not <$> shadowExists)
 	(cmdProperty "shadowconfig" ["on"])
 		`describe` "shadow passwords enabled"
-shadowConfig False = check shadowExists
+shadowConfig False = tightenTargets $ check shadowExists
 	(cmdProperty "shadowconfig" ["off"])
 		`describe` "shadow passwords disabled"
 
@@ -183,11 +187,11 @@ shadowExists = doesFileExist "/etc/shadow"
 
 -- | Ensures that a user has a specified login shell, and that the shell
 -- is enabled in /etc/shells.
-hasLoginShell :: User -> FilePath -> Property NoInfo
+hasLoginShell :: User -> FilePath -> Property DebianLike
 hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell
 
-shellSetTo :: User -> FilePath -> Property NoInfo
-shellSetTo (User u) loginshell = check needchangeshell
+shellSetTo :: User -> FilePath -> Property DebianLike
+shellSetTo (User u) loginshell = tightenTargets $ check needchangeshell
 	(cmdProperty "chsh" ["--shell", loginshell, u])
 		`describe` (u ++ " has login shell " ++ loginshell)
   where
@@ -196,5 +200,6 @@ shellSetTo (User u) loginshell = check needchangeshell
 		return (currshell /= loginshell)
 
 -- | Ensures that /etc/shells contains a shell.
-shellEnabled :: FilePath -> Property NoInfo
-shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell
+shellEnabled :: FilePath -> Property DebianLike
+shellEnabled loginshell = tightenTargets $
+	"/etc/shells" `File.containsLine` loginshell
diff --git a/src/Propellor/Property/Uwsgi.hs b/src/Propellor/Property/Uwsgi.hs
index f76d6a0f..4eb94103 100644
--- a/src/Propellor/Property/Uwsgi.hs
+++ b/src/Propellor/Property/Uwsgi.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
 
 type AppName = String
 
-appEnabled :: AppName -> ConfigFile -> RevertableProperty NoInfo
+appEnabled :: AppName -> ConfigFile -> RevertableProperty DebianLike DebianLike
 appEnabled an cf = enable  disable
   where
 	enable = appVal an `File.isSymlinkedTo` appValRelativeCfg an
@@ -24,9 +24,9 @@ appEnabled an cf = enable  disable
 		`requires` installed
 		`onChange` reloaded
 
-appAvailable :: AppName -> ConfigFile -> Property NoInfo
+appAvailable :: AppName -> ConfigFile -> Property DebianLike
 appAvailable an cf = ("uwsgi app available " ++ an) ==>
-	appCfg an `File.hasContent` (comment : cf)
+	tightenTargets (appCfg an `File.hasContent` (comment : cf))
   where
 	comment = "# deployed with propellor, do not modify"
 
@@ -39,11 +39,11 @@ appVal an = "/etc/uwsgi/apps-enabled/"  an <.> "ini"
 appValRelativeCfg :: AppName -> File.LinkTarget
 appValRelativeCfg an = File.LinkTarget $ "../apps-available"  an <.> "ini"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["uwsgi"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "uwsgi"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "uwsgi"
diff --git a/src/Propellor/Property/ZFS/Properties.hs b/src/Propellor/Property/ZFS/Properties.hs
index 5ceaf9ba..47d5a9d1 100644
--- a/src/Propellor/Property/ZFS/Properties.hs
+++ b/src/Propellor/Property/ZFS/Properties.hs
@@ -3,6 +3,7 @@
 -- Functions defining zfs Properties.
 
 module Propellor.Property.ZFS.Properties (
+	ZFSOS,
 	zfsExists,
 	zfsSetProperties
 ) where
@@ -11,9 +12,12 @@ import Propellor.Base
 import Data.List (intercalate)
 import qualified Propellor.Property.ZFS.Process as ZP
 
+-- | OS's that support ZFS
+type ZFSOS = Linux + FreeBSD
+
 -- | Will ensure that a ZFS volume exists with the specified mount point.
 -- This requires the pool to exist as well, but we don't create pools yet.
-zfsExists :: ZFS -> Property NoInfo
+zfsExists :: ZFS -> Property ZFSOS
 zfsExists z = check (not <$> ZP.zfsExists z) create
 	`describe` unwords ["Creating", zfsName z]
   where
@@ -21,16 +25,16 @@ zfsExists z = check (not <$> ZP.zfsExists z) create
 	create = cmdProperty p a
 
 -- | Sets the given properties. Returns True if all were successfully changed, False if not.
-zfsSetProperties :: ZFS -> ZFSProperties -> Property NoInfo
+zfsSetProperties :: ZFS -> ZFSProperties -> Property ZFSOS
 zfsSetProperties z setProperties = setall
 	`requires` zfsExists z
   where
 	spcmd :: String -> String -> (String, [String])
 	spcmd p v = ZP.zfsCommand "set" [Just (intercalate "=" [p, v]), Nothing] z
 
-	setprop :: (String, String) -> Property NoInfo
+	setprop :: (String, String) -> Property ZFSOS
 	setprop (p, v) = check (ZP.zfsExists z) $
 		cmdProperty (fst (spcmd p v)) (snd (spcmd p v))
 
 	setall = combineProperties (unwords ["Setting properties on", zfsName z]) $
-		map setprop $ toPropertyList setProperties
+		toProps $ map setprop $ toPropertyList setProperties
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 5f103b8a..944696dd 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -90,7 +90,7 @@ spin' mprivdata relay target hst = do
 		error "remote propellor failed"
   where
 	hn = fromMaybe target relay
-	sys = case getInfo (hostInfo hst) of
+	sys = case fromInfo (hostInfo hst) of
 		InfoVal o -> Just o
 		NoInfoVal -> Nothing
 
@@ -170,7 +170,7 @@ getSshTarget target hst
 					return ip
 
 	configips = map fromIPAddr $ mapMaybe getIPAddr $
-		S.toList $ fromDnsInfo $ getInfo $ hostInfo hst
+		S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst
 
 -- Update the privdata, repo url, and git repo over the ssh
 -- connection, talking to the user's local propellor instance which is
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 542a1f66..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,264 +1,156 @@
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
-module Propellor.Types
-	( Host(..)
-	, Property
-	, Info
-	, HasInfo
-	, NoInfo
-	, CInfo
+module Propellor.Types (
+	-- * Core data types
+	  Host(..)
+	, Property(..)
+	, property
 	, Desc
-	, infoProperty
-	, simpleProperty
-	, adjustPropertySatisfy
-	, propertyInfo
-	, propertyDesc
-	, propertyChildren
 	, RevertableProperty(..)
-	, MkRevertableProperty(..)
-	, IsProp(..)
+	, ()
+	, Propellor(..)
+	, LiftPropellor(..)
+	, Info
+	-- * Types of properties
+	, UnixLike
+	, Linux
+	, DebianLike
+	, Debian
+	, Buntish
+	, FreeBSD
+	, HasInfo
+	, type (+)
+	, TightenTargets(..)
+	-- * Combining and modifying properties
 	, Combines(..)
 	, CombinedType
 	, ResultCombiner
-	, Propellor(..)
-	, LiftPropellor(..)
-	, EndAction(..)
+	, adjustPropertySatisfy
+	-- * Other included types
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
-	, propertySatisfy
-	, ignoreInfo
 	) where
 
 import Data.Monoid
-import "mtl" Control.Monad.RWS.Strict
-import Control.Monad.Catch
-import Data.Typeable
-import Control.Applicative
-import Prelude
 
+import Propellor.Types.Core
 import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
 import Propellor.Types.Result
+import Propellor.Types.MetaTypes
 import Propellor.Types.ZFS
 
--- | Everything Propellor knows about a system: Its hostname,
--- properties and their collected info.
-data Host = Host
-	{ hostName :: HostName
-	, hostProperties :: [Property HasInfo]
-	, hostInfo :: Info
-	}
-	deriving (Show, Typeable)
-
--- | Propellor's monad provides read-only access to info about the host
--- it's running on, and a writer to accumulate EndActions.
-newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
-	deriving
-		( Monad
-		, Functor
-		, Applicative
-		, MonadReader Host
-		, MonadWriter [EndAction]
-		, MonadIO
-		, MonadCatch
-		, MonadThrow
-		, MonadMask
-		)
-
-class LiftPropellor m where
-	liftPropellor :: m a -> Propellor a
-
-instance LiftPropellor Propellor where
-	liftPropellor = id
-
-instance LiftPropellor IO where
-	liftPropellor = liftIO
-
-instance Monoid (Propellor Result) where
-	mempty = return NoChange
-	-- | The second action is only run if the first action does not fail.
-	mappend x y = do
-		rx <- x
-		case rx of
-			FailedChange -> return FailedChange
-			_ -> do
-				ry <- y
-				return (rx <> ry)
-
--- | An action that Propellor runs at the end, after trying to satisfy all
--- properties. It's passed the combined Result of the entire Propellor run.
-data EndAction = EndAction Desc (Result -> Propellor Result)
-
-type Desc = String
-
 -- | The core data type of Propellor, this represents a property
--- that the system should have, and an action to ensure it has the
--- property.
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
+-- that have the property.
+--
+-- There are different types of properties that target different OS's,
+-- and so have different metatypes. 
+-- For example: "Property DebianLike" and "Property FreeBSD".
 --
--- A property can have associated `Info` or not. This is tracked at the
--- type level with Property `NoInfo` and Property `HasInfo`.
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
 --
--- There are many instances and type families, which are mostly used
+-- There are many associated type families, which are mostly used
 -- internally, so you needn't worry about them.
-data Property i where
-	IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
-	SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
-
--- | Indicates that a Property has associated Info.
-data HasInfo
--- | Indicates that a Property does not have Info.
-data NoInfo
-
--- | Type level calculation of the combination of HasInfo and/or NoInfo
-type family CInfo x y
-type instance CInfo HasInfo HasInfo = HasInfo
-type instance CInfo HasInfo NoInfo = HasInfo
-type instance CInfo NoInfo HasInfo = HasInfo
-type instance CInfo NoInfo NoInfo = NoInfo
-
--- | Constructs a Property with associated Info.
-infoProperty
-	:: Desc -- ^ description of the property
-	-> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly)
-	-> Info -- ^ info associated with the property
-	-> [Property i] -- ^ child properties
-	-> Property HasInfo
-infoProperty d a i cs = IProperty d a i (map toIProperty cs)
+data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
--- | Constructs a Property with no Info.
-simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
-simpleProperty = SProperty
+instance Show (Property metatypes) where
+	show p = "property " ++ show (getDesc p)
 
-toIProperty :: Property i -> Property HasInfo
-toIProperty p@(IProperty {}) = p
-toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs)
-
-toSProperty :: Property i -> Property NoInfo
-toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs)
-toSProperty p@(SProperty {}) = p
-
--- | Makes a version of a Proprty without its Info.
--- Use with caution!
-ignoreInfo :: Property i -> Property NoInfo
-ignoreInfo = toSProperty
-
--- | Gets the action that can be run to satisfy a Property.
--- You should never run this action directly. Use
--- 'Propellor.Engine.ensureProperty` instead.
-propertySatisfy :: Property i -> Propellor Result
-propertySatisfy (IProperty _ a _ _) = a
-propertySatisfy (SProperty _ a _) = a
+-- | Constructs a Property, from a description and an action to run to
+-- ensure the Property is met.
+--
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
+--
+-- For example:
+--
+-- > foo :: Property Debian
+-- > foo = property "foo" $ do
+-- >	...
+-- > 	return MadeChange
+property
+	:: SingI metatypes
+	=> Desc
+	-> Propellor Result
+	-> Property (MetaTypes metatypes)
+property d a = Property sing d a mempty mempty
 
 -- | Changes the action that is performed to satisfy a property.
-adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
-adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
-adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs
-
-propertyInfo :: Property i -> Info
-propertyInfo (IProperty _ _ i _) = i
-propertyInfo (SProperty {}) = mempty
-
-propertyDesc :: Property i -> Desc
-propertyDesc (IProperty d _ _ _) = d
-propertyDesc (SProperty d _ _) = d
-
-instance Show (Property i) where
-	show p = "property " ++ show (propertyDesc p)
-
--- | A Property can include a list of child properties that it also
--- satisfies. This allows them to be introspected to collect their info, etc.
-propertyChildren :: Property i -> [Property i]
-propertyChildren (IProperty _ _ _ cs) = cs
-propertyChildren (SProperty _ _ cs) = cs
+adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
+adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
 
 -- | A property that can be reverted. The first Property is run
 -- normally and the second is run when it's reverted.
-data RevertableProperty i = RevertableProperty
-	{ setupRevertableProperty :: Property i
-	, undoRevertableProperty :: Property i
+data RevertableProperty setupmetatypes undometatypes = RevertableProperty
+	{ setupRevertableProperty :: Property setupmetatypes
+	, undoRevertableProperty :: Property undometatypes
 	}
 
-instance Show (RevertableProperty i) where
+instance Show (RevertableProperty setupmetatypes undometatypes) where
 	show (RevertableProperty p _) = show p
 
-class MkRevertableProperty i1 i2 where
-	-- | Shorthand to construct a revertable property.
-	() :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2)
-
-instance MkRevertableProperty HasInfo HasInfo where
-	x  y = RevertableProperty x y
-instance MkRevertableProperty NoInfo NoInfo where
-	x  y = RevertableProperty x y
-instance MkRevertableProperty NoInfo HasInfo where
-	x  y = RevertableProperty (toProp x) y
-instance MkRevertableProperty HasInfo NoInfo where
-	x  y = RevertableProperty x (toProp y)
-
--- | Class of types that can be used as properties of a host.
-class IsProp p where
-	setDesc :: p -> Desc -> p
-	toProp :: p -> Property HasInfo
-	getDesc :: p -> Desc
-	-- | Gets the info of the property, combined with all info
-	-- of all children properties.
-	getInfoRecursive :: p -> Info
-
-instance IsProp (Property HasInfo) where
-	setDesc (IProperty _ a i cs) d = IProperty d a i cs
-	toProp = id
-	getDesc = propertyDesc
-	getInfoRecursive (IProperty _ _ i cs) =
-		i <> mconcat (map getInfoRecursive cs)
-instance IsProp (Property NoInfo) where
-	setDesc (SProperty _ a cs) d = SProperty d a cs
-	toProp = toIProperty
-	getDesc = propertyDesc
-	getInfoRecursive _ = mempty
-
-instance IsProp (RevertableProperty HasInfo) where
-	setDesc = setDescR
+-- | Shorthand to construct a revertable property from any two Properties.
+()
+	:: Property setupmetatypes
+	-> Property undometatypes
+	-> RevertableProperty setupmetatypes undometatypes
+setup  undo = RevertableProperty setup undo
+
+instance IsProp (Property metatypes) where
+	setDesc (Property t _ a i c) d = Property t d a i c
+	getDesc (Property _ d _ _ _) = d
+	getChildren (Property _ _ _ _ c) = c
+	addChildren (Property t d a i c) c' = Property t d a i (c ++ c')
+	getInfoRecursive (Property _ _ _ i c) =
+		i <> mconcat (map getInfoRecursive c)
+	getInfo (Property _ _ _ i _) = i
+	toChildProperty (Property _ d a i c) = ChildProperty d a i c
+	getSatisfy (Property _ _ a _ _) = a
+
+instance IsProp (RevertableProperty setupmetatypes undometatypes) where
+	-- | Sets the description of both sides.
+	setDesc (RevertableProperty p1 p2) d =
+		RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
 	getDesc (RevertableProperty p1 _) = getDesc p1
-	toProp (RevertableProperty p1 _) = p1
+	getChildren (RevertableProperty p1 _) = getChildren p1
+	-- | Only add children to the active side.
+	addChildren (RevertableProperty p1 p2) c = RevertableProperty (addChildren p1 c) p2
 	-- | Return the Info of the currently active side.
 	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
-instance IsProp (RevertableProperty NoInfo) where
-	setDesc = setDescR
-	getDesc (RevertableProperty p1 _) = getDesc p1
-	toProp (RevertableProperty p1 _) = toProp p1
-	getInfoRecursive (RevertableProperty _ _) = mempty
-
--- | Sets the description of both sides.
-setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i
-setDescR (RevertableProperty p1 p2) d =
-	RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
+	getInfo (RevertableProperty p1 _p2) = getInfo p1
+	toChildProperty (RevertableProperty p1 _p2) = toChildProperty p1
+	getSatisfy (RevertableProperty p1 _) = getSatisfy p1
 
 -- | Type level calculation of the type that results from combining two
 -- types of properties.
 type family CombinedType x y
-type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
-type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y)
+type instance CombinedType (Property (MetaTypes x)) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y))
+type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) = RevertableProperty (MetaTypes (Combine x y)) (MetaTypes (Combine x' y'))
 -- When only one of the properties is revertable, the combined property is
 -- not fully revertable, so is not a RevertableProperty.
-type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y)
-type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y)
+type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y))
+type instance CombinedType (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) = Property (MetaTypes (Combine x y))
 
 type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result
 
 class Combines x y where
 	-- | Combines together two properties, yielding a property that
-	-- has the description and info of the first, and that has the second
-	-- property as a child.
+	-- has the description and info of the first, and that has the
+	-- second property as a child property.
 	combineWith
 		:: ResultCombiner
 		-- ^ How to combine the actions to satisfy the properties.
@@ -269,73 +161,37 @@ class Combines x y where
 		-> y
 		-> CombinedType x y
 
-instance Combines (Property HasInfo) (Property HasInfo) where
-	combineWith f _ (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
-		IProperty d1 (f a1 a2) i1 (y : cs1)
-
-instance Combines (Property HasInfo) (Property NoInfo) where
-	combineWith f _ (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
-		IProperty d1 (f a1 a2) i1 (toIProperty y : cs1)
-
-instance Combines (Property NoInfo) (Property HasInfo) where
-	combineWith f _ (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
-		IProperty d1 (f a1 a2) mempty (y : map toIProperty cs1)
-
-instance Combines (Property NoInfo) (Property NoInfo) where
-	combineWith f _ (SProperty d1 a1  cs1) y@(SProperty _d2 a2 _cs2) =
-		SProperty d1 (f a1 a2) (y : cs1)
-
-instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where
-	combineWith = combineWithRR
-instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where
-	combineWith = combineWithRR
-instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where
-	combineWith = combineWithRR
-instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where
-	combineWith = combineWithRR
-instance Combines (RevertableProperty NoInfo) (Property HasInfo) where
-	combineWith = combineWithRP
-instance Combines (RevertableProperty NoInfo) (Property NoInfo) where
-	combineWith = combineWithRP
-instance Combines (RevertableProperty HasInfo) (Property HasInfo) where
-	combineWith = combineWithRP
-instance Combines (RevertableProperty HasInfo) (Property NoInfo) where
-	combineWith = combineWithRP
-instance Combines (Property HasInfo) (RevertableProperty NoInfo) where
-	combineWith = combineWithPR
-instance Combines (Property NoInfo) (RevertableProperty NoInfo) where
-	combineWith = combineWithPR
-instance Combines (Property HasInfo) (RevertableProperty HasInfo) where
-	combineWith = combineWithPR
-instance Combines (Property NoInfo) (RevertableProperty HasInfo) where
-	combineWith = combineWithPR
-
-combineWithRR
-	:: Combines (Property x) (Property y)
-	=> ResultCombiner
-	-> ResultCombiner
-	-> RevertableProperty x
-	-> RevertableProperty y
-	-> RevertableProperty (CInfo x y)
-combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
-	RevertableProperty
-		(combineWith sf tf s1 s2)
-		(combineWith tf sf t1 t2)
-
-combineWithRP
-	:: Combines (Property i) y
-	=> (Propellor Result -> Propellor Result -> Propellor Result)
-	-> (Propellor Result -> Propellor Result -> Propellor Result)
-	-> RevertableProperty i
-	-> y
-	-> CombinedType (Property i) y
-combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y
-
-combineWithPR
-	:: Combines x (Property i)
-	=> (Propellor Result -> Propellor Result -> Propellor Result)
-	-> (Propellor Result -> Propellor Result -> Propellor Result)
-	-> x
-	-> RevertableProperty i
-	-> CombinedType x (Property i)
-combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
+	combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) =
+		Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1)
+instance (CheckCombinable x y ~ 'CanCombine, CheckCombinable x' y' ~ 'CanCombine, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+	combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
+		RevertableProperty
+			(combineWith sf tf s1 s2)
+			(combineWith tf sf t1 t2)
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where
+	combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+	combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
+
+class TightenTargets p where
+	-- | Tightens the MetaType list of a Property (or similar),
+	-- to contain fewer targets.
+	--
+	-- For example, to make a property that uses apt-get, which is only
+	-- available on DebianLike systems:
+	--
+	-- > upgraded :: Property DebianLike
+	-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
+	tightenTargets
+		:: 
+			-- Note that this uses PolyKinds
+			( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine
+			, (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine
+			, SingI tightened
+			)
+		=> p (MetaTypes untightened)
+		-> p (MetaTypes tightened)
+
+instance TightenTargets Property where
+	tightenTargets (Property _ d a i c) = Property sing d a i c
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..fa939d2b
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+	{ hostName :: HostName
+	, hostProperties :: [ChildProperty]
+	, hostInfo :: Info
+	}
+	deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Host
+		, MonadWriter [EndAction]
+		, MonadIO
+		, MonadCatch
+		, MonadThrow
+		, MonadMask
+		)
+
+class LiftPropellor m where
+	liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+	liftPropellor = id
+
+instance LiftPropellor IO where
+	liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+	mempty = return NoChange
+	-- | The second action is only run if the first action does not fail.
+	mappend x y = do
+		rx <- x
+		case rx of
+			FailedChange -> return FailedChange
+			_ -> do
+				ry <- y
+				return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined 
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+  
+instance Show ChildProperty where
+	show = getDesc
+
+class IsProp p where
+	setDesc :: p -> Desc -> p
+	getDesc :: p -> Desc
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
+	-- | Gets the info of the property, combined with all info
+	-- of all children properties.
+	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
+	-- | Gets a ChildProperty representing the Property.
+	-- You should not normally need to use this.
+	toChildProperty :: p -> ChildProperty
+	-- | Gets the action that can be run to satisfy a Property.
+	-- You should never run this action directly. Use
+	-- 'Propellor.EnsureProperty.ensureProperty` instead.
+	getSatisfy :: p -> Propellor Result
+
+instance IsProp ChildProperty where
+	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+	getDesc (ChildProperty d _ _ _) = d
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+	getInfoRecursive (ChildProperty _ _ i c) =
+		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
+	toChildProperty = id
+	getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index 53fa9e77..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -4,7 +4,8 @@ module Propellor.Types.Info (
 	Info,
 	IsInfo(..),
 	addInfo,
-	getInfo,
+	toInfo,
+	fromInfo,
 	mapInfo,
 	propagatableInfo,
 	InfoVal(..),
@@ -18,6 +19,9 @@ import Data.Monoid
 import Prelude
 
 -- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
 newtype Info = Info [InfoEntry]
 	deriving (Monoid, Show)
 
@@ -46,9 +50,14 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where
 addInfo :: IsInfo v => Info -> v -> Info
 addInfo (Info l) v = Info (InfoEntry v:l)
 
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
+toInfo :: IsInfo v => v -> Info
+toInfo = addInfo mempty
+
 -- The list is reversed here because addInfo builds it up in reverse order.
-getInfo :: IsInfo v => Info -> v
-getInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
+fromInfo :: IsInfo v => Info -> v
+fromInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
 
 -- | Maps a function over all values stored in the Info that are of the
 -- appropriate type.
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
new file mode 100644
index 00000000..e064d76f
--- /dev/null
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -0,0 +1,213 @@
+{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-}
+
+module Propellor.Types.MetaTypes (
+	MetaType(..),
+	UnixLike,
+	Linux,
+	DebianLike,
+	Debian,
+	Buntish,
+	FreeBSD,
+	HasInfo,
+	MetaTypes,
+	type (+),
+	sing,
+	SingI,
+	IncludesInfo,
+	Targets,
+	NonTargets,
+	NotSuperset,
+	Combine,
+	CheckCombine(..),
+	CheckCombinable,
+	type (&&),
+	Not,
+	EqT,
+	Union,
+) where
+
+import Propellor.Types.Singletons
+import Propellor.Types.OS
+
+data MetaType
+	= Targeting TargetOS -- ^ A target OS of a Property
+	| WithInfo           -- ^ Indicates that a Property has associated Info
+	deriving (Show, Eq, Ord)
+
+-- | Any unix-like system
+type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ]
+-- | Any linux system
+type Linux = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
+-- | Debian and derivatives.
+type DebianLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
+type Debian = MetaTypes '[ 'Targeting 'OSDebian ]
+type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ]
+type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ]
+
+-- | Used to indicate that a Property adds Info to the Host where it's used.
+type HasInfo = MetaTypes '[ 'WithInfo ]
+
+type family IncludesInfo t :: Bool
+type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l
+
+type MetaTypes = Sing
+
+-- This boilerplate would not be needed if the singletons library were
+-- used. However, we're targeting too old a version of ghc to use it yet.
+data instance Sing (x :: MetaType) where
+	OSDebianS :: Sing ('Targeting 'OSDebian)
+	OSBuntishS :: Sing ('Targeting 'OSBuntish)
+	OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD)
+	WithInfoS :: Sing 'WithInfo
+instance SingI ('Targeting 'OSDebian) where sing = OSDebianS
+instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS
+instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS
+instance SingI 'WithInfo where sing = WithInfoS
+instance SingKind ('KProxy :: KProxy MetaType) where
+	type DemoteRep ('KProxy :: KProxy MetaType) = MetaType
+	fromSing OSDebianS = Targeting OSDebian
+	fromSing OSBuntishS = Targeting OSBuntish
+	fromSing OSFreeBSDS = Targeting OSFreeBSD
+	fromSing WithInfoS = WithInfo
+
+-- | Convenience type operator to combine two `MetaTypes` lists.
+--
+-- For example:
+--
+-- > HasInfo + Debian
+--
+-- Which is shorthand for this type:
+--
+-- > MetaTypes '[WithInfo, Targeting OSDebian]
+type family a + b :: ab
+type instance (MetaTypes a) + (MetaTypes b) = MetaTypes (Concat a b)
+
+type family Concat (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Concat '[] bs = bs
+type instance Concat (a ': as) bs = a ': (Concat as bs)
+
+-- | Combine two MetaTypes lists, yielding a list
+-- that has targets present in both, and nontargets present in either.
+type family Combine (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Combine (list1 :: [a]) (list2 :: [a]) =
+	(Concat
+		(NonTargets list1 `Union` NonTargets list2)
+		(Targets list1 `Intersect` Targets list2)
+	)
+
+-- | Checks if two MetaTypes lists can be safely combined.
+--
+-- This should be used anywhere Combine is used, as an additional
+-- constraint. For example:
+--
+-- > foo :: (CheckCombinable x y ~ 'CanCombine) => x -> y -> Combine x y
+type family CheckCombinable (list1 :: [a]) (list2 :: [a]) :: CheckCombine
+-- As a special case, if either list is empty, let it be combined with the
+-- other. This relies on MetaTypes list always containing at least
+-- one target, so can only happen if there's already been a type error.
+-- This special case lets the type checker show only the original type
+-- error, and not an extra error due to a later CheckCombinable constraint.
+type instance CheckCombinable '[] list2 = 'CanCombine
+type instance CheckCombinable list1 '[] = 'CanCombine
+type instance CheckCombinable (l1 ': list1) (l2 ': list2) =
+	CheckCombinable' (Combine (l1 ': list1) (l2 ': list2))
+type family CheckCombinable' (combinedlist :: [a]) :: CheckCombine
+type instance CheckCombinable' '[] = 'CannotCombineTargets
+type instance CheckCombinable' (a ': rest) 
+	= If (IsTarget a)
+		'CanCombine
+		(CheckCombinable' rest)
+
+data CheckCombine = CannotCombineTargets | CanCombine
+
+-- | Every item in the subset must be in the superset.
+--
+-- The name of this was chosen to make type errors more understandable.
+type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombine
+type instance NotSuperset superset '[] = 'CanCombine
+type instance NotSuperset superset (s ': rest) =
+	If (Elem s superset)
+		(NotSuperset superset rest)
+		'CannotCombineTargets
+
+type family IsTarget (a :: t) :: Bool
+type instance IsTarget ('Targeting a) = 'True
+type instance IsTarget 'WithInfo = 'False
+
+type family Targets (l :: [a]) :: [a]
+type instance Targets '[] = '[]
+type instance Targets (x ': xs) =
+	If (IsTarget x)
+		(x ': Targets xs)
+		(Targets xs)
+
+type family NonTargets (l :: [a]) :: [a]
+type instance NonTargets '[] = '[]
+type instance NonTargets (x ': xs) =
+	If (IsTarget x)
+		(NonTargets xs)
+		(x ': NonTargets xs)
+
+-- | Type level elem
+type family Elem (a :: t) (list :: [t]) :: Bool
+type instance Elem a '[] = 'False
+type instance Elem a (b ': bs) = EqT a b || Elem a bs
+
+-- | Type level union.
+type family Union (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Union '[] list2 = list2
+type instance Union (a ': rest) list2 =
+	If (Elem a list2 || Elem a rest)
+		(Union rest list2)
+		(a ': Union rest list2)
+
+-- | Type level intersection. Duplicate list items are eliminated.
+type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Intersect '[] list2 = '[]
+type instance Intersect (a ': rest) list2 = 
+	If (Elem a list2 && Not (Elem a rest))
+		(a ': Intersect rest list2)
+		(Intersect rest list2)
+
+-- | Type level equality
+--
+-- This is a very clumsy implmentation, but it works back to ghc 7.6.
+type family EqT (a :: t) (b :: t) :: Bool
+type instance EqT ('Targeting a) ('Targeting b)  = EqT a b
+type instance EqT 'WithInfo      'WithInfo       = 'True
+type instance EqT 'WithInfo      ('Targeting b)  = 'False
+type instance EqT ('Targeting a) 'WithInfo       = 'False
+type instance EqT 'OSDebian  'OSDebian  = 'True
+type instance EqT 'OSBuntish 'OSBuntish = 'True
+type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True
+type instance EqT 'OSDebian  'OSBuntish = 'False
+type instance EqT 'OSDebian  'OSFreeBSD = 'False
+type instance EqT 'OSBuntish 'OSDebian  = 'False
+type instance EqT 'OSBuntish 'OSFreeBSD = 'False
+type instance EqT 'OSFreeBSD 'OSDebian  = 'False
+type instance EqT 'OSFreeBSD 'OSBuntish = 'False
+-- More modern version if the combinatiorial explosion gets too bad later:
+--
+-- type family Eq (a :: MetaType) (b :: MetaType) where
+-- 	Eq a a = True
+-- 	Eq a b = False
+
+-- | An equivilant to the following is in Data.Type.Bool in
+-- modern versions of ghc, but is included here to support ghc 7.6.
+type family If (cond :: Bool) (tru :: a) (fls :: a) :: a
+type instance If 'True  tru fls = tru
+type instance If 'False tru fls = fls
+type family (a :: Bool) || (b :: Bool) :: Bool
+type instance    'False || 'False = 'False
+type instance    'True  || 'True  = 'True
+type instance    'True  || 'False = 'True
+type instance    'False || 'True  = 'True
+type family (a :: Bool) && (b :: Bool) :: Bool
+type instance    'False && 'False = 'False
+type instance    'True  && 'True  = 'True
+type instance    'True  && 'False = 'False
+type instance    'False && 'True  = 'False
+type family Not (a :: Bool) :: Bool
+type instance Not 'False = 'True
+type instance Not 'True = 'False
+
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index a1ba14d4..d7df5490 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -3,6 +3,7 @@
 module Propellor.Types.OS (
 	System(..),
 	Distribution(..),
+	TargetOS(..),
 	DebianSuite(..),
 	FreeBSDRelease(..),
 	FBSDVersion(..),
@@ -16,6 +17,7 @@ module Propellor.Types.OS (
 	userGroup,
 	Port(..),
 	fromPort,
+	systemToTargetOS,
 ) where
 
 import Network.BSD (HostName)
@@ -28,10 +30,23 @@ data System = System Distribution Architecture
 
 data Distribution
 	= Debian DebianSuite
-	| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per )
+	| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per 
 	| FreeBSD FreeBSDRelease
 	deriving (Show, Eq)
 
+-- | Properties can target one or more OS's; the targets are part
+-- of the type of the property, so need to be kept fairly simple.
+data TargetOS
+	= OSDebian
+	| OSBuntish
+	| OSFreeBSD
+	deriving (Show, Eq, Ord)
+
+systemToTargetOS :: System -> TargetOS
+systemToTargetOS (System (Debian _) _) = OSDebian
+systemToTargetOS (System (Buntish _) _) = OSBuntish
+systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD
+
 -- | Debian has several rolling suites, and a number of stable releases,
 -- such as Stable "jessie".
 data DebianSuite = Experimental | Unstable | Testing | Stable Release
@@ -39,10 +54,10 @@ data DebianSuite = Experimental | Unstable | Testing | Stable Release
 
 -- | FreeBSD breaks their releases into "Production" and "Legacy".
 data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion
-  deriving (Show, Eq)
+	deriving (Show, Eq)
 
 data FBSDVersion = FBSD101 | FBSD102 | FBSD093
-  deriving (Eq)
+	deriving (Eq)
 
 instance IsString FBSDVersion where
 	fromString "10.1-RELEASE" = FBSD101
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
index 4c6524ee..f03c174f 100644
--- a/src/Propellor/Types/ResultCheck.hs
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -22,6 +22,9 @@ import Data.Monoid
 -- and `FailedChange` is still an error.
 data UncheckedProperty i = UncheckedProperty (Property i)
 
+instance TightenTargets UncheckedProperty where
+	tightenTargets (UncheckedProperty p) = UncheckedProperty (tightenTargets p)
+
 -- | Use to indicate that a Property is unchecked.
 unchecked :: Property i -> UncheckedProperty i
 unchecked = UncheckedProperty
diff --git a/src/Propellor/Types/Singletons.hs b/src/Propellor/Types/Singletons.hs
new file mode 100644
index 00000000..f2089ee8
--- /dev/null
+++ b/src/Propellor/Types/Singletons.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs, UndecidableInstances #-}
+
+-- | Simple implementation of singletons, portable back to ghc 7.6.3
+
+module Propellor.Types.Singletons (
+	module Propellor.Types.Singletons,
+	KProxy(..)
+) where
+
+#if __GLASGOW_HASKELL__ > 707
+import Data.Proxy (KProxy(..))
+#else
+data KProxy (a :: *) = KProxy
+#endif
+
+-- | The data family of singleton types.
+data family Sing (x :: k)
+
+-- | A class used to pass singleton values implicitly.
+class SingI t where
+	sing :: Sing t
+
+-- Lists of singletons
+data instance Sing (x :: [k]) where
+	Nil :: Sing '[]
+	Cons :: Sing x -> Sing xs -> Sing (x ': xs)
+instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing
+instance SingI '[] where sing = Nil
+
+data instance Sing (x :: Bool) where
+	TrueS :: Sing 'True
+	FalseS :: Sing 'False
+instance SingI 'True where sing = TrueS
+instance SingI 'False where sing = FalseS
+
+class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where
+	type DemoteRep kparam :: *
+	-- | From singleton to value.
+	fromSing :: Sing (a :: k) -> DemoteRep kparam
+
+instance SingKind ('KProxy :: KProxy a) => SingKind ('KProxy :: KProxy [a]) where
+	type DemoteRep ('KProxy :: KProxy [a]) = [DemoteRep ('KProxy :: KProxy a)]
+	fromSing Nil = []
+	fromSing (Cons x xs) = fromSing x : fromSing xs
+
+instance SingKind ('KProxy :: KProxy Bool) where
+	type DemoteRep ('KProxy :: KProxy Bool) = Bool
+	fromSing FalseS = False
+	fromSing TrueS = True
diff --git a/src/System/Console/Concurrent.hs b/src/System/Console/Concurrent.hs
deleted file mode 100644
index 12447637..00000000
--- a/src/System/Console/Concurrent.hs
+++ /dev/null
@@ -1,44 +0,0 @@
--- | 
--- Copyright: 2015 Joey Hess 
--- License: BSD-2-clause
--- 
--- Concurrent output handling.
---
--- > import Control.Concurrent.Async
--- > import System.Console.Concurrent
--- >
--- > main = withConcurrentOutput $
--- > 	outputConcurrent "washed the car\n"
--- > 		`concurrently`
--- >	outputConcurrent "walked the dog\n"
--- >		`concurrently`
--- > 	createProcessConcurrent (proc "ls" [])
-
-{-# LANGUAGE CPP #-}
-
-module System.Console.Concurrent (
-	-- * Concurrent output
-	withConcurrentOutput,
-	Outputable(..),
-	outputConcurrent,
-	errorConcurrent,
-	ConcurrentProcessHandle,
-#ifndef mingw32_HOST_OS
-	createProcessConcurrent,
-#endif
-	waitForProcessConcurrent,
-	createProcessForeground,
-	flushConcurrentOutput,
-	lockOutput,
-	-- * Low level access to the output buffer
-	OutputBuffer,
-	StdHandle(..),
-	bufferOutputSTM,
-	outputBufferWaiterSTM,
-	waitAnyBuffer,
-	waitCompleteLines,
-	emitOutputBuffer,
-) where
-
-import System.Console.Concurrent.Internal
-
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
deleted file mode 100644
index 5b9cf454..00000000
--- a/src/System/Console/Concurrent/Internal.hs
+++ /dev/null
@@ -1,556 +0,0 @@
-{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances, TupleSections #-}
-{-# LANGUAGE CPP #-}
-
--- | 
--- Copyright: 2015 Joey Hess 
--- License: BSD-2-clause
--- 
--- Concurrent output handling, internals.
---
--- May change at any time.
-
-module System.Console.Concurrent.Internal where
-
-import System.IO
-#ifndef mingw32_HOST_OS
-import System.Posix.IO
-#endif
-import System.Directory
-import System.Exit
-import Control.Monad
-import Control.Monad.IO.Class (liftIO, MonadIO)
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Concurrent.Async
-import Data.Maybe
-import Data.List
-import Data.Monoid
-import qualified System.Process as P
-import qualified Data.Text as T
-import qualified Data.Text.IO as T
-import Control.Applicative
-import Prelude
-import System.Log.Logger
-
-import Utility.Monad
-import Utility.Exception
-
-data OutputHandle = OutputHandle
-	{ outputLock :: TMVar Lock
-	, outputBuffer :: TMVar OutputBuffer
-	, errorBuffer :: TMVar OutputBuffer
-	, outputThreads :: TMVar Integer
-	, processWaiters :: TMVar [Async ()]
-	, waitForProcessLock :: TMVar ()
-	}
-
-data Lock = Locked
-
--- | A shared global variable for the OutputHandle.
-{-# NOINLINE globalOutputHandle #-}
-globalOutputHandle :: OutputHandle
-globalOutputHandle = unsafePerformIO $ OutputHandle
-	<$> newEmptyTMVarIO
-	<*> newTMVarIO (OutputBuffer [])
-	<*> newTMVarIO (OutputBuffer [])
-	<*> newTMVarIO 0
-	<*> newTMVarIO []
-	<*> newEmptyTMVarIO
-
--- | Holds a lock while performing an action. This allows the action to
--- perform its own output to the console, without using functions from this
--- module.
---
--- While this is running, other threads that try to lockOutput will block.
--- Any calls to `outputConcurrent` and `createProcessConcurrent` will not
--- block, but the output will be buffered and displayed only once the
--- action is done.
-lockOutput :: (MonadIO m, MonadMask m) => m a -> m a
-lockOutput = bracket_ (liftIO takeOutputLock) (liftIO dropOutputLock)
-
--- | Blocks until we have the output lock.
-takeOutputLock :: IO ()
-takeOutputLock = void $ takeOutputLock' True
-
--- | Tries to take the output lock, without blocking.
-tryTakeOutputLock :: IO Bool
-tryTakeOutputLock = takeOutputLock' False
-
-withLock :: (TMVar Lock -> STM a) -> IO a
-withLock a = atomically $ a (outputLock globalOutputHandle)
-
-takeOutputLock' :: Bool -> IO Bool
-takeOutputLock' block = do
-	locked <- withLock $ \l -> do
-		v <- tryTakeTMVar l
-		case v of
-			Just Locked
-				| block -> retry
-				| otherwise -> do
-					-- Restore value we took.
-					putTMVar l Locked
-					return False
-			Nothing -> do
-				putTMVar l Locked
-				return True
-	when locked $ do
-		(outbuf, errbuf) <- atomically $ (,)
-			<$> swapTMVar (outputBuffer globalOutputHandle) (OutputBuffer [])
-			<*> swapTMVar (errorBuffer globalOutputHandle) (OutputBuffer [])
-		emitOutputBuffer StdOut outbuf
-		emitOutputBuffer StdErr errbuf
-	return locked
-
--- | Only safe to call after taking the output lock.
-dropOutputLock :: IO ()
-dropOutputLock = withLock $ void . takeTMVar
-
--- | Use this around any actions that use `outputConcurrent`
--- or `createProcessConcurrent`
---
--- This is necessary to ensure that buffered concurrent output actually
--- gets displayed before the program exits.
-withConcurrentOutput :: (MonadIO m, MonadMask m) => m a -> m a
-withConcurrentOutput a = a `finally` liftIO flushConcurrentOutput
-
--- | Blocks until any processes started by `createProcessConcurrent` have
--- finished, and any buffered output is displayed. Also blocks while
--- `lockOutput` is is use.
---
--- `withConcurrentOutput` calls this at the end, so you do not normally
--- need to use this.
-flushConcurrentOutput :: IO ()
-flushConcurrentOutput = do
-	atomically $ do
-		r <- takeTMVar (outputThreads globalOutputHandle)
-		if r <= 0
-			then putTMVar (outputThreads globalOutputHandle) r
-			else retry
-	-- Take output lock to wait for anything else that might be
-	-- currently generating output.
-	lockOutput $ return ()
-
--- | Values that can be output.
-class Outputable v where
-	toOutput :: v -> T.Text
-
-instance Outputable T.Text where
-	toOutput = id
-
-instance Outputable String where
-	toOutput = toOutput . T.pack
-
--- | Displays a value to stdout.
---
--- No newline is appended to the value, so if you want a newline, be sure
--- to include it yourself.
---
--- Uses locking to ensure that the whole output occurs atomically
--- even when other threads are concurrently generating output.
---
--- When something else is writing to the console at the same time, this does
--- not block. It buffers the value, so it will be displayed once the other
--- writer is done.
-outputConcurrent :: Outputable v => v -> IO ()
-outputConcurrent = outputConcurrent' StdOut
-
--- | Like `outputConcurrent`, but displays to stderr.
---
--- (Does not throw an exception.)
-errorConcurrent :: Outputable v => v -> IO ()
-errorConcurrent = outputConcurrent' StdErr
-
-outputConcurrent' :: Outputable v => StdHandle -> v -> IO ()
-outputConcurrent' stdh v = bracket setup cleanup go
-  where
-	setup = tryTakeOutputLock
-	cleanup False = return ()
-	cleanup True = dropOutputLock
-	go True = do
-		T.hPutStr h (toOutput v)
-		hFlush h
-	go False = do
-		oldbuf <- atomically $ takeTMVar bv
-		newbuf <- addOutputBuffer (Output (toOutput v)) oldbuf
-		atomically $ putTMVar bv newbuf
-	h = toHandle stdh
-	bv = bufferFor stdh
-
-newtype ConcurrentProcessHandle = ConcurrentProcessHandle P.ProcessHandle
-
-toConcurrentProcessHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle) -> (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-toConcurrentProcessHandle (i, o, e, h) = (i, o, e, ConcurrentProcessHandle h)
-
--- | Use this to wait for processes started with 
--- `createProcessConcurrent` and `createProcessForeground`, and get their
--- exit status.
---
--- Note that such processes are actually automatically waited for
--- internally, so not calling this explicitly will not result
--- in zombie processes. This behavior differs from `P.waitForProcess`
-waitForProcessConcurrent :: ConcurrentProcessHandle -> IO ExitCode
-waitForProcessConcurrent (ConcurrentProcessHandle h) = 
-	bracket lock unlock checkexit
-  where
-	lck = waitForProcessLock globalOutputHandle
-	lock = atomically $ tryPutTMVar lck ()
-	unlock True = atomically $ takeTMVar lck
-	unlock False = return ()
-	checkexit locked = maybe (waitsome locked) return
-		=<< P.getProcessExitCode h
-	waitsome True = do
-		let v = processWaiters globalOutputHandle
-		l <- atomically $ readTMVar v
-		if null l
-			-- Avoid waitAny [] which blocks forever
-			then P.waitForProcess h
-			else do
-				-- Wait for any of the running
-				-- processes to exit. It may or may not
-				-- be the one corresponding to the
-				-- ProcessHandle. If it is,
-				-- getProcessExitCode will succeed.
-				void $ tryIO $ waitAny l
-				checkexit True
-	waitsome False = do
-		-- Another thread took the lck first. Wait for that thread to
-		-- wait for one of the running processes to exit.
-		atomically $ do
-			putTMVar lck ()
-			takeTMVar lck
-		checkexit False
-
--- Registers an action that waits for a process to exit,
--- adding it to the processWaiters list, and removing it once the action
--- completes.
-asyncProcessWaiter :: IO () -> IO ()
-asyncProcessWaiter waitaction = do
-	regdone <- newEmptyTMVarIO
-	waiter <- async $ do
-		self <- atomically (takeTMVar regdone)
-		waitaction `finally` unregister self
-	register waiter regdone
-  where
-	v = processWaiters globalOutputHandle
-  	register waiter regdone = atomically $ do
-		l <- takeTMVar v
-		putTMVar v (waiter:l)
-		putTMVar regdone waiter
-	unregister waiter = atomically $ do
-		l <- takeTMVar v
-		putTMVar v (filter (/= waiter) l)
-
--- | Wrapper around `System.Process.createProcess` that prevents 
--- multiple processes that are running concurrently from writing
--- to stdout/stderr at the same time.
---
--- If the process does not output to stdout or stderr, it's run
--- by createProcess entirely as usual. Only processes that can generate
--- output are handled specially:
---
--- A process is allowed to write to stdout and stderr in the usual
--- way, assuming it can successfully take the output lock.
---
--- When the output lock is held (ie, by another concurrent process,
--- or because `outputConcurrent` is being called at the same time),
--- the process is instead run with its stdout and stderr
--- redirected to a buffer. The buffered output will be displayed as soon
--- as the output lock becomes free.
---
--- Currently only available on Unix systems, not Windows.
-#ifndef mingw32_HOST_OS
-createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle) 
-createProcessConcurrent p
-	| willOutput (P.std_out p) || willOutput (P.std_err p) =
-		ifM tryTakeOutputLock
-			( fgProcess p
-			, bgProcess p
-			)
-	| otherwise = do
-		r@(_, _, _, h) <- P.createProcess p
-		asyncProcessWaiter $
-			void $ tryIO $ P.waitForProcess h
-		return (toConcurrentProcessHandle r)
-#endif
-
--- | Wrapper around `System.Process.createProcess` that makes sure a process
--- is run in the foreground, with direct access to stdout and stderr.
--- Useful when eg, running an interactive process.
-createProcessForeground :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-createProcessForeground p = do
-	takeOutputLock
-	fgProcess p
-
-fgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-fgProcess p = do
-	r@(_, _, _, h) <- P.createProcess p
-		`onException` dropOutputLock
-	registerOutputThread
-	debug ["fgProcess", showProc p]
-	-- Wait for the process to exit and drop the lock.
-	asyncProcessWaiter $ do
-		void $ tryIO $ P.waitForProcess h
-		unregisterOutputThread
-		dropOutputLock
-		debug ["fgProcess done", showProc p]
-	return (toConcurrentProcessHandle r)
-	
-debug :: [String] -> IO ()
-debug = debugM "concurrent-output" . unwords
-
-showProc :: P.CreateProcess -> String
-showProc = go . P.cmdspec
-  where
-	go (P.ShellCommand s) = s
-	go (P.RawCommand c ps) = show (c, ps)
-
-#ifndef mingw32_HOST_OS
-bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-bgProcess p = do
-	(toouth, fromouth) <- pipe
-	(toerrh, fromerrh) <- pipe
-	debug ["bgProcess", showProc p]
-	let p' = p
-		{ P.std_out = rediroutput (P.std_out p) toouth
-		, P.std_err = rediroutput (P.std_err p) toerrh
-		}
-	registerOutputThread
-	r@(_, _, _, h) <- P.createProcess p'
-		`onException` unregisterOutputThread
-	asyncProcessWaiter $ void $ tryIO $ P.waitForProcess h
-	outbuf <- setupOutputBuffer StdOut toouth (P.std_out p) fromouth
-	errbuf <- setupOutputBuffer StdErr toerrh (P.std_err p) fromerrh
-	void $ async $ bufferWriter [outbuf, errbuf]
-	return (toConcurrentProcessHandle r)
-  where
-	pipe = do
-		(from, to) <- createPipe
-		(,) <$> fdToHandle to <*> fdToHandle from
-	rediroutput ss h
-		| willOutput ss = P.UseHandle h
-		| otherwise = ss
-#endif
-
-willOutput :: P.StdStream -> Bool
-willOutput P.Inherit = True
-willOutput _ = False
-
--- | Buffered output.
-data OutputBuffer = OutputBuffer [OutputBufferedActivity]
-	deriving (Eq)
-
-data StdHandle = StdOut | StdErr
-
-toHandle :: StdHandle -> Handle
-toHandle StdOut = stdout
-toHandle StdErr = stderr
-
-bufferFor :: StdHandle -> TMVar OutputBuffer
-bufferFor StdOut = outputBuffer globalOutputHandle
-bufferFor StdErr = errorBuffer globalOutputHandle
-
-data OutputBufferedActivity
-	= Output T.Text
-	| InTempFile
-		{ tempFile :: FilePath
-		, endsInNewLine :: Bool
-		}
-	deriving (Eq)
-
-data AtEnd = AtEnd
-	deriving Eq
-
-data BufSig = BufSig
-
-setupOutputBuffer :: StdHandle -> Handle -> P.StdStream -> Handle -> IO (StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)
-setupOutputBuffer h toh ss fromh = do
-	hClose toh
-	buf <- newMVar (OutputBuffer [])
-	bufsig <- atomically newEmptyTMVar
-	bufend <- atomically newEmptyTMVar
-	void $ async $ outputDrainer ss fromh buf bufsig bufend
-	return (h, buf, bufsig, bufend)
-
--- Drain output from the handle, and buffer it.
-outputDrainer :: P.StdStream -> Handle -> MVar OutputBuffer -> TMVar BufSig -> TMVar AtEnd -> IO ()
-outputDrainer ss fromh buf bufsig bufend
-	| willOutput ss = go
-	| otherwise = atend
-  where
-	go = do
-		t <- T.hGetChunk fromh
-		if T.null t
-			then atend
-			else do
-				modifyMVar_ buf $ addOutputBuffer (Output t)
-				changed
-				go
-	atend = do
-		atomically $ putTMVar bufend AtEnd
-		hClose fromh
-	changed = atomically $ do
-		void $ tryTakeTMVar bufsig
-		putTMVar bufsig BufSig
-
-registerOutputThread :: IO ()
-registerOutputThread = do
-	let v = outputThreads globalOutputHandle
-	atomically $ putTMVar v . succ =<< takeTMVar v
-	
-unregisterOutputThread :: IO ()
-unregisterOutputThread = do
-	let v = outputThreads globalOutputHandle
-	atomically $ putTMVar v . pred =<< takeTMVar v
-
--- Wait to lock output, and once we can, display everything 
--- that's put into the buffers, until the end.
---
--- If end is reached before lock is taken, instead add the command's
--- buffers to the global outputBuffer and errorBuffer.
-bufferWriter :: [(StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)] -> IO ()
-bufferWriter ts = do
-	activitysig <- atomically newEmptyTMVar
-	worker1 <- async $ lockOutput $
-		ifM (atomically $ tryPutTMVar activitysig ())
-			( void $ mapConcurrently displaybuf ts
-			, noop -- buffers already moved to global
-			)
-	worker2 <- async $ void $ globalbuf activitysig worker1
-	void $ async $ do
-		void $ waitCatch worker1
-		void $ waitCatch worker2
-		unregisterOutputThread
-  where
-	displaybuf v@(outh, buf, bufsig, bufend) = do
-		change <- atomically $
-			(Right <$> takeTMVar bufsig)
-				`orElse`
-			(Left <$> takeTMVar bufend)
-		l <- takeMVar buf
-		putMVar buf (OutputBuffer [])
-		emitOutputBuffer outh l
-		case change of
-			Right BufSig -> displaybuf v
-			Left AtEnd -> return ()
-	globalbuf activitysig worker1 = do
-		ok <- atomically $ do
-			-- signal we're going to handle it
-			-- (returns false if the displaybuf already did)
-			ok <- tryPutTMVar activitysig ()
-			-- wait for end of all buffers
-			when ok $
-				mapM_ (\(_outh, _buf, _bufsig, bufend) -> takeTMVar bufend) ts
-			return ok
-		when ok $ do
-			-- add all of the command's buffered output to the
-			-- global output buffer, atomically
-			bs <- forM ts $ \(outh, buf, _bufsig, _bufend) ->
-				(outh,) <$> takeMVar buf
-			atomically $
-				forM_ bs $ \(outh, b) -> 
-					bufferOutputSTM' outh b
-			-- worker1 might be blocked waiting for the output
-			-- lock, and we've already done its job, so cancel it
-			cancel worker1
-
--- Adds a value to the OutputBuffer. When adding Output to a Handle,
--- it's cheaper to combine it with any already buffered Output to that
--- same Handle.
---
--- When the total buffered Output exceeds 1 mb in size, it's moved out of
--- memory, to a temp file. This should only happen rarely, but is done to
--- avoid some verbose process unexpectedly causing excessive memory use.
-addOutputBuffer :: OutputBufferedActivity -> OutputBuffer -> IO OutputBuffer
-addOutputBuffer (Output t) (OutputBuffer buf)
-	| T.length t' <= 1048576 = return $ OutputBuffer (Output t' : other)
-	| otherwise = do
-		tmpdir <- getTemporaryDirectory
-		(tmp, h) <- openTempFile tmpdir "output.tmp"
-		let !endnl = endsNewLine t'
-		let i = InTempFile
-			{ tempFile = tmp
-			, endsInNewLine = endnl
-			}
-		T.hPutStr h t'
-		hClose h
-		return $ OutputBuffer (i : other)
-  where
-	!t' = T.concat (mapMaybe getOutput this) <> t
-	!(this, other) = partition isOutput buf
-	isOutput v = case v of
-		Output _ -> True
-		_ -> False
-	getOutput v = case v of
-		Output t'' -> Just t''
-		_ -> Nothing
-addOutputBuffer v (OutputBuffer buf) = return $ OutputBuffer (v:buf)
-
--- | Adds a value to the output buffer for later display.
---
--- Note that buffering large quantities of data this way will keep it
--- resident in memory until it can be displayed. While `outputConcurrent`
--- uses temp files if the buffer gets too big, this STM function cannot do
--- so.
-bufferOutputSTM :: Outputable v => StdHandle -> v -> STM ()
-bufferOutputSTM h v = bufferOutputSTM' h (OutputBuffer [Output (toOutput v)])
-
-bufferOutputSTM' :: StdHandle -> OutputBuffer -> STM ()
-bufferOutputSTM' h (OutputBuffer newbuf) = do
-	(OutputBuffer buf) <- takeTMVar bv
-	putTMVar bv (OutputBuffer (newbuf ++ buf))
-  where
-	bv = bufferFor h
-
--- | A STM action that waits for some buffered output to become
--- available, and returns it.
---
--- The function can select a subset of output when only some is desired;
--- the fst part is returned and the snd is left in the buffer.
---
--- This will prevent it from being displayed in the usual way, so you'll
--- need to use `emitOutputBuffer` to display it yourself.
-outputBufferWaiterSTM :: (OutputBuffer -> (OutputBuffer, OutputBuffer)) -> STM (StdHandle, OutputBuffer)
-outputBufferWaiterSTM selector = waitgetbuf StdOut `orElse` waitgetbuf StdErr
-  where
-	waitgetbuf h = do
-		let bv = bufferFor h
-		(selected, rest) <- selector <$> takeTMVar bv
-		when (selected == OutputBuffer [])
-			retry
-		putTMVar bv rest
-		return (h, selected)
-
-waitAnyBuffer :: OutputBuffer -> (OutputBuffer, OutputBuffer)
-waitAnyBuffer b = (b, OutputBuffer [])
-
--- | Use with `outputBufferWaiterSTM` to make it only return buffered
--- output that ends with a newline. Anything buffered without a newline
--- is left in the buffer.
-waitCompleteLines :: OutputBuffer -> (OutputBuffer, OutputBuffer)
-waitCompleteLines (OutputBuffer l) = 
-	let (selected, rest) = span completeline l
-	in (OutputBuffer selected, OutputBuffer rest)
-  where
-	completeline (v@(InTempFile {})) = endsInNewLine v
-	completeline (Output b) = endsNewLine b
-
-endsNewLine :: T.Text -> Bool
-endsNewLine t = not (T.null t) && T.last t == '\n'
-
--- | Emits the content of the OutputBuffer to the Handle
---
--- If you use this, you should use `lockOutput` to ensure you're the only
--- thread writing to the console.
-emitOutputBuffer :: StdHandle -> OutputBuffer -> IO ()
-emitOutputBuffer stdh (OutputBuffer l) = 
-	forM_ (reverse l) $ \ba -> case ba of
-		Output t -> emit t
-		InTempFile tmp _ -> do
-			emit =<< T.readFile tmp
-			void $ tryWhenExists $ removeFile tmp
-  where
-	outh = toHandle stdh
-	emit t = void $ tryIO $ do
-		T.hPutStr outh t
-		hFlush outh
diff --git a/src/System/Process/Concurrent.hs b/src/System/Process/Concurrent.hs
deleted file mode 100644
index 0e00e4fd..00000000
--- a/src/System/Process/Concurrent.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- | 
--- Copyright: 2015 Joey Hess 
--- License: BSD-2-clause
--- 
--- The functions exported by this module are intended to be drop-in
--- replacements for those from System.Process, when converting a whole
--- program to use System.Console.Concurrent.
-
-module System.Process.Concurrent where
-
-import System.Console.Concurrent
-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
-import System.Process hiding (createProcess, waitForProcess)
-import System.IO
-import System.Exit
-
--- | Calls `createProcessConcurrent`
---
--- You should use the waitForProcess in this module on the resulting
--- ProcessHandle. Using System.Process.waitForProcess instead can have
--- mildly unexpected results.
-createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-createProcess p = do
-	(i, o, e, ConcurrentProcessHandle h) <- createProcessConcurrent p
-	return (i, o, e, h)
-
--- | Calls `waitForProcessConcurrent`
---
--- You should only use this on a ProcessHandle obtained by calling
--- createProcess from this module. Using this with a ProcessHandle
--- obtained from System.Process.createProcess etc will have extremely
--- unexpected results; it can wait a very long time before returning.
-waitForProcess :: ProcessHandle -> IO ExitCode
-waitForProcess = waitForProcessConcurrent . ConcurrentProcessHandle
-- 
cgit v1.2.3


From ebdbac3243d7881e2bfac1ff293cf04c7cd69c91 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 09:31:57 -0400
Subject: add

---
 doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn | 9 +++++++++
 1 file changed, 9 insertions(+)
 create mode 100644 doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn

diff --git a/doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn b/doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn
new file mode 100644
index 00000000..ff5d5434
--- /dev/null
+++ b/doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn
@@ -0,0 +1,9 @@
+Currently chroot properties containing any OS can be added to any host. Of
+course, some won't work. It would be nice to type check that the
+combination of inner and outer OS are compatable (ie, some linux on some
+linux).
+
+I have a partially done patch for that, but it failed at the last hurdle.
+See commit message 0b0ea182ab3301ade8b87b1be1cdecc3464cd1da 
+
+[[!tag users/joey]]
-- 
cgit v1.2.3


From cebf755a6710548bcff4474e6010eefb83db08ac Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Mon, 28 Mar 2016 11:06:23 -0400
Subject: close

---
 doc/todo/type_level_OS_requirements.mdwn | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/doc/todo/type_level_OS_requirements.mdwn b/doc/todo/type_level_OS_requirements.mdwn
index f1c3e59f..fed1b279 100644
--- a/doc/todo/type_level_OS_requirements.mdwn
+++ b/doc/todo/type_level_OS_requirements.mdwn
@@ -52,3 +52,5 @@ work with that version, with some added ugliness.
 --[[Joey]]
 
 [[!tag user/joey]]
+
+> [[done]]!! --[[Joey]] 
-- 
cgit v1.2.3


From 5473314f57196887117cc45ff066ed4d74115ef2 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 11:06:01 -0400
Subject: show childProperty same as property

---
 src/Propellor/Types/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
index fa939d2b..6fedc47e 100644
--- a/src/Propellor/Types/Core.hs
+++ b/src/Propellor/Types/Core.hs
@@ -74,7 +74,7 @@ data Props metatypes = Props [ChildProperty]
 data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
   
 instance Show ChildProperty where
-	show = getDesc
+	show p = "property " ++ show (getDesc p)
 
 class IsProp p where
 	setDesc :: p -> Desc -> p
-- 
cgit v1.2.3


From 2f82a87fd7f411b9f619e048c1b9b54de6126987 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 11:30:11 -0400
Subject: refactor

---
 src/Propellor/Property/Systemd.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e0b7d572..1e0c3f86 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -195,12 +195,13 @@ machined = withOS "machined installed" $ \w o ->
 -- >    & ...
 container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
 container name mkchroot = 
-	let c = Container name chroot (host name (containerProps chroot))
+	let c = Container name chroot h
 	in setContainerProps c $ containerProps c
 		&^ resolvConfed
 		&^ linkJournal
   where
 	chroot = mkchroot (containerDir name)
+	h = host name (containerProps chroot)
 
 -- | Defines a container with a given machine name, with the chroot
 -- created using debootstrap.
-- 
cgit v1.2.3


From 5633d420ec883d3b46410a8e0bc52225905efd79 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 11:42:41 -0400
Subject: fix info propigation from chroot to systemd container

---
 src/Propellor/Property/Systemd.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 1e0c3f86..e5441817 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -201,7 +201,7 @@ container name mkchroot =
 		&^ linkJournal
   where
 	chroot = mkchroot (containerDir name)
-	h = host name (containerProps chroot)
+	h = Host name (containerProperties chroot) (containerInfo chroot)
 
 -- | Defines a container with a given machine name, with the chroot
 -- created using debootstrap.
-- 
cgit v1.2.3


From 5da36e4f59c982ae80ff3d73b9fe9524becf2dff Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 12:09:58 -0400
Subject: setting up joeyconfig after merge

---
 config.hs         | 2 +-
 privdata/relocate | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)
 create mode 100644 privdata/relocate

diff --git a/config.hs b/config.hs
index ec313725..97d90636 120000
--- a/config.hs
+++ b/config.hs
@@ -1 +1 @@
-config-simple.hs
\ No newline at end of file
+joeyconfig.hs
\ No newline at end of file
diff --git a/privdata/relocate b/privdata/relocate
new file mode 100644
index 00000000..271692d8
--- /dev/null
+++ b/privdata/relocate
@@ -0,0 +1 @@
+.joeyconfig
-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 29d8b616ea2dca958f8785266e33fac63cebcf46 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 12:23:31 -0400
Subject: add hs-concurrent-output to freebsd deps

---
 src/Propellor/Bootstrap.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 3b4c3106..2ad0f688 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -109,6 +109,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "hs-exceptions"
 		, "hs-stm"
 		, "hs-text"
+		, "hs-concurrent-output"
 		, "gmake"
 		]
 
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 07e2f92389b18c2fe3c820bb9100fd586451ac75 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 12:43:01 -0400
Subject: indent

---
 src/Propellor/Spin.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 944696dd..c6699961f 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -98,7 +98,7 @@ spin' mprivdata relay target hst = do
 	viarelay = isJust relay && not relaying
 
 	probecmd = intercalate " ; "
-		["if [ ! -d " ++ localdir ++ "/.git ]"
+		[ "if [ ! -d " ++ localdir ++ "/.git ]"
 		, "then (" ++ intercalate " && "
 			[ installGitCommand sys
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From afca378d8624b31955e778d8d9a66713a3431f36 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 14:32:35 -0400
Subject: propellor spin

---
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 24 +++++++++---------------
 1 file changed, 9 insertions(+), 15 deletions(-)

diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 0ce64939..227f0131 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -20,6 +20,7 @@ import qualified Propellor.Property.Apache as Apache
 import qualified Propellor.Property.Postfix as Postfix
 import qualified Propellor.Property.Systemd as Systemd
 import qualified Propellor.Property.Fail2Ban as Fail2Ban
+import qualified Propellor.Property.LetsEncrypt as LetsEncrypt
 import Utility.FileMode
 
 import Data.List
@@ -296,24 +297,21 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
 		, "git update-server-info"
 		]
 	addremote (name, url) = "git remote add " ++ shellEscape name ++ " " ++ shellEscape url
-	setupapache = apacheSite hn True
+	setupapache = Apache.httpsVirtualHost' hn dir letos
 		[ "  ServerAlias www."++hn
-		, ""
-		, "  DocumentRoot /srv/web/"++hn
-		, "  "
-		, "    Options FollowSymLinks"
-		, "    AllowOverride None"
-		, Apache.allowAll
-		, "  "
-		, "  "
+		,    Apache.iconDir
+		, "  "
 		, "    Options Indexes FollowSymLinks ExecCGI"
 		, "    AllowOverride None"
 		, "    AddHandler cgi-script .cgi"
 		, "    DirectoryIndex index.html index.cgi"
-		, Apache.allowAll
+		,      Apache.allowAll
 		, "  "
 		]
 
+letos :: LetsEncrypt.AgreeTOS
+letos = LetsEncrypt.AgreeTOS (Just "id@joeyh.name")
+
 apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
 apacheSite hn withssl middle = Apache.siteEnabled hn $ apachecfg hn withssl middle
 
@@ -335,11 +333,7 @@ apachecfg hn withssl middle
 		, "  CustomLog /var/log/apache2/access.log combined"
 		, "  ServerSignature On"
 		, "  "
-		, "  "
-		, "      Options Indexes MultiViews"
-		, "      AllowOverride None"
-		, Apache.allowAll
-		, "  "
+		, Apache.iconDir
 		, ""
 		]
 	  where
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 0f410f8acdb9e0b84ae364e80e5ee63adcb2ee50 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 15:18:39 -0400
Subject: When new dependencies are added to propellor or the propellor config,
 try harder to get them installed.

In particular, this makes  propellor --spin work when the remote host needs
to get dependencies installed in order to build the updated config.

Fixes http://propellor.branchable.com/todo/problem_with_spin_after_new_dependencies_added/
---
 debian/changelog           |  4 ++++
 src/Propellor/Bootstrap.hs | 33 ++++++++++++++++++++++++---------
 src/Propellor/CmdLine.hs   | 30 +++++++++++++++---------------
 src/wrapper.hs             |  2 +-
 4 files changed, 44 insertions(+), 25 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 1075773d..abc7d530 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -60,6 +60,10 @@ propellor (3.0.0) UNRELEASED; urgency=medium
   * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
     these complex new types.
   * Added dependency on concurrent-output; removed embedded copy.
+  * When new dependencies are added to propellor or the propellor config,
+    try harder to get them installed. In particular, this makes 
+    propellor --spin work when the remote host needs to get dependencies
+    installed in order to build the updated config.
 
  -- Joey Hess   Thu, 24 Mar 2016 15:02:33 -0400
 
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 2ad0f688..b60dd8c4 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -6,6 +6,7 @@ module Propellor.Bootstrap (
 ) where
 
 import Propellor.Base
+import Propellor.Types.Info
 
 import System.Posix.Files
 import Data.List
@@ -130,22 +131,27 @@ installGitCommand msys = case msys of
 		, "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git"
 		]
 
-buildPropellor :: IO ()
-buildPropellor = unlessM (actionMessage "Propellor build" build) $
+buildPropellor :: Maybe Host -> IO ()
+buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
 	errorMessage "Propellor build failed!"
+  where
+	msys = case fmap (fromInfo . hostInfo) mh of
+		Just (InfoVal sys) -> Just sys
+		_ -> Nothing
 
 -- Build propellor using cabal, and symlink propellor to where cabal
 -- leaves the built binary.
 --
 -- For speed, only runs cabal configure when it's not been run before.
 -- If the build fails cabal may need to have configure re-run.
-build :: IO Bool
-build = catchBoolIO $ do
-	make "dist/setup-config" ["propellor.cabal"] $
-		cabal ["configure"]
-	unlessM (cabal ["build", "propellor-config"]) $ do
-		void $ cabal ["configure"]
-		unlessM (cabal ["build"]) $
+--
+-- If the cabal configure fails, and a System is provided, installs
+-- dependencies and retries.
+build :: Maybe System -> IO Bool
+build msys = catchBoolIO $ do
+	make "dist/setup-config" ["propellor.cabal"] cabal_configure
+	unlessM cabal_build $
+		unlessM (cabal_configure <&&> cabal_build) $
 			error "cabal build failed"
 	-- For safety against eg power loss in the middle of the build,
 	-- make a copy of the binary, and move it into place atomically.
@@ -165,6 +171,15 @@ build = catchBoolIO $ do
 	cabalbuiltbin = "dist/build/propellor-config/propellor-config"
 	safetycopy = cabalbuiltbin ++ ".built"
 	tmpfor f = f ++ ".propellortmp"
+	cabal_configure = ifM (cabal ["configure"])
+		( return True
+		, case msys of
+			Nothing -> return False
+			Just sys -> 
+				boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))]
+					<&&> cabal ["configure"]
+		)
+	cabal_build = cabal ["build", "propellor-config"]
 
 make :: FilePath -> [FilePath] -> IO Bool -> IO ()
 make dest srcs builder = do
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ee057d05..8fd2bf18 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -114,20 +114,20 @@ defaultMain hostlist = withConcurrentOutput $ do
 	go _ (DockerInit hn) = Docker.init hn
 	go _ (GitPush fin fout) = gitPushHelper fin fout
 	go cr (Relay h) = forceConsole >>
-		updateFirst cr (Update (Just h)) (update (Just h))
+		updateFirst Nothing cr (Update (Just h)) (update (Just h))
 	go _ (Update Nothing) = forceConsole >>
 		fetchFirst (onlyprocess (update Nothing))
 	go _ (Update (Just h)) = update (Just h)
 	go _ Merge = mergeSpin
-	go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do
+	go cr cmdline@(Spin hs mrelay) = buildFirst Nothing cr cmdline $ do
 		unless (isJust mrelay) commitSpin
 		forM_ hs $ \hn -> withhost hn $ spin mrelay hn
 	go cr cmdline@(Run hn) = ifM ((==) 0 <$> getRealUserID)
-		( updateFirst cr cmdline $ runhost hn
+		( updateFirst (findHost hostlist hn) cr cmdline $ runhost hn
 		, fetchFirst $ go cr (Spin [hn] Nothing)
 		)
 	go cr cmdline@(SimpleRun hn) = forceConsole >>
-		fetchFirst (buildFirst cr cmdline (runhost hn))
+		fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn))
 	-- When continuing after a rebuild, don't want to rebuild again.
 	go _ (Continue cmdline) = go NoRebuild cmdline
 
@@ -149,17 +149,17 @@ unknownhost h hosts = errorMessage $ unlines
 -- Builds propellor (when allowed) and if it looks like a new binary,
 -- re-execs it to continue.
 -- Otherwise, runs the IO action to continue.
-buildFirst :: CanRebuild -> CmdLine -> IO () -> IO ()
-buildFirst CanRebuild cmdline next = do
+buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+buildFirst h CanRebuild cmdline next = do
 	oldtime <- getmtime
-	buildPropellor
+	buildPropellor h
 	newtime <- getmtime
 	if newtime == oldtime
 		then next
 		else continueAfterBuild cmdline
   where
 	getmtime = catchMaybeIO $ getModificationTime "propellor"
-buildFirst NoRebuild _ next = next
+buildFirst _ NoRebuild _ next = next
 
 continueAfterBuild :: CmdLine -> IO a
 continueAfterBuild cmdline = go =<< boolSystem "./propellor"
@@ -176,23 +176,23 @@ fetchFirst next = do
 		void fetchOrigin
 	next
 
-updateFirst :: CanRebuild -> CmdLine -> IO () -> IO ()
-updateFirst canrebuild cmdline next = ifM hasOrigin
-	( updateFirst' canrebuild cmdline next
+updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst h canrebuild cmdline next = ifM hasOrigin
+	( updateFirst' h canrebuild cmdline next
 	, next
 	)
 
 -- If changes can be fetched from origin,  Builds propellor (when allowed)
 -- and re-execs the updated propellor binary to continue.
 -- Otherwise, runs the IO action to continue.
-updateFirst' :: CanRebuild -> CmdLine -> IO () -> IO ()
-updateFirst' CanRebuild cmdline next = ifM fetchOrigin
+updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst' h CanRebuild cmdline next = ifM fetchOrigin
 	( do
-		buildPropellor
+		buildPropellor h
 		continueAfterBuild cmdline
 	, next
 	)
-updateFirst' NoRebuild _ next = next
+updateFirst' _ NoRebuild _ next = next
 
 -- Gets the fully qualified domain name, given a string that might be
 -- a short name to look up in the DNS.
diff --git a/src/wrapper.hs b/src/wrapper.hs
index a204b60c..289b12b5 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -99,7 +99,7 @@ wrapper args propellordir propellorbin = do
 					warnoutofdate propellordir True
 	buildruncfg = do
 		changeWorkingDirectory propellordir
-		buildPropellor
+		buildPropellor Nothing
 		putStrLn ""
 		putStrLn ""
 		chain
-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 76ea2388363e48a764184895d9a6cb659bb9a70c Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 15:38:05 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 8fd2bf18..d93a8e3a 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -149,6 +149,9 @@ unknownhost h hosts = errorMessage $ unlines
 -- Builds propellor (when allowed) and if it looks like a new binary,
 -- re-execs it to continue.
 -- Otherwise, runs the IO action to continue.
+--
+-- The Host should only be provided when dependencies should be installed
+-- as needed to build propellor.
 buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
 buildFirst h CanRebuild cmdline next = do
 	oldtime <- getmtime
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From b3b49ad53db956e5de43fd6b7ef785f026740f2e Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 15:40:57 -0400
Subject: apt install propellor dependencies more quietly

Avoids spam when most deps are installed
---
 src/Propellor/Bootstrap.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index b60dd8c4..969e1a42 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -71,7 +71,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "cabal install --only-dependencies"
 		]
 
-	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install " ++ p
+	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
 	pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
 
 	-- This is the same deps listed in debian/control.
@@ -128,7 +128,7 @@ installGitCommand msys = case msys of
 	use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
 	apt = 
 		[ "apt-get update"
-		, "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git"
+		, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
 		]
 
 buildPropellor :: Maybe Host -> IO ()
-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 4cf53da295be13e99d00f9c59f45454e42a87b1d Mon Sep 17 00:00:00 2001
From: Evan Cofsky
Date: Sat, 26 Mar 2016 12:21:12 -0500
Subject: Add simplistic support for apt-software-properties-common.

I know it's definitely a very Buntish thing, but for adding some larger
collections of software on a very Buntish box, it definitely comes in
handy.

I also think that it might be possible to support a lot of the features
using propellor properties directly as a fallback, and that might be
something I could look into as well.

Thanks!
---
 .../Property/AptSoftwarePropertiesCommon.hs        | 121 +++++++++++++++++++++
 1 file changed, 121 insertions(+)
 create mode 100644 src/Propellor/Property/AptSoftwarePropertiesCommon.hs

diff --git a/src/Propellor/Property/AptSoftwarePropertiesCommon.hs b/src/Propellor/Property/AptSoftwarePropertiesCommon.hs
new file mode 100644
index 00000000..484f7b08
--- /dev/null
+++ b/src/Propellor/Property/AptSoftwarePropertiesCommon.hs
@@ -0,0 +1,121 @@
+-- | This module provides properties for Buntish.
+module Propellor.Property.AptSoftwarePropertiesCommon where
+
+import Data.List
+import Control.Applicative
+import Prelude
+import Data.String.Utils
+import Data.String (IsString(..))
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+-- | Ensure it's installed in case it's not. It's part of Buntish's defaults so
+-- one might assume...
+installed :: Property NoInfo
+installed = Apt.installed ["software-properties-common"]
+
+-- | Personal Package Archives are people's individual package contributions to
+-- Ubuntu. There's a well-known format for adding them, and this type represents
+-- that. It's also an instance of 'Show' and 'IsString' so it can work with
+-- 'OverloadedStrings'. More on PPAs can be found at
+-- 
+data PPA = PPA {
+        -- | The Launchpad account hosting this archive.
+        ppaAccount :: String,
+        -- | The
+        ppaArchive :: String
+} deriving (Eq, Ord)
+
+instance Show PPA where
+        show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
+
+instance IsString PPA where
+        -- | Parse strings like "ppa:zfs-native/stable" into a PPA.
+        fromString s =
+                let
+                        [_, ppa] = split "ppa:" s
+                        [acct, arch] = split "/" ppa
+                in
+                        PPA acct arch
+
+-- | Adds a PPA to the local system repositories.
+addPpa :: PPA -> Property NoInfo
+addPpa p =
+        cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
+        `assume` MadeChange
+        `describe` ("Added PPA " ++ (show p))
+        `requires` installed
+
+-- | A repository key ID to be downloaded with apt-key.
+data AptKeyId = AptKeyId {
+        akiName :: String,
+        akiId :: String,
+        akiServer :: String
+        } deriving (Eq, Ord)
+
+instance Show AptKeyId where
+        show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
+
+-- | Adds an 'AptKeyId' from the specified GPG server.
+addKeyId :: AptKeyId -> Property NoInfo
+addKeyId keyId =
+        check keyTrusted akcmd
+        `describe` (unwords ["Add third-party Apt key", show keyId])
+  where
+        akcmd =
+                cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
+        keyTrusted =
+                let
+                        pks ls = concatMap (drop 1 . split "/")
+                                $ concatMap (take 1 . drop 1 . words)
+                                $ filter (\l -> "pub" `isPrefixOf` l)
+                                        $ lines ls
+                        nkid = take 8 (akiId keyId)
+                in
+                        (isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
+
+-- | An Apt source line that apt-add-repository will just add to
+-- sources.list. It's also an instance of both 'Show' and 'IsString' to make
+-- using 'OverloadedStrings' in the configuration file easier.
+--
+-- | FIXME there's apparently an optional "options" fragment that I've
+-- definitely not parsed here.
+data AptSource = AptSource {
+        -- | The URL hosting the repository
+        asURL :: Apt.Url,
+
+        -- | The operating system suite
+        asSuite :: String,
+
+        -- | The list of components to install from this repository.
+        asComponents :: [String]
+        } deriving (Eq, Ord)
+
+instance Show AptSource where
+        show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
+
+instance IsString AptSource where
+        fromString s =
+                let
+                        url:suite:comps = drop 1 . words $ s
+                in
+                        AptSource url suite comps
+
+-- | A repository for apt-add-source, either a PPA or a regular repository line.
+data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
+
+-- | Adds an 'AptRepository' using apt-add-source.
+addRepository :: AptRepository -> Property NoInfo
+addRepository (AptRepositoryPPA p) = addPpa p
+addRepository (AptRepositorySource src) =
+        check repoExists addSrc
+        `describe` unwords ["Adding APT repository", show src]
+        `requires` installed
+  where
+        allSourceLines =
+                readProcess "/bin/sh" ["-c", "cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
+        activeSources = map (\s -> fromString s :: AptSource )
+                . filter (not . isPrefixOf "#")
+                . filter (/= "") . lines <$> allSourceLines
+        repoExists = isInfixOf [src] <$> activeSources
+        addSrc = cmdProperty "apt-add-source" [show src]
-- 
cgit v1.2.3


From 49255357459cd2f5661e5f6832ac1f611bb37967 Mon Sep 17 00:00:00 2001
From: Evan Cofsky
Date: Tue, 29 Mar 2016 13:05:35 -0500
Subject: Adding support for software-properties-common to OS properties
 branch.

The config-simple file now shows:

1. Adding PPAs
2. Adding apt keys from a remote keyserver
3. Adding apt sources
4. Installing signed packages from a new repository.
---
 propellor.cabal                                    |   1 +
 src/Propellor/Property/Apt/PPA.hs                  | 121 +++++++++++++++++++++
 .../Property/AptSoftwarePropertiesCommon.hs        | 121 ---------------------
 3 files changed, 122 insertions(+), 121 deletions(-)
 create mode 100644 src/Propellor/Property/Apt/PPA.hs
 delete mode 100644 src/Propellor/Property/AptSoftwarePropertiesCommon.hs

diff --git a/propellor.cabal b/propellor.cabal
index 06142155..9f74d264 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -78,6 +78,7 @@ Library
     Propellor.Property.Aiccu
     Propellor.Property.Apache
     Propellor.Property.Apt
+    Propellor.Property.Apt.PPA
     Propellor.Property.Cmd
     Propellor.Property.Concurrent
     Propellor.Property.Conductor
diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs
new file mode 100644
index 00000000..9831ff30
--- /dev/null
+++ b/src/Propellor/Property/Apt/PPA.hs
@@ -0,0 +1,121 @@
+-- | This module provides properties software-properties-common.
+module Propellor.Property.Apt.PPA where
+
+import Data.List
+import Control.Applicative
+import Prelude
+import Data.String.Utils
+import Data.String (IsString(..))
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+-- | Ensure it's installed in case it's not. It's part of Buntish's defaults so
+-- one might assume...
+installed :: Property DebianLike
+installed = Apt.installed ["software-properties-common"]
+
+-- | Personal Package Archives are people's individual package contributions to
+-- Ubuntu. There's a well-known format for adding them, and this type represents
+-- that. It's also an instance of 'Show' and 'IsString' so it can work with
+-- 'OverloadedStrings'. More on PPAs can be found at
+-- 
+data PPA = PPA {
+        -- | The Launchpad account hosting this archive.
+        ppaAccount :: String,
+        -- | The
+        ppaArchive :: String
+} deriving (Eq, Ord)
+
+instance Show PPA where
+        show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
+
+instance IsString PPA where
+        -- | Parse strings like "ppa:zfs-native/stable" into a PPA.
+        fromString s =
+                let
+                        [_, ppa] = split "ppa:" s
+                        [acct, arch] = split "/" ppa
+                in
+                        PPA acct arch
+
+-- | Adds a PPA to the local system repositories.
+addPpa :: PPA -> Property DebianLike
+addPpa p =
+        cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
+        `assume` MadeChange
+        `describe` ("Added PPA " ++ (show p))
+        `requires` installed
+
+-- | A repository key ID to be downloaded with apt-key.
+data AptKeyId = AptKeyId {
+        akiName :: String,
+        akiId :: String,
+        akiServer :: String
+        } deriving (Eq, Ord)
+
+instance Show AptKeyId where
+        show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
+
+-- | Adds an 'AptKeyId' from the specified GPG server.
+addKeyId :: AptKeyId -> Property DebianLike
+addKeyId keyId =
+        check keyTrusted akcmd
+        `describe` (unwords ["Add third-party Apt key", show keyId])
+  where
+        akcmd =
+                tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
+        keyTrusted =
+                let
+                        pks ls = concatMap (drop 1 . split "/")
+                                $ concatMap (take 1 . drop 1 . words)
+                                $ filter (\l -> "pub" `isPrefixOf` l)
+                                        $ lines ls
+                        nkid = take 8 (akiId keyId)
+                in
+                        (isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
+
+-- | An Apt source line that apt-add-repository will just add to
+-- sources.list. It's also an instance of both 'Show' and 'IsString' to make
+-- using 'OverloadedStrings' in the configuration file easier.
+--
+-- | FIXME there's apparently an optional "options" fragment that I've
+-- definitely not parsed here.
+data AptSource = AptSource {
+        -- | The URL hosting the repository
+        asURL :: Apt.Url,
+
+        -- | The operating system suite
+        asSuite :: String,
+
+        -- | The list of components to install from this repository.
+        asComponents :: [String]
+        } deriving (Eq, Ord)
+
+instance Show AptSource where
+        show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
+
+instance IsString AptSource where
+        fromString s =
+                let
+                        url:suite:comps = drop 1 . words $ s
+                in
+                        AptSource url suite comps
+
+-- | A repository for apt-add-source, either a PPA or a regular repository line.
+data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
+
+-- | Adds an 'AptRepository' using apt-add-source.
+addRepository :: AptRepository -> Property DebianLike
+addRepository (AptRepositoryPPA p) = addPpa p
+addRepository (AptRepositorySource src) =
+        check repoExists addSrc
+        `describe` unwords ["Adding APT repository", show src]
+        `requires` installed
+  where
+        allSourceLines =
+                readProcess "/bin/sh" ["-c", "cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
+        activeSources = map (\s -> fromString s :: AptSource )
+                . filter (not . isPrefixOf "#")
+                . filter (/= "") . lines <$> allSourceLines
+        repoExists = isInfixOf [src] <$> activeSources
+        addSrc = cmdProperty "apt-add-source" [show src]
diff --git a/src/Propellor/Property/AptSoftwarePropertiesCommon.hs b/src/Propellor/Property/AptSoftwarePropertiesCommon.hs
deleted file mode 100644
index 484f7b08..00000000
--- a/src/Propellor/Property/AptSoftwarePropertiesCommon.hs
+++ /dev/null
@@ -1,121 +0,0 @@
--- | This module provides properties for Buntish.
-module Propellor.Property.AptSoftwarePropertiesCommon where
-
-import Data.List
-import Control.Applicative
-import Prelude
-import Data.String.Utils
-import Data.String (IsString(..))
-import Propellor.Base
-import qualified Propellor.Property.Apt as Apt
-
--- | Ensure it's installed in case it's not. It's part of Buntish's defaults so
--- one might assume...
-installed :: Property NoInfo
-installed = Apt.installed ["software-properties-common"]
-
--- | Personal Package Archives are people's individual package contributions to
--- Ubuntu. There's a well-known format for adding them, and this type represents
--- that. It's also an instance of 'Show' and 'IsString' so it can work with
--- 'OverloadedStrings'. More on PPAs can be found at
--- 
-data PPA = PPA {
-        -- | The Launchpad account hosting this archive.
-        ppaAccount :: String,
-        -- | The
-        ppaArchive :: String
-} deriving (Eq, Ord)
-
-instance Show PPA where
-        show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
-
-instance IsString PPA where
-        -- | Parse strings like "ppa:zfs-native/stable" into a PPA.
-        fromString s =
-                let
-                        [_, ppa] = split "ppa:" s
-                        [acct, arch] = split "/" ppa
-                in
-                        PPA acct arch
-
--- | Adds a PPA to the local system repositories.
-addPpa :: PPA -> Property NoInfo
-addPpa p =
-        cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
-        `assume` MadeChange
-        `describe` ("Added PPA " ++ (show p))
-        `requires` installed
-
--- | A repository key ID to be downloaded with apt-key.
-data AptKeyId = AptKeyId {
-        akiName :: String,
-        akiId :: String,
-        akiServer :: String
-        } deriving (Eq, Ord)
-
-instance Show AptKeyId where
-        show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
-
--- | Adds an 'AptKeyId' from the specified GPG server.
-addKeyId :: AptKeyId -> Property NoInfo
-addKeyId keyId =
-        check keyTrusted akcmd
-        `describe` (unwords ["Add third-party Apt key", show keyId])
-  where
-        akcmd =
-                cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
-        keyTrusted =
-                let
-                        pks ls = concatMap (drop 1 . split "/")
-                                $ concatMap (take 1 . drop 1 . words)
-                                $ filter (\l -> "pub" `isPrefixOf` l)
-                                        $ lines ls
-                        nkid = take 8 (akiId keyId)
-                in
-                        (isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
-
--- | An Apt source line that apt-add-repository will just add to
--- sources.list. It's also an instance of both 'Show' and 'IsString' to make
--- using 'OverloadedStrings' in the configuration file easier.
---
--- | FIXME there's apparently an optional "options" fragment that I've
--- definitely not parsed here.
-data AptSource = AptSource {
-        -- | The URL hosting the repository
-        asURL :: Apt.Url,
-
-        -- | The operating system suite
-        asSuite :: String,
-
-        -- | The list of components to install from this repository.
-        asComponents :: [String]
-        } deriving (Eq, Ord)
-
-instance Show AptSource where
-        show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
-
-instance IsString AptSource where
-        fromString s =
-                let
-                        url:suite:comps = drop 1 . words $ s
-                in
-                        AptSource url suite comps
-
--- | A repository for apt-add-source, either a PPA or a regular repository line.
-data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
-
--- | Adds an 'AptRepository' using apt-add-source.
-addRepository :: AptRepository -> Property NoInfo
-addRepository (AptRepositoryPPA p) = addPpa p
-addRepository (AptRepositorySource src) =
-        check repoExists addSrc
-        `describe` unwords ["Adding APT repository", show src]
-        `requires` installed
-  where
-        allSourceLines =
-                readProcess "/bin/sh" ["-c", "cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
-        activeSources = map (\s -> fromString s :: AptSource )
-                . filter (not . isPrefixOf "#")
-                . filter (/= "") . lines <$> allSourceLines
-        repoExists = isInfixOf [src] <$> activeSources
-        addSrc = cmdProperty "apt-add-source" [show src]
-- 
cgit v1.2.3


From 73e61cdfadb10dcdbc2a8117ef82c413a67aeef0 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 16:31:46 -0400
Subject: improve comments

---
 src/Propellor/Property/Apt/PPA.hs | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs
index 9831ff30..b708fae4 100644
--- a/src/Propellor/Property/Apt/PPA.hs
+++ b/src/Propellor/Property/Apt/PPA.hs
@@ -1,4 +1,6 @@
--- | This module provides properties software-properties-common.
+-- | Maintainer: 2016 Evan Cofsky 
+--
+-- Personal Package Archives
 module Propellor.Property.Apt.PPA where
 
 import Data.List
@@ -9,20 +11,19 @@ import Data.String (IsString(..))
 import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
 
--- | Ensure it's installed in case it's not. It's part of Buntish's defaults so
--- one might assume...
+-- | Ensure software-properties-common is installed.
 installed :: Property DebianLike
 installed = Apt.installed ["software-properties-common"]
 
--- | Personal Package Archives are people's individual package contributions to
--- Ubuntu. There's a well-known format for adding them, and this type represents
--- that. It's also an instance of 'Show' and 'IsString' so it can work with
--- 'OverloadedStrings'. More on PPAs can be found at
--- 
+-- | Personal Package Archives are people's individual package
+-- contributions to the Buntish distro. There's a well-known format for
+-- representing them, and this type represents that. It's also an instance
+-- of 'Show' and 'IsString' so it can work with 'OverloadedStrings'. 
+-- More on PPAs can be found at 
 data PPA = PPA {
         -- | The Launchpad account hosting this archive.
         ppaAccount :: String,
-        -- | The
+        -- | The name of the archive.
         ppaArchive :: String
 } deriving (Eq, Ord)
 
-- 
cgit v1.2.3


From af53c3443bec6a47b88933f388cca253a05ed432 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 16:33:54 -0400
Subject: layout and indents

---
 src/Propellor/Property/Apt/PPA.hs | 119 ++++++++++++++++++--------------------
 1 file changed, 56 insertions(+), 63 deletions(-)

diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs
index b708fae4..49fa9fa7 100644
--- a/src/Propellor/Property/Apt/PPA.hs
+++ b/src/Propellor/Property/Apt/PPA.hs
@@ -20,60 +20,58 @@ installed = Apt.installed ["software-properties-common"]
 -- representing them, and this type represents that. It's also an instance
 -- of 'Show' and 'IsString' so it can work with 'OverloadedStrings'. 
 -- More on PPAs can be found at 
-data PPA = PPA {
-        -- | The Launchpad account hosting this archive.
-        ppaAccount :: String,
-        -- | The name of the archive.
-        ppaArchive :: String
-} deriving (Eq, Ord)
+data PPA = PPA
+	{ ppaAccount :: String -- ^ The Launchpad account hosting this archive.
+	, ppaArchive :: String -- ^ The name of the archive.
+	} deriving (Eq, Ord)
 
 instance Show PPA where
-        show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
+	show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
 
 instance IsString PPA where
-        -- | Parse strings like "ppa:zfs-native/stable" into a PPA.
-        fromString s =
-                let
-                        [_, ppa] = split "ppa:" s
-                        [acct, arch] = split "/" ppa
-                in
-                        PPA acct arch
+	-- | Parse strings like "ppa:zfs-native/stable" into a PPA.
+	fromString s =
+		let
+			[_, ppa] = split "ppa:" s
+			[acct, arch] = split "/" ppa
+		in
+			PPA acct arch
 
 -- | Adds a PPA to the local system repositories.
 addPpa :: PPA -> Property DebianLike
 addPpa p =
-        cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
-        `assume` MadeChange
-        `describe` ("Added PPA " ++ (show p))
-        `requires` installed
+	cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
+	`assume` MadeChange
+	`describe` ("Added PPA " ++ (show p))
+	`requires` installed
 
 -- | A repository key ID to be downloaded with apt-key.
-data AptKeyId = AptKeyId {
-        akiName :: String,
-        akiId :: String,
-        akiServer :: String
-        } deriving (Eq, Ord)
+data AptKeyId = AptKeyId
+	{ akiName :: String
+	, akiId :: String
+	, akiServer :: String
+	} deriving (Eq, Ord)
 
 instance Show AptKeyId where
-        show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
+	show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
 
 -- | Adds an 'AptKeyId' from the specified GPG server.
 addKeyId :: AptKeyId -> Property DebianLike
 addKeyId keyId =
-        check keyTrusted akcmd
-        `describe` (unwords ["Add third-party Apt key", show keyId])
+	check keyTrusted akcmd
+	`describe` (unwords ["Add third-party Apt key", show keyId])
   where
-        akcmd =
-                tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
-        keyTrusted =
-                let
-                        pks ls = concatMap (drop 1 . split "/")
-                                $ concatMap (take 1 . drop 1 . words)
-                                $ filter (\l -> "pub" `isPrefixOf` l)
-                                        $ lines ls
-                        nkid = take 8 (akiId keyId)
-                in
-                        (isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
+	akcmd =
+		tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
+	keyTrusted =
+		let
+			pks ls = concatMap (drop 1 . split "/")
+				$ concatMap (take 1 . drop 1 . words)
+				$ filter (\l -> "pub" `isPrefixOf` l)
+					$ lines ls
+			nkid = take 8 (akiId keyId)
+		in
+			(isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
 
 -- | An Apt source line that apt-add-repository will just add to
 -- sources.list. It's also an instance of both 'Show' and 'IsString' to make
@@ -81,26 +79,21 @@ addKeyId keyId =
 --
 -- | FIXME there's apparently an optional "options" fragment that I've
 -- definitely not parsed here.
-data AptSource = AptSource {
-        -- | The URL hosting the repository
-        asURL :: Apt.Url,
-
-        -- | The operating system suite
-        asSuite :: String,
-
-        -- | The list of components to install from this repository.
-        asComponents :: [String]
-        } deriving (Eq, Ord)
+data AptSource = AptSource
+	{ asURL :: Apt.Url -- ^ The URL hosting the repository
+	, asSuite :: String  -- ^ The operating system suite
+	, asComponents :: [String] -- ^ The list of components to install from this repository.
+	} deriving (Eq, Ord)
 
 instance Show AptSource where
-        show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
+	show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
 
 instance IsString AptSource where
-        fromString s =
-                let
-                        url:suite:comps = drop 1 . words $ s
-                in
-                        AptSource url suite comps
+	fromString s =
+		let
+			url:suite:comps = drop 1 . words $ s
+		in
+			AptSource url suite comps
 
 -- | A repository for apt-add-source, either a PPA or a regular repository line.
 data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
@@ -109,14 +102,14 @@ data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
 addRepository :: AptRepository -> Property DebianLike
 addRepository (AptRepositoryPPA p) = addPpa p
 addRepository (AptRepositorySource src) =
-        check repoExists addSrc
-        `describe` unwords ["Adding APT repository", show src]
-        `requires` installed
+	check repoExists addSrc
+	`describe` unwords ["Adding APT repository", show src]
+	`requires` installed
   where
-        allSourceLines =
-                readProcess "/bin/sh" ["-c", "cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
-        activeSources = map (\s -> fromString s :: AptSource )
-                . filter (not . isPrefixOf "#")
-                . filter (/= "") . lines <$> allSourceLines
-        repoExists = isInfixOf [src] <$> activeSources
-        addSrc = cmdProperty "apt-add-source" [show src]
+	allSourceLines =
+		readProcess "/bin/sh" ["-c", "cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
+	activeSources = map (\s -> fromString s :: AptSource )
+		. filter (not . isPrefixOf "#")
+		. filter (/= "") . lines <$> allSourceLines
+	repoExists = isInfixOf [src] <$> activeSources
+	addSrc = cmdProperty "apt-add-source" [show src]
-- 
cgit v1.2.3


From 1755835c5cae7e0771512b137dd06fb29a8b940b Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 16:35:45 -0400
Subject: Apt.PPA: New module, contributed by Evan Cofsky.

Merged https://github.com/joeyh/propellor/pull/15
---
 debian/changelog | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/debian/changelog b/debian/changelog
index e31c8d51..ee3311e4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -63,6 +63,9 @@ propellor (3.0.0) UNRELEASED; urgency=medium
   * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
     these complex new types.
   * Added dependency on concurrent-output; removed embedded copy.
+  * Apt.PPA: New module, contributed by Evan Cofsky.
+
+ -- Joey Hess   Wed, 30 Mar 2016 15:45:08 -0400
 
 propellor (2.17.2) unstable; urgency=medium
 
-- 
cgit v1.2.3


From 170a4ad8f4341757e2cc3d64cf2bd18d849ab178 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 20:48:30 -0400
Subject: propellor spin

---
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 227f0131..74413a3f 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -253,14 +253,14 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props
 	& Apache.modEnabled "cgi"
   where
 	sshkey = "/root/.ssh/git.kitenet.net.key"
-	website hn = apacheSite hn True
-		[ "  DocumentRoot /srv/web/git.kitenet.net/"
+	website hn = Apache.httpsVirtualHost' hn "/srv/web/git.kitenet.net/" letos
+		[ Apache.iconDir
 		, "  "
 		, "    Options Indexes ExecCGI FollowSymlinks"
 		, "    AllowOverride None"
 		, "    AddHandler cgi-script .cgi"
 		, "    DirectoryIndex index.cgi"
-		, Apache.allowAll
+		,      Apache.allowAll
 		, "  "
 		, ""
 		, "  ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/"
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From babeda7843f4b52889fd717781903661c7270924 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 21:04:06 -0400
Subject: propellor spin

---
 joeyconfig.hs                                    |  1 -
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 76 ++++++++----------------
 2 files changed, 26 insertions(+), 51 deletions(-)

diff --git a/joeyconfig.hs b/joeyconfig.hs
index 3852f14b..489a0f58 100644
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -297,7 +297,6 @@ kite = host "kite.kitenet.net" $ props
 	& alias "mail.kitenet.net"
 	& JoeySites.kiteMailServer
 
-	& JoeySites.kitenetHttps
 	& JoeySites.legacyWebSites
 	& File.ownerGroup "/srv/web" (User "joey") (Group "joey")
 	& Apt.installed ["analog"]
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 74413a3f..a6cb3794 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -126,7 +126,7 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
 		, "find -type d -empty | xargs --no-run-if-empty rmdir"
 		]
 	uucpcommand = "/usr/bin/uucp " ++ datadir
-	nntpcfg = apachecfg "nntp.olduse.net" False
+	nntpcfg = apachecfg "nntp.olduse.net"
 		[ "  DocumentRoot " ++ datadir ++ "/"
 		, "  "
 		, "    Options Indexes FollowSymlinks"
@@ -312,41 +312,27 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
 letos :: LetsEncrypt.AgreeTOS
 letos = LetsEncrypt.AgreeTOS (Just "id@joeyh.name")
 
-apacheSite :: HostName -> Bool -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
-apacheSite hn withssl middle = Apache.siteEnabled hn $ apachecfg hn withssl middle
+apacheSite :: HostName -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
+apacheSite hn middle = Apache.siteEnabled hn $ apachecfg hn middle
 
-apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
-apachecfg hn withssl middle
-	| withssl = vhost False ++ vhost True
-	| otherwise = vhost False
-  where
-	vhost ssl = 
-		[ ""
-		, "  ServerAdmin grue@joeyh.name"
-		, "  ServerName "++hn++":"++show port
-		]
-		++ mainhttpscert ssl
-		++ middle ++
-		[ ""
-		, "  ErrorLog /var/log/apache2/error.log"
-		, "  LogLevel warn"
-		, "  CustomLog /var/log/apache2/access.log combined"
-		, "  ServerSignature On"
-		, "  "
-		, Apache.iconDir
-		, ""
-		]
-	  where
-		port = if ssl then 443 else 80 :: Int
-
-mainhttpscert :: Bool -> Apache.ConfigFile
-mainhttpscert False = []
-mainhttpscert True = 
-	[ "  SSLEngine on"
-	, "  SSLCertificateFile /etc/ssl/certs/web.pem"
-	, "  SSLCertificateKeyFile /etc/ssl/private/web.pem"
-	, "  SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
+apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile
+apachecfg hn middle = 
+	[ ""
+	, "  ServerAdmin grue@joeyh.name"
+	, "  ServerName "++hn++":"++show port
+	]
+	++ middle ++
+	[ ""
+	, "  ErrorLog /var/log/apache2/error.log"
+	, "  LogLevel warn"
+	, "  CustomLog /var/log/apache2/access.log combined"
+	, "  ServerSignature On"
+	, "  "
+	, Apache.iconDir
+	, ""
 	]
+	  where
+		port = 80 :: Int
 		
 gitAnnexDistributor :: Property (HasInfo + DebianLike)
 gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props
@@ -770,15 +756,6 @@ hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props
 	& "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
 	& "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
 
-kitenetHttps :: Property (HasInfo + DebianLike)
-kitenetHttps = propertyList "kitenet.net https certs" $ props
-	& File.hasPrivContent "/etc/ssl/certs/web.pem" ctx
-	& File.hasPrivContent "/etc/ssl/private/web.pem" ctx
-	& File.hasPrivContent "/etc/ssl/certs/startssl.pem" ctx
-	& Apache.modEnabled "ssl"
-  where
-	ctx = Context "kitenet.net"
-
 -- Legacy static web sites and redirections from kitenet.net to newer
 -- sites.
 legacyWebSites :: Property (HasInfo + DebianLike)
@@ -788,8 +765,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 	& Apache.modEnabled "cgi"
 	& Apache.modEnabled "speling"
 	& userDirHtml
-	& kitenetHttps
-	& apacheSite "kitenet.net" True
+	& Apache.httpsVirtualHost' "kitenet.net" "/var/www" letos
 		-- /var/www is empty
 		[ "DocumentRoot /var/www"
 		, ""
@@ -877,7 +853,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		, "rewriterule /~kyle/family/wiki(.*) http://macleawiki.branchable.com$1 [L]"
 		]
 	& alias "anna.kitenet.net"
-	& apacheSite "anna.kitenet.net" False
+	& apacheSite "anna.kitenet.net"
 		[ "DocumentRoot /home/anna/html"
 		, ""
 		, "  Options Indexes ExecCGI"
@@ -887,7 +863,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		]
 	& alias "sows-ear.kitenet.net"
 	& alias "www.sows-ear.kitenet.net"
-	& apacheSite "sows-ear.kitenet.net" False
+	& apacheSite "sows-ear.kitenet.net"
 		[ "ServerAlias www.sows-ear.kitenet.net"
 		, "DocumentRoot /srv/web/sows-ear.kitenet.net"
 		, ""
@@ -900,7 +876,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		]
 	& alias "wortroot.kitenet.net"
 	& alias "www.wortroot.kitenet.net"
-	& apacheSite "wortroot.kitenet.net" False
+	& apacheSite "wortroot.kitenet.net"
 		[ "ServerAlias www.wortroot.kitenet.net"
 		, "DocumentRoot /srv/web/wortroot.kitenet.net"
 		, ""
@@ -910,7 +886,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		, ""
 		]
 	& alias "creeksidepress.com"
-	& apacheSite "creeksidepress.com" False
+	& apacheSite "creeksidepress.com"
 		[ "ServerAlias www.creeksidepress.com"
 		, "DocumentRoot /srv/web/www.creeksidepress.com"
 		, ""
@@ -920,7 +896,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
 		, ""
 		]
 	& alias "joey.kitenet.net"
-	& apacheSite "joey.kitenet.net" False
+	& apacheSite "joey.kitenet.net"
 		[ "DocumentRoot /var/www"
 		, ""
 		, "  Options Indexes ExecCGI"
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 947e73a2021fcad36a806a224f171e0dba9ee7da Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 21:58:56 -0400
Subject: propellor spin

---
 privdata/.joeyconfig/privdata.gpg                | 2721 +++++++++++-----------
 src/Propellor/Property/SiteSpecific/JoeySites.hs |   10 +-
 2 files changed, 1389 insertions(+), 1342 deletions(-)

diff --git a/privdata/.joeyconfig/privdata.gpg b/privdata/.joeyconfig/privdata.gpg
index 027c5972..458f1d93 100644
--- a/privdata/.joeyconfig/privdata.gpg
+++ b/privdata/.joeyconfig/privdata.gpg
@@ -1,1343 +1,1386 @@
 -----BEGIN PGP MESSAGE-----
 Version: GnuPG v1
 
-hQIMA7ODiaEXBlRZARAAibMc8dMCIWOIKLWMsEoBrDvoc7JNr+nEMwwkZ38jtLmX
-nGmZIvsGSyoRySdf58vtGptFMCesI9mLWMduYdcG3xl/J37QchHsY6RqP+ENIlHs
-AbuBoAKknVbTOmirPJ0TDz770OJ146a8OwmCkhDfw33Yp82I4G9qD0cyDGpRamiO
-pm2e7yu+oib+hWaRhALKjaj1+JK04nQyLlQ1aYCpqLuavCsVdfUR6ZmA4UFmzEx+
-MUYB9V0cpJM/beaBIJ8T+70m576NiisTKJ1XKAbUx3QHPFkNCVBa+ks1Vz6QcW29
-tk014xdecKTkm7ACNZkRmBPOhg5dYXv0mEWwCaI3Hib8qLfzF4E3x5O8sX9SP+Da
-90Lngi+q3r7KaQx8HJx7sVkZe+Lnqs/VqekK2Q/PZZOadu9fwuz4p06n5ym9V5Qu
-JnIzXATRrUOS90rEKjOvvtAI454q7oihQhBpEQxH7Hq0D+kxKr+FKAz7yrct+XFg
-rMLkiz6rzDfe6Zwb7kQ2bD6TraYS6t5Y2K49QByw0IqOjaYWun3YdQlUNvHVErqW
-UICAT8fhOSj4FRvXPy6bt3JulPZRshcu0PGGpcidQ0gWGnrtomyOFyOg4MA1dTMZ
-14FG9vMIHA66vc6+9U5nnJdWFTid4Wi1Vu0pHbXH/6m9z30NxU1oIAROE0wD8OTS
-7QHBgxzmHKYRmZj4yMlEXNdGaZb5i++oVQCdBfHaAmZA6BhhqjL9TCast3LZNAfV
-nujlcF/6Uld1fI0dlqTyZ4uMmfCiV6kmsyq8h5/NI33AffOkN4MMUSLnsS6nTJhG
-3d0QJLgYm5MBvzpvHYmry+ji4g1WpxasboiGNqoTgKbEpuZdHEDWeUXh/3ZVQ90R
-a1+FKA+RM4x5koN4uvonzn5LR8QZEDAMP22ZluQY8/L9uy+TtQ7QcRagMl+2myNS
-zNL7xsW38z6A2KjavDYh6G1EYsujqFqDsRVUjjL38sYo+l3MpconFJ6SXxtRBQcd
-nM3X3w9xPiVIGbp1YvffMtwmpEUdpdos3OTon4MjXY2+7HfM4atU7my+qOwv8nSy
-GXCbwYby8qAEhZJQyE/lnfwdBicYD3wRYZ0s3syx4f0Nu9KKP/AoI6crZM1nNX9/
-UNwZYL0S53RE96wvSqPNnxwTPITNAxzPSyd+apbKpC/oirP9iA7xDwA1sQIjPHb6
-ALja6xnVFZAbpO0nd+BZTG8ik6b1BN7Qd+e4AePrfuX55fKOTtcmNKKAZyPTcYJe
-1bwC/IKLMSXo7jJHaqmwX4WjZabKx+s7Xkl+D8sW/H+CRfKhNV93KLCHrILxFQgV
-ozmLD/rH2CMy8iB/95n3u7Gp+lQJXCUDtzizpQxJ1YPkqrzYPbMz8i3OVq4/1Ggl
-2+M7upWgjWh0kZBQFWTtb1SwlX4p1LZfvaNRaRFO5sBJFklJuqfsAhU+lKtvdo0A
-carjRofbDLlEptFtH7XhFqAZPeCwnZGLjqG1kVreCYsp1d0XC4yBkXoAu2XQiGh/
-Eql2DlOIM35a6TotKyve4gWRAEIbn8yeP932vwqNLzhuQVU1/mpobAWUcKptiIuQ
-DDKwdZ8vaDtKOLPxoXqO6ST2VmM/DhVSWkk1HkKTInY5XfVCXKY8XEhFbNGPNXyq
-MJRRI4uARGPKBboMW2tFHDlVPCeNsFah3A+8F2RTwaz4nfLKpBHZqUiNDVVmYEYz
-ayHMqcZEcGwY5KxKw4lmx0trnE1vXlJPujhRrzOjzuVxYu0OGq+W6qmVRx9h/USi
-kPXlib/DYqWz4gm1rRCX70Qb4tbILuJmZAFXNo7kYJrb8+4VKhHH49r35rF9DAt6
-HzNa990g7/noZ760PDRFaf6OQh6HhW4dCRIMevmvNqLpgKi4f82NWgXfUel4jdea
-+eHpOmg7g0xefQ2ff8T+6OoaEbFXmm1ODI7YMfWnbR9o4SM+SimA23MyCh3iACUV
-mh8g5udw2/VsqF2I6tA02UYAI+nfa7D8mskTvYUhISEcZ8hFhu/7JwNljUFwilN7
-1m72K7SBnpA8fbUkwoOhWgSymsmy4gILT1zeyMAPwmi9T1REesVip6peN6v3uf2L
-Ejx3ymdADY6kZFrQ2QWwxbXhjFz67DK8iA0LVvHjBa+PmDunFwiO+etBfhqkPMOx
-2bmGLV7XkZ2dPeEVKn8MGUcjuiYNfh4oo/eGyqx5KD5pG8EC+ZcP1+CSqrEzIdiE
-Dp9O0HzXPNQV4tUd2WhaSt4mbU8bW/v4wdpNxi+VtMURx7tneN94dRnvwuvsmLFG
-I07kvnTRI9MCa2OpJSqodAvQuLjRZq0eD7RMmWRNyZ7OhaI47tSJ0rv5D74SZo5e
-KQ+iqgGZfD25iHqgWQgf3rqxllCYp1T9lKwybfYgc4YGNGLbL48B0ddrVP3tEiwy
-h3vOzhzRwWLhqXUl4QivVcL4HdsGbMBQjJg+9HDlJ/8RzXAnR9fInj/gcaq1jykc
-QlusAgm1+nhHf/iq46u56yq7ndIo52Sj5AgDizOZ6AAlPJKY6DxbxIa7gt7leP05
-eY1KW/U8eVK5RPUIvVmwirILPCbj+ophM+AkzwS3ESWMxrBxQV0JN0ZBn1qKFWFZ
-XrFI9KZ1rzq/C2mU8yByMYXllzipnuCTjMXfa0J+UP5qIYXjkWI14KBoEt773vVS
-Ie5ObFOCNacd63n8mysStM34kIBEIZwpzWNe1uhyJ+gSLMVVQ0GQsjCn5wfMotaR
-bE10FATXyt3HBO2TKV7QCfFwtBGa35lxaX3OEns9Yjb2R71BfqIiX2otLW0qFMt6
-uQyTqslKV2Q/OPuit/eUOYbcWEeSVAx0SgHBxro9lWAsjFXy/jxn72ZDYzbd5Y+X
-8zCZ7opvkQYt5YynTtP5bOsp2wvqXUEcv3M6bK9SoC9kgHXljuSk/t2kIX4hdCIA
-wedCxmDlVmAgq/Q1pbGkmGefd7Cj2G4I7nGpx71tSIKxgTfNsBS1yQ5aABJ7WdX2
-BBsDPv5A488b4V/x2gU6WS1MNGg/GUcRt01HDd+UYRg8BMi1fC0sYn0fZbzu9nz4
-MYJ28G6gvvuEPGlv3I0yKhSJRlzM3Q3Cen9n6eduHjQkb/czDq6V3wU+7x/M8sHg
-iP5faqNoxBYqLxz4jdUzdn1w/1thVbchlYkt4djf+VpNWnWWQuUJUwykM44LnjPl
-rewc1qBIt0SmbM8GUYfE8JFYoegi/DxA5lOnzaUcPD38C8w6epkODYNjPdTDJSv5
-Tuq74kvXuYKst1Hmcejvs40hmX9dRiMG2ppdB7MNKomrP5wb5lRy+TTVLYQQcW2n
-YpeZqzSRD2/RBSDt1faeBQqocOZAWJVxVZTYGHbUqZs9cVGd8Be+hIatBFDDiheb
-qzoXEadmqKJILWZ8b5UFape0Utkax57YPP5J/ydTnhG/2xDDHJSmLzte+hfCblJE
-q4YCCITlYTZP14gWwUHpnUb4nX+Q5vYEqoDcpS85LP2sFCunYrEWSksLE+j2RfR2
-K96smkwsleNdcYVvEinZRgy3N/psePUGzMHQopJOkDWiJeNsbeOI2jvBDDgAfHNZ
-ycbdz3NKa0tGqqHI6U1VATkjaw/l0voFdgRiOYd5b3AMn+HY9skXBuS0XMlsUtYz
-4/pGGtFq74CF9ACtFO0dWNrVuVJHjZeKxpBQkyNTiHl2ZfphgvNZbCgUenQ0WlT0
-4awmC4ysNtpF51rMtooi1nIylarlgxvoVzCnSd4vnkiXPBgHMykUW+yVgt31KyrK
-/T6aFEuTqH/KlvnacwnjVVLe4xbHOJLa6BRycXvQuD9FW+BGIAmqNgliCEVl3wy1
-/R4PDgxz471+Gz478n/hZdM6uONVxCuzAWPVpwqlyJExrKkRf75tGy7FFYfujC3C
-NCNKBQaHDImQpjIvwOY2WhPmObT4Kzwn0AdWaBtPgMD0ijv+ux3umacJWev3aImN
-5Lt1k9xTN2alPtSwBPw9CHoxV6MKuVTxPfAo1dmCFUn1ZU2Xoyx0lNqBVsgzzOZt
-ounszDfVwIXL0cQbEhj8H9wzTOvfYFWdIYXH2IERfCU37GSpMDfBGy/7dqDUrJJh
-Jho9R2oORSxHbUEt0uGjhlLBjykzQIV0qVcTZEbqVJtJUcrchTT7N//zs9KMjVIn
-NMo3lWv2dn07w8/T9MDy+e9rFMfo5ehq+sTDWmlnEVpVuFuaOQvLr8rvghHuTDex
-YxNZAFQUzYXWJ7Uxa0JRJULO9IQzi0sUvMBymFSVwso4W/T7xKiQ+tQepDeb40hW
-ZQyHl+EeaUMsbj0YU4lEgHiehRMUjQ5es8teIufJ1EWeSDdrx8LOI8Cjh5PZoLX8
-Wv/5ExI0ii1sYn2OnPgd/DnnvJ9cDMNIkxrQXHgnZECGYaaMZgAXT9rvF/iONU4F
-eGvqBwe9nLEDxe1DaRX+KRHMqV8qCQiwVu7vmehe/4E4z8rrbsDEZz9bW9lfw7H7
-FJMT6NH9TTyOWybOUYfNjcyztguZN0VXeL5UsGizzRt0OAfu//sFCD14HHu9qd9G
-Y6Nzs8U+NYk+s9FMzqGur7usBDvQdjgJSVUrSz5ZZ5HQrc3jHHHWfVLnEOrhF2ZT
-1fP+fM/hxCaMAGkgJkdnGGhXsHmXdFuoWRRMrfz5Ta4NWeuZjg3PgsCzctg+1vrA
-Dl88WA6hE7x0zkcrQdJ4l4riYrCBdsh3HD+Cn6rXtXtJfyGSRDfhWVWZSwZhyK+1
-uRWtGvB0s0uGupJdbIuO7FwsdsdPPzwoaynsDWS+2ZeE6cVoHk30W2QJMj9ck0ir
-i9mKbwDLoUWodX6hqgDO4kEPRLv5mEOEbLDFH4Reaqokd8jLxGVftPpb/nTZzgMT
-hvhb5fqohTDhj9SHfBN6u0TcNDhXQolnLESsUZF2ux6QOf34ttuzOomjnZC7R17k
-cxzcR5Yy8I2D/UrTRKiHKMtu7QWpQ/lkYpNuQ31p3+tRMRWsfYdObngK8SqcT8pH
-rVencegbi/DxRe7ifpo4mDJ/9x3sRCk5CPY1Oy20LEK7yqtxu/ElTT+xsRIj9Alj
-JxgjhY1ECQcg5GNVqTsj3VmjjtSO7O2sO0TAorfaVqrLfmwnRqrY0aQQ6G6gF8zg
-Olzv3qudNatm2Co5ucIZbuo3/XppdrgoFMMLc3ym6t4cXKmB0GLM8Le+QulH2PJV
-imBYK0LBr1eaZrJ5XPyoUm60QD9jqDjAkTj5WWDvlXwv43tN+noO8Y7EN0wEE5yJ
-QHEvyxvmVMWfXqzv+MGA4lfMfqxNsBjM/KwU5/IlfrwxeFRu+wjdoj7RHLRPnE7E
-Cktg0wJ+lgPdsAgSPQITDsk1ebGsovaX1Xwn9f3ke/8aFB9evUtA+VD9i/c2PFlf
-AJ7UoXSBRPRlL0imAViK8Xz+S8rr+OO3kH4LFerC54EN5ylhOBIt9qnr7dtVk/0B
-nHpndh/PNOJeH2XTMc0LgApeWMcFzHVQo9OAFE6L/wKqjceSdXB5p//REabtNsW6
-8xUE0bY3h7nC6opMNB+mDweoO8ahXRn0Pm7K4LDNpH7tmX9OtPHynbD4Bj4kkOjM
-bri46nTaVU41+aJcKjCqUZYMeSmdlU6+H3pUyy4cI9vB/D+n2n8yBItfXiKHJMzq
-jL6NcD+asuyv61g+i4jU7OQa8Jh9rqwjOthA+3NBfLNSEPvCFIt1gYtPOpaqqeWh
-Y7NooHDPPFJ1xf9vb82v7p8vavUXa85+vng1uW83gA3L5iHpEqNm2lQRoHlGrRjU
-WdT93MNDjaHh+9xpgi+bPp1d/xEfOC7UlXXzRGLKnvS5ARjjyLDuUto18cVKEDCj
-MEtaV0mTW52+/DgDyXc8krRZtDj8uCBXdqrS41O5RyN2wnQc9LiULsk4wx3X+7Eu
-S1xNDMPIxBqZiE50qBB2dAswg57DJKYSY0F4s+842PGWMpd/cZv795A7rQIdT5bk
-Pcm3II4OtGxKX50TY//b7a2jCH3tyCxIen3dj2zFo3IWSIz/kGTUBKqVQcqHvou3
-UmBYdg5soItc0lb3dhOW/EFLoTyZWTlpt+f7NFIE2hAMjE+cnZlE54ET7VXZJM86
-KkNyBZEaZJWwPdYIfSVBusVB77vhthTz8hiiE/6SjqtSjvsHm/wBWBg4rX6m7hR6
-TDTBFvqVLxwYlbSU/KDFesMf+AoBrk9YJIGZvlt2EGpQflar26fhSisoxwG41vdo
-hkHbfCpdRyaXayJ+MCy9brAX+tHzStEoKoIrtqMe/bna12sL2ZBIzWhTNk68ylu5
-/iND7RNY5hk5WnfnYWPP0uG5L4EZzIKoxWEpRKfnTRAUed81QuXDqiCBg48gNZx9
-0O1k4LMKlp/RrbubK+ImIAijfvOGS+oqLTNWbuUBNOyNeMrnUATQEOZ8aXuaS2Cv
-b2isxXBeg08HPdAV4WHTSdt7K/FrVSw+bJDXfp191iiWH/ZPJU64ngTGKskH5CE3
-VUGhcOlDeHg2koDejJ5zgjsD0fvozGMhuRpZEH/WJnF4ZRh4wbWIedEU2abglg2o
-8uHvTAgooKJNbThL7HuCDO9QAlZ0lkIEUAH/kwCwRYvCInSGi7ClJpDig9o13hzZ
-W1CqGByKKreQ0YAEdMujzKESzjTO/hpxCrgCk9BF6Y8EMRnItDM8Kn5o7Hmqu5v8
-uMPOwFUW9gglR1qel1GGC7R06l+uISXpFE7mlPWjQqJCyA46TOeXUn2trWSFJHij
-9Nl7nUtDp3+hWGgFkLVUYWZD7S3jQPA2KwYSOLaf3X+Xe5XyGhvZPTgKneyoch6d
-qzS5B++yti/mZy5X4Swfct/6W5Xsrr7z0HKnuKkeq7Msb78l/gn+MvJX2M+JTTrC
-ehIyjyVEB143AzRhxIVHq48d6h9BIsKi0isUOP3ZP35lZy40O9KdgIkmrHLmw6MV
-iqwMSG1Di/4fSxnTV6ooMN5dP0Yxy59xcC23OaIE6oDyTi+zziFOZ47MJxP8YgPf
-i5yrG+qTW/T6KWzIXFqcuiMAwmUSNCJgpRD387KUYLu9y+Huh7JhJFARxiv8hM5o
-O+zQIJ7squ4P1lOcId1rue1loxfHhNGcKQ1kFKfer440Q0U6a0LQSQwxvCxJb2G+
-92PZsz8jkKdaisNVhKcI/NM2KCcmqvjg1bEFZD69Vt1mQmZx9YQvSC0mzWXnBEGw
-Sff9eocERRqH0o5LIILpTQjFDbZSR7oGDPmj2V3cfF2yMDGvjEQKIZ9VPQLeW8FL
-9jrSugzxmQzidZVk7fd7e6ZemQuRr2aMT5ZQBFSe0UEaY8onBJYXNRGep1E5mHqM
-ORZeguMW+UacpPF6l5ComwlujbjXFS8td7djavWcrncNumXwbavLYoJucKXUQvFa
-w/rWtBlOPbrv1j150RH38koqPjYKlhlFiIvX8PtBRjDD+pw7/8mA+Jl2IAwoYGXz
-M2WGGp/eOtMgrCuq+IMllNCaGmr63xttXe1nvWLabgUtN5OObNiJzM4tpLaZzXuK
-T98KflcwbUDo4jXNaa3Gav85aZpeRgn8o4UWsOXjIocxt8yqXdScXHXbkV2IKw2+
-TDTfHZYws7HvbBoNAaDXYlKX1bjHesZVEJOJv+UNKWItgv63x+nhUVj1OODImsKE
-mx1/JNpxTblKBxZTCcid3IQhywo7B7RSx6PXeyvQ+V4kSOUAHbvtI2gcHODLRJUR
-wHR/5t1YZFKDuNUwXxVFUeSy5BoGDlIFKBieTydfDV5OFXg3onqEbbKDWAwAjHok
-OF5g2h3K3Nfi2kr6ApyH0w3iAbhIpnyX7LjNwuwZ9w60i4oHeLKzzDb/cZI59ekK
-X9GI6ZzelJ3JH4MLQIqdmWLMGuMtiqnfCmuvrZcubEZWKXKBOIELzrhX1u55DIE1
-4wmhza4wI+7TjvvmsEj24XGfYmtucuI0+np3o5g8me+Qcc6yk+u0r0HBw8jQXrIJ
-FLNpu+iRfsBGZkVvpEeM6s6EQMm6ydGees3VA1Raf9hZAE9ZMF7zZYVRQp+VOOGF
-3V2xfPL+0exOIeZUFZ2i73gsNKDuz1zhW1Z9/Sl43jwzBRAx9tB2cK+Y3om8SUty
-Ta7HADf/Swr/gxUO7XjOe5nZglW6HfxhpILZj8s1RVEvcXQ3lEqXOOIkpcdGRmmu
-AdtiEPUiAgWgHIQOXfRCD+Lqn1a7VOiA5vCUdh/cJ/9ABzRnmem0r2QAWc6w0OD3
-8gCjOMeTgUnSiUMjOdZXw4WAyLGU6e41P719tXZLn8nk5q3VkwK1dOu7o9rbQ312
-HVM81d0ai8JF23+5v+crs5PVM9azHOEsuUm5VlPlqtAWXR9fUGipXDxVA8GbJUUm
-o09BZMTAg/d//jO+Sflq7eVWdjdVbagdVHqxvsIdQ/naMBCMNHySnFrpWzl41HqI
-gDrB86F3ZZV4Bps+zG1UkZgNagXgeNBt/hMw1jg1MoT0QahQ6m2nsp+h2manO+Td
-HsYLPveP70n+HODi0tp9FDbpUJw8DlMXfaxKAZjAfX2OfkVbwG64Q5mJR9ztEEQV
-zZs2+XUA3+IgoCOW5UYv+YskBPbXapKvYH+Jcvzi1M2QkYBHZOetLbJ/UArwpwVs
-N+Odua8r7E8Rmhuq3Zc0aolWR5Q91Vt898dT3+ZENFTNa10oqy1esi9EulwNIUig
-fRUvtFUWmxJww6eT5n8Gm/kgZKI7GNIZ73ZMFT37tdhFkQqcPHQmEWkJ7o0CrCJW
-jaizd8T08bXQZPM9LSjL+8y841CXAl1LTQneXylHWEnQkRuEVW8E1Jj6yGFCGcwc
-mzo2KXnSqZBJ1ZSJrFTx8EyETxtdL4z4KiNZbNmLgXHLZhK+HMS4O/yVPDTe0Aa+
-BnQcEgFN/FEWusetRG9zbwQG3MEnlThas3vIeDKBLrwCjmzNncUPYfbhbZvq/i93
-tCCUgzwUbQ9p9cZdH/SHJVJDMz9jQPNXOlzbOW+9frfKoVTStcv0ADXv1iqdn232
-Xx7APEIK6sJIDWm7AwO0IJ8mK1T2mXmGfG4pK8zfxoPUwvfSaIPY9MiEqO5nUR52
-79qcEFUHb8x+hXbmxxY79tLqFrXFuQJ81ar2NIqy2I1IJgwAwuVSx70CtATrSPkI
-VJh+f9ktFuUUnzJQ3Z7/0P24rFWnt18BKv0Ajm1kpsLieCGUsadNMjwzfLzmt0ro
-MNEmSJPCDtRwgqItw53d1yAln9TR5R4zopBaBLW/AX/nh40u7tKdUu5Jc4W3FA6A
-t4gVvdOOqHw6YPEPhGRN0LgBFhHN0vNJ0RHQYL7Y8pXP3Kz++Aq3JdeiTkqX9JH+
-T1NcH4spbjQdQhFREfQj740IvMv3EIctvTgrzW6v1sn7YkSGJnbbi2HcBXptdx+h
-Z4wCuUJg+FH60Hk8TitqMUarLghOhXCYAPb0DtsOK7715pJzeTDIgNkcoz+eidhF
-UKn6XX9G1mhPOvxGDiED7CYUogLyMrzxQfyi2taxoUEbjs6TNux87TDdo1wwumXI
-cxG15m4UGLCYf115eH4lQG/oC7zFplvVCVsO2llZeYKJVl6B96sFCp8lY7PGQHqc
-ZJnGRkel5No9jL+fldmK9d9NcPJMVzvooBLwsAl+H/tfe+TM6q4+1qfANAEhPnId
-qQexGWjJo+XIT7vHees1uSAxb9Hyw7FpcgdQHBmHX/Cjd4DmnvWo0/d1pZhJAInW
-tuHcHpUvALKvRLQN6ZMHxlcorucrWmi4MJMp3fxO7c3omjnyKqn3pdGnIxjgdVwI
-Y4ut0YlmvOKX/64c5vxaK8ODUmUfY6bk1nMJ2flfghMMgDYIvnljAvyUAivh0jvl
-DQe+frWsujWQjGxrr1E6eeYh7YYuV9w9jzkZjvLEXkTxLL/zcWyqRqgnpnHAaOMJ
-FmtFDyONUhkf/c9mcmraE4eESjc650RBOWwoxhlIAgCdIluOwvShJQi8KO2/SqF3
-NkGsNAoCzsNP3Ri6cq5DUYVLl94wsfQtGu9DufQzeOUeojGzHYMTqgxiJjkTP6bw
-2JkZNS1gBjpurALkJGTIheOC+HTxwYbwtrPPURlhPq4gMu4DMmfwYDegCCuSiezT
-85LefcoX8j6c9sSBMbB6sGmNvS/mIYp3QodTrtA2TSVz7H0QsmdMP5nrlook9SBY
-uEayFCDBIKqw+xds/8hQwmEI5FM3V6HjklVILUzRZHtcjUvZPA1cvk+Swyn9gsfa
-lrkAW8s1qZxv6/kfVY8RIKLi9tak5WMSCyqXHApI0WGM0sAbfk41a/kKLBj7pBYC
-qeY5HMEz/EuJe/TOjE2kKHjOtXxL/vnjTxMXM1Fpsglj4l6EGYmRf5AWxCM9He+E
-+u1H3FVMfC1kX9Ipn14v5N3defy38oRxosN3lHqCgAL/s89vPNY+9nJLBHi7CiB+
-dJw2v0ncMUWKCOknz3uqjhACWJt+QxlUwlWmlgtZ0k3raYVKfwML6jfstIt84EyJ
-E9ydqVkG60VGHlLCTjq8V5dXGTZ6NcNsIgo7IeKa47UBt6n3+uN7lr78DiBCFRcv
-s+K5IyIV67c5y5KRLreTuKfgiM8DuiJtOVPXmIrYIq8KNSpwwlshxOW5Z5hap8Pw
-TDrQhL7MGaiNBjIhGuF2oLRMMZkqOyXIE9twkIeUVwK8FgkaFSQed8qOEh5cjfBF
-VCXyuT9S+lmrKozCa1UFwet9fn8PMkSNNAmUpnkURBahtB7egyszYh7fdX0d8Ofn
-eVWf2sCgJaptLPSYSzvAieha5Xc4uLB7MP0xWG3kHqmFpzP6ZYZyAl1my96fMKgL
-OYko8I+PLoTCFR4FMVGVeNUuc6kUROMHI/UmWssUEIw/e7m1gQ5va5K5tGu1baEB
-yxmMM6/K2S/uyuEMijZGOFsp7tJKTVqt9P9bkAP0ehA/HFcWoQOmvtK220832Ag/
-y6SWvUp5EKvKxF2PTI37WE844opfCcznZQ6MTXGa+M6FdYElPKr+EwMnORx4bkzl
-evCFbz1zDa53b/QBlynINYbYzcC93PjacUxnPXxpBgIz62VLlH+IcA+2nCLQWyDt
-+LdsIhb/OXFf5TtFZOUfQaczXExb5jmhb30hfuChGjyhMtDjCvqj5v5h8R+Nm5pS
-bcGOJScyjvujYFbf532ydmNpsRCM0pi1PPlwXzhGnU9mNp5JmxS2wCx6tfZWIaac
-yOmQZy32BH1TMaRYJivRHFLGzVkxct9r/3CI4cnvv6oEnKo+GMNRlHRsOw5457jU
-2wFOgruZDSoDhD8/+ufOmat0AnMUV1btVzIRjGFZxiNUWZ+a25tOCALyuFUUa8Z0
-6YGgtBtXkFxZghEGPhOaBq9vUbRPyrOi/1qhAnYJDJp7yqY0eDTg/lW85UAUDxmq
-mmRpHsvBDJVHqWrwL3b13pwhtEiiiWpovbeL3gRcD+vbYYN09mpiygTC5vRXbUX7
-8xRONmqz8z5AQtU2DE7jXNIn+R02Jjt7NB+ODqMhB1gB9r0Jo0oPB9r9KYoR5s2R
-TO/uYn+iErbhWIxDnnEh7oJ6AFi9y2IerRLgeY1sPQQn7yCc8dPThNnh7fgp1JHj
-iXEZ752eLHuOq2skQsrpu58s/62aqHzbAAxldJKVwRa3KMyHQcVoH6hLQjX4Gjda
-04p/8clCAlN6LuacDjyYWVLBDWlwln41o39Leg+eYBIS7TBkqIADB7wCBkuAP3Rd
-fY+3jO61aJb2dnTWETQ30+BHY7rQU7HwPuDsZjhfm5brEX2MvV1W9arpn+TtQ6u2
-oXv1BtecTBt9Mxub4KCQO6i20+zGyuIBrpIwxQbauYul3Ow393G3pmhrZ1ePEfp3
-cQDLgFwakFV4gd6NlLnAkPPEokc3+NvK/gwqj2hJ5uvKEBwln/9zlja5PiLFTLc7
-sDNebwsxC8VNhK3MPhFHHVfP5d+xUBHjEMRPbHXZLubffeZx4TIbC+cUDREbjy6x
-565rAjt7LijAIfEgT3H0Tky+N9v2Zbf3RE+o/5ZmMnnwnFSPn+GGhqswzj1OqJ6d
-42575KG/504ybgdFV7ZJvnRQO/P0Fi803voFgDyKC4OQ3YBIR0MjfrfPZKgxGjpD
-WazGYo3JEVIU5S2MPZAfreFDASHl/yQ3E0liUpMmdNlULkB3M0KacUg3SRi0bEdo
-cgCuZZnFEPvCFLPh610WCIhgcQRNKhAdFuk4/947PtONLMpXcmMMgJ0s1neoQW8r
-sX4pwcq+c6Zy17WNhHmIbxUZ7YBmxRfNR9lsl4HDy8vnlaxsXXjNqj2znjcMcLIv
-GHlAmLZ2sKi2M+MD/8U4f0EwJUimJTwXwaN2nSL2MnFJB0+1b9JishCIotMSfi+1
-M5UgeshyZCNouVQ7Jp4c7EDkFc7/PPWij8xld6GiGrSI2o1R2PzWlGgrmmD4EOty
-wF+blFLd/t2QcehNZSQd3WsiLot5250NhPv0iZExNq06cBV/7z/mvix+i7z6XZMz
-t8p7xIACnCfhpFRWHobLwPs5NQFeadlCRozUF/dvUsnp95QUQD8ItDqK0ktjwuAv
-MCnIkEl84XIVtRcAjtbgajJgawOy11Ii1tUvZs+/ik0ma1qV+y3AG+UVsDOcFVwZ
-G5/P6y86evtL4oF8UsL8o65EeK50lmO7xpPJ1axQxMiksLHBfsy0Zpp531rRtE+o
-yoDm/sWiUrl2lbN0tsKp1xLqe+WRFlCML3EmixtCe9CAiOWgmfHlrdi6BEimqx5a
-6VcJ87Zy246/8/wgl3eQSkFzki7NcUJpJe49gKFhH2jgzz0Sxa9ogOkQ8hmzNkUO
-0JNBEtqUULqM9YaJ7YBCliP7aG/QiLEgVwcg4OEZ/t5FxPDdLMXquLWh6uiPpSkK
-JDgrLaJCBw98kAgFGxFOIKkv/ueqiIzsF1PSEuGgy1zS+ieiX7kZgT5J+zwK6YAl
-f21BaCiFYIl477nJNZYYAfT+sJeVIC50K7v3FqD+MAD9aAmBNKdOlzhK1zsEEg3O
-quF1YoSeGG/s+l16Qs8W4bEH7ByI8TOnTmc//lVcO+l7jlfnM5hcjeA0kgSJ4tiW
-XK91pWZp30VU8Bx1wva5rSuW/SYd2wD/wc1RsrXmilEjBXYzac1jW9KohXGkG4BL
-xbEitVXon9uJQbHwVe//QV+6eOuE3WPBpSBv4F933jwNlteJ75kYuf/sbOyrXGbu
-O4Pqu/mlXkV6OEGKXsVJPZvDgCK9m4nzWNGUdRNd3TLrHhjhnw7+F2uNsrxxbUv5
-UD2YfY4xDgBjq/49tDe/hcw4l8Z+IfEcz+er1ltdcFHM/lmtvlRMzN7pAbR59Pay
-GYuQ/B2e0JddUgneipLsBnbJixKka2iItYt1IdYO8pYEjNWXCioNcixqJ5WHYwx1
-CjKcoH+CpTForecWIIiWy5HX+ot+PFA01+KgAv0Sgr1ynHv1GuGuRvIOg+488Q/u
-FRdbFIUzUqSqI+BV/OhKvH2Oyj4tuhaHMs5YSTS23UK9Qzs+wCTY36/YbMIBu8e+
-5WCVmEDJo3olkaCXcSdSq9Fl+jD0cZHqJoIF0lr3VNMpaTEm/BI1iDbwbcFqweZr
-vDp1+PX4K4wTVVSLsK5HFF0QUgz6pEpwgAO3yZSy1aKYFnmMNJBsYwU0W1Jh3bgt
-hTBEtGq4N+16LOFCiN2mpkq3A2QhjjMrmWL4PwUN0LT6zqXydxa03pAmGlPmjCJb
-Tcp3/0Yu7PH9Vbpip7bujtVhnJyQ9u4gR/79iKn+tKVI3/CIyl73kq1Em+sZbJNm
-SaNs+7zjJPWb9UZETBxhcM2hsWSm4iMY1KnrLYZGWHOrr/P/Nm01Ds8BKSji0yRW
-KiY1sNXe/8SffJOGJNwv5x0S1hJo4l4mi/5TTos2faksVKNqKKARBF5dxt+hd1wQ
-GBamSGYpZUW39pjxW0uuDt6bQ7Js98VWoPWi/GrTPeF6GzBJ+SZUP6n1h2fBeZ1a
-ysts4qHv+8rKWLKY8sDtdARS0gnAVko3k36Xza5gSF846HnjrrBOkxxhsSbaU4Ng
-GV99KSk+M1ASB8ub7uUltjHK9PAXhWst30i/dX3f0x9GXNlKhrS/NI6ifDrtRN4r
-QRFDcGKk+bfpczzs4qLYANaV3aSdJWHaHGjdqbHj14sBPCTPdhFSBttEOA7EW1ij
-nGJp7aKp2Qr+97OTz1JhjQf2X/hXLzl6+e6AF3L1jya7+YOkfRI+TeF3rLwSvhSI
-plkXChG3jKzS3IV9TE2PMUywF7M+bVwIsAMO85zPp0V34f95vO2xB0dV/oTRWM5F
-7Kl9KKL5rviAf4tAvoDGWSAOH+pm0TBgIF7kaRFsl2IqFouc4k3ewKJNzVLXJYjp
-b9mh0TYukaBtv4ypJSithRJDKq6R9Q2k3GwMKAE2azFSJxazK9TXKq/l32GnPjeJ
-4yTsPKxIRub4iMPlaLFnxgxtOVwlQtKnzoY1VJiwrLncOPu+osnXKPBaGxv0LPBK
-B18e3sCywoC/1cSGN1mQGCDsAjrAOOpmurZIed1INeqeLuxoymJ8rAI4DXB/FEAs
-od8E+kPvwZR1TXST95MXpKJ/v/jLy07YT4cmt4y2iDJiWXSvxdh3LhsD7LFNItyg
-rBcuvMXmBEvQxnlrFPcBeK4YIvDUgzBNL/bRIlxDmfxjiJXq5r8ZowYaWWltXoLd
-W+ra/dVjG5S9IKD5wF0O6Y1bxaghKGuGOUP07ia59ghSKGzUl1qLDkrwRaoWNuWw
-OLSC1Uql+CkKJtKukAn8j9relF0lgtSOXk9ieQjmUshZNyeixYVQJrbDzqIzoC+F
-n36qARbLc5YtCSpCwyYK5VA/zaIvDv7X1sTUFnc/3x6kWXx4zMHicCcal0qccNe5
-/JBwyxAwykn61Bvgcbu112pkbHNblxV/BvoNjDHap8uCuqOhbF2aDSnMglcGPVIG
-rF3F64ZeiVNCx1HQpmMurIZ5nBXF9X4NmLr0sp9u2PaRQ1WKEGqZAHExSp+v2fSr
-8AtBS6oRQErVcrEzqM7e94DP+RcSiWeVvzi8NjAecbh85PCOeO2Lo0h6t/GDHeVR
-3Gfd0q+mhB6wneuXkSTU79zbEzCrJ0SGJNrtkZs9ciTX9fMj/OdhrscHan+LiLl4
-wKtwny4HUOkeyC/GfC6UOeJ6mK5d+a+3qu8hPUCVm38jHAVQJNqhT6hpwXOWk2lw
-Pv4inp1f5oEiVBsDAsb76ghEmoCY0eGqLGuUM4WyzEBIXnfEZciZ2h2QOZdWKvzA
-LaYIDDSuAGidSpmBKnakiU1ZJSThdONnPP6CVrxkQSFmQCQKMObv8c+eSyY3DreG
-yf1rEFiBrIJKMPKlAe7szQdKeY9+0gvMuONU+i5a7ETiwRkMO3TDgEyDuUnViMVC
-vTfvUsUHAEDY6ZYabauGlR/Em1MZzdHQWlLhYvOknauLLsSKwamfBvtlLR6Xqp8q
-cVFHS7GPjCgc6efYr9VeI36qryRDei3DMmXHwF3PXrn7yiuAbcs9s0x8NmtZa3lR
-tACm6eTBzyJi3PR5JEYODpn+WgPANWmkpB/qQCqJCu2uO6hQ/nuVfkUT0lwcArgh
-IOKZ+Pvmqz+I+dx+z2wORJHvz6GeZ0Krb9sgGQ0Yo1ZLmLp2mugiTjkrTfQK8eZ0
-en4LDKOBEsdrr2wPmUyZDW/EpdXCGDpeOfWwdG2OCMNgZpcu2RQOyiCatpe5yTM+
-oozYcnr1AjgufCgMpXkz4jKFUgpXWDZ9jWRBid4mb1UvLMwniUy+4+Qiq4pno8bC
-gBa5+1ZGTVvHdkzQMUaD7yDqk2r2hSEq40IMhWJqt0QTYvWf5d2VS3tJzCENM2SG
-tifBTFr4MjUKOfxjSJJHQ9OlbTYqUlMAgKyjRVAp0FUTAy/U2GZ7jXbco5IOvcZf
-K1wwRr72FpxCd+/+oOQ2qdi3+81+2skTkRGQc8rcssDFxHhamQTE0zIvnOgev89e
-1OqMWh9RHnfn1jIl1Eq6dIWemyfDEjuNvTFqpp6SRCz9lW+B7E9kmdvzHfUG+p3u
-D7/DqkVTzl/E+r3XU3WpRCMuS/S1vCqyebpwvbjFL0hxnVBIc+ikovl1rerIUsVs
-rZgm5hhSyoXZvcbmiPLOtdpK0JMHGiSlsN113IGrayxoVrFtEwwHeo4XLySvmoep
-UOwr04l4nTX2ZFDON9CXVv9k/ZIPJqRW5xTYsxehukrWzLwIFg+SS/Zq6wHDwL/9
-7yP+J4FbdSJBhi4iklN0dHtcNk/3jfDKmxOvmIx/NuE4a76d55/aB3Gh8P2Ka7RO
-r0dCO16X4vtUtdxGPRVRfj2E26Eg32cucwRhH7HyKoTDTkzK3JcOUEDBgcSSGFNB
-VZUIHELbxjJrYw0M5SsTi7uKl0XcPFmm9HAJ+tBuue8UkERGyCKQrm3/mmS24LI4
-7+rG6sjSHsNjzCF8GQHbFD4D9GpRdnpdrDvhLNtSHvEwDT8+QLKmrHDTCUxLvg6c
-DqVA0H1N1HkepT3Bp9Mpjy4HeD/t+kotA1S3izT+K/r78+RRSAggFchCTPS6CU7A
-DLTb5bVowargoQtGnGIS3X6wKw7T8OiSp9L8cWcfVpzk+QbPLCAy2xpxkFwLpgcg
-ZW9WBpj4EldH348QFXH4Be+H85OmD9rV+m6uh0kHjEff3J4qL3fza1zt2/PCpSe9
-zqZ9ZbGs4FbxRiRdjFwskIWBLp7SnL3RuANkeAkF/0ASHbDijB7Ct9TaVuyQq5cC
-Tk+BfZx4XpmU6Kmlp+2FI2nL0tvgYv44wb18yyvQ3iQXvqGxX9kR0AeN6sFAjgUC
-byoCJdVlYswGYhPDxkNTDJVf5gVmZKg7IkdmfjeM9u7zSi01QOfXW/E318O0xvLM
-5hTogFFw4aBDl5TMHHiJFce+z1bEric2T6kqkOXlocy6/Fl4duorCJdisemInd+1
-HyfC3n6e7dmYkGu7vw2X1v012LTdbsYaafKF7q3QIKZnjW9+fAo6elG6x79xEaBt
-/l02LEjwEAFc+bY5TxHeTz9ShPY96ysfqruD6j0kBWmrnUm+Ypv3jbdu/dlI4IMa
-wfO0uZNDN7PkQCNi24tf9ngU0ccx128H3keEtDtOVQj3VYa1LeRrrVpe4J51u5/2
-L9mCUVdB5WlPVawf2TQc9gzHsXjToAFSWo/kg0uXVlNTylf1cgAKsCc/xHwT7Dxr
-DLP7kD7VSdoCKTRDtn2yuYyOpgj6KYgzGqgnLlZYNRsLBUYBcNJxe81n6qN67SA6
-XBZ8UUrfAYlXt2M0Qp2oxIpKlVVgqZo+g5pLuZSJ3A8eAzDTQu3emBm/mzJ9nm+n
-5yGgSxo8VktVkyK7Jsn7fsVxmo2hSz4gx2nsIRB/Q4e0jt5JciLR5QmhVK8vBWr9
-kDMyjnASkxHFflN79aSDyNLxuYi0KjzXYpmuni3gEHaZeU/uu5haJsUdlXKJVyv6
-cGtccWswObrf1E6efii+hn+NzN85gT+Wkwi3QMY0UP8Qsix2QvvJUb/NT1jptiht
-uvLRl9ZNQ0NxB+IrVsD/V2hYyhVleDvSH/wyDk+5e+r2vKsBHAa1QN3QDodqIOA3
-VO7R9HVXzeJyFNXAWFwZPJuOEW8XjHpT2/1YrZBFc0VCRM4zUtStRTZ2T0a29OeI
-QgUv9ND0d+vHfxrfW3/t/fAysyrMMgrPdGdQWXGsAWNVjH1VhwuXLVKLQ8R8mMgz
-vElMSyaZPSM6Pgg4QVHlHCeTy1vfB2ZU7UAp5cq0Op15fqvNzS/z339mMeqeikvM
-Cz4/fC1iNSebZx1r3FtEZMzIPwJbCGkd2EpvxOE8R+1r2jUW3w0XctAjLvpacFe0
-ta0zhRO/CJay9Figs6FYmGSLPA06FpR1J18NC+fQOlwPfhERSndX02ZPKEHYY5KI
-rnAr13xC0Ad8lO/x8d8y4dHPdVc2SVd1gfMHfL5NzFosQpZDR14Vc5PDl+PM8v0b
-QhlPsyZxQ2yGdQs/iO+9GezihfigJUFLMqAb13FJ0ynmMc4MHVVaM1T5vhnAMmzZ
-iu08B1kvb0kSy9an2mn1MskxFP0qGySvcutAb6eLZYC1hqVECI3CYxUxWjuW9DuW
-b2GMBZxPS1Bu0YPpuB1Oq7Ms9TEfuf/5+XfSTKWrL5oHbUs5P3juYRVaR30d1lSr
-GDBWN7UW+9U6I475ist2rG/OhOlhPmsey5/1RHwkncTUGp18lI2t2zh5Jo3pJ5ao
-6nWNVcoQCEcSTthxOOlw/pwZnNoCx8hEmZGsXZ29zC4EE22ThUNRmFcyMR5dgl0a
-gFAYUAIFT+RyrIJt8IqRVTSy/08BKgag5wLzJgLfxDC1RO/XHOxdik4uQXoHkAK2
-8iiUMyPrKpZc+81TaRGAjvgHqkW6/UEGhjyz3PW4uxomd/LhRi3D57R0h87umzn+
-6gRXcC8FN2FfC5LjBaGwUwER3FSew02j0R7ksKBNsJbTJGdLKfj25N0Bw30kuzy9
-XpouaGXtuhfOl5v4B0E9JvWfhvzBB3++tr9L4hRX1PHsuNeSl+s27iv/DRQQFAK0
-eAQX4O7SY23xbZVu4nWaGSm7gTCS3jo+RtwTHJr/jbp08f7WHWyKiEU/Accu1KH1
-OTIGk5cib4vOzCxrV1G4mYDB8oliHGAQQbGP4aGX73Il7vAO5NXRkUvo0q0r3O6y
-yXEeFSvt3G8yLZxaN8fBXuQ/Y8niMYtD47aDLh2fNvhNb17ZgUyVGL6LlipOZsxF
-pz0VGCgpcBB72sJsZl5MpkRv8cs/2ezqTqU6Jp3Mv6QWk+qqvKKtz5+0b/iHgoAE
-O9Lbv/FZlOESNKr6/gSJjxnrmfWShslyX17RaD27tGcq0bTbV5F0W2KaiJkkDvUm
-gXxqb3Vw6u/QICOkf+009uUF9bIMGyxkM3RtbV6FN6VW/d44P46rcTafV6ta5njS
-PnkfqqbCvQsM3H8UeIS++9M2OYAsjKIMXmCeFfLTPSLmbxpVbeFb9K/9tR1blrOA
-6HwgXWUiHAAxRVlaBfiSbTg6lvIJX9xtZPd+FVEYkBJo53LVX+WEgyTIUjWU08GD
-RvM+D+xjD303WHWhBmeod+yoyrFJQ/yK3CSxJ8VJMbfwjSC4hzskti3W2MXPBHAF
-BOH2PXRmKbzRDjOqNG2s/yWAhghzDlobz2Mg6kxtd+ksbSDKZaCOhfO1JKPTEwmy
-5vjcIAt58RVV/hZMDtyWIjW9+rIKYbd89YQF6pVlbY8l/FqvDIWbzrVnWMDjwCGG
-z+xE2f6yaAHHpA1evTjktp3lIG9h/jX+oFh9c0fcfr2CFA8I9fciJEnM/xTvfjcR
-TItURG5wk754OKd5+70ai75pWO//W2p9H9oe8sU3pMZOhUrG2m0qEJuNrlW7Lzu7
-VUHjsRdPW6glMLR2XLl4f9rEo2wabCeB+MJOCIh7zpdfaUlscp2bBf4jjQ/D4JUJ
-2NJXrwRbb3AH8IUDPe936ezBNsuEzmXczrX1zfudNcu03Sww+gpVeO7jgne9NO8J
-idJoVAaOr5kg5d5ELXiXwrkn9p64N3G+GfkrIl0o+i8v9DjvOI8LB7Mgezp0N3Xw
-1PxlXr+OEGpMzL45wXiIIU5HwSFt2xjr5PgtrQdT/GCrczuuOVaqxZi7IvqcD8pm
-W+RPgbLp8M7MAwnk9xaRSGcAPN/rTIbHcUJLDxf1817UvaU+uTBSk1mjR3PJvnYC
-dJ+lmwbDdFc0wAMpYGAQok6UY1nNEmoO+ShJtPtpWS7i+JI95xXxWeGQt6nwx82Y
-hq4oehog/TOyaIwK8JMgHTsn7X0iaK//LzKTYJZann2pUDIWVjSJXfJcRk3d6xTj
-doJv31cFpL/Dq/H72YRSuxKOMuZKAlrRo8i748aUD3Ft2cNUrada7Q+Hbwug+AoE
-cidJSDidpllARdxkGda5useMKH4XTUd8QN1oEp05t0jOfzYREhHN542r38/ghEmv
-2APrc5VaTw5dPkxzqUS7RB3AdhhptVu5IX5N78lQ8H86y6BFYCNQrgs9PX4nODL6
-J4Rg5EBmWda2VZLLaToInSl5i1udVmZMoAnRAJZguT0UTrzPYOp1qs3GCDSRfjy0
-vR+5vCqHWQw60Hqs9EVJU+xbPojMOYGmSP4+Kb0H4crY6LJUlXwrZVt0l3M9liB/
-6H4uNh1K5gJIMgMiaqDJWLUew5MXr3p+roSfbOrHgI7OwbOzr1kcnQSU0lGWR/1a
-qWdtGa30BDc6MbBUdGj+faZuAOitkuNck+PfdF4OiCnsi5giSlx8UhIL/YzSSXER
-uuf1cnU9lGuS2XFz8+lrGK8YMw1Wz7rdosjWV5aCel2UfaifB18h5FmPtnUZxvbS
-lzmNBqMW1Cj8uQ7Bz+yGjZobNMXSaV14UK+bJFeOBpGEwxrnH0g9z6gwWY6X8iVD
-2MmeO4UAWJSGM2Q8cFZgez69h7C0SswUivc3OTHDQrMKjVWSIB+ynHc0KvbGv+TE
-hVdf814W8tIOGnonc45pADwu5x/deBE1V8kyDQ6UvEGfOfd1fYefU8Ml4vdKMG2w
-7PW6NE3//JfJCZDHzUAGd528Bb1PCOffvwUBmMQNOvhQpi7ZXG26R3XBToXssofh
-6ZVeqKlcZdsiMKfH9ixMWBALs0C52IIjvoS793xqfAScZs+ycAzVhEOzlqAGFI1J
-WBYvgpl8psmbqcpPapVwL/X+cz4MueftmkQKvuOSI6G9gEEKRZxnwfoHX4Zden2e
-9HydeIRxgd43AJaYpsZFY8hA4n5HGHkehs5zR35Mqaxr9XOfQeOZ5I7Y91RVc0WW
-VCVgtQ7LLBFa/LYt5WWUP0fBSvYge8jAbHVwgcypi9ii8UW471aDpSXvc4tGMMzJ
-KMvigizgGP+709SvAuD8AkTWa1kzgL77J/M77icSgztTvdIg82r8v1nqq+cc0khM
-hJYW0Na8+PLmfsSbNWdNvL4jekCjID4RS3iEstZ6sK3y/jHGsEUAkQ4gyLJb2PbU
-l3hwQDg45G3lQ+ULmK9FS90EqPBFNnPkFTyUd90aJVgShChQfwqcaDSBcVb+lU+1
-/G7amMAawn5Bd6vu1lxdfUiLgeu9xvCFF9qmPRMD3s1Y13N/n37gQPUWextSvtTu
-0PhuMpHrt4PRkEoFYzM9kQC3xqREgdHSKfrkx69tJ3b60RmPPVpQWnjXT2tGhmdz
-Vz/c8TvbNgwNmTuKMRg8dxeQbEch/D83hPLvQeuVCaLBdR1V0SpT/YlIiV17HDpe
-XAlO6nF79ZMtUXmufbwuGJovpN+EjUeIOVC639Iqx9a9coBFy4QP1/nNfrAWcRfu
-bVndIKDUFZ1RDDbD66WVOtxE6eLEw6sBFIf1NXOuzGSDJVXMl8FxZmbHL3Q0sKvt
-NvC16E3TPlXAIyVL8B1L+qyp2HQcPgJbc6U54ZB3tcEzyQj6vjouGGQPaauFeaK5
-zCLV0JGE13Pjg3YNQ9706sFK15LIbZRtM7GLpbx3UABQbc8s3qvLPPwnhWf5hmuV
-TNMBQLkU80da0QL0mWTTKMlgmuvS4nR8WDnMOC54ZWoJ5QUPg3n30h5CXOQnE5Fk
-E8qYel+kOocJHLJ7FV+JeBtuLqPDk3kfb/Rh2X/wbyMxXzqminVIcDMW2lN70sKI
-tAftsqSigTFpb0dNLNKb62SXWByi40cN5F2fi77J1y0hD0+upVRfBNsfN+FYDJ4b
-o+bolkAq4WdeZUlrfk/qBfPphxtbxDIZ7Xi2YLpbv101ZmVGBrh4mkrhF05taqZe
-n2TX7rmml/muEGUSXSmXOWn1PNe0qLkAh1kBoWpLDtCzdPicEe3WZIlFWJhAvVzt
-ehbl/kJsPI3tNvzXj/yHz71RSGbzACHU06uWDwYCS2ebCJ9HhwHgiToQGedC5A7o
-zVm6bmasjQIBvlVvkzWKZYWdNRBGlBFZKa4LPGJeWBED++zPxCUoYH4LVcSZenUF
-f0OuaDZB8x97bgJa/c4WubzhSyYLiF+h6/SSp3x6IbwicjNuI3fuBDffD41pU/lX
-MYVYsrWDec29SM1R0yy/cxZVcCaYmLG+XeAt7p3bWNaguhOGn+2jXWU8gquQXzN7
-/z0Pw/NeA9CevMAXprqy4PF45jJJq9NbWT5g5K0pbNu3eh3WudQY4MMx9iM1VHge
-JtN8FkIY7Du3uPMnE4Bfl2kfg7NNrY5q52ifZ3v/bfeTWycx+DlgaN1tpZoh+uMe
-nEAeBqEjyXvlcmRqClMCfSonPSkm6mANEvOdPwkN3eW0EFTjBy3WFQ3BJ7cCfWTy
-IZPw4YIMBuKdBLssjNun+LImfqVs/Gds9A7/W1065PCk0FZMQe7Nb8MsVWmVXT5I
-zMODdTcxVP1HUy439sw7iHa7ky4CUCGOWcFeReMZBszjRe21fMrWaGp9dbROsmZz
-lhs5zz27D0OTWoy8cyjuNmP4hrtfDEvp3YlljE4YjNBapxe3HwW72gjrMIHxbR4n
-L6yabWRcKEvF2FlbO1hLAQmu0a34n1It4VUkiCgF+KoY9MtHhtWXsYdOy8n+H4kt
-Dra/1J9P1oLIDHC6KknOkZsAaA2hdsnNt+GPSEk9wuLT89A05WS4d/kh9zDQpfXa
-qulxmJhQ5Wd9Z63flx7nLM/baUBiPfoXnuEx8pLu3N4zHPoMQvkwkQlJuYHE/WPN
-PTK0zU7TXPLTgRaSTe0cgzvO7XdQzOMJJtrS2192SaI8CLmsY0eB9/kk0xh4541j
-lgny/q6enPMKitl76VmtarX8EjdE513ivy3DzRU9Nvb3NpPiHPR2T4IK35OqNqXi
-cNnXclTLmMZu26OD1KtfF2WyqHUAhUEJtYDLo2YaW5VAAxheIX6KFI8fXn3mIjOU
-taU7XsHtUGx5pGNAKNBP9uu8AHnlX95jB3TUo5bOMCuvYOb7Wys6mnDcmu+fHT5/
-fXUb5rXvz5br1q1ELMvhI1nJ6fHRKKeqSo5Dsw0zz2L4stMF9vpQ5eFTq0PoAT5a
-9EXBQqJ5fn9/c4ZWhp8RDl6gkwxwTy6pOQcdySg8JJ3zMQHhHcD6KAhjALq3+SgM
-j8o2mUBQxH2pv0Qcb18ng90VcTO0eFpWvMYqbuqFVWaxhRFrbG40Us+TgB9MX2tt
-78CcAMlgjpXtIv7XldxJMwX5s2bjhJ5k9/OZdVmAPaNnMv5Zt/EDtxtFGFuThPpt
-F4gIDdjr/R/eqch6+oflQv3Vyfom9fL2M2xMIAoy2q/9cLtsLIeSMxpkee1q5cm3
-6QPwubR0bZ+BB26OzQm2SzdTm+gVbodgJuH6nyWVPcqQfPNHu2vpt4QJ+ObTmHUJ
-GQN+4+D1zYIl5pzysWpOMU4wwFQFwueqw/LCmcL9kWb6DiU/zijB+UjnwYwKE4y3
-CjlI9g0g4EuNjgShnm3f55IvJOAL12p5HO4eF+CPeHk76KXzm6hdHYGoW62UXEaC
-jf0XpEOHnSMXjRhtczkQ+sBiosQk/hKL6dQFCL/jKC7ciuxeBYhrBDq04izoFLPm
-a0gj84TnmudWJp3xrdQFMU9Za+NuoW3I2q5m/IJ6hGTRHciR1xF+7nlrXWdZLovX
-mKIiqLeMWIl6zl4zK+yuRtaMGclWHd2VPMeHMexSAKcJvXA0G4wrbU5Xfe1WecZX
-I12v56MAyqLZEjpz/jXs5oEqEwdw5f+fdgdp1hub4bSkN30gPiGQz85FIEKj2KbM
-Vzjx49umhv1nPX1GRPPl26W9XSXTBmjTJBGrWMHGL10/ovViaEeHNZ5Avfcdz59c
-DzENV/Dp6vEM+B9oyXB/RQh9xF3BhNrdMRES4HJexR4Xu0L270ww5BgIIZ3jkh/l
-gwKUjuh9vWr0w8uGqeGOgVswXRi9OB8qkDJJRDtjm1+AKaw6EmIS0OSuQbhnohFE
-dGNWyGYq8ZHfiwXwsN8SEBUybRvevY/UcVyPkr+rsgcMlHhYi7rXQmRkAAvm3uPE
-81kwHnyib/WRqbdz+6edbbIFOY7O+FjPDOViX7E/8k2CVo5gJwYnbxFabGL6xB8O
-BjI41CFlMiahaj9FV/id9S99vkxhezwfNDp1qasxJUH2usdF0bnF4BPR+9ZeJePi
-bLeuUM94dXiZ/BXg9jIoZIsGRJYu4BsgNjyoIFqwkf7z47aW4zcSaxEHP66mrTgo
-xwGUmkGgZjTCvpZPJw5NNygZhM0mypde0bb4ymZBTq3TMxEq6a43inj0mj5IJZtU
-9VXVmN6i92b5LuqnCFlE0/j7MsHE1qmrjMShgJs5RLPWTL+Ub93Pahku8JJ9OEQI
-IQDVjrlNnegR2AXfitUTJGvU93T+9jJo0x9AqKVkSUYWT7zIV9WdLVED3oh62iZA
-RB9V7Gkki/2ncgtniFTz6UZ8EU27n/E1P7sZFRNa9AfjF2jINQGdh4nA+8ouwbak
-+pAy3LR1F7osyO4k3OxkKzV5f5k8iB/Q43CwUOWplO4MSU7DQWSjySDk6xAFE6hQ
-fdK01LL9HCfAWhLLOtBrPczI5eCAi70+p5ApC6rxizp7QkvQX0cJW5YkfVjywpvu
-0nsPUcfwvfmIcbHEqN/h9nThLF2sgorX8nbmqxCW9rbcu+7ph0qR0AsiwVckhjfH
-7X6IZXMXDBbrYXaqOtsYfBZKqk65il9vM0L1eKgTOvg36CQ6uxS9BT/f6iViyyzH
-7yKTG1So2qS6xYdpxxe57zYZyCCRbzVN+HqCpvTek1IAt1Bjm+d8wQvOPuTIyuHT
-540BLV4N2USgyDJHn7/BrxEalVXm3fnAeJ6CYAzyKYlnXe3vHueYjA/U6uN1pyps
-YPrqLprPAPw9TT9OVqGef3ptpyP1rDRK1kkesFF69KQUvA5yWaWdn0oysFf49j8x
-HhHO20jUE4otqwbLhEdJYoH/eOOyIeDaN9ctO6cnPM3tX9WxnThq3038BWCnN11D
-h4aEMcz5V/hPwp4Hb6q4pYXlJAud4XtsJUIMrpkJ5oY6UYSSzyFzYAwkPHnxeWeJ
-+FCe4cT6zEdiOpG5AGM0VLbQyYujl+brdoK+qFAih8DAJWIh4c/ceZ7ffOrZN41U
-qBZtDAAbhCo9RSuqlLkxbL0skhV3//cNS50WfxZ4Jj4MQzoAq2aedS+V6wiQ2/QJ
-sb4nNu4ri9WMm3Htv6c+foMrFYgiXodpb/K6OjyaFXYEgoSRK+QYAUHWgPW80dWS
-vCTY5kCcRy0bocDAWwQwKXH+NEAMBfbBdcrmdQ/m7ixQl3HNtFpV19RgDQBYeULP
-ALGMLrzXz0vTAbwGGmHd7boIGqRqb6Q3G6pstbfbjOxRbbcCYnc+YWtUX2iTmv7G
-B+lbeglufbPchDrgEbDBcokl9UuUSpRtbVOPAsqXiQX9gq63D+iDjcD20z5u74U0
-QfXIW8qKT6OVJbjl4OcvvPm8jjAWUOuE7XGnkFcwW2WGzPE0mEDf/7DNAbfDSjN4
-WQiQXLO02FAK1w8Afn53cb8NHsdxZqQf9meNUh/wtoJ53wBZjoCqfziMzNedhw1a
-KMKYTdTuHn2NfZqMA38s/f6g5gjRukMYEQFQC0U9v1uxNxj6Tfk90/Pa5SOD/wGi
-0dmDLp7WSIfOEASwCrqbukMfXKYCmbMyXPFIYD7XBzfy4BqZUIrJT4DjBw7fDhmQ
-OmJo88AELpViHiOb8cRa02ft/D5R3/Dy6r8e17HZk5ex1fnqHTFx8OP9ZeTAyY5g
-lVam95UVJmxUN+ew0IhF/ZcxFhiSPfN3dN1AFsOqBAI3YEoVaTzL7dv1fgEdlS03
-9XEOyq1n+cmZUMVt88rzlB4s91sHm4SsomF8dQn5l2K5xwJQaxcGRrAY+LM+5JVi
-CSsXWxp/5Ihwp4cYF5xTAxg8oRTzppvb+zNpfuPStbkk3Vg9UFux6Ft9J4DA7LGA
-Zymna9ubSckS3lJwDUIhKIwJXBfjQOzbUMRfgxAeadD5VKWmYb8D9ci4H8H4WOYI
-kC/PuaYvxxknzxODHu4XSUEHNoz+6iqwG3FHE1ZtUBziZUiigq5dVcO3XLtYbtIh
-AqRe8+Gskv/oY1X39/qSuP2FruTtY+WCuPf0LMTU1/Zf5/U0SDZU8cndKOn6DaeS
-J2m1H8Z8q7vC47e8Rx4X+cwlcicWaTleHjdLOhbco0vVWlrx/BuUa+1p0ZvW7n/T
-O6qG8pytK+8gzZR1KGMU7HWEpGZ0d0TRU2ZV5TzKvmDterbXBQOE2RMCq8FFvpoQ
-jallTotlVnKyFX0E1iWXzFE9Nr9wIu0HKDr72KmPdTF98Vz17H7HzFWNEWJKof4y
-WxJhrXtln148f2tTOBrqpt6Qxlv4ZwxpatuTjKo8zCfg/jeTTljU+aytDmjYQE25
-lZoA9fayZOPp63JAfxewqtXh6uT+lyzIIyewNF0EGfo2scHGd01KFwIvUaL/h3yd
-jdZshrglua8XNOnJo/nbTdWJbfmmHOyLo4sEECro3X9jaxWbNXQm7US4vX4u3TGf
-i+qnli7sxyFx1s08KByziukdN1ePCQhxmHMFRoYem53uYH36xU8okyCFDfXgqGhX
-nesLCWtTGsLozSKibRa7z3rbXbrLnDw0c8dAVQDD10PHOUidT+aIoEv1bL752EgL
-xP3H9abC67R8SReJtHCKbgBSKiLXNoWo3j13VAXQwQh1zyS4W4nclhfu+xUB7FyX
-ENH9Nvpp2udhwXdeKQRzUjSrkoN/076mpT67Ur3vkX6/m3sSCWzaQn44rw3yoOEL
-0mGURJ+cAZAdiN/UFDzxGRUumw8zIquKzEsW8LiiGGtmQQ6anWUsZZPL2pftO2t9
-nWD661kPiP6GguySOIMVP30PcdAcRjIMqvHTYMw/c1tZZ6aEk0/82QCI/CL4CbeD
-mfqlueuQC8h86JzocLD8JE++a1pLEgXEYlaQS9N7aReNetrckUVz/NuaMgmQmJ4+
-eqxjo1fgqfpemnbN0/ytxTYzGrKHSkj9FlvB7hBhzHxe5fJzZxCN0Vu1B4w3JMx3
-r9D5q6MAOMneF8OMlpRo/TO6obVSJgtMrVQ6vIyh0ICDUNu3c5n/2bKvDlOfO4Ty
-CJkHjXI1tymRtoONDL6i009zID7cXKhdh7avjeCOO8/AEsvbDF5RKedIe5s5P8sD
-g7HDFsJ6XO9QTb/yVIfDxAewWOHHJpA5egAujVkRoEWXJ4lvUPdiONKw06lO2OD6
-6q0akLuIayWmwEt77YTLB32iDDcqNc32q5mJOay4zdFaN9o1XcNC4biQDYdOnMgk
-bTHYvy9fQ/Th8I50DYwBT7Ln5wDM9qSnOTOY2H8PC9kA2YrEMzCMCwqigJtbiC8o
-r4imA+g9DVoFXjzbftSZETYXheP2Z4fVgTie120OazD0rNS/gsh0EngTYmyzHKWT
-7uLMT4uYa0AQj68j7Y/k3ZMMMgPNuXkGpK4WKabEEAUyWCYS4dbJX2FDMNFg+Ak1
-QuKpNOIarpIEgzMY/ukObal7im+tqYGsT587Bi2jUDv0WzpKWqYE+NVlQL3LDWgv
-he/yUaRO8XsLS5eKnDBs0WRtEaZUaY8P9IcuumV46/wc3so7e44HvCpliWGymUrn
-jvpJzDfF15OfHuCW26onGWNoz9n8g9ltbZcF8fsfI3BBjB67wnFr8JHvmpljRB4s
-Fsa1yy0alaMXQOm54PLN0SGE3+eiPNlc6g1QgwpqkhAjkAdArRCB9fTtdmhgeEXf
-GKh95DyyNoMCVqjfMWyfVCVts/qSpC0yTsJ6fsl4xJiUrXsW0i15nfskkGeLtX7A
-ViDI1Wb8j3jkIaHqHX5zJPiQXyZ0KGPjJ8vmzkgNxm51kaqtWW6vOTFPTWsJeH4N
-8H2w/+Gj7dKmlcOnutBew8lmHvF1kH7fH9gvZ19E8EoRgkazW68iXkkc2Fkdym7S
-qbKB1U3zMG9em+YJcTci5v34Vw3QjivRoaZAraijCvyWyP5nPFrQHjxz2wQx/Ykw
-Bts/ZR/hDEcaZEDi/wd0/D/Rd5bdgmelNXQfgil8ZZHchwX/97rz4etVs9orYEZ0
-RIrXHpyCDd8pFb+I1ySaMFHkyxfc80mtRYYwBEJLclSFFoGVXtwXCf8JYR6odWHH
-3Mn6sTNdWPOIVT3XhoYhlwR2PdNoMSOj0DuPT8INEuniJUBX73/h1Bg+lhoNaewI
-7tO4751SPhkhnx9xR493aSHXHMzwUIXGODXZ9TKvDYxfBmzCxjXojm5QBedtHENP
-K2D2MrsJpRGq05x+7YKw5gSptuMvHrtOOCaCk8WMiAw6g97QMWLqKDyrBa5qQW+M
-t1GfPMt2IUKcBFQguBORKZin4lUqrjFSlV97QhaMJCDuL17dzmjDk8NuYy+c79yR
-mk9G+/871lmqhVvNFi7Ic17O9lFZcCBaw/0T7DwKrtKBpw4e9VpmXmVBYZnEuESu
-y3EkCyVafBu+t6RV3f3tz1i+6k17U23pCHqCqC9b7abpk2/Z5FWiG7Oeg95Y8zgg
-BkKCJyPczQLpacPRr4VhfapdXYczUBn6Fcl9Tg4ZAuPwFwjGGuwCRJxnfan2M1D8
-rR5NpsWbLYo2EZGchIMVxqmLz/JeMyF/41fRQZ8Ta/Wwr0FgTsCqPNwGb4fr/2bJ
-xV94nXTGLW3TwtbnsrjleRGsT/PbRK448KWpyhauXh0zEPhfQhM//f1u1DWaKGmx
-k5NkyQI3ypnsuBHCxNwUfUH7fjyR0SuG/ARsv0/D5j9ehLFi80N7fHFTRGwrQ4p7
-Dwd+hEn3WngoOYmiJzWxbNMIljvTTzkj8FwB4Oi9GEt2eEEK+qdJCQR/pSAwUGey
-xDP01Pl9bqberzswOrVh3V8cHWPjvrz/l+3RhyVdN+t5IGyQKewuWItGoUpV2kF5
-CKMvSzWgsxrmZHmug7jUTpEj2K+HOP3fLkSrI9FalECfesWctZt0JnNhAGxlMY8u
-Itj1J4rMnhnY2/B2nJj/XpodEpm9qC39AltEQXlQvmZ/VhAKWvgckjmQ0oLLlO3u
-h1jSGcHkyNzWpK1vSidi/EGttDgyDYkcx1S4hUwVKJqVL/k8A6UWr6B9SHSpPuYV
-RFMHy0lLt/3xaT1rx6b3q1Yw5eV16KHdKs9bsm2qFouymoHvMFJRbRbzdgBu1TPk
-WyLaPd+wchTGcaoehszRaNABmLhmvHYYnfEjmExcjGX4NJAxgfJdZ36/FBkCS0Tb
-CilxJcAt0Y/c8iOY99xmLUk5LapBWCSanipNC0bQfIdCWfrI+Bd9Q1TD0x2VA+FI
-WFYHw6tB0U0O5eq9Tnts2wTGyV2IYxbcRBYG+I1A19UY4NIybebmuy9O23oOkRZ2
-XhVi2KCibhIePgWdIoN86NjxEJcmpsvxZYFDdw9TWh5oKSDYS94hXdTMP6gByFKh
-jqLwT9x3hhq7ydU7cfIzCOWSFn9yvphCSoA/9FU0h8PKfULvEMK0T5erbdaE0pSD
-3OGwyFZnsIobYAT9a6CB0X71LStftg/puwU2CuuillgygzBz8nriRPooMYGnvkv6
-8Zu92JgwryJui3XmpKMhLs3GNGzYrxNzq0m9Y1dtOt2aO+zMUHtUnz3xXwSgboGh
-vkiMluaE+RKahVy2T8bbtkyp/4EPx2dyGOwBcrlwcgASrXuzE4obu6MrriF0CKwO
-+jVZRiDLfdjT4224p4T76jY4yHT///W8vbZdYL7tr/t3rJpWBo3IPSMN3f/WG2jD
-cmGrUUrQZX7G5VaxT9rvxV6BFqD3G2Id8VqWKPzs+YtGq8hRa/Bz/3JCCY83w/ao
-a6U5lAc2Tf9Ph4GkXY76MahLX2DqeIyUWVpu6nGj5Sr8I1VdEHvP82fy7cOmtTyj
-+fVO23En1CUX6fAA8nbLWZafVl8XXLKUkVEnAqj4tgWaf/AGR9AUpqJp1baLnbsR
-n6iESrl8bGun6p9pwUvJrJmMo+kMFEbr+9jsN5veEPmaACVptww/Sh6Wtob+HYQt
-R7jpIy4iIYLWoD3LtZGKjKLL3MUH7kAN1JvYgrpmGPgBhZ8CwUnPp3+qybTYFs4P
-SbAAo1HmVx08AQbwUP21caljUCKGzrzgRwaSwMRdzL7swr52zNXIdjBIRGa4oQX+
-ja6AmOc4LmYXrToAo7YV3gH8akNUA8P0i5OjcSrL+nOTAkGtRs1rzTJU6GeADq4A
-GFsRM7nGkmSsc4P2N4vwRYXtcWEE4DNNN2P8tP8CA92bdkpA9rMpmON9mXabVRsg
-Tscggpmtfv84485nMQ7B5iVgITVSyeoscSQc0lDtCpRaV0/kjepsT4+QCr3lkYCY
-L2DtR7Z+JsVKhMGqjFyOz7Vk0Ksw9/B6vczNxSPg7s7s5UFDtMTEj/iqOjnc35Yk
-EugBvonQA1sHpAxN8rngVtFSB/QMTeo1PGIZT9jN6/ATJdPU8MaXk63fci2kQho/
-yW9pTCp7gOFp8PAbjx7AIVDBQ6BnFywPtk12RArtbfHvqC//Qt3/hwDrpJ/zM0mk
-0JymxS090teCmkYtAmJH1fv1MuapztpaUuOI9dLO3eh/BLrYxFRWqHf07CTwAVZz
-SNjNG0P/RsIPMR2kjSVwYFC0NLaUYKA5PVU8wIBwb4YkTvBrD8OvGrU5AyHggP9v
-rze+eHA8gm0WiB0OTP62BmyPRYFpwmvPvfwKfkbZwTHWv7O0cQiKudQCo2+Xl8G8
-QVXhWlUy+L0v9GJ8Paub4sCZs3C4H2pDjHYAt9GNRLIgvLhiPJTP42xAWvtAMEoC
-knKxR0pmwmeKGg//pSeDAnjfkIUXBDealZSPyXm/HVKNoi+tAWZTWtcxDpNDYycF
-TERtgDWaNA36QQDt0W5ixOMwG455rYy4cBFKCb9u3Dle2/Y3w9BuPHmR95TsHTTe
-RRMn6Lge+TJmUd6UWbWPhlQ/rPEm0kVzcZDe8C6WnoxcbhVZJVCHVi8SJ+W0MZIG
-lE9y+9IgbyQl8X7aPxz2Wz3vhUdLP7H20CIgQ6gjLSH4GjfFIO97qqmRzLoKaRUD
-ZZxRWc+3a7cXeQXpLETDbKjLks0OGChSjYxBFBPcIsYqsbZxPugerNpyazvxcd6V
-dByb12M12lZcs7zXY/kJfDSk32qrlMH82R2qG+GxOql5gTuKCUpOJ+MJT6EpQF24
-Kx3KRwYoApaCLwiKWxRUSjUtONIoKu/i9sAA9wPLPvloXvospuYHyw8RBBETDlon
-G7Pf32NlaFbCqfFMvBBeVgqrLpKha8rljgZN0PTEfi/SYHcO4X1AisavDN6VwPLg
-P5EGe1frzRIz4ywgTiKU+go3GLZ0ABa2dNL2qr3zjkJzr7jKsir4v5c5wZJCXG47
-7aaZo2EHf/2P6+ahtSmjO+tPScrKM7uheJ+qD7lLwdWXfKeuyUwfUK2MCyWzKLsV
-PMGVBNRc0qgJGxxEKOtri8TH2xrR2CtA9OucsqEivx0Msld1UT+NApNY2SxkySCC
-GTgHgSen5Yi5jjMOl0WFAZbuORWTYx7pnL71g4HLTvYV9fh9Wxjod997lYlo65R1
-vxmZY2VnWLVCXeCEDhJDF5UwqAGinOvHYwQyClGuGa5lrl6aWxoevM1wXYMJtUsD
-sNqukM5qO1WRsyZn9w7Xg1UbvAIZu2ksEl+C5ZpNuBkqhKj/9X6ZRfqFNiMy1d4K
-+pFhA2qQEWkhv3ATcmR5ysuACglql7tXmj07C+Ew1AKgsxMUgsPL33SnOemMr3Y9
-CzM4zeXi9BxPkNMw4Dy57ZmmG3MKiuA8tlRdboBHlsDSDw01PKjae0V1NPZ/kml+
-VZkLu1SvXjUif3+X6JzbJu7Hp1Dpw17wBa0HWCUpIiy4xY+/oahMCy3u97g+ZZTj
-Q4EGFsWp2pGq3gSlz93os6jkCsopMP0BhvX26sk0OBX3NUIBpDjzkNmV+9magwze
-WPs+TpDO6RlXzgXstMbWTFvOjN2nkilr+IM+Bj5CcctcJY4oCb2NlUnEIQdnDxnW
-Uh5gcgVwGDiUTnlwhPrUIVOs1S0f15uGBc1vrE0vKRC9c5XsHxM+Wmv822HLDE0A
-Qq/ghWka/FcxCtg2BBRouWxPcVkWbGvBb0aHE6KS8aFk/rNng/17yvKje587ZiNF
-DC9GxTZSoADFtCUAFBCcnFJP60G9Odm1GR3npfvwLJqt/uAz5TRlP7+UV1ahTw1q
-amiNAbg7ERLxNECMKpNcMf+1FR3gfG8pVHO1XdQKiye1iNM3bKeoxiVMbGrUrJ8j
-iCRS9tQ4Ua27Dv2yisqKfVGpqeDIUwx+OkxagL7aUysQhhrZqjIlVQQUs1hu/fVi
-z7SaySLI0t/7hEYW9yicv4atJTVZ+taTKtlD6Gk3hb2GJEEycv1TzEI+CWpohrnU
-rLjzSygcBihlG1Hg3VhWkJHTyc8K05EarjRZoT1nI8lUIkiX91rMCVFXOUXSV6vv
-+Z21d/69uNXMw8QLGfTC/RmOiH7z5ogI3DlOfdThgTt9Kylrd9rViCRiyLCnU1uz
-RCmAZL9gSNpakqiDf9lOTvHeeQEwV90j4MS0fVQxe5q13OZ7Ma3ujP8hiIcd9uM+
-oePB0UhcWAio6QOnYmh6wn8QEIrSpVhirJzrQju0xcjZs5/oQ55ZhnUZiZQtYuGD
-5mPhXmMQFrGSijvnTfmJ+Ol7dm4A1L03BJFfJLuVcBpo8iNALK+0bnQynTU6FFoy
-dN3c6WVaSmuQQm7o6/FQuKLoVgZU91SwqiWn7yHw61eQfvKxTLdk2eFsvYrbkXf0
-JDNNuGSDlmb7W8Pv3fbyZSfjuzrcZX47aLXKUTYrTrOz5AOGYMKxt7OOl9yFbaoW
-HnkkFoqJ/XkwpteUQcovt4vfHQ8fMGceDL3rh8QGelNK8K4p6qYzKpAnan2IXRAJ
-APg77ywp/BryuYdvPvcTrfgQ6io0U6IykQ1Rb25GSozvdTZoQmab5k/GBPqG427Y
-cO0qPNq0vmC7kuDLNZBiWNyO74V7VX7dxYm0gX0qtDZxPoHfgcaJeVmPPpiYaHBC
-9Nt7+JL6gYcq2FGGeTtY/JyhBX49wie2hr5zPgM2bi0EgkoXWUxK4hHMhiDvlpBz
-ZbKp5obvfyTA6CZCkyYYL5l3zeF9eHEtMixA6WrTUNKhT4cvla+52dtA01vFeGSI
-6EKm9gFfM+QMzfYW6+u79QDWcr05lgdpj0i/7cWeOL0lOcgmzXUu0OtRTfsFgPYb
-sE91mE7uwaJLxNDVfKF1wPDVxKciSAFnf6S+EeGj1wYTz/OkIrvSiAl0r58XZHB6
-f7qcZP2yM7dZlkKtV79DIIYMOsbE0AWMKGeNvGpm1/zz8VyhOhV1KMNycfsKDrYI
-bojw7jfFDJquyT34mtLQitPHXzXmSb5EI1Jf4ytQHHBBFs5XILgIVq0yuHZWIjqg
-Y2ITHokfoVkXVTrROSLKBRmdgjpG2C1xFutDJtyUoReCHsvqBGVpClCAol1Qf82Z
-5LnV7BmYjFv+Judd2k4pRM9IDoFjVCuMtWN5259zECK/v3BySkXsBcvn5rLbK3HE
-WM3r/i32BUhwzONDMirELj3gC66f3ibp9zWSEQ/Ofd1TAuMcuOMn7hfypab4I3FQ
-8veBh7IeXTFHzH2hWMG1StIw79oZoKeDXQJUWaNh1/QDFMRrPoxZg4ofeCeJlxRT
-BW5Bhr5Gh0McvQRM2Yze4LnzrzJl0Tqnqotxofe1VtabHTQFxdNAXma6kz2sJDe3
-kMpW7UoVOGkzHx9ubXLiH8F1exIzuZxdv4m1hJ9Aj6D5FxannNiQ7fHvgWRGMBmw
-PViS3q+U5I52/HkDJuBpvbVMSaF5/1ssN9hmFUYEvqJkHqkFawSiHzIAMAoRBxCH
-v00jdQ45Oged3Rtj1bwSmLvIF4KABL98gUd6YCNLrhsi7AlLZLswiaXihOUyfUI8
-X6jHA+HT+mvQACGDa2nHXlEKeFV1ba74Tkz23tcck8+5lS8XXsaEoWIwOelYeoKf
-+uxXmnugeJ4PaM06W5Sas4sxX7EqbTFl9k4NcpY889gC1qMbcwqnSkDpj2dlN7k/
-byVviuLyqtt4okSjEfCI7gVC78sX6mVMCBeoiUXz4kweuF9zmLuHiMR8trPPVaIl
-JTvXyzpyZ4zJixXulT2nKmez8TazLHvTYpB9JjfT3ShZTWxPcAg5Nv5hmV3GnTG/
-C3msIr50pwcp8s6ET95MMoJisHsvqh6dCHvF3vKmIv6ZyfBdBY0Npx7xUUejm4d/
-i0+uuMTlDkJY2yoMCeVvpuhuOAzvlRt1cv8I2DJpRn7rALo5wdZZQy4zJiZJQUKT
-ya+ylBy5gSuSwnFAzhMY7oLNS3u/OhiAkaZFiUvzqbt0OAkrvPX1Tq2AAEbWoMis
-N+oOnBjPmg1AHusqhvEvkTrNrUnow+YMnDjE4IEAZQ1bFEN8Q1zPOetdYP6/OgCN
-8o5FQKXtfzir5vX227mXn7Oaaw8QOxoJkzaw4x8WewHceXZHwe/9b/xiAKkMprH0
-ew8ysNR4qBIK1N3ZCnYRh3tq8ohOXk8myVWEPwyrVY7PRePe5WBm6DUBVWbfgKIx
-wGi1XDbejWrixbJerBtP1i+Fal5nPOGZfbb+PZQyrCG8NOCybTqyuaXYj7JmMsjN
-WOA3NSjoOo8lHwsdgz1RZlZqxP14YYH17WU9QWo/9fbaUIck+En2xh0LPUM146cw
-6BSzH9GHISO/dDBBfODdCh19UTOopZoVASvqYer5mvg4oHLAs7wDGKIZ6+qOV0Zm
-NNMiTMt6HzIRO3mVrHWF2NcPp2sgPjOSk/BZ7LTLr072mY4O4U6mHZaWW0MnEuO5
-MTA+DBtAYkHdhkrgMHqHUv+ixKtQVpyDCopuLV70MedbDh/NuW2NWyam8n2I2TDn
-gJwb81UcKzU2ANtUdL/WhLT/mIefSVv1+Qh00DLipbLvel7JF+cGMP0vdO6TAQoi
-e1a8A6B9xVuEsKG7+ujOzh+HJAUq/ktlKql7dRqQUZaBwqS75eJ5ZGHU2KOXnNud
-N8E7SOgZQJqDy2oCR/dsZNyKI2UoxxKW6baucXpIyNG6LXCw3fg/JgQYaDgyDFWz
-FJqNT6UWr/Qc62nRfbq6e9j4BlF23X/LQAA+gAhyAoVI/jFkFv4d1SXIP1e7A3Ov
-SjFbUHIRkdCzpj2CmSrcmfNezEXs2KmNh3wSOKuuzSJhxhIwRVUGm8CJPsdJIGFs
-grSkhkyDeDkv6XBxPqjRH2GPNsV9tm6KabcHDww8Iv+Aaf5aEirPkll9fkcVhJmP
-fcD+9JBZu8Mt/k8qafiqfgs346IqW67h5VEHLQPz0vkIPfTwyJx7X0GieQzSebSw
-6k2ZLrxKN9XlYHeIjdno/7zSvVvW7HYsA7PLrA4N8rxke2Qcjg2a//Rc7DGYoQ6R
-zG2PWXOuLX7HGxdIhZcVk4/nZvdB5sfQefk6fnGKpl0o4lWVkqvGzWLh3b8X3elR
-xOJMQHV0wDCfanCJEM0L0+3WzZzeRCtnN1IKV4oqtN3uBOdmvDD8VLDuaFcsSad3
-8UccgF5+EkAeZF2U3zHyFynMJJgoa1AnA+QX+CoumE/QtMVNXZm/tpBE8jdb+XUd
-iQYfgqz6dZ0D+d+YRH142my698lv/ynl4NeS4V/fbi6LF8IsRvM9HYhE198+1jsn
-3LEvsovInNBW5n5gKBtAQu+/D0CT0TO9n/PNUPm+/71M0TUoLYjWPyOSGW4GK/Fj
-5FqmUD89FQOne8fOBCi/34vShZ300n4MUbT3qLKTEUSyyKSNbswj0i60Xp/+Oxro
-h8byGTauLkAo6WBm3fK/6HMH9bcIlqb6jdZ+yu1WVwQHPdpHspLD7E2tqKggmfiJ
-DiDz1EcxwHvMsFRP1Zm3AQcSfVOIQm77liTqTunyOK+Cp9ko2d9UEkNSJ/1pNnfL
-K5pjwghaIxgRXi4WhQXqVNQcV0A+KbNMcmmD5heqLc+yXHTk2Pz5s+eU57XZQ4hf
-6p3vOLFZ307O3X85wF833bj3G7wp5ySlkIMAm26yE4+pcGpDukYzDH0FC/pV2ND2
-AcDd1Q9etg+wDT6euBQ28fouSlHrv1McyaCVRtw3V4ybNQXbT9miyb3h9RAEhmXJ
-1rO4rAIv4NLZFtCwWl0G5MJV82Voe788me/roA7nHb6/F+WCov4e4JsKfYW/2DIt
-RMsI6idqnc3aa53Wv92kC8FQHvzFloBX8bpfS8Cx549ShI31KErfOEbv+tISEkp1
-+GpQtSu5OmlCbtxMjeg9OCSBA8/kfrHTjXUvO79FszjJBh3ijBOXT+zqNE362ORg
-w3Hi7kOpMu/PSfnW5czC6mmB0V06koPplZvPPacye9mVXwdubi6L2g6ELJhIJRh8
-wijWNu0QOMa0f5aSzFwqMC6artb0kkxZ1FzJ+y7DAAc766NcqkMS3MO1wkIcohXj
-bcKGloIUKpIp5xrKTWw04gELyANRpNHX7OobKa7F8syRrJlGbpfJJXfGa0SWl7hB
-LPKmHkZu4v3O2kzIfKuiYy/NGJcdm6PHB7VLyZ8sHdzymW4d1LVrCe0AUKa6b2CY
-vfVLDRYp7xkfjsUwRyEBjxbjS0ABXz+K1Obg3MFXvsKHstovez50VXY9behdPkXV
-RSlGaQT5XVyfCnnbTiUSgqcOE5qvkMgMJcf+B+u1E6GpUzOJDXpTRuejW5DYhFXs
-KOTvnLwtXMm0aS94Jpnsr8qtxmIeHIbk+2hNK1h6gS5ximEtDMLubT4G7K9UR2Zz
-BLwnsU7MUS2dN3uxstx1A1tEkVcSd8GiDbFQ7KD4hiWEWSEFIlniutQozJQPCamB
-2C2Y7dEXWWy2SWbztul692TxP2ZkojrSp3bEzUVuJwZoWC36FNQn1sS05Hb7Tsei
-B6Mh/t+Mf5/Iz/a2E3ixCXpgsJVVGZqBHFbFtWP+xZQMRjhFm2GAvpUclv6RpLTW
-Hjm2LuIP9wh0Z9Ka7pXLECBnZ7PhoeKb0PRjJ4wGUfYHLb3nooM/v4x+gmwytwWw
-TDGNXvthMNJhvYg0VvIeZzEYaKCmkW21e964Bx/0lZCEaxywK6/ZdcF0JlBwvTwE
-wudTTTrbrGM8oWCCYiGC7wxWNQgFT+Pj34D6U8GebWS3Ikv71gEjJKVv/LB/JoZF
-oeKnlPtX3MwwVnndBMJzefNe6xjQ+6o8oTcvRXOxuqL+vitvp88vvFCJZRf8yh3u
-RpwftUkxBPnca4AsTHbGdcy8ajbviVdecnbeZI3ZWnu10b+jWi9mJPAWbLKbXz7n
-saepMDEFWaWKg1Lfs7AN7jNcvXhPqFIeJu35nOWwPuxnfgN0UrYI8ZwdwC52nx7u
-01ZeUmOY1DIRPtSC+xIBdfngBN7+xrvzSYn3xOrBEaFGoorkdsZpcOrJ+8cmX4SG
-6JqmNGxuxZJb+j2Zz9RyORT6J0Lcaes0ETVebXoEU+yQA6gikPySUHv4DBMVv0V4
-UGrIn/53terz4Pez+DYNXXPU8LPiuYh9x5uCM5K6aXgXUmGuPk0ElP0jHrhQukK3
-r/Z/BXHiSHt/7mOexIDLp7uhiIE2MNeoJy0WUTWMwH7n7Kk0UzXJifJPQ2VwCYiw
-zBmpMykucF1zr0kBSQAJywpJb7IzGHpBhDiYUx/eJ9PC82xibnlBcbKy7pgr9caj
-hS7P9v2KZsa4nPrLDFIFjyO2lGL0XA6UOBHkW3g2em/XMzkUijPLU8tZwp9J5VKN
-TVK1D88ANndSfUoPFaIAemqnlUxNuYMkWNG8j+iJ5lVD5TlEe7WcsNqk+7yRIog/
-YlBktuyh69Uvv1P4iwaMYtrVqJ+FMVX22S0rTbnpLeTQWcsa8yBGQmelGJRlznNr
-UgICyDkhiiAwuU+G7IQiQPk12UF27kBmZkIp5qv8DiaXniBvTt4C+cBdXH9qZ5K/
-7/ywf50RLPpYPHCZhWR8FwOkTVOpu0xyereNH63a4oPoY5YMaIvU/HGe4PBH40BB
-1LL13y+PHAuICdOyvUrbGJFQBPlVn2brC8HHeYtazt0JFu56Cx5GE6mM3LABubG5
-hwCinhgXkB9NSSgN3N3pGX9DMklD0Lv/PSbLijZ+VMpK9Aa4CUkM8JVbRvPg/Fk7
-aicjF5HNiJwNZfAe2bWNNXxsp9Npvz4ZaH6QyWCNbHSTgMdcKDGNDyLQnjRYuz1b
-xvkKdVhwHWr/JHZdViy9cVqhoxNQPftg/LKGkb++1jIMDoAxh42IogNPfIkwOG0t
-JsC7+WhJLRxaIUESB7CY6FslskkmqLtjqD/DHCzWYNJ80WOro4soNxiPuIidW6iT
-o+KrXkMZelOowcBxj8fa1Mw+cx9ro53I8OK7A4RbYupd0++MkLQaT/5RTomAg2QK
-xCofc3IOgx7Rl8dAFfnZ30+D8ZY5rM5Q329Ky7sD812OZceEXTwibiTEuT42/DhX
-wkxkh6w19rvufdnJs2NcrVXw2uWkYQwVl/kho4JDdMUbdBI7YJoLOhfhpLLbPYok
-06Yb5HkdioJgGRVEbpnaTkZPD9YP64pX249HazmSdZsknSFgU9kyp/yy4G6n5UEh
-IGrPYh/9MCc+k741r04oaVGbE82NgorEJjwT0KelKseOzI5qltNQrdFu6QoGMDbg
-08g1PqeUISa699tYVPhegvxRFYzpudlc5dEApZ8YSb40b36XaivCBGBXHfIWrwLX
-HdaxAnmjO+yP2Law65N97l56JmLYfzqkU97+WX2Dy4qc/1eFrqrW6zBtInofTVuF
-/7PcadBnvMxc2IMHMMNf16NNlaVJ+pm+bNVHSFfJCOyObA2Tcpv3luDKlKjlJ3K0
-85hQmU1JIfdQzrBfAcCK1FqPYy4h1LgDR/IRfY2Eobf0t/VXNbGdkvS5jen1i66x
-Cd2caEEZ0Kq6WhzTpj6K0tyd3Tav1UBQbXOi2Cq/fvh/SuO4IqCBkXjIrDTLVBXC
-AHoDJHIsWHkhYqVC18Dnactaw7aYOj9QhMjDidQOTnrV7M42VCsYSOcEUERh1OZA
-aPqrgFP6h7fhydXMKO+Qr/dub+hY3J4mRgBWkWRHIOw2Pqn0OoJoZ+1Bz7kwMYMI
-mXwpvV1u2Fijvu0Z5SqmrKGanDwFsdHyq1yJfjBQaxw21jG72+D5ErwzdgDdbAlT
-0HrzejopzT2rIgpua9V32wTjphamrhVEjNbpqnkUxoHJRIfNF9Ip6IV5DaPZdahp
-Ad6/2TnQdduDKWWnEMZzU7UkWCHZwPmKU3zHrD+98eBs417Evm/ZHuNZ4HzPV9c4
-ZyYEEGUKpENfqSfDOUbpbJK5QL4ZLmuSDjPDpBxqLDveqTZP0EQUdGLEx0M4Jc9L
-uDY48WblD2rn7QRAvj+Be0Zed7nY9FgY0qrc8Fz0g+WWnUAwTMgz5pe7jUiicIBo
-12Pu59s1x7vCXzc8JAQSc+WGcm1rttokAoApeJehO/Yjk58T3jJuVGMvjG8o8XtM
-KGdWKuc4GgiLFdq/x8Q3ncmYwLGa4KXVYrA24D+th/4nmUAS6lTakzfNRg862Dti
-sfO37lAUo1aWJyfDFpW8nvUcZly+zlJu8KC7nucXXanpVjOhEMJiaXcohF6zHRPP
-qpP+xD+HPBIYskdVCdsjAl8BkkXSwOTaeyCuR77eFqDvhKhnaMtSqhDxNlph/zkg
-gS+620tv9LubE9vvYSXZVT6XFowKhd4cgco7/HewlpMPsAstLXS19d5UDnya0lKV
-VARZmHv3FLPPF9TDj3zuobR8sCdjGTWmYn9S35GuGFf0mV8qkwsM3AnNeJX/tO9b
-ZqTgK8FOdvc62AI4KvNnZ0La53piYkINSe+xKQYURMj9GRyLe9Okdku4WcQVdoVc
-AAYTG6HlFxfZ+ZnxdIyMdk7vEE76rK3hYxiPkoCSQzHOwD+cx0tfgiaB7sh6ftY8
-tr0aCe2yE5BWWtEzI75ioLT6vLqwbAr71tTQy1g0wgP5x7EdIkMn47cdPoOkUf03
-4a1dTuSJ57lJjPPsf0RXv1tE/iO03Gkv0VpeAvEPLMn/ObfzJuPav4yL5sMMgCpd
-ZujMa1r11N4Rfnf5XePEPoD5pLt6OjCFMuy56q8UJZYAb96p1VG+dkmHkCwm9/+P
-mD/NvM2MAJmCnXxtoOkZjN8aifhY4/TLev0ZOLxxXVPP4rqCYjxr2ybCV/dbcYTf
-jA4TsNvEgEuKJHzHFoO2gxWwyjjik4x+zVWAmb/qIGepbwGYOA53UVWPvlzgVNjW
-Of2CGHYbiiQUxQIAgeAawDYre73tQGbT6vzcjEWXpMOfpMguUNiYa11zNCMxjseJ
-YeQsdK5d5ab66BIEu31Bc+vPwr2kg5FIH1r6b+H0lM1x5xRGpXORZcKKDsUlaEoF
-XYWKU1bA9/stcZZ6Xx6jLoRkODemb1d4lynts9tSiEBNTJIWv9Pt4vxCgnjjMV+5
-EG52CxQKmii3C3D7H1JEtwhkgFhVWVFC+qhWWRgp+fwYX5+LhYC1Trq3XaOGpwnZ
-0q3eIXTViisIrPbe+HtFHgJau7YQ5aWQbZnitBVzijp2yAqUfMSZJNltJXQIp6tx
-YsVXXOxS+d1yOIKjoSkm8vcfsIT7dVph3prtmfXVKl9RJo8EAwMygh9KBI9flqS5
-5KmDD06zPz7vxtbZyo53evxqvRjycgyNR4Tz2119Z2W9bqrtpuvokBcOu3MIIsv7
-nhbL7FlzlqfyHG88Pd30qKBIqd5sOqJvxEoRyxCd5QHyxlv3+sE/kBd8iO7P0wVi
-bqnqtFrQUpNK5QC+V1/jFm2KpOrR6IXN/b3sz/SZI3oo2+2ake1Nc56IOrbnAKih
-haIy3TWEdnYrCY4LgeG+GpqoJ2hff0091fW9oVXf8zTgq5S2chlqqVkt195z7Z7l
-bDB3pjsbmbs07KPFHi0p/lALKDfqWuZSJOPQBNGNrYXNqa5yZ4bVqUfptnayQxbB
-uyEEsn1tN6oibcVFFJTBnjI/6J2+H3eABtnJexpRScOEgejBRj4pX+6shW4hDMCQ
-Ny7wy4Uc1IjE/POvAMZ7MhMwWTQfgZLqi8ywF659GOB8sxYF7I4IfzTfjYXQfFXw
-mkaodS3K05RXVlKyvdAtTFSA6C8WnwaEemJeKt8G7GEDOqy3hsuU1cQkudO1ga8l
-9Z+Do8n2swEzWL1oQUaauPGdtPn1Q5mu1Zv90RIILKs4Xy8jf+FGlVWXCuWBPphQ
-CF9+ViGAz4RxH+PqowFcSYzDyrJO+eMe3B4fzpme/CxxS6G0rjAdWP8r5xrP417+
-z/G0Jm4tL4stFeOlut/PFM95XQ6e45bJtm9VNxKVXh8loivI0AH8LdQ+VcDE/GlF
-DZ8yqWV6qP6dZ4XFfNbblvFeGbH6YBLAqlV/ymX/eat+35jFuSUO+9VyQfxukqL3
-vlm2wl2FCvS9qubtEPMBcNtvc2robA4OFWHQrBYn5OZhE/g0Sn0e5CFzzAUYON3s
-N4jWrLBoRTsOTaz26Mb8CiTtId23FjGrU8jZeBMB+Tqsidq231r1aOpAAsa/brcp
-VvkJPTu1rco2cFY61Fe/Euig6ZFr/FdJ7CKxwTx8Y7i1aSZ2CeuDUp3PYajBN2GB
-w/YnUKzoVjO3mCxpMfjIOiInjJ+O5BA7ra97xuX/c6g68WYxTCcPPlusJ4mo7su8
-opV70s/VEgCfqP+0cn1AdeYkt79Xcbcvn7Q8IjiBwOdsUA3Lw6RLNdPAE6rgJMcd
-qqS6+zWwljRCkgxyxJjWmrOIVCK7EI/Z3r77kcX5vrEsOXTVhZxrmSPaiwSf3gKq
-zcaA4Xqq5s+tEsxZWANdqFLJzrohnWxUXkLdV2pAH8+jVk/hdY3XrBP+rrfpgB19
-0EYe8yFw16Z0Tg6IyQrf782Dj63sIdT24zNDCM5ks6thkPslPQbJP/JjgKgsOWur
-keZEhLumEe4hSEYsU+/VfVaCy10AepXtrHTHxM5jlxfCDtcg9936KSawUYfb72x9
-dIKUO3jwxuYtlVZZLP+loX55BWi8BdE5A3NYSVFLwrWTaZAinQp0iD76+AB9bkgk
-rZ2BOHJ4e2vvLAk5wwNdTuKJ2Hb83oXY9kl3uVOp9gxvosGu3jcR7vU2cEeV8kKk
-+wSJ6SAPf4nvCb2mvF66ya4M12z5Dy0sbFTzZh8/ABa8+EQh8esnOewXnGk53mVF
-kp1ObP7eC8EpMK/YqpNgf0/625OhaH1phptvQEJU0KBfzoaBlMJN0b6QNqrzbdiO
-3ZivoOPyUoxHyWTnle14PqfgS1aIkDyYO/tnrBZ87NmY6rNOCaKYe09U+VsJk5b8
-R91b3ojWQmuCh1c8rD/oNFE+gsWh2lDeqnjLSQ/Hlyc8EhbWcr7yGl8k8eai4Qrl
-HXO15NkntgukO4ahPNbWaPJ6JvTRsx/RFRgk7eXRTTnc1l/+bCgMmp5UYMz4UVEL
-GGxH17QJ19snUeqCX24eKFfgTG51sabxlk3qnCrS2ugnQ/BwkG0fmDI51YJbzFq0
-p9r7GQvOne6licjnpdN1b6i3LYfnLdehV7ENSqUGHHVZxrE0SbvtHQAA2sfUBofl
-zOuETXIywYlikGm5eTZDQreOxyZUFwpZQNLs8sNw1THAk9WSgx/Jb+8eAXQlelWE
-ySiuM2dNa7aQkRjTCbJzDC3vMpsUwdPBI096ArAGHzHhETIHEUYvarXXqMwiasPY
-1kNjxiq3IeTp+EYMAdQPMlnySmuHQKwh3Ua8T3Ai0vfQyTBEaIf/xrymxihiLrKs
-cslVGsJLSIYq0PkfVoYUTAHFmWV+jRFpCICUjl09WZLZk5JjP/pAufD/kCUCYLBl
-rrIHvNF24r8JHhhCLstW6Fc85qvK6teDO1QrleHxTNyKdVOLffMNEEqwgY6azjhw
-G5UNY4JeLZ54AWE7+TEFhhwm5P+cAumD/CTpFuxahvROmQzQtQ+OBpoHrbSC6uSx
-7s4wNr8rtqar0D/NOBDWDarM9s02PrSuxR8CGNsXwNeqV1J35xuCVX6Ku4SoRdC+
-nFqwZbxtlvTiEaovdEpcN9HyQWtU53rtGH0ZtOvtvdY+RY/p5YGwqhiX0Y10/F6z
-XKbPMFeiOSrVwfqQaZZKx8uQFdA5ZwnCWacg3oaw/Se6lvzOK9Hox54fnOyiETOo
-exnpX3iegdOZ609756hk+RNOuv46EtFPzGqQoDcDx8X/euM8FbacXPj+uyBKHuUg
-My74UeSNPC49F0hbPHMSTZY7gWx2IxqFZnfPhRVv6FHXw0EDgjtHiMKa1I9eLtfY
-u6SnkLaAg3pcyw7CcgutRi2KuGdNLuwataXWtrg8WVeHYtDbxGahIPEUjEh9XpYb
-wL6+ESHkHmoD0kwbHGNIjSxYLFHes40nHJ6+tnnNQxxCG3Xxr32Dps5IrZ8GiYlD
-ZLlg6bBGwMjscWZO76Xv8kslNOsh5Oknw6fNvvsh/rW2HZrUd/G9V6KW+DgDxhBG
-IIJayDwHG6dAYMeXozppZMTiggUYAJKTijIecEyXAz+a5W6g26/o0lC7D7TA90Rc
-gjfnHqDz9qdQRjhoCUrhCRSvv09wmcRFTj7pYMs1W9zRZFMhusNW31VB8HaS6/0b
-+pHeIBdj7yuFccrEk86b0w/5JJpMQJdzPskk1Wlnm2Bubz89BKFPgCYrprta3x8H
-pLt/8e9At0592aphyC/2mEQ9jN1wjrx7hXOp3nznBe3qgZXU2kpPNlixTEu+nHiu
-DGwA5nHD3RbCnUM1SUSox7Ns3pp2VXqu/7C15P53C0QNc4EQMNEFgF1Ga17mQbKD
-3SEgtUlsNGXjP6o2fmF/bcXbVROB3NWd3ODewns3llSSynYe/hmRSFuuicqL837p
-JnwRCQ/hlyvFyBZY2aN6H1cVFvdqYP+79vU4vXj0tSIDRrkrtlhTXiUzyvkaomk7
-PeZjjInWMjZkPHZDEAbT2iPPX8x66acFWQKlqNzB/du8wn0iaGbAcsyKHZtVU+1z
-n57XrUTqANmwzIkLsBH1pHWAqlYFVxlBgh8tszve9WTG247/8un7OrS16Z0MR+Re
-1P1J+UfqphJOGwZ5nh5SzX0NtmgFx9RGIjyKIbXKeKN6/p4vX4URC+8x9hBPPvMC
-2j+gmZssoK3/sa1CKmfLcsu8l+Nk4dCg+0OjfOUJFa/HHwCKJLYCiOVm+cQ0tgPt
-oY9u6yyoBL20PAM/+G2amHR5bA13egs+c9vgkCNqKRShR+UFBKAe6UCrvSvX5d2l
-LL+1tYwjdtpJWoM2dtwwV8NbtxAy2cMarMou5HMPhxWtFmbGcSZv3WaXS/7qsmzN
-Z9wuZa4mSJfIX2m+sDQ0q7zkLfCHwAtoubS4aUfkW+9Zd8c0MMwMgSGUvVzF7nMM
-htZtmhPkVsGnI+HpgfzMjdoPqESx4IPYL7UP3IbZJjmX+fj2O3Qcul1LEYglxyvk
-FcWQZUqKzGkE2O1rFVud0k9TdbNUcJ0lv38nvhxw7w0KFYpliIfTmPJVNIfZ+i/E
-9HCsbaKg+J9BwfgsN+g8tS1yRMNfkIkhEKUxr74dFQBtKebBX4EEq8SQNRY5O61P
-ucROFZKeNUGVUDHw0lf0ECwQgxNMgvd1vVpwQaCOVuBW1rJZiuU3q/YHq1JnhsgZ
-xNGiOshvVCbwTNj1sjkynXJuV+SryAShRCq6C2AAzotp1M5MC1Fd3soAOv/UPK+U
-0dTowQ5nS7gCSrgMCOIA9LK/rcf7unz70aU0gO8NYe0qEYSA7dlDrs6LCABbaF8R
-nc+8extSWOCZYKFC64/0fiFpMc5z8g8asSNNfzvaoXHn0FMb2zAF+zsc0PqFTR6/
-LUqfOBQc9nx8zNXldrCaAppmgSdKFfMnMZxIXGV+OLKJlKhCMUX/6dkOWoE3Jtc9
-frFSMjtRSCNhNe2MAJUGpNk2J9Pv9lJ2+redR1mpBw4J9HcUTgRT9Lrhzx1DJoFD
-yyaWWL/f43YFgXNGpZ0IftNCFAXMlduEC11za8baXrh2cmCdz0Vt398HT27bg7Gi
-bQ1ZLa58yGRMgfzfD2ihB9yBsCeMBnnKhIRLqaD8hpxF0JW9o9yIUd0cv2bSdQZT
-UG3yxg3Cj1AiiiyjPOYVaXLLp/Fri937CqEVbYT8kabD4h0pYrz+qCRRRxEOAtb1
-M3GqNsnugm6PopTPgmdkRH4SKLdFQHFnhm2FnqVT1THaL2jDwD71SqfFhsPma2g8
-Wf4NYyWPFf8V2qDb/J0GgdeMKYtNgVJQlv3fMopByGplj+1WmWMsT6RIjTjl60/R
-hFhHvKz248crp/YvYmJtO18Poi7Jr4v+VeDBSdlSpR5cr1SbtULR5xGk5xmhiLxg
-hFFSIqxvhW3G7uPNAaNTHKCW+4xpCny505/R37Svztn0MFT846QDxQPj8ha1R/HD
-xP/ac9vBAprMBXuqrc0gWDFIDHME8KqKyKf+/LfQ5dTKEefk+zz5cPbxmgY4WWBt
-/99gpLQ0n9dO5veH23IuSoHH7ta0GTkBUFeusBqTBFQWbS/xr4AJQzmN+5E02JFj
-SfJ9WfX+YhARGEDNwq9w0oOHaI0Ju9feaYw8FIsBpqVP6RaJClkDCnthBkTuaAVb
-4D14h0Ym7YEYtnDn1iwY3z9slrvKKwD4gBalJruxLdNkMoeM8u9nzjt8xQ1HEr9o
-WZAQpCbWAfZNdK0XIbGBj5lAm/h1B2fcU8ukCrcl+N+Wpk/r+9jfCbtY0eIPIuib
-cIiYhIRD6K2zzpxWgV8dYF6BWxqlBbzBI0q2oBu1TkAQl3DoN+NPKLWhvaiK+ejR
-Le9GJ53YqdKoGNOL7L5+wU4uWce+GO/GdZMLoXawR8ygTIM68y6Yw+3+lls/sI1O
-YcAFrRBlJtRDXmzjxuZCZY02PfXRBR6/KBFSHfYoODMs/DrlbYrOSKuxDreSjieQ
-ogXG59ADMcARQYhFbPoVsyysYvs+3rJP4lBC7uFVCGvmPdYMnLjdiEU1QdGhl6/5
-FBsaZSYZZTGT/wge9KlKgE+lv6WuUgh1Hew+yv1ndUpGLGHdsAs/lqHevJLAU9MJ
-JpfZrESAzXvguLgauZYqYipzwQ7mcFRVVbUBE+7Bnb65De5GpWR3DfUPnI9MY16X
-4f5vxnNP/0OW70D93HEcKC4mq7uJ15KTZTYoA44yXf9aBmXV3wNsgiLhuHc5woSD
-GlCTdfCwnjHJd+IP3EfHurnRC/U3IBG1EXd8eZ3YiIVlgNPF2RE4IKEfQaYrJtSX
-8UCYbwa0s7K3tMaKOyCYSOevfZmFb0ghs/By6DyH5r9j1rLZlyFG7AJCCk2nOxKk
-ONR4NfiCgTEueVRuEDl7TgSY2SHfp8BwNB20htOw/u3Qy6Y5JdQT7u9u/gF/iR95
-GiZ7HjSZ196igQYXrstRcidsIJWUF0x6XcKfALFZudG6pisMQVafs4zeirQ/Gldo
-1cu0FdG9Fd9X0dgV4Pmy7FaEOvfFVlAqEPQcy/sYhpj5ygeqEebK2wjmTQNxQNEb
-qyGIVHaJIrKxstByPMiAiDWj0atLgLWtEF3UIIjBaFCZHoHqrXMWZa5VmsVsEBia
-HsfXunTHJgojJGL4XiCvkU9rmjLhKVHbxe4tsAYbWktCa8v4EfHv3NeXkpcyUgcA
-6h0j2WJjUEAEzX2IqOQTbz5UMzAqARB33HvacatY4U4lk98vyuIxVqkLDaIMS4Ns
-icind6OVfdmElyArq3c99PaKbYxy6Bdftw+M7IJk0fim3ANRsHKV23cHqkSf57lB
-F6BZzqaAOu/t8bNNFj1uQnIaq4yVXGk86VnaZ0Y/v1aDVvlYUUe80C2Gd179etCb
-nBhr+6XXksUTjIVSRIS18l5rbgcHYrWfxX2PSEEVz2agzePwA86XfJK8PxvBbMY5
-M5kNOTWgl+Ypdx4Ys0niJ2kv/KON6xZPA9v+bxjrJd5Lazk/ufB1wvi8A3NbosH6
-Yb7+KUUeaBPVVfz4UURl7q7xS9eLZjHNpAkNNZOSFWnGEDX3Pgfgc8kU05zlfIPY
-Sa9QVT7sD8wBtYFOThgFsExvBnP1e51H3bc4G8K/h2IetjFCB8tJQGTRNGV+gfe5
-KWNR9GgBgLkvK0kBROKu6Y2p+H5u3tmLH0g0rAjEUCrh1z7FkREelHFj2yMDG4+/
-oLEKfhzVhQPssHcLrCIexVwjlHGpvSTdOXfxEijl9uGMqWtTMQ9Ytu/X25QFfRPx
-s5j3+Hb2torwiTXm6D/O1xMfFl2vwLp1mM0p9h0LWyDF4IcRxobAa/6RItTOIcdT
-30fYRYY9DDh3elFlPqG41T96CbfpBjez6TPJStUOzWfValB2TEf5gM25W9Z5wLhj
-Q200wGeKPQaTZ75JlzCNNexr0v+4CbV3MpwRXKUqfiJQXfOGlVFhWbf6D2GFChOO
-fPWnWG3ZDvRRzX6aXsKHo2ycVrTAMdElOSDIKorJ0Af3amGq15dDt/NwUsjdzQY+
-pQ5e+Eg8uXQny2UB6sv9LYlYBtnFWzhFtjWaIEVb29oM+xQX7tXsoKJe4Wetq15L
-cWvG5euAftzBMgwiHzIwl3+XhsL2tREVTsEGHdSXCVynO1ZWoJi3dV8dkIZH9i6Z
-VSwcj3kf1NelH0o3GCM2judj6nRCC5infgyUDDe2CzeTwymqTnTqOx9AgXXDv872
-UAU0AKEXYYGHCVy3wdMGNPgt1AveC/YYZXOtyBF4pj+6QDxNyu1bWjP98MOHnl14
-avV1h0iBlqxnZP6uhQPsC1YdB9x8f9AYr9Yb4KcUnq5TXd4mANIsWF38uhKce5Vt
-2oeAZk06y9XTsrDrHsoU+/n7+0lTZ3xcbWPA3POM+l9nJRU+3nSCJBn+Txvid15S
-wYmSfmfj1gUEqskB8GzjvWD/Oeqwrl43DknSp0n80jS5Insz8JjMwaWqyPoaEWHz
-IbLIFnrHOw+S48DZJIPBQuew1ONejc5nq3wdCM16sW84g93CocZLZILWhfzxibPg
-mTjdhbGQ9atRDIs0fyEvSrD9V6yK3OL5bJfAdR5R3yuP6yV6G/dHpGQ0RvDt3ab1
-I1XM/Ls5RP+sanoaEPY6KP53Ps1GFOt9mGY2LWyvR7z+7nZte5CoAxfCoY/542Kf
-um+uhohdtvnbSipqxa/6CD5ywBwm3ZEtnhXG2sP9hnsZbYF/NnlLhENwA8wMGPZY
-PnXnQyjuRKzsAD5Jzy/l5JwbgmrYlxMGdQRPGiA39cBDqq6845FpOJSysmN+tA0i
-8CoyXHVUV6mejLViMcjMmOzVltwgmysoBt11okwTY01hEPpfA/4YdUmLC59S4u8C
-Vm3OviyfdVR0f0WnE/lhPDTeWQewaAsLWatYy0hEjBaPdX9OUG+jaOfxEK/mktLL
-Pwf4wckWO0BZ3lAroYLm9AavlwMWjrF2OTrpuhk15AVbFYA3OBBzq3kBGke+qdxe
-MxZi7wMeDleYS2E1tHAXzcETNy3HX5QEutHTMch80XVNmLU3dzLzrW5xxdbNSU3o
-Zcb4EAQHj9N3FBkIlWnbGK8PcW64ISmgA0boHdnduONXBkueZQYXSqwvGHMTH1Vp
-XElstVUy7wqJx6tPoXln95EFYjCiWfVi9pu0QTSKxCTwNGM3xR7kPOgjQCT3OJBK
-G2BTWdRb9FdQUyecTdbw7eV+Ap9OhvLHau7EMXyvpTt5J/lCiRAfrH7JkMYY4Hkp
-QRjB3097GwTLfSkyVzL9n1ElrI/bDIGp4+purKJf8JliQZU+zn0nXjeBsyVKOG+e
-r8UL6BzBjw0O7mVlLd3mvZcjncIAALDMQi66pQb2Jhp7VMttePABWStXWbJdX/Gr
-c1a0nVQTZqibM3aYssnD9T8DhgUBVUSDfZIETysxQ0/W5njv/qrzhokWi3y+LVod
-NgEd7NMS7TkoO1/BQQCci2i4wSBZfzK4PZES58hgdAW3A8SSd/rgNrBks9ybFlYn
-vBMAg0SUJqYaPyaOT4UW2D7mgViX7ZZLqFV7mPswlMRWaed4zQTCeuK4LGfmXx/3
-urW9l454zTHZyx8RQ9foQR4Git463ABVqEdVkqXnC4s5f4jN2VUkBP0CB7kSLwEF
-trj+fxT7YlCrqKi4tVi9/h1dnllFr9dRB4EeGDTz/u+CIkCxOTiWpL3XyolJ1Btj
-tNl9/0TSnk1z+QDvEu2UORU7DdM8iIFqHILzZ7tVl5q3Pc25eiEsWa9IshvJVczx
-rlgURaEcRs0AjooO9IQnEvAKo4r1083QcP+WFMz6UVs6NC2S/jubXk20jSy1TW6k
-rkL3/yD2NfutS/TETi1iNPaVrpsyaNar0yYzDKhSBK2IEFleJ82TA/Ua/tAUhiGi
-0M9eLFwYPrWp+ZgNYwj3ccwlbTuancdbWvrxnKCZaUkcEVOFPPy+ip56Nx1IDkX6
-rFg/Hb7L/tYz96nrgllGtSscmstAhuGyMtcdo5b7oYxXRZA9jU0x9O59LRhsIp5w
-BFyx8pf9HGK4Sczn0yT1v2/OLvxW177YcmCbRGaIY5borersZRHL9OtQCTl2gdAv
-NujOokWL7UmMhFd3XkoKrM8VcA8B59+0HCxSmEukrGJWMdf1RkmyPmjyfgMlcEBi
-zBoOYVDwfKpWSkijP/2Rh3NclJSJA8DVsr2iE5qfmUaEP7pAi80d9S9FamQqSFhK
-UYp3FhKrtlB6RJkmFyzw+WrgZRbyL7WXjdRoBLKrsrEW1hf2zF/hSAFEVIboYj2N
-MhgHuN25MwEA9oEGerE7s9DYyoFKHSsKUk2R2/BFyqnWyRMdkguXiVVzDiLdxLjJ
-2WlNblX/HOsDSmbKzIM+Ezi+yrY/5zDy+ZJrRXReqP8ELjmKaeloPQV3C7020UeD
-QGG+f41IXNpuCSyehc5owiEkgJsigSOFogQgKP4I63/xRcpDsjltz9KJEvdO9F/4
-FFv1d5TdC2CA5iCZY9/RH8B7YyYBKzBd8TDJZZDrhXaPn/8fNGFByOoadlfCoX8g
-2+HRo9dipCj5XOLK7qvAP8Vz77LMoV9078X/Q66+FljyM9szjZ0yhuRcdZjpc1Y1
-ZqT5/ee0cBvMaKrwKAiFWpNQhEV+GXRd2djiNcp3CHfEIeGmTpqJCJQi8jdpeoWc
-gqcT9JYuzhVoGLT4UB/igjA47BZDChRz+Ga8pBlCxzpquuUQp/xVxv2wPR7HPrSQ
-TYuy5GXGeIpglwUaFX+Xw1l0l76hOSNAVY2/gWGCC5naJhuMcD8Vq/9lF32fikhL
-VwFwQAwPFQ2tj4tDCAd7hlQCnQ+A1NBj75whWCPmhoax5UMTFH/LmKbCSdlUsJ0L
-d4GAS7bPVmlKdndZEr1dSfiOjgDRmhbdCZ2Z7Ml95MS+EGdLctsNkeOhyqdzOguP
-R8camPVAL7+NKKWQChqA04bLZCXFC+Pk5vuDlYx4CbKjjkymGopOO9P57OklPtCH
-J0bwmCQJquvONlPbp53/2qrU7xMBo/iEuH2nkix2XYb6Ui6SgZKEja0kgOcQ0/8v
-LIyyTebfoeKZH5hS9TYlz0Ez+Vvx2NPB1yTDwZ7aRLgiHCr5DPN/e+vHWvM/bgWv
-51kXy/Q7BSSCFL6Or1GYYfdK62uCXDSHDU6TADLFomM5Ic4TvmD3bBB0bpmwsmLd
-0mSIi8OVQlbNXipFdbXI8avMw+LfNNQlo+W182CmKrMBEx6HLkBQCqqznCWZl9z9
-wfGY9nwARJqO/3gtmLs7aOZ/Px33TKDZjYQT34cKrE7TbdDrgdJj9eHly3M6rvEZ
-RruCtgQnT1g80RJpqOxMrGEFHhbLvvh0zf6X7ZPTf9pJIKqNprJ+DnkkyL+ywhb9
-jEygqB+tMPOK7GbsLz0Bip1D0Dt86a3/wPNI7unZwYtWF7q/xOUc7U/7F51IllGd
-5HN1bppL6JA8jMatlM56OBIkNU+aBnPbpmNye1F5suvDIKrwjFNs5CSdwrX0B0Dw
-fpVALNbbLrZNzKbckMCCoXkJPjmAfXB+NrZp/Mshw6Qv9WUk7QqM/3LHE+4lat5J
-o5bjnnVhz5Ot2tGaWIwaoo6n5Z54rZ/C9w4GWdo6ND//qv3uUcrFFHAeKcsYOXYh
-NNzF9RzPoO5eqgELM4C7zLgveREA6Omm2r5ScwsP8HSYgOki/S1m+ztW10/E98dy
-fCcIJES7jIB998U5JK5FZ30WQe9kDE8ug6OCV0tonbaPt6M/QHUP6/mnB6rLUFof
-d0eDpWivkVdVgSskM/FRiBBQcZZ0OOQ59BSwg0ZAgQy0Fej4T0dgAZOQOApomYPk
-3GcSHroDKnLih7FiOGeuXhxo8e5rf4oaPUTVhgbaRyRVKKI4ofFFJp29QsXLfrrK
-DoM917D4DtdJpb6fJazHk8UyzR/5ZBo2FS1YdYNAQo2we3Woc7IcDefNtRkaWt1h
-M9CbM1O3tD/yvwA91nfPabCNnSmrl6FhWOsKplwYAyo5+pMEtBMj5oWBlqm16fcE
-IZNKlBovr3euGBMYyZGIqzDmRaBHsfxxDgpMy6EqOIHza6fuwlr+WwBQGM49BRkN
-OQqQdWYUVK47BqZxKq6SI2C47/kGj/YZ5ZOpNDiuMJduJBXD+igKHIiTKXfJxI6H
-x55I6feJMWLK4kjh4M+gciDNXk2wqje6pr7ricruwsOZ+aoRBI51qO/gPxXYoZ7w
-4/YeCYifrSCiaK5uGvTpDtMCzty224Udwf6bgXFMRODIZD9JkLoMBlREEaLqPD0M
-Oy7GkdrQ/f8YK6fpA7Z6y2dbyHju2F4UsC92cToY3Pb//nIaqOk6bmZTE7ZQbKww
-CEzs34YVYQYnLzAtDmayeYUyIAfpSCQopHLYmhsQ1NJgizTtIHw7G0UbbI+K0aVT
-qRdTtYkCWFtgzR2fxWiXk0UyBkXtq5vI2gxYNPO5GFMChrMz0rS1rfi8f39hku8w
-To5wHZjl6D/ah5EjvwK/4dn+ijlt5B4VhYOGqay3XODFpwjzmFoy3zFqI0ZPyuWL
-XAtB6qEixamOvF6Yu2nv3CSyn/Y1dmijYq73So0vIpq+SfRc2MIUrKkECGi5IRki
-D4TV7csC+pcYzeKrVQFCn4X3It2UA5GyDA9B09JmKBesy51HzHwVO7gctvuMa3j5
-ckTEYsRreDNOGDB+yHDPAV7LTn2Y1Nmm8i17dC/WcAWK7BMhM1QSeNCbNzVRrxJt
-ByRzmx/pQRIuHqwT1ki5kKStrVrIFYQWkIZJzCbgcOxd5FwhRzRNXF8RKCVwiaKu
-JgOzv6Hk3kiJ9RBd/AcnnHakxE+JF2YsV9qn+B/sWgq7EpQNUMtluhDYk5S61ITr
-9rAl9LFlH6XXK3BKtBrR2aKDhHAMEZH4LkyNbitM5ALHWY1vPf9+pTsF+PwYsd7F
-q8SyaJMZqGCUQEF1hGzRyGiTI+BXVUZNTWl/ON62YHU2H1fYXKvwsIyaEUEn4ArZ
-ZosEGybijcIE3PhRg2aooNK6w/ltjL7M/ls0VUASTFqwmpHrvnGsY576b+rOiJic
-8G9troDfE7tdVzBAxvO9xHA5IwyWLp3SWfcYjyulI4Zzlf0bpkASc/aZo1zwNbeW
-RYYehO1PlMwLsdID/E2kvpCBHgC3Pln+2xtBsg56poG2aBePPmGQ3xKs4AzT3jAq
-3fA2hFBYtewyZj8Ay1Mf1P6hMzciB+pnCREQynVtcNIDR2BwinRF0Lq0FKyKhgPJ
-x93n31kbuDsqa15zynKmwCxqe2Cobg2u1zxNEiWPgMrmkXRpKh9nnKB5aILCyVcu
-ZvO7e1mRFl5ZjacGhSkwVzLSshQ9Agh2lkfNpWzsTpldh7lZygll/AuGkwxY9zHC
-FbtEAaYij62CbaW3eh9OPEH3nirECpFvkgtnp6NgPTcTSnMTKhVcbgQbc33iTOiZ
-Its8PxsUh/o2F/+wmmniFbRtSD11eG6zEuGbqJ5W8YbEgnZlcsnSHNnDpYLD/CZ0
-J/oVV/GCXXESPFzGYH1a2x4MzYKs0gwSB5nm3PfVZgebmDjVs2TtnhzNetyYmXeM
-51zy43V84kgu70ygL1EmKrm+bZL2AEFU746j539G1xwQkR75BRTd03guchiWLBdt
-TGaW2cS5ba4yGcKZOhopvGO95yZcgsVrQb1ZlCfZIsAGp4RjwskyusTG19KBHavr
-K2HasXXTLw963NoaIHPGnQqqeVsu04rKJsO51A5JFwJNZu+wtpeawv0W2xvD7USA
-5UT6OZTWMlfy0QEifiqG7E59md1zWdBFqFUA8LwVnqiIJn0LcrX6cy1//ES0QgWs
-3u/7Q6ssuPrMw27/bmea5Hs2+VJP1uvQ9+utuNXxaX/MHHBRdXlPVcwjjyhOSuV4
-Zcz21u08V65XXQdY/wh3reLNPpRd/12tDf1TbktxNVWnlV+my7/r0wD1cWpLFYr/
-sSntQ4gmwz7W98IU+0s/cq+tLkKuGZTZKHb7Cld60NZggrMo+jp237iQmoincOuF
-8TCM7Nd0hw9Nw9wB5N8rdA5DNqJDstJH1bhYWtOaa6L1ObAzORKCzHMuQ8ZqeUoz
-EO/KdRe2HKnauvo4Q01xAkQW6EwxL1Jq5nWZ+jRpcYmgA4cjYTzjdIRVtVLq/YEI
-BfpJIzM6fm8ORzWMZtbelVouyCbt7kxKBR7qU5Oh5Bx3QWLi4cwBQ5qDmELzIc8C
-VCHgQDHsyG9v8a/Tykqvy5HQXD+bfajiZtnYR108KfRAK7uzJfngnA954C0dRGap
-tQmTKwn9G2zZjOQXui7w03JmNiNHnlR1T4ElXnEO2K8q7JqQi5QwvYX18ro7dSTB
-esJnum3DJVWQlP8p/ihxBKsA2OATaepVCO4cu+kRh8KRjsFEv780fUTZtj5jY2vf
-KaR+rr7EjdS4EiwqKYe9l8Z5bqT+FrBoY3S/uzRj/Tm5XLH7d/UmqX7VKGm1mPzB
-LtV5JfZvdUCB/0OT690twFN9/iuVjuk4sioQ6y6FXrSR/PUccEZ4tJSMNOJzgwIc
-r4xi6eze4DSd2DkxcviaTZ4hz2ciHCsp38r2OUYO0tECorMCfc7pzDhpgEz0s24E
-RVok7Kdpo6yYKNzTjads6EkAWc8ZDT39Ww60Op5DyEytwOrrkBhGvee4JmtNZ4LU
-/D4yhaMUUjfS5epU5owg0+YaUfLnRl+DEah/oWhRkRgUjILx+BJw6j0zNwWiCKjr
-6GBfg3+P+6GpYAz5gnq5hcOlFYa1T6FouNf2lSf/9C8+OM1ViX6pBJB2SsGyd4H0
-EP5RpsQBj/qaGQ8KyzdAN3EFQ1pb2cFUUAtLGFLAPaWB7o+QlcTQ3vnGZ1PWAP9v
-LEfwQWwQtq+G/nwkyDqAqdtakoE2KfvyJmLM+yfpuUGtc/Hp2jxPsnAgANWrqJBk
-+m/NQFoxrG9iFoUGxP/oRmOZPvnz0/EdpabwQAO8ywPcLd+DqYPmJMxOc4BHnrwL
-/xdeDdxsL+7jNqmJxilsJhtzbshRiKEky2U+JeDcReHVnfiygZxLhlzdgX9kEpKF
-Rj5Rgx7t7w9FLV/Y2BHvHCLSZGaMi9dOve8Fu1DvHbZH8J4IQVMg345XUL9wdBcK
-v2dHzWFt6P4jV2axQN+JMNKdGlj50oDgFUx0k1px7JadHt24XACbhfXXP6bAqOJz
-7zwmxxcrmBqQujKQcBJpM6V5cSjhx7YC/DJwM9t02Muc++0P0KskmwOku4yjbR5s
-cLfOtFISh5zOVsYpEszX+4VqMJZjBqP0Ed/8FhRJmHumsqtFKKj705oL49FSpW9V
-bW0uQWOHfHNx8j157zlf3Y2hO6c3xqKJkzzIuyWK3mgqSI3knAd31spR/3pewATI
-CEaVWKpkhUZzyvaqMKMMLIBaPaamrYhH1CswAeJAx+3X9UkFdVswaCa/SSpL6lWt
-9mJHkMHNRmizFol6wW92BdPrTnb3xEea3iDTe/sRsQJ96v3I0+vgEyZlaCxAh8rw
-D22Yw+BstZY0/7tVdV++q0WsOHkBpQ4mImtUCQLiybfeN+hk5Aat+XLoT0R7IDWD
-llFWloEoOFPtx6BykyeUXHLdZ6vF9zs+q0N+g8+kViuSaSulmq+yCZdvhYQdxYKs
-sW1AYxiu3kFEVBND3ZVc4WiLsk7akwerGTuJrGgf8PLPycETvkoLz1SyR2bjnDPI
-dsGRQ75pE5atiXLXD3R7vdD7MjpidP9KntUItXTtf92D9Rk1Wud1Ro8g1Qk8gJ7J
-B6dvh6QWFhnOdVRkKvRkK4SGREpFub8fxtlvge9ov8ggcFs65Q8Yb+2gYc24CVAq
-jVOiveYTuKuclAPfisY6PDqx21VZBYWdjjaHjfiXpr2K8r1diQa/dIcSIZrDklEi
-H0pVgXgG0Xt0HjCu+vUrhabXo3u/IgeDTFbnOgLQI+8FU11d2NZ3DoH0r+aM5T3J
-Xa87IBNTD2J8KNI2O9EqT3hZ6bp6P1rnyM3KZX+iOZRtdXh1a59yddRFNQSPkUpD
-FaGTrNzd3nGr70a8EW/HIuvYJP3+S7lD4hKpBX28m9nNevXbxgtapQ9EznpdAL+D
-OxEJpJWUObcgas4GY/TmDQx2ZAW+sGOhKg2coD1SW0m1VGAxYO5Js1ziqyVwkEH3
-N2/QQVU1Crk/pn5AibVlA30y3vn2SK+OKq7xVHTXkpDjX+sIVj0h+iBIQQeoHPJs
-pyJSxmpT5b74w7GbMi4GOETQpgnzRcnDdtZiVFyLiOQQdMOojZildHpBpvbG1uZg
-FmY/75kU2vHB45G65PZ2wi30HqBz7W//ErnsaY1MsZ8wvix58oudA6HJ1eqHJ04o
-NUYef/6ALjYi36shQoLJKMG+rwc03R5im8mIXX/cCJEnC1/Rp/Wb7VwvCzBP6BGT
-QzP63q8YFPpogt2orte8kTRGUztCMGJbSR+102THw7ol2eg2hW1kvRsc2KWJxbPu
-bvR1zHdspMHxyugDaMXZ8SMDE0ucXxjm1hqtRo5OuOpm8fDdXXkHh5hR5YusaEqa
-1qWK7QC7XV0uoQyZElTKiG5uCtu4TOK/lYtlSitPNvDDbSKaAO27AUyUnZrHTZWZ
-7sgha3s3Hvtlm5dmSPFgwwznaDHgjckNsbwTmkzN6S72PM+aj5WbIgzfUDtuYEgP
-SC17GPegzsz6eYsjiaKgjdXyc3+M4ApyJmmkimO1mV4U55c7dp2Iq1P8wqlHC0YX
-41mQB67n3fiE72qkwe82ycb43aS/lPcf5Ytt8qhWkurGuWmLzOH4yVdp+NpQY+Wb
-v8++ESVQJdyiORY68SfD52EmoaCbKfz2By6H/NeJPUj2b+AiOBjIIcx6X38JGUTv
-H9O7e4R2VN9iUcYRDniB5UykeiLiIq2PH18PAp3WJ4JwrIwdi1fvcKCxY6lqRKGW
-g4fwfuYhn6/+fkT/3PgVrYsy06HZigDtlaW9w2ByrvA/L4gcYt+ulk6zY0TnR8JT
-s3pqBTMU36wcoVxs+hVZr6ByjJxvXHT7PQKAaugmiJsuCsUnz4lapQWE/XhlvKBQ
-zkPJnk1+BxtQ+wuQvxCF2ZYciuY58JzP82JwuHf9KP6d7AAn9awh14tCua4xwRrX
-mVN5BgX70qhyWKn6x8PXpeuh0+gONyiiHEx/JkM5lRyx2swuPAlYNYosWdXBMQHm
-HHRbL5rwVngAIzRp6zefukyEQFnSL1O8BVwlTpqIl9U8BiTM3kNlMTiruXEeiNKF
-GBuj0dB7q7TxQ9NAEG0MwuKoYbUFr+rYYA6F8IqS+63kOSPrsnOBGinASfXD6AP8
-VQRclIH93TY6lfRX1hXisbFljUFHIz/N42L2t2qLiVymNxf/PuBHfDzPhi9nbagG
-5KFbmXqoDXBdTr4RT3T0r8Nwcoc4BJFHgB2HwAHKnMmJ40xmD+qp98HoWReuLX+O
-cAQenCVBfc8DJPgCWRVfBiEsnAcQ2ZKdKzs6m7chJghYikmaWjxD+OsRpye1zkCA
-51IbTYjs7rVwi3LHY2NQ3NW5CJMx+Bg1o3oFcs8DhPLDCK6yGYNJoNYboAB1I3sv
-UWRU/EYItF5+PJ6bZR7aQIODB2Lz43S8VDKlE18NEJukYk5OXjZ9Q9dJCsMw91Ij
-Bok8eygKQ/kjpdbJxmt0PIsLLVXC5nNUaK1p3dHihd3H6sB1dx1ed0TouSyitvrt
-q/AJEEW25OHx5RGUc8WmUKHUBYeEH3cDPRwU7mtMvZvVluYh+KV5fe2C1OqChRAe
-P7LMP/o0QkzeDjZEo/+xkP3Lb7GSJ3MJHaRovzkpcEM/lCXuuX5OnPQfrKARaBIr
-exwwR0f/wBr+gaAgPglBBm2Tfi5o514xCwrFfQE3DtRRQqOphuwki4JohXl5nmB4
-grTXkqUf/I1wlA1/Al5+2VzU6/IiaS+olJ/PQgiCZRrVP6Ei/GTxaeOmLnjJuMXy
-roZbdnJppgDDBmcnmRJJvmmGVvvMdKa3+AGT2On06zrPZpTDDFTXtMlH+DDKf554
-mwdScazB2i5TYfoOwK9vV3dz34MNw/MmfvoqpBcFA7/EZNDewOnqcnYJzpfuqo/0
-zPxONOpanaNOF3yd5tcRymR005VvkKxzYzJ2YjAMf4UE7FJiR9cNhl94IZldOAHA
-kVIZMXptwLTwUUUiEYx5mSqKrHq0zPSc6VTcaIyJ3AEGcweto0gCof8EAlC58dkx
-suQYYhC8QwgUNre8qiczyadHkXQpxAr7Mv1ECIVFnYNdxHixyHr86sms1An6l5Ot
-v3auXak/47B0vNHcJUp0ZVSjchXrL2LOV3WD0mD62GVvBbwIkskl9V3owy2xVBWG
-cg2d6dTgmXH1lCx1hfwaWB9R4MeTaVbiV8uyv75mc0y6GH25qByKEYT4M2vlvRq1
-5mQvW+Vr+/oeOiDPklmWNdnAKrlvI/+TiMYCVTbCYtwsWe0E38PJ+hbzakCYg6k1
-IrgI+RqMNb071Vya4WZq87/qyOvfb5O2vxFtiDK69AHR1JIZcYubzhw7dbFaGAw3
-cV771skzzdQqX6R0iaVHYgtx+M93UQgcswafMZHTkVn0eRqwGm24Nq0ErTv2Mkyn
-RiDfpCj6VPHH/nc3MSA17Jb6/mVVsjgMOau8Zg+pqR8wECybDPomhuQHvi0jUyFN
-1BfB0KPgVC41RCRz/IeuWl8mr/ESDELW36INkEpDdMZEt1yKiPAT5sSC4fa/VIJS
-hjaPpeMN/59RJ/BeubG8uxKSc1B6yenssTQ7y2X2JW0OzDq8jaHcWIzRg/Wevgl4
-cavP+KCZFU9b2SPFnllJrcoYN3Mdfv0VcCfE8rX0C1WytuDfmVF6Kpjc+KRlJFDT
-dSCj7/SR1d4xDxhx2T2BlmpnidR1WdTNx4Bb4q3uhZ/GXmoSnAqPSEn4CI1fhhgZ
-YPdYGEy3fx86IZjgGGtv2fxFHcK1vTcBiGDoUIrLeZZfXdN2xHoVtklUfAkVPsJu
-inVznqaX9FbzngzYEsRxDCRHJcu9c5wehmNSGILGGjqLvhVeJPvBFErjFQA/tU0+
-7+WuSWpyTG8gkXBB50c61aNy28sdcsBBsoG2kbIZrGHUcKmWY902UXlCQbsDW0WW
-SDE3+IolntzEE7vKaiDhD0wq21ktRZU07eglbiaxm7ryzwjVm8ctKzugXW2U/Ih8
-um/Z+uHVN2HVPFjRLDJrh68Rgpz8XcJMgY6BAPHRjzNNREH7yVfYYaxSsV7cLFQ1
-wmsQC1zVAPiq1WORG2seLbrpM18hZmjKXXoGTfg4T3VubPgwrdu5hNDPaY8UetIi
-KS0PS+XWxOeTpY+4aZK9Y2fbjOUV4ZE1cZAnc1HVH940FpfyJ3BXYz9+DCcwCDMs
-DovYXcTPZ/FC/BflXZVTAp2p1nzGKU3K1z0jD3jvrt37uGAsKczXpd5C7JYlJYEG
-Vborp33rRPK8KXExpcdj4bkn1DJ2KAkMHaCFv+Qih18yEOj11U6xIOK0UZPcgc7I
-pAelk/QXldmKEP4s81pnW7WmipcZfpPU5hcgQ3JE/Eqf6UYGcqsSgpkd2Au7AQDR
-7r//zkYwZe2OwGdUmBHNOrTrt7915RrshoZuoOF34vABUSRLfJ2AK+NrVnjpziql
-QYrdMxM+8H7p+2oQh3xOwNLYByR65CQmQO2rFSkU9SDoCEAxgPjVSEunagjYpGHr
-J7cdG50oTMbh3vMqd7+Mi5HwWH1tHUBVO/E9goguBP7WxKB5cjtoAM6qW1dFo54Q
-CYuaG1fugOoXstfsHdYe/8ABimfJWWXWvV1WYc0dViA+45f8KnqWec8VPheY6pVi
-wWWvuHINcslJjluUI1NrXQK6sZaNz7nfF0qXcrbSDljkbrj9v4oq61vUHeVmPATE
-nN0Zu5iy+kZ2+98iZYRV8crWziQxUZ1zczYPx3KbwC2z16OtxEiMHgaJ+5QtizE5
-uJFgr+6LVPWg2MZkuzu3sQ7m9GiHXWsU3oJu0QiUoSkKH3YZciSPijnpwTBh7sm7
-uFJ83zmakjohApqzVhwHFWbiDaN7nzxp063V3vcalh13MBScmzePvf0m6zYLxr+x
-fNqbYaojLz7BC9uQzuCbbS6ztOp1aN3RG2/c4Xfhl4cgdmcoC1CDYnZFrZD9IE9k
-u3oC8aYtER2K1mXASCP9p2OTRb274nV9YV9SAVKzppwT2kXfQMVY6j8mqMFIkcTY
-mIul21w+pIPJpY16n6nYl0u85PczlZ4zXWWUOI83SYiCa9MG1f5y+s/7anaS7U4v
-ByilYWww7xYDoG7IjbPwIRb4vvL4bMJ81prZWX5gFS1q17Nrkq4b2Phx1sgB70u5
-by+Uopa7mZeqnHvYJVvjLSCKQGljtDa18Yq8hPHO93mtwCn8gT8ufaOBQW0HY6OY
-98hifwCOKaM1pHfeP0VMzCdDFd0bn6fNHE26zt0/IPQRZfnLK88zU7DqWWXHTXEk
-4eBmAYaTWYoe2R84U7HNU1lJmsWy4OxH67fy5IyGrcJ7WkGXr/5a8BlrfWq1z8B7
-k4cAVmp5PI+3vCP2Qg5Z+aDARA5NZZeqmOX2is2aNyQcmRUmOkTBzGuOqTiYmX9/
-Q9BATR1tPG8RFOyRiFP8qTJe07qGyAIvkFb0uXKZtPZBiToC3b39Krd2PR6DLI9k
-ga2nvLNsIWeRH0eRaBEdxGq04/RjZlgO15deH5rglM1A/gVXszB+FsuvXdzAeou8
-9Ok5yDfkSpfdgt2iVnGjv/L0owKeYjipkbcQFmNDh+AA9H1EWCEgwziSsEd8dBiP
-VMOlI/8BHPWT1X7lyqjN7TcCAUJuwrcrUsJIX5D3hWpN8eZp+3pXqbGcqhVFOOVa
-NEYZSAjqNqhg0Uto6uubVn5X6BNCeMtqkE1Ig4A1pgn9SzcU6gFs26s5gG8VYf7V
-fzRw3dzmjBV1+GfcxZIcJjOYjOUjbieKOynSH5QHONf9FHtePV0K9gDNYOwSJldO
-EIYfBAmWn6U0Dsb+Cmze2zdaD92G6csnO+wiBSXMM/zXgkTM85qc/niRWi8VuavR
-WhjbxKqzj3NmEErj+GH9Z5cGSBLSVl528ss7TzLekTCZjdV70ZP93DS3fFV2rdeR
-bMFgAmKZS9m0ooMn6e1JSdss/tOoJP5qzdfaseXHqnq+UvsQ1j/oyvfkzfxwxw0l
-N497NiRTI+azWa4BAH2BGv387xTK5XsCGHRnNPaFXugIhQqDx8xrpjdVoH+3hLrt
-ibDEQJdV9Zu/5XhYKUML5tCwsGUC1DXLXd7nmynN58FA43JirX6tU+DIn6LWdsb0
-HWgALsD933DBte/+cOAbd5g1jfuXEn6DG6SkdGXnHjpXg4SRuAqdMrnS8PfpQYRo
-7HFzdjcylGohxGX2a3Mmn9z69SG1kJK52vYPbdpjOs42xrukIwcMerxoiO+zx46+
-61BIHjMfkLdCZCueuyctUNp4JMXaoda1bgiKE6H58+PkI6yjs82Aim1OlzzMqALC
-qEGsnaidy+wzDHKVc7Lt0mIkz5NAV96Eb/Kjp7LyHkbL8F27zhYy/GtzAiSgTGUW
-GrZM0G/9QgSJf3jpsQQ9HYq8TDU7SZUoRXOLSnhUR7LKNs46tR+Moro1zEXINtiM
-81rnI8tLMw02LYzMUweJQLMHOsKfHcv/lz56knkboRQgQYt+ziln2D0+uEifV34X
-nwnFL8NZ6fm+0VpEOLY8skJuTSNIsavK74c9EbFUxwqhivJop6GGMcGxHDun3ir9
-i5G8Yqnk4pFtqqy8zKgh9e/P96mieW8Tiat9PGwg3LpSj62YRdNibQp8/7Tgaqy8
-fuvMnEG2u6lv+ooeSiMlg6o6HoJ4B0k9nSTfcWdqTT11zxSzSPrnx6ZF9dQwWieU
-7jwO/SRg684J+tDXHcbLPl6uLX3Z8o2gKhajoxbghBoK8/L4VEYNfmEVjQCTmRo1
-bqDUiUjSmoU0QIos8X3ih8I+KXxlGrsyNCmT2Eb3km6f8LroeO+R98d2gqsFnb9X
-cq534IkFBX6x3Exw2pNGPMgXdqWWItBZ0nZhbnxNIwJhijBjHXj4mi7kxbC6VF58
-IgkTN1nS5+7EZcrpQvAxVR22U1MFrM+2/PBN6NtnGhfxL0gPI0U3kerBuVdYibrY
-p4d67y6xUTArs3pgnuDG/TuGx9pUVwZECD7+q4yckjuItbQDnMVP1REatKLznf33
-pLD6hYTVqAN3wyBDCThKPu3gVtb6KccbofDv4+MC0UHmMBTyRh6Rsh9pfBn5Uf46
-1Cs2hDjAD3ZrCNRh+c6Ut6x2gPm/HOD8bCKptNWR9g+HbiOM2ioa3OehQObSpSRM
-PDp/tGA0gW2/gk92oHCUrd6EXLPnLillAB7lvI4ylyDCCou2q67edpby0GyNEbmf
-boMDUulipqwCFqLBJfr2j6IKTnbXHlS5k2COV45Q31jcrs6QFJSXWYT0jNvjhCTz
-/YpLDSKyMGjtD5MFTXooKQyMcHkmALkVvV+ktMGAcZXK+0FCoBtH7hr9s1g/2B3I
-PJlrL8dX8pi0A8xSZ01ZkTyJF6De0uOkyOLfZ8dt7rGzEdyeaauPtRJVAFfSLLMM
-g7JP8nc9kPGXJisCUmDEUY4rtU9bi2goloNk9VjAVcxhDPaC4C8dRDsTVqYk+ndN
-KbAgr4TgEfha0qnycYwcvZtCFCnUptO87JWERauuOompXETiNfEHNhNTHv3jgMwY
-svzOl2HFqN3I6v7pOPNyjtyaUaegEfG74k8re2rljsc+zVWzA5ClfJ1zEOTVUCzg
-XqgfA75eExxsaud7eBZFXYMDFd+ubD5LCOTJzJXbDkRjqP/re3qDxWtg0gj3yxUy
-+FtyX4f1/Rr1ZrQN1mAQJ/tyFlqWci+mAk5Y2xDAVdcKg1xQYYhh/lbeGJtVdIE5
-C9J4jsi9RdNLZKMZY5h8gwgatcwakwd2XwHU8ITcp2xraYQyj0w3uzBx/7px8eD8
-QWGWsUUTNycs5kVC0bVaHaXRYiQLAOwJEPKo+Bc+PuZ+F8LGPXh+GhOdDoSyXPAe
-WxZa0b+KuEHy05Jyq9FPdx8taCF0DEOvoOB45KK4xM3FezyvLKZuxVOPu9nmMmDd
-iFrv1+ZKUnxzmZB94laq4Gal06grXCG9DoQOrgH+5wHTkMJB6BBluTyCYpQFvIRM
-HureZxQavU/smWQQPhnAzqqUbHNMj/aZOqbcl1kHHMYvHdHBiPgcaeR+y8svf/uY
-c3+uMBLLjEvnpXtqt68ugt1B/T+TVhSplFkq+jep+ht1Rj6Rv8kJPc6wrvpHJl4V
-L5cSwFCY9EYjVRDbaJ7UWxRxVfiAH1J9A8Igs4gM1ho2DP8eEbcZX9nb01CYV463
-S52nlbOpg791GPpsjwtwvnR55g83OwDBiLLtWTKLrp9cAM3NdqKlQdhny0FbvURM
-AP7P9Bi6YI1H0dtwodsdCtlAwSrvrDcYD2noU7BEwdvJ81YrzVToWLTOHXDqADDG
-77NWLhJfhG3vGzzGCUrFIganVmMtHl5WpxDYUyRqEYjS4Vt2CpUzL6cSTq3tCxE+
-ZegDhc/m9UU0t5OAL1c+69cUVSywC4KOeLLDW8XKcJ1gT4vxHH2jT4rH+aZQJcnt
-hzUfOxdU+tJPMYEhcQulxuIxQAMXNX0Z+AQC2czv8DxjYEMuNxBCmfQW4PnIkD5g
-1IaFzFntXhv+k7i6SjvrfQfSI0QE8pB0phVnxgtAnUVx8lkvz7xdc6JXDLXV7yJk
-QqhqjGEyViln2/StEmESCz1XTNbH/cGkhliROkwWWfxy8kkeU4JmUW96JTooBDG6
-c+0zxxJCMRYNf8yN7UcEmMkKlyrO0A02KMFduk39usgMXaeiBiNsBChVJXPCElCI
-4Y38m9dT/pQPGIisR6Ux+tIcJftcjwhlrszhAacxaF2uw39Y7YUhf/yguODHh9hK
-98jP4fcv5afyEZiNs9WAYD18Z5hoO4qEMiRrtXqQnre/2+51l6/8tedB5XVpesjY
-m4Vb8q8/uz68sR1fhW8XYDqIq8d/zHECow80/TtOZC99jvXLsAHbdkGEPWMJ7lNs
-nloEG/XtqxfqzJZwbVDQ++YvwMaYvMeo3TETrp2dK7bZxtc/0EANxvZOQOa1PS1T
-598hnl7M1q7DOourJmOLKQy9PoBPzKOSug57jM+ghBBehuqyg4uVyYJ0lx/cRqUo
-CIjoDFiHK7WXGClK+n6hQx85NHfTaHZ+TTjXk/D6M3Cz/7DFwbA7h3J9UdErXWTu
-Zj77Ce3p0b8Ftf2g4hJdYjOm3xAhaRN1rGpx2XXiBsYIK+kkhRgIioOLg/qzVqUw
-abLi0Ihu7bvIE7wMTUfpY9+sNQ/vsBGjQvGbpVNMnnl61wAvTAzXfWN9/OyE/Gy2
-JivO4lwC5W8FuM7tr//uM5T+WpqJVaDHEsWeeqeED6ZhrsCCkNqzwlBLNTKl3Eg6
-UADteNlJLGTPKEvvl62TAK80jCwAbqNEoQDsbyDD/hyQt/PxHZ3efd/8PSUN6tcI
-kK5qbFCAPCyBZvdMWXfSSb5Cm3pamh0xLyN4/Ea+GykjUxGejBmVCaFXr4LCQBbL
-X2mjig56BQL9WIP6ajpmJceUPlju8medEWD24bjyWEg3ay7wMHpGlD16Ecp843rq
-WQPAfwYs5qEo6EuKbx6BN2D7r57DFR66Mpg3fBSM6ETbKhhzYxc9UXL5mQ8rls+e
-kc2Hy5E7ybFTeqT71don7tTg5ovcPg+f1/U0QPcSj/bmxoO+bzpvUe6HsXr4NCxx
-PgIj6MRgaItHIM3pjwxMdDCNxotnWC7ZsmhwLrfA1SLSwkFXjruc/F+f0GO1zoHL
-7ArDhNccok1TfHTdiEkVxLYtrrx7mpUPw/6Op/2DQok0hXhPmpv31sa5WTA2tWOS
-q91SWbsqoMHteU3N4e85uJZ4ZVp2yjEt8EKsxh6anJseeHQZ+Yl7YZCPv0C8wEBG
-4P8Bz2RfKDTC7M33yp/97w4FcuKp+1QxpY0NwmEh/jNiE6JQo91XHiJ3jWl0wAMb
-jWbQl4rn/sJzawdlju8Ynt45t5GyHAH52cuWAY8dGtbf4cJqoqQKL026auR1y22x
-jjL7dQKd/Q4m7FVh+TwbBgH2jo3fTA7nFRfi8MgChznHKFKZjQRKN3PPezDBEVU/
-4wLAjueFnSKjMUDOVMndkgL9zAZue500Z/SeZpls0XW8imMG6PLyALZjax/WCTrl
-DfO/yy1zzQdtSLf/S5VoxmEOL5oXPrWqv+wfr1UovffhK9lqT4YN72gouRcUDk/4
-j8hdLtUfdKop1KnXHUYDOqJhG/GSlhz8slAdcLJnQNJU+EdUG1i/g3wEzQ7Hp2et
-OsIeOFxNffek5MoOt1Sj69xT0UODsfZm5ah81ZFgAZWkeoRXqaFYl/1weu6rY7pk
-cpCxNsfUS1oC4eSuQeLlzEnx8ZAPqKTUitdy9piSQ5dU0/ZdKXqU8qF2Eel71nPh
-BEoS1l/Z3dR1B/Gw6RAidsruxHqBrE8a7mAAHDNrjFKpCJivsYYyE3krbv/wKWfQ
-/7AAaaDnG7qVdaKFAP4PzQe90VIwsvaP55sl+kk095XZ39BYqa4Wp3LfkAFlAN7m
-wX7N4TJGUgMFnsiM8oqcnslmzB68HNrVFyNyjG168L9jYXPaEeWZdVCzvBfehfDd
-er8VRf/fneMnFeA+YgabMyKHW7LNpcEXhZBBjO2LeWU1ka3k5KvBi7rfOhuM+/ni
-ZsSvzqLdRglY/Se6G3tN4IT9poBi/h5Pf4eiOs+jwX+Us5fPxmcU+Rw2P4CLK5Oq
-USQTQgOat6zf7x6wz7c5SVnuR5mJsxs8xOv2Y7iXB62dM+fhvhNHwkW73e3KMuY8
-7s1XfFNUrx0S42/gzcWx6w6kba6I21vlCbHzTRztsvNf6X+GIkJWayzscsLYrVkV
-HIvSRINqCKy7iXuWdAEwhynvhx9oN7me0YCDk8e5DuG9bX0bsvHOMpRvp68DwbyP
-SYRhk4YAfMuFk4eTWzeD0yQffS9uch79oxVA7RsKMqY9sDSav+lp/VKkUyMg8tB2
-CJnRGVm7BioVfbsHMt8BNixuBu+aKm0CoBCci2liODHt/XQ/BX3erjBqqmTFbQdm
-UhJJ39ZTKRdMYb9SqoLUpjaMoft0xzBswf+KmoYw2iVShJcplUbi/yv3aLiPrNcl
-naU0R7iqIFFTdWsPmr5X85Ze7l5p+ehBQq9Fvc00Od3uDmL9J9A7olFzmv/8qZeM
-XqJAs24k6mGon+BRFMEL1mbNiSBKQ58RkfmCo9OemgZJYY/7gf+bziCCK5YGKl5C
-O94ChB3LbYY8XKII92n+tyOhyJQiATGutOF/GTMaM5vXszy/SpjacOV8nF/+CrqR
-VSOQYkWbYP3V9/YfoOnuJSWmc5vInA0arSufyVvcjK4S08DqvzkdB4vF2g7dZhh/
-V/cziUjW7qxu+UJ79U5Rj8ipu4oiAyEeFys+UuQlHce4Ps3aEytb6PqB/gVHJ1O5
-r829K0udQ6mjClLDrnXh7gFw57kHeSX9rMvJI4LsOeruioOUcNiIBjFWMjaO60q0
-Ipjd9wE2k9KlUD54XOVtGJMIyWMx2dw0l8eZJXFfnRyAy7MCWhb8qJ7mBpadmUn8
-OA+6LW2bdpMNsj41HCPvrV7eV0nAJ9+cSaf2d1UZfTWjO1ziw6cVi/JIg/GzfDCe
-ww8Srx35hYeoR0vT2dbA7FoAk3/lMl9e0u/5AWA6I1K10NlJmL0eVBK8aqjNB3T/
-s1LaSdT8fpTIzKd1/Wo5TiQi1US1QQmTiGs5ZCzwjQ4ux1lrpFzwhCPvqVUBGbub
-vt00xVt7kya/ETYZ7uZPOezXPTbIvPcFW4tGGRs3XnW61jrTdn61+oRDRmCG3vAL
-Yu7AV/uu89DlkOrxfbuypAjVZTBm1u1ioca2+AX7wGzQhz+rSbdoqXsLR2bmj8Hb
-VDQEtrnzbuUWUQ3S7TACvSf6ylDG99r2wfbonhjU7thS6R62JGmrNGdw08qN5PTJ
-X2ybg1o9crw8PrKjk5SYgD3pMgQaS7ANSocsy3V4HNX9cSmBvWk9LFKSPulrvErl
-DR6qI/PimoPVPhcGy4xanvBtXN8QzPpcMQWowF6ps6fLGceLl7lJtzUb4rjCq0Cv
-fI3fJyh3etIH8chQOwTrQWW3svJVZdYXzg9WA5EJkVFAeoZEXyFfrxg3lf6wLEdl
-ZuOqxvcuGRkqSL5QYFqyfVdt4HvqNfOxyeGsYm+h328rTjbvGrgVlsHuxPpQZwo8
-87YUId5F7fkZaRrmBgaL2K5r5Ruj5pVfuKSMaQc1BxRg9lQcpHDLqmR1txdVpA0m
-7U/8u2qrdswBmLGWIEbzS0zfG50Pvf/wxm3kz/JnJeBzj43KhqhgDxFDJePuIT6b
-9mG9NvelWArkJsHscTl1B8DB328aZYNXBPTNQx9c9pwjyXdyP7CVgdo+F6kprk1Y
-qkmQn+4TDLnZC9SBlywM+ulxykpzu8wnAPloMjx5++KUf82+sys0WGuBB5FZKW+S
-prCREWx1FX6ETAQdHJBpTEGM4l9z1qt/FhLyAPAbIvEC4DaFEI4/DBj4vJDZS6ke
-B5X9u1oJoS7+WforMZenLcxt9O7NAIIS5eIUXxiFLkCR3K8a/ZZj4tLnhPBpTV/B
-taszoTfGfbnAbezwaJilbiPbdln2++qsqt7SzBHmUJSAsNDMQCDq3GjYE4l/6015
-vD+AX9eKwiZpB5+M+MLcROuL0l5TS/nVv0CJVz1PqB81gy4Vjl8WSXFoQ6a5ncNN
-FbzNfFc5PL59b+jpS1jUCEMqqe/aDA6rCKSTwdSVH4iQcv+LSlQeq1XJWNpLnKz3
-d5670re28WWJXNtnHvWlI2BSUvvIQcW5dQ9f5Hx86jbY3hXm7nKciLyfDjluDZaB
-o9Nkvd+KL457+jFdnYf2eCeIU6W6jYlZpiom4IKsAhsUKhfzjlU/mfcvROcfE8Wd
-e5Rh7LjPhe0dHZPKrc9OEHJEPTqypOAeKH79ixWvL1EgoQ/HDcuS/yWXkOQ7iAmq
-3ty0OeWHFdkOkhdaoz93ZYbWkBf1Y4WcaZSuu8b4qWZBh1YnIeb9wUg9BSF6pcxk
-VwbK16rPo+rteYetmMUZl/lVQHnzoMuLDxjlDiE2j7T1ZZk/Q6iQBvoV91kLrCbb
-DLOv3MFbhuF2padWe287pGHkyXw1Eg34gjUMkMKO2zYqx0w7mT2S9fp9wX7q1nqa
-ps298+3WUkVqtTz6xcEXd7ZrYEGMjeQZF4hJ71cnIpzDvr3ozfDyVzsHIpPyr7mt
-8LzXfaeNIq5fOyT25FbEFto/jYDoUsFZoVpq58k6Z7NySac1SnuPUBxvr5DkGwOn
-Gi60oGFSGnt7LHOffsUsysaawoQfT10XjyiEqCXI73f2dVaxLNCuo/28FbooqTcF
-dKqWQ7gK3tVrq0BX322Lc4Y1/dFEQ2v7HZFdVXltWPPFWHVUnMkr0dA6hsuKIVYN
-BZ294SA752022uscA+PWUj04pT3T7OvR/WU7IMZOhk8UjqpXlmI4QXfdVhRthC2l
-fvMa0W6+e/twTtPCNgGD9t69kjYbd7HXIHCzDPX/v7eNVlhW/eOlIxwI2JvyXZXM
-QrppMuqwUTxGVjOfoex+JftUP+Y6GT/KXdd9AxQRjXwUGgtbtXb78ABgN8OkdGB9
-mEybXWJYw7S1BJGVFnhqbxTeJ3e25FICnPXLHWME7jetrh9mcxRVyRy448rlcOOP
-HL5RhPAL77C179+l7aT227Tdov1ATifDDCWsak4bRdHfD1gcX+RH6cryCoRENwTi
-kjMNbedLZpLSoymmNBsDYkh/LoqZaPlzzUYW8uv2CxR4dOYibLRiXLBpA1GSnCNA
-psENL9bR3do2SmyTJp1FREQ/0tlZukDZZIKENDp8PsKqUqdquj8NNmh5OmJGQI4R
-wIF+C1dh7ZAAwfLPYbnNO2kgH+lNdSx9cKVRV40Jj7GFb4oUNOV6wfHXPVbW9txw
-VBCkKYX5aXbHERq0kmLJk9Kq8AWHtiWg4q1QOt2p7KTthUAPhzcLW9X8D8yVKxe/
-uWs+eyFcrDYk/Uvstn9xunARuAdpgVIqSRlx+KKrUxeP3VESPIowQisI0Qnn8V/I
-ubOkOhz16QwK6genWgucQA69F2pmTuu4FWUGqClGsrL2cjP1Ht3xQYfvz1m9tlJ+
-BXXo2bDjke9sbvccURqBD4m2odjsSNyZ7wWqp59OXCJ6Yl6oxbQz1j0FR4iY7/8W
-GyCf/FF8LyRqgQPJwd1joqz7zYiKxEPieiwJPudaaP1CMzDxlNo/Vs1rfT4xqRbw
-ZwETjSaZYhlNqQMrXHYpP9lFCHsFA6EwwZo63G9ENyYbo+bNzIvPmPG4Vavm+C4O
-XKYtGQcQevq4iYniAxEIYUi/HHDyrUW7pjJDJr39gmGqbLP/wDYDycDEAeCi/nqX
-JBwH3lveS3n4MGOUCqRtT5oyepSquDBUWlGGgWtQbX7npv/Qyh+9/rsLUXLfd5A4
-n7JQTtpnV7kE7xNe88lzZN0BZ5AlIBtUEZeye0CmN7Omj56jN4L4HKoDPaZrYWTa
-1fPgMcVvWSEi674eGMOQYeeMN3Y8sQPT6xfHX+5uUg7A8UgF1mUNjwCakoW4J3xk
-dLwE9+eOmo0NpJhWQ+0ug47L/Sqk/lVvec4+72wYnS4EZWrnhHcU7TcCGEyJFWDL
-ejqsOH88o3w2tinDBlVmNHb96KO6sFBXZUyiIGcq60jZdN8uirufIeW6t7jvl6su
-3L7+LgP0r2Y6JedIpvdMNNM6ZEMK28mg09US643ZYpO9iMl3dUTKKrKHs7+fJrOQ
-NxEKJtxRbIwjeK68RkmjktPmNAxYKX2H5MOuzFx3+Z5TZKcNd4eCNrp2vj49xEL3
-WR+ZzwjsvM47aOFeb3glK5D/k8fcvhZIzEunAiGUvZtUIrI2VEpf2EuIF+bkK9UD
-LJO0x7nU48PEzwrlZ4p4IkvIeEYz6u83cTx891QO+XaZ/ZimDiOlKkV7r1o32CF7
-aV9Ywm1ln/+8x74DKc58+GsL3KMIe/ncQ4g6tg3DDbxulEpVupVS6C70yzwW4lHb
-EvN/5PZkGyvIFYR3w2aqxs6enbPTfAm6q+VL/Szp9u613n8DSIH8Wj5HcDGp94PQ
-703ME4O5CZQu4q6x1vveDIvJacB5SIf/4ZuRLjEnQ7NSnrAk03jixiwSvngy0IB2
-HGp7bRZ3vFmr/Qesyc1TbxQ1u3kqwYjP5LiCuFz7xvrUEVEmHhhtnJjrK6pDu4XL
-/VXTX7jLXE4Lp9HoEF7FI/xxefUs/qBC2vBjuUioitJdphUj+NMC9Z63mOCqGLCn
-CJnR8CdLPB3Gc15WO8wFtFrVDrwDH+1jDughj/BvTMbj8Huq6zQCHAVE9B+aaLxT
-TpYcNNecSlLUhA010/M+ZdkEffvyJUSETRxNMzX4reinCcqgLUzD1QnAXHUK9HE5
-rgOCnO0XvZyUp99L48sMlQcfzqNDOb3sCx+VxoOUNpshshh+Pk9UlGZ8evubYs4u
-hkSGcw09JTes/lL4mC5DQYcQxGQypBSG2zFBna6wL7qkUZttDCXxWimQkg5QYOcY
-t3NAsnPX8cDniLdnGdyUAk6kQBSq0G7rpUUAVJXVve3K+FTsp3BnKBV2WqCXIrj7
-icGxpbLYX5dcXRoCQtMCGuhjlZO4+l7AIf6IajInZKhT6WCVHBbYTs/VkhryPMNF
-IEGzqiZCWzuX/yQQdTkyIGcK5nnEfZXGUdQB/aFCCXMlZrncfk5HghVQXWbYqqTY
-rv0WzxyIQl8+9dtOELaMiqMyAHCDoq4e8oJZeHMItxaXn4c1KS5ENvm0naCv/NNR
-Np3Y0l0mPVCcMjspWVnGiVrP6bMqPEl2E6x0C012M/uxldih/P/qlnXgmNselFC+
-U1uQYIEdOEDAj4wG5IVYF6Nl2JMxiDyGrLvFH8uUs436LIK3e7FSoXuljYZAfieM
-v15ngEbSSeyWwfnYM54G72eqIC33Z/s7SgTQTCGEECrwXOzwT03ciacPDtovF4bb
-4gKfOKOCThvKLdja0LqLIzehcgJfslnuQ9qVBeljUBBAusxlHRbd0WykqhcJ39nw
-aZ4ItTYKm+JfKSNg8e0SxyrHORmBs9FMFLQ5YdIx7wTmx5sfG9dI7ZpuJB2YKQ8W
-DUojlKX3sHfe+8Ax/67VzRfrniz2JVqqbPwIyYbiJgQ7RxURYFPmg196721NfQ+z
-OqOsZfbZwNSNxQP95dq7K0UfGvBz05BzwqdufPS9+39vNO9NFdB24oxd14a7Yrgh
-LMXIfuy8f9vyB8s5tmKFNJhkCWkUBkM8XH86+3qbR/oQSJ5/SYah427a1NuoDf8F
-bqoBD5REjeisTqZ7DA6eTyie6K+qGeHNuZZjlojlUWpeRdWPQUIZuGQrsNJf8mzr
-F70FT8RmBiTM2uqkT84qQObcWQ1GDUBm7s2ZbBaH8vt3bvNqyX8MYN5pv4aDtnoJ
-iU9teS9EKt2Eg8xHwYSPR63lRuOh13PRTWoZCCvX9a9KXU4iGummIZn9FeDSwDqD
-JFrZB0GUsybe7NkvxgFbC8pS2CnH55zCtawBa+Xb8FKaQq4R2Y67lxPKBqobndnU
-18AXVHiJiZm0cPa86gJL1mkJElf3OBwNbRgLT5bxTUdZIZ1cT1BF0zlkHL6qXAl9
-RRIsS0MWpcMvhPeXnBOKZLk8uo5TWodaRzX56XWW8nbByFRAepgx3C17i0hTh/t7
-296mXPBNTAgxTTgQrXTGcgsRckI+ksMoFJ57h8Ig5eRKQgOPcyaF8gjgfn6U9GTA
-d6qqqKmciJkQrkVo5S8Cg6UjxNTpGvi40crgDcaEbdMa4D7AZRJUp/pBXgS6WUky
-gX1R72GbzeXErAmILwwFmx+66r++0q79I4WaT8QzsmdozzmiF0WTG6W35Uo6kFZh
-6zysjOcHqzeCtdnWF7w+FtuaaJQc6wYsYrG9GwoxQsgDGXKNRh7AeI1cBA6Z59A4
-CjdfV1wz2cdF2viigwND6hHR3EJKPTnspppleAHehcj0AChf7UfYq3Mlt3keKukw
-m0ZvFLCuFZgAe0soFOuZ28KzN9AuVNGllz26HXlbYqY15WZVOljFB8u8KxSVkTIa
-EXa9C7sNAId/taeXVxoV/+2erai3X9u7gc3QZeprR8fUNpniZquw2DdBwQYTEOLd
-i5p6+078V58SQOa319QpZf9ngCiN74knCuNzXUwID0ao1+TdMYyBCVGAtUx7xfEr
-NXf7eMPl2td6bV1hcteEw2Nn4keuPLHIfbyXrIClxPy6J2bJMduPP6ExNn7JGXjA
-J2j8jxjvVSyaL8E2Fi3cC5UwbFhMqm6ajPwc5fro3q0Pt2bFI28ewwKZekrIvonh
-JX04J0C8IHVo6Srpc/GR7eUzV+Ct3KXPToT7QvWISk1h+y1w3jbefoJDx2uQ4bon
-cIz7xz4c5GfIxWA5uCVsFrKozDnWhy04BvxAoeDN9vCzAEd8F2Y9W/5IZuilGcEp
-zlVuK7NJCQ8WqdFZqERib1f+z39pV8VkX3UtscWJqk+By8ljUeHpN02af8UHEUCD
-VDtceRdzP+3IxJii6lPlcjUUMMXCFJdAy9L7Ar/7IOTI18wF73xuOe+Jk+qFNIKz
-0Gc2eoELb+i78Xs7qZnH2EmUS4J08omDbqymcRAr+pLH4ps8p8O/dfNw22qjjCWR
-6hHc3XwJZ107Kz6azVHgnTgNKEdm0F6MoDXNMd3fhjyXUto4vHYQ0kC7wPwDKxcX
-0YIDSK5qt/rd6gh5q2em4qUL1v76jUXMtcaOvVLVLwAFL0FUF7Lfe1EhYad/KIUU
-ksJlPs8rP1bHUuAXT5qRUY+kTPtD5E9yZYjUdEUbQkovXnJ7ppAa9hY5H6wM7qi2
-UoedHYtfyNaj5tot1GJY60Ji37zYdzDAYx0+EfHN8tRe3JU8szklQ865laxtcmfB
-FNybkQKhrOq+bCMDQXaNvwS65TkiBDp5+Po/nho3P9A0b4TmEfa5fNm2hjDF2B3Q
-doerLA9PzxqAuypymRRghM3t/NelyQ9T8oPrOk02K/98TO8b//l9e24HGym2fm5P
-au/JItc/mwbcefdiZPFYRm5MS4qre6t5Wjdymef9cZezj6RW6hZzxtd++Aj7im7Y
-iFrIcRnwUJCUAKHfi2ncWf+ax4qV5urk/YugZcCerP+eUK9XQow0vgHrr04AlWt4
-khVR4OeOhSEXv2DUWdylXjybhn8Aoxu3dOtMYXoXJZlRM5W9bfpR+7XKjMGzW+T3
-RW5MQxLz5Bqeo+Evvge6d96QT24uvdksS2yrD+frC+EW63bXM10qCGD1dLbJhMGy
-hR/yfpqLdcrRbJrUUKJdz/33qZMdkR35vBVEfAZGiTgMPj3VWSxt2CqIKBp61GDo
-gYfLdkZWP2qRk4/o05vbpyCTtIE6RYrKtofO7m0gFqx1gFadO3FZ2iToqQdIZqkw
-5jWWWgRHzzFDl9mZwSqRkYAIWmaoDkVqiwhLiblfyBwt2BBGhYuSydwNu4u752Ii
-JFhh1wOQd7xHp7uJdteoZpKKVtUb2AhhkXJNrbBgcQ3Y+/JQPiv9DXpwOFte1Wb2
-8jYQP4eUDG1X4iRh4vzPcFAWkd585IRC3VTzRGCgdq8sUJNqIdNP9SNgNe89Rr/t
-l/Z7Ngadz944df7BObcsfX59FxSHTYODPjcUixlrkAtFXF6KdHslQOZUI/a4vlF+
-4JoFHNTG+BAjkA8b5XXs0aqQg7zzv5OJrAPCdtwC3y/SF0kh0iLxQMkaXyelwOBz
-5H1K1/3VZj+IvhxofC0F+84eDnJeIVDueQzPzaS9Z3quJKZcLaeD4ZGf4caBLJtc
-AMuoW9t9JFqvBRsXMXlHpNnXycw8JgGpreV6slnFmXcrT7LJRUQMdKwlqj/QeUx6
-suBJzsxlGbQ9aUS3pKsnJHZg0rBEpysuV5vzHT5BrtuZdrf5bUIMl6fEeXI4xwpo
-PLsJsA9GgOKJ/p3K+fdadOSKUNxiOcqZWeFGrHjleZDtA4/7zi9VWyCTC0uiwH5v
-67BrWNz6Wp6Nk2vDfWTtiRkYbaewu/sk5i9Tp1iRA4gqTH3RLxOGatJmA4VdI1tH
-2aI29WyFD7lxW+JFI06fq6gYj//G2VN4euZx0kqR/eH0GlBpx/SjRKiFNoAXS6sK
-ZYS2vzj/yiLKOSc770k8GHhsJWEnB+ux63+HokUSbr6EDk1i+P0jTOo88QcWUYYA
-kNeFcCsVgptyiGDYrcViJvLe85gRDqc0ONOgGYGNKRW4cOlBcWWddUypaAiQ4f39
-bC6IGRlkL0MAgDle8Ag64JqGSlMPZysQp0HRhue9/yg5juepO+a546x0cH5usour
-k1B8PF+yj1Ve9XO1aESL06ao9hLjChPN4DD75wXPgcfzc+7wFvv4G22SJ6GUJVdc
-2hdEMJQPIHU45Qre+m7q2lXEvsuTD5jtrvI/ZQFwRc/VIEBU6G+oNb6UlrvQoMKf
-uiKoo/eRXOWDVoXbEhWLzhWNEJ0jmqlTcunl7T9roo0rIpnCFwiFrAjcD4Dsc9WG
-xJHI94Y4/EITz/LDOO1TrK4AQOmxU7/E/d+xV9J6uZuhpY0ingyRE/Jip652od2q
-eCVQBpeyUDuad+GKoDsMLztYD7W6ixEm9j8xkmU1aQG7LkCkrFXwfrdc277TjWCB
-18vL6I9AM3JT+jZTHnsoLbMGYr7DG3/0QuCbBOEVdkDErVXm8f4fEE+aOwT59zD2
-HKDd5CvLvA2LNNADZLFAKooDdQkXk+Otpssh2KY6Oq3FHoXLNPAw5Tzl5xqD7UG2
-R8B1GhGN6uZpF3QdpKdylGHAYVNRF9RnfAoT8TpzlDcVGSfngrR/gtDsqMU0/FIr
-Wj3zgP6BWMmqKTBEiGPU8GkJJE5cE8yW35jlyvJSQPpSCvao8WiG9LErxlbx8qWf
-hDMtuiJHpDwcVXT9jv8kkmiIvT7H37EtMLrCZj9xERpPpwZfO9C8FlXK5/0olBW1
-TWUB+AjttCrwGHJ42L6GKiw8iWHVxioHQ6gaXXT1dX93r6KfRlu6H5dkxr3c8yKi
-CD7S7kQPfqPZ4kuaK2BzRSfVSzUBJuUKz5VZOKkAVsCOxDZPX2uqYFWF309XoFMd
-kVh790gJbqrKhuieQGVbFXtrQLDLeQz6NL/QQyDEk9fOq4+dIHGRCK0Qk88zLO16
-yR/uf9LXsCn7eQZ0RX2BIfPLk4g4PiGvboUfcQjDG8ONdXKw7F+4O3nfMFugDTh8
-SuNi5Ndoz3dMCQja4frLooniwSFvKFNHPS/GB8ehagFFG7iskFljf5IWn+UkIm4u
-OUeZJY5lHS7oFQ63X3NGEUHj6949RRxq3dSK03A2zuoJqTalhXgeeoWZGiOlTujS
-JHngExI8hZLdvtPHt78SUavbURcuuk6BAPXEY62SkwyGZ81vnY0rmPtEVTsM7krK
-utFeU5zb3XSOilxa30akXAQJamQzlcoeS3651sZ7oKAlniaaai01IYOlWI3slvI9
-iPAda1Z30/obDPYp+FjIq5Gxao67/ZxGrWSpTXoWPJ2+M6lszlpvq5m9JlvFhFeb
-QBrZ/lyqCR0+bKkU70HBSLq+FQAZNFMPnVfdXklbZk9guN8dTZIKbHtzDrB113BB
-/ghplNhEuPNREv2ezQoumrRy7CRJ4RfYAOXkgzki+1TxV/dZJI5m15ckUVFMuuSi
-XTKPtm6obl/wTeabiusrvc3OAn4ZKQIoZ41h7A3CdE4mEcpKuhEm8zSnPaYQjv2y
-sNP6mIgIVfUuhukmCikaO6/85mlo+DX1gFknhsc46uvKx7tSwRGmBSTkDIhxE6/5
-gTQQ2d+oUXj4ENRCZYETB/R+HeurH4+4CEvLXbYNEP7fWanexYeJfl2o6iUEQ5HY
-NdISlRwUvA4aTC4kwAVKOKLM6PBjQ2Ot7QymLKhuu3znyxVQL4i1Nm1KHoDtYfLY
-8jAnV/jU0cb2wg0+JE7Lof8R8RH3zej6jDKYmxRlsjq0BYBalqHEoKdfWxbmCUWW
-JhXcn4S4/QsbW44k1Y0HI00mzEikoykjn3oOkXApPa3KEjQFK12QJT9efYGwgjqL
-e1mEMQvT10OWBPWAy9oRkPr2LTL/2gzz240MvmBVee+ZfVnyIPy8Dqxral7GeGcR
-aYM2fUndOUdnr1175KWu39bJw8e+3ryU34UREvxV3ODTentLePIgsEoe/jdXFAHA
-JxlzK66FngD2r18m69BTyH3xGm6gXnj51gKNNq/OwjXo1HSEP0rbfsee7CGqivU5
-9gimkdrrja1TyOlS7ke5lpjxJj0/VRiusmR5TTYuYy0ROMgRtwatf15n9f4cj8SV
-72dySH+Rtp/rDnjCNsCR5Y2wqAZpNUz6oDrSIMK43lrV1I92zFdU8HQo5d7RFBSZ
-Kumwe3OImNQtG+nLSiiFc/aX0hiWv4rlUuXbWhHPD0DKiiA7v8Ex8iP7GxW9Yfs0
-6DYZq26/EbQ9iHYUnI3jaWQSdpwpce0bcQV8zvFOi/b/Wb8J9Dj99D18qdLVHgu5
-Gkur5xFlftUf6B+3qb+LpBOvEj26o/bg+Cv+U71RKQTk8E5P6YqYGzU6rtW4QvEE
-0ZGsvez/+Tpg2dU+yXwFBVjH9zYI8hlc3UThgqlEJ22b6Hbq3bH6eEeaEL4g5m0A
-QQqEZxP7FdF5iixGd388QjC9t1Bud327655EmBi5TX+GNSynmGNZBCcXandWNUk5
-/U2f2S+9kvPHaIRfFD8vA7AV9Z+mYccMuGqA/jhXzgkjgn17ltwDG9GeuNoqSsT1
-x9nr10hHCPxodkauuuUiBcXxE99ZPJ1jMMndAkeysUADldnnvCwuqwrY0cq4JK0J
-ENwkQ5JUQMzpMQnScN1ZDzosMyQq11GP+CMOtW4tzS0UCN2ayk03SP0l6+3DlWOx
-J/+eXdkvn0EjSQWR/rKbSP6KMYzPw5GFA94z1xPopuMWpLq8dZQZ8d5fZTT+8RLB
-k0h0HeiC8Uky87vqHH+S2k+jrCNMi0/gaHwUXmg65rgFo7gRMjX3qlwAOJ3eRsIm
-5f3AfCEVvp2CaFh4v3PidiY/lr6iPAUbDMJXhkN9yIoNJ+QzA5d79LaaCmFCG9Mm
-IfqGrZg1pqeO/vVcnH8RCyBpVY4byA5Nuw0ma1bq91WoY4Ulqc55o57w6x3QUfEH
-rbPtseTc5ItPB3dxUZpjlrJ4+aoXEzhqIiT2zGDvfz1OxhwZ6OVRUN8RkCk/9JCP
-7oIXuxe26+JC0quLuahTn0oS3/qPTJ/S9KDdP2rJWZuRr/J77MUZY0eAqfV6wszo
-W262FEVSjLGSQsJEzPNMz0Ou/MFOYOmE+QwOTRTOqW68v7j+c0876Rlz6npKzCuB
-xpdXcaJvUhq8ns+GAattlFyl5lES7yvmZxWqy071BuUTMSx4NFQezBT8lU/KCCWS
-fT5+hd67hvA87EvIejb68G2Mi5wd8tjeNVvd03y1mfXbwsfZHlv0NxzGb9g911LX
-2f360Ky5FoL30OPaIynaRDYF2r5vs0IWbTxURXRlg/NcKveNWzknaKIqhFaDjn7i
-MSuyDx4ekbij0awuZTjWcgXK9wDTLVQWCzEXpj7jYmmp66xpu9S6X+vgGlqEGSn1
-hTxb1r4kH5rlL3A6HwlxICRXV4c5OH0wEMFQA/7WkNiPLHmx2jIfzxPmdmvJDy+o
-vDPcIEXhEujjvjoSLYgjWLno7075zXFN06AlcaDvWwIZlzZmzOYpOROw7h6TQXC1
-ttHXe/a7aXUd2H8u3KjncNupX/A+r7vZsY9dfw3FhrFWqlw4uMxbxoKm8P+tCh24
-iW585tnvDVRc2L0LEIz+6KhYcdcEMM0D+rEe+CyUfN4bKP4933KzwvB5i6w0Ghjm
-cLlaDgoC3vzoMydAHgMrACyBnEMnUN4ZvgE7fx3LGftka/L0VirvRLzKE/j+7S4D
-ieriGRM+FI1gu67ZgdCiM+vmYaZTXK5MAoYtT+u8Z+GM2cTto1VdkOfB5uDjdu3P
-wA7Y/jysmltOzougFYa29aHiQiaNX2XxqEB1ucJqR468ZGeXwdBc4oLGjx6zPaeS
-0g0kSCTUzjD3xSHcQ3n8qvtCemf0rDI+Roebl+QRZvYF0sHAePvkmJgeBBx7Ogi7
-e2Bfw1LvN8sDaUOQqwKF5EjC35QEnOsReTnjg0iT5q2LJyU3/lw47I6xvtErPerk
-dPn6I5h/X5ug+Oy0hJVNpO1DMSy/W0Mlp8aML3ahU9HDcJKd2IcDJ1qDrHqxsXUd
-JMXxhLyFDH3hFQm+gwDOH4azM3a7SoEoqKfxbNA3QSc5yeuyLfbBkUbNvX79lo9G
-w+xaqX6geoBJijtElkeeSmjQEJeDxzZtlH/8YzEi5k4ktcTRb4tn1EPpf/P9HqBN
-gKEB9f85tAhkySqg5RV+ZmVrjlFFya/IK7qCTSxMWsZwu2rgorRTK1FXB27gg62j
-qB6ed8cVf4OADqoaTeMQ2zhhqXguhko2RVoDKrqIBrDD5sZW6S6hJplo9psz2XJS
-+c1UZ+6t9bHqgZmrwIzjNrVFXXs1QIg4MScE7cUUsJJtsf7L266Y0rao9XPwCRV5
-FUvK8l6sLVrg3YBRUNrC89cSmY6G00bc3DkPIm+HmFJoTMzAwIM8NatT3j/4M8qF
-NpoFcQByjCUXiJDJuWaLDKmbQNwjukQ6RZrlPdPf1ffo7zp5B3o91fuilPPqDjck
-h2+utKqBUGjG9h6qYt6ArcoQ9PCdPYsjduuGPqyGQgBIG1HsiJu28Dhc4nibAwrL
-LN8UuIeKCQ66m1qGqbLpfCDcqScDD7im1CNr8DQX0nMtck4vX2XVKBCreJJFxGoO
-liQJT7iIqt9nHFrFmESKPg2Li+s/Vj9V/OpQl1KpfvHuSVdRuKVPVu5k6vFqUHS+
-AZQxHnu8BD8v0/IbPcOJcDH3tP3T29K9yKgwJOstiJffZ0Mu0HqfD+QTFKixv3mm
-uDVXri3UCYGDDJPQEeQCLSf5I4f9m/L4fv7AQVljOjGN+8o2F68VqhQ43h12bw6y
-CjuPQ5F9FaAFvjhH2a6KEQfHGV7JBNsXXznxu7vb3xXI+gehedwYROsgEiHMU9xj
-0vRwCoGnhUMoVCSdh1h7q+8Ju/3VGDJR6PzkF9ajgJyFjEZy5/7bDIojY7Z2RXvh
-TKBqzfTmAZE8NrAIOixUb/5PuRrH0JTILAiThuZ7n1XMKcm9rz2Zbm7xsarzOv2h
-OfR0EcYnW/tBTGO5MTHmKWl/lmsQTrPQJp7eQPntsi0biM/wS/lWFpzpl8W3aEsA
-w29/IAbLQaROfJdi9WdbNq4pzKj4AOVFaEMFOvp0BKOxabiPVrAyW9YyyDLn3+PK
-SzthO+qNkG2h3/q0zmyJyVQaMvny+DsUkB3Z9EK+bM2QLKmrD/oSgpDFiI4oDY6m
-4143q+vW6YVCCV6XJmGo41wwoY32uP0PnqLCWUe/qUEckJiH4ZayryF/TpOB+VDr
-anzo/PMYvUOko3qNuBSzBYle1oeARTizD/sA3c4Q+WPM30BcH7NxvPW2NVSvyc1H
-s4gvXigBQDxqENA/MPvtgFdrQNBHNjHcVRhnG+ziBRUzNOCZ5IjI9R6sjR/4lyOr
-h3/4Bm0bTvVVnLIaiYZWA8UBSef/2RLUjKMMl0IK2BYDyBwXSchPqULXud/OPtTL
-MtcUNNgTGHGexEwnbBu8TacFrSFQMnTrOP2djyOmzniNHLYOXOLJt5rYR0qjd6+r
-ey61eTNAlg4O2MJITT7f1yAwHc4Oyr0KmUeMKdhrU93i23Qx/JdqhUvaIKeDldT9
-2r/KH5OPEelX3hwSWoC8jeyhhFM2MwWvRtwc0ojwnmo4M0gU8C5KtJd9DqaGmyUu
-walDEXVlQdlviB/oOPB2Tn4mYmV/1fYWJ5S6V2nIBst7UbDcjZCc119F2wgr9m2B
-eqAGDR3WdmvfvOyKK06BCKhVSVlSrtya6w3xbn9VJVN7SGVuI4P+Pbbozya0kvuc
-IVSum44tEcOWL/Dl0MrPWtHEgBDAr51upNvHXwiIzG22MkVY2ss3kOwWMpEe2HMj
-PLgHgsyx92DCJNyvDMszjyOk0uD2UEGPxmkY4BMcaeisFlnRajyBcfjLwEGuhKq/
-g/dBnn+9x7cWk/p6iM5V5XnWFWRsOUKRqTNbuXf8AUNF1orwWQTgvuBaetkgJ1UY
-5sBreSD6sfutOGd9iLMmU9BtBtWmM9y/wP8sVfYKKmM87is9LkGm8ZBgHX5nu8gQ
-gS6N5Yi3ZMFcwBqgBCRI43ocpjI4+mjGsa0/5jVAqrxzea6KaZBRm3ZxCe7vpmCM
-x5+V6f1bhOqBRFqPANN6sQlzrJ08FkHvovClJMI9UZTc0vVl+6fjq96zMDII8lyQ
-t5fnp+gySYErq8IvNWrOUK8aaF0umVg7vCguGN1TzAaOLUNA5efJxeSBDuKyq1j4
-lHCKpH9m567xcLH7/cwxTYHtvN1QgfqNcvcJOS27G9JUvBqczx24vyuEI39rZGeG
-1QSn+MmjMg9cZ99OGyz/XLsVrzJn/80YYOpQsOx7krmxVqAosjKGJ7cWjFHF9piH
-WQkrhGgzf2eDkhVoY+epzlt38LnhyhBGxyZUvwJXmeIDDqV+d+LCBaVAGCDUKVee
-H6dSSR3vmOTt/aYVVpsYLZcFTZ/km/9dmDNduOrFroeumgAqNm0CRnTjR9nTKEd8
-3hjhZhzRZpB4UibImK+8ln7fPnDbjZOFYI1S59kyT4gAnNRMWSEv6dHYqTludfcE
-NJ2jYCc8JDwadOSvxL6YeaQ+1O5U/MZhxF1eG9crUa0D2eAxI3QivxCdl+dWExgO
-VQj7H28NYV8wW9LBRnFvhb+5vOf9nWPGonRbg/2H5liMi8U1owR/koIA87dX+0tL
-nfR0lcucoT0+6ju65OCVAO5busv9A5sMpVUw9psghQN07nIETosPxzNmycdcsOK8
-sag5oaYzBUqLMA2WoapOiAijFV9Szca3o9WJoPnhUc96fDYMBgPbIuwJPuCgtnL5
-ssZQ1ettUd7Tp5dVCyGi6TfzoubOFogVGirz+7j6IRereAbqwOvgEaKRZ33on/gA
-FFfDtQZx/9cO7z+kyZuKZyR5mCfyQYJ8CNzdYPRdGPLbcGriOZGPCGetwtqjlFjt
-oLpS7vusbyfQuFR8pi5Ign9yHDZ1r5vwz/xAHbsCZFwQEpA8nojvx5R/047EMfQJ
-v3fKfNK6BkUVqSBe9vsTsSecibt+R1/XmI6R1pdGax5YmP0Gciy1Ukmv7NtGUPza
-MvYJ6rje4PjQJ9QNbpIkLA/8kvOh2fgdz7ny24nVhh6xlr2QNelOpGbcRBaGccLO
-772G1gMmxiUtW7lukO8qM98zPluuVpePbBevQOzRUFavJ+vJxXtJKkMPEv++cyo8
-7wMvaugbUBw7ZZ1fvZkyzWc2PyQTLmgwX2+M/H7631sxCaZVxtEMYAqEvdYJ++2v
-cf0Mdu0M0qwtwPcfYCi2PhKhKWnZIf6kJjsg8iq6Bf5SMQ8JxJwRJESegSkKNm59
-htpzJafVvye1l3+ilgXJoasy7AJ028Aa5wKdlC/AeWeL787XTKy/dUxnaFI2D4Os
-Ahk4FB64aHBPr2qVsZRMWNU8pRxikwnTzTX0MXW8Ge4tgiQucytwbWZWxZP53Srd
-2sLHxe6LgY+kVqeCOwh2GtGzItNtjsB8hjW9lN8zCvldpZnYor/6DoedJ6SMMwT1
-rQxB8tagq1dOiMXdlwnVPpstKSJofTLgiXKNZaCLHoConGNCO0cz4vefuhdtzuPU
-v/Rf+7cJmXFWru5YxfQFI1vbG9vqrDPoAC58gCC9BzAvzuO5PDoTU2pcTB/9zqJ9
-t4yetdLLpFyxd4MTiXoUEjzlNsmyMZ4HIpAaGluloUPyz9fx1wJpPTFuX05KS8FR
-BaxtLkdVdndBBE+CGqfRrr2Z4BXTPBXyrt5bDkbvMh5AZw89uYOu9pmI6dh+jzGw
-o3B3qC0QNhR94uaay8v0oeXhvKji11KgoYRuBLTAwKpcxiFue3ePxIbq6F68tL6Z
-rSvoQXGcDhjgDiYa6haqzxo1y4RgxybwuUP4UOWD3nWklNzkxnz9RiLnwUHRt36j
-oMCB1C3JFjY6pNPUFuNmHDiV060jjZmk/A0R92/JNiUv87dZ/7K46r88H81nv4Se
-Za/Td5p1DtKRpc3mT6R/3XRvrIy3g5L09BUGCPuW1IpKu6zOAt07QrwX/WAvgf40
-zsWQUgZ0gaMkZkMr2QgIcgzQOiMhCIcylxu1ky7jgnhhCq7Xny24jQ4ZFj/VtwUW
-P5TopAUtSdmzNgnEbG2JNsCumcAIpNAggEeDpVvRq1e+yYIkYvHrv4qwhl6UJmLA
-cyh6BQ0kaQ16v++Rt2PYz7D4VZzXfXULHUhTgbm5Jwx5v1GEWohfQ2IjvSs043DV
-SRi094WAR9NCN23suwQ22yoYNP0z83Wkej43c8OfapreA8Ndiy2QSQXD90n05hI5
-PWMQ1zZz+wVWSGLIoTj2qEZtnpSUUw6sLqVsDx2vv+g86ubbhzHhfC5yIJs5HFxB
-u6/rPtqdHm8Nvuu1Lb7AQsS2v9E2GBR9akzm8L8KsBcvIqbeKZi22zbix8A1gA8e
-iNNmh0c0jBNJin9GiFMy1ij8+P4CJKFHHlcOJuzpW0RZY+f9wG3tKc1zwao8G2vV
-e8CU9Umvccoya/HAMHvlDPhQ69hS0m4aA7GwOwpnX0uss7e7rGeohLYxdvQ8CuO+
-vdxpnIY65HncnX1tBWiovlAs/3KAR1J/pHKqU62v9DLIvWjKeBHWjOHlKqHFQ7k/
-7cFcs4kF7bxqP1SVf3Tcp8NN+uvYdtkEEOfi3AaoVsZcaSCspHzgTlO4FFCH3mGM
-Hq7BPsfYxjg5VVaIkYGz4ghfc9v9n+G+NSw0uxmZBzbmzGSgKHAebflHHh6aLnSJ
-0h5JhY4WVQFRDtasn3j0yaFQWGGEzIknIYzaz5mN4ArTvpkXMpRlsAJYxAZeXEh/
-H4rjPdNIEzKUeNbdRMJfLwh2awQ/3R7rYLwQjP9oxP3XQxXBhxEz0drYj/BN9M+o
-QsD1ilS3ijiiOFiVdZyAQBlhLOCmHToiILvMBh8JOCXI1sSm1kYhnwTe4R3D8jwK
-BjhhabQ/agpfheNsfFZ09BrB4j8B6OV8cwD7NjTJilYD+4WqJquvjaluEtmJ4cMi
-9JFpTgZAFpOQcglwdl+zSaJ/A+ZSRbmkN0DfpoExE1GIrR/hIsOf46xwB1WHxrO6
-tyIF85ehBqOuBdFtyzQp/lQ9t0xuy2ScijfxliwWGyuiYBrJGi3ptoDJ+SZ6mZKw
-umV1tL/3sOXO4p5sIzW/S19UMQHfrXHUAofDFoZQqizv+9vR1hRKyWWggLD6C62r
-5ZQ5IKfgMI9Pq5LzMc40cwl9GFCviJyZVTxp5aIQbIt8G2DiMKflhHtDM4NWS9f4
-VrS58h9bJi7cgWOcnST39t3ZaXCR7XMD1PGgX20ouw9QQ1ffWDzjCK3dHWWXxGei
-VURLV+IPDsG3p70eJjJjegHtTrGD0OyavZ/F5lv6tKEDoZmHJpMXdP7hUeiJeW2v
-zL6+1Z2brk1S+Qhtmqrct94lHV5tKCAUo/T5tOBef105MTFaEbp7f2I5Mqb4l9nd
-N1hNqby2X7nrfVf3wjq56hExTwkNuSMxza56KLsZrjA9nOMszblza0pV9uvzZEL/
-wM9mY49Eu8ZyTHSxXss8lJCRrm5Fl1TZFy4blB0klHOKjnqx33RJooWFgU16sP3W
-7uMf50qgxqGFBoqZOh/HQ4yB6dGjPzDTLQjesbxGZXMOYoSwbcVI/sZUHBcIcjDr
-002nDJmivTZtrqXz6kKHo5Z9fCmZ/U74CyjzFoR5PSO4E2wsWDPWqs2MPb6JZMM9
-kDRgE+MAeQ+QVwvij1N9bI4OqsnRW/JIqBicY3A54chbkV7YllcLWBExgL0iLtco
-muDLZNSwSubE+mnVEyB95GJ+XwNfL8ULsl3hlsN4vcbYNbWecXnqE7cm4RRb+M31
-mmx1+ZHqGsLOf1iYgSWp6Twbu3WlhOpZ3+qHCzOpwh2kvNZyMm7LDNhX5u/jOets
-oNTFL5zt63g4e180B69vRlSBDHQe5BDX5UYGOUGvLsZ7v/CXN1TUY8jMiOfoffMS
-QJivsUMIy4zidcBwmxjqlyLJmlNw/vv2eL8JIeDC2yEaSHEN9ch4Rhyhg/F7ni3s
-zTgOVSFmgRUKhz8zaypDtNd4BdUacYibCN6g3haC7+LoxB4j227+9dK56uZbFgeg
-hlL/hzhF8wGXxpjeAKALx7pmSPjzhEWtPCztHGVtIWdy5D8SxzPsV+pdk4KCRTnw
-oouHOpYoKS0FE7uHBSQs6xgzT9njwxlhm7eyx+Dc6WOXRpfnHqhnL6C6t3wGJZWO
-U6Imba5bZ1P9HQ2mgoAMLpSbq3FT4kr3iFfr6hloxFFteZp+Uja5kuz8kPeTDhkV
-3w9ZLDYx4UHLF5zc46vMuz+tfXEI8OYBiT+V9tz4MT9+E72wbAKCB1XxdXQ2O0MT
-gHjF4s3OAzN8ycv3g6SSHgjB0dx2cjWt9mJpSwqaIX9c5KuNoohD62iSh/FeND2Q
-rNhxCTaO2tyoL8y6yKDFcdXDpkYuIYjAfnfnk0ZA2ak2B8BVL/6ukC9rGaf2bKfR
-xofxzmH7vuBL/wgcbisGbsKev+iF8kMryiBiWiv8shRHpU4UMyI9JpHli5rPABcG
-4Ri5VGuWU8ivgIJaQpCCri0WMM2CxdAzTiYTdV5rKPybD8m7iBwvtzENHSh1YXpj
-Bs5kuiP9zUo8ItDi4lcSWF9gkOdmlHahOI9C0ojYC9G/3ehmrNJE6dnuEoYsoiGS
-WA5n3AMIX9vO99P5nug1juNttMq9GAmx4eBCMagGhVsPNJVFwThCHsnv7Nr8nIJP
-OqPpUqiZEPwLl/2y50rDubiOfFyoDMKGnTY726dnXvtiwmdONeU47A2IC1r6tbO5
-QDkzyfF7XIeVgV6frZ9MvcN5x4n0ib/Ls3LFGoW8AtmdHzrs/sIqKFsBANKfZEP9
-+X4kDaHSAwsvIJVxV8sYMMG68pMXrgzPWGbxgsy8kqg9WuI5Jf+f4wvUYT9wfbJ4
-dE+K4+jIMUsVoFH0In9Fih11Hq/IjYSn8FuVkGCWJ8Y++mTIV595pjcgLZ998SGF
-OfGxcVeXuts1ucFhINBms9jDE/JiDaRWEZ8sg2ry9fMQz+QPEUWCwnunJin4NckZ
-wo7dcZYjgZdSYdTIpG60noHfJ6d6cdzwn+aANy2lcfbHGw2YpQCNEOmbWpdLG+O2
-3Rj3Y1olunSnQACK0zp6AtQVQk7jty/vx22fJDy0UPQgzWvWgAWpw0uSDc2ehWRJ
-i+kWqZq/J1fdKcdwxbF+jRaMxHUsuaMtVSGqRU7H4uhdM3EN4KU0djuvMOo6xzDY
-ShgBfkLsNwSgN9Ld5RiC4ATcROeoBP6lTqoX4HMXp1OORul+xyWA117u6ElRewkO
-hxiMVcmM+Kqvhddv0IjUd37BFIrfOE3ryRVh2UK7ucOkFYlods/wFOPjirlnDK5y
-ZyVWvBiEf42QjHfX+Bk+RIDdTnldz7ZttVUNCrTSM36nNeF/bs5rq+IzVrgIV4SN
-RkcQd9DbW0mxG1Mvk+ebkDnrplAR8hlxtuVYqz1Bd+7ZpoKkh6NPRvmuQr7DW66I
-5VbaIrFxLHpkAg+Y9Y7ZAxREbYGl1Fn/9qcNA24/TThyhemKTkl7XDDJdEtJu9Lj
-KChmMzvd9zoPMxjudNDeN2PxqI3HKVtZ1Cr6oJPM5+rO8SgB/p8RGHo45Kd1JHhG
-+TeLtyAd9+pi7QrrF7yQDvgIvmzdCmRWp1QHGSpMmvymqF+JB9hZ8HN0JYZqxAyP
-AxnDF8Au+jVrX5fCBqTRKB5r6JoVmobmRgL+Z07Jm8t8YiHV2MxadG8Fx7mhGGL9
-MPC3AQ8oaNzyqHkT8v9YkNLaROmZB7mjcnDlF+C2BanEjQvFAj8PWocWpN1CuYzK
-ASa/6X3B/Gc9PootCmKROD0JKpSkfgHNFZu/VXffqt0SrGMaqscVJ2qY7btWLKt7
-NpwxvFXtU+WnlVD3EfiquUQWSWvv4fEaJiTlKVmUyHKxhtq6SgL5B3DqCvMva+qm
-0zCc8my5w3Y1SDhHrbDp618v3u0Yb8fnWMI44sz1+RRo1Pi2T2DnGG8NESfO7/yj
-ftudvnUZmPlIk4p0hTGu1KFnmVG8UC/6DOMohDgci8EIe4uaE47EgOBKyG+QfEoX
-iX7CGOaKU0+A1I9WFTWLTVEh/iVQD+iqWEcoc5QXOdkwCsLn1EVIY3a48LHhMg9y
-bmBKeZqgEE2ywPH/aLOTTXeMvsmSUfeI85+06xN1sPt0Bh4VAqMqomWvKuE5UE2u
-cXyNvdVftp8qmiJ/PDrHjiLIK5usIRxnXbi28HAPTfj0mqCcsRE5i6G3cI62JSD6
-askrqezv7y63Qlx+5nl7T7Z4ukryphrxFS7L18OlwlaZqVxPIuMtezedob34QoWK
-n35rv2uwSe/5PUNOF0KTVxfIDkkVICjKnaTyFk1Stm6n/LB/r/iHnQ/QmQbXtqpU
-NYznbDF8Vjod4+ux9h+bDKQ4JhZr+ZirQg==
-=XxLG
+hQIMA7ODiaEXBlRZAQ/+LIwdo0dZpnlj27p25hQ8AXf288zNaI0eICp3Cfu0c4Zn
+wLFC68iUWe5Px4AZoDhq9dM47R9JaDzI0lRWcb2P82Vg4eFUw5505Zis7wBp19TO
+dC9LsekoAayIrOHr9F0B00NHn80C5uvgd8X7g+SLHdpKFB1qdCarPspTjIRXesKQ
+0BKn4LtW3tKabYMQf2V3oMpUm80p1daEXwf12ubvKnOd8gAr+t8nO8sI7rG/X6u2
+Eby9sSBbjHejGOwGuEE1QgOaSPVIBFRzWRhvwSb7xsiYNhO07JMpTF6XZ1W3Y1uu
+ZrWjiOcD1FtNRHBVDSUBLPBagVDtDWYbiFp7mS5slcEB8BdIwMPHJPGYhw1gbaLX
+jpAgjpptmNBpPVNQF9FfMnaRfOvMTxy4MA66WZxwbNYDzycHD/GE+c3bGB6dt9w/
+x/xGNcMlnspu/K+7D4kDOCdQG6qGi3AgUVUhwSe3yJHZMseWI6M6YXj/9bmKkUTQ
+qqbZObom/8ChCiZly+nntReGA59zcNAMQl9C1QqYbsrulCBwVPMruZB9Sg2CmSmC
+97de7tVDOOpZ37iq0bgD4Kt5fq7KD8qGQQHJ3dNUR5N45NCeeeH20Sn4jqOW9Yq5
++l5+iG7VZ4QYWYB0Ts4HBi+6yV0pFFFR05uppu6mBL7xXujYDKvVyTaxFbkvt1jS
+7QFlm5RfLdxLmps+vpxYzYs9kvsJ9BqllORi+5jCMm65NBbqZZNuALuioHGY/aqM
+gULJdc4OPWY398JyKmouVj+0pnxmAp0jYf5HgNHhFL7nSP+ijvAVCfhLAkI/cZ2X
++5axYj/1TT+lXcqDXdEWHm/bW1Xe1MN/JvAaXHYas9EIou7gTLk/fNKyrAoJOq9z
+7lXcpElF6H6rqA5ZmGBOBfRXod7wb1I6EmNtMsRAQfcBsyUVqT5GPsLI+Ko12XPm
+f0SPRwoaOBftncGNLm/F3QdpucwAqXO6YtugqyOxZ7hDyIi5yY0YGWpWcibXc3uT
+AqeapdfjwFGPA0DO7+mv8hU82O3jZZO5ci9RTG74CwRJ7hIKO3udiyhoDTJgdBTB
+GKi0Bd4F5zkNo48UnKP6seHzylkM6uuvkWbNaHK1nMqS7W3f1BuObtQLVw7DUF6Z
+n5V8OxTXCG7HJCO/xnyGz76+ImLf9dYoMF6U5H5F4+xR0W71GWmxNUSPEBf5inTD
+tC98Kbd5uLHu1s0rQyKNjz1G7XIBaX9cqmG1u+Ycvm3pwFcPu4kQMmehhKmvH6ou
+o9J7qED/EneDjCm4zwCg/VlWhz0NlE6aD7343bmcmpZy1kEFtcQx3kQHXvvIu896
+TXV4Uj69nw2JPBZlCpHHMFim9anK5murbV9zkfEm9baSYrzTL2O/4BdEhcxiH5IR
+MAu9m8JKmkh8Hlg1TqTBDxtyw/9rcjpHAD2hOtD7hnioRxutrepk2x6ElZgEMDyM
+X0cvkbCA1+abgEisXX1K9ns4Y6zEtXUfNkw+XFKYcBhM0XlcVRqfUc6mmnf3eEId
+jzR5oDNcrtAeynOy/7OYHzJ5USwIDAzyczypCvmI895kU5yh6xtiCki3qeKqqsjg
+5ptl82vvLBlPb+eB3UNYacgmYbB3m1lgmG6IHQnL3PVfSJl3oo/5kkIMMbXyljFb
+YCGLT87ACuf3LoyWK3xMtGWVBtexNajhPSMyrKVJe84WNHMkjUA0Y2fv5hZ9wQVP
++EvDOyrSiE45U9ZwynJ8N0e2+Y5Qt8oEWnlPs2qiPgj+rheoxnWEj8PfTZceL5LO
+w7AoT0NFpEbsyc36X6J4gusA4S6tj2y3XcQg1gsfVNhh5l/C9JzycBPJhMePL7Sz
+jyHolgujHOAKHGaS8BTajqR166E4KsKsK77lK+j3HpBlS0Pard/upn3JTdm2jxOR
+B9js5yJ5ouclXiQA0S1NskADB0WA0ZPZW80XZ2YL1v8lbVNZeCwftvpnkxX+UVmI
+iJsQM+ME8OmO7i8btNRsAwwf77Ocbtvfijg+wcuPHDy3EPaYZOchl0vqdCiWyKWW
+oC+nhIxaWrztAnDuufiE1qcGXCRpiEwHSftsypx3yi8vBHe6gjvAgUs4vdmBTIEL
+IVIRlthj0aJocK6j9fnTDozrDu+CCLw4676+gn+zfmuDpj7HCn5aDYH45B/8Dk2O
+73OEoSJcGKq5aL1BIyjtnbYLdrHhjdyAvaRwWam/fu7vNNcTZWp8i3dTrLztDrU9
+L8oDWzwdJ2X9a1zbpMxOsCVxHWSk9mi+ZEI9ijvQcOi6sGTSgVtj8hVch99E9p3+
+W09TKcpN6EKaA0SUcC+WFamCAMbo5Mv1FS2IaGrHAKvMor1iOceYYSoKfJgeSBgh
+oxMry10qob8xnAYXOPOAr+j40fDnChVT2VCEXdRpKsc9gtou9IjUmKAwE/pFloJp
+u2tdvmmfoKtsF1pHg2jujLNdoPeZ4bsePPrE3xjsfEoO5Jku0yEvgu6Z2yiO5Paj
+gcPJ2wKAh+UXr4LFeR+RBmmXw+/j/VAkZXKjuCwnQuula6SfUVEgU+pyvwU0pKE2
+I+uUPTpXH4WaEtcG+6VsOPAjrgLwnwJihgdCIyis3EPOI+EuQP6TkA+cK9x3gv3e
+gvY3Tfps8cBHBL9lRIlDLEE23KhQSl0V6D9YKGxAS67M2wXQ/BSeo2UeMZTYkpbV
+Rh6oPcZjJVXyupmLX8Z69Gl628akkQs/S47DSBgM56OB9RaJYkKXDGpH+gNDYegT
+BWyUUcefmfoDlKZlpY+rqHBXUNlm0kZFHABrNJeYPfSYQ9vRZWdUv81Cfi69JpUE
+Hzhr0ptkl8HaFin56jSuDmwvZ77O4VsTOC3YiTnqMqoEYISx2HX8jHm81L45FTUA
+yzlAWk0iI+eyX5GKDBkSRTVPtynSRAotzRdz2/297bucZX1rxcnhT7SyQWCkeQfh
+ynCZND1ZwWii9jLNfmcOtmuMRl3GBg/xfDPn6dOq65CqzZQpPCuBfN1n+EYClj3M
+6vsch7S8r81JjD6vtEboFaBdhUbythJ8pAQ1QqudVmcoxSWfOY32+IfXrlzKRGv8
+e/27xkTCZY2Co8oFNczztN34TlWf/hFPvr6A2SyUxUQELGJXIX6h9I7SKLe73Tn/
+S9V7SegD0o2fiwX2Rs1TPTBODYIa47JTLSzkqraDb1X2NyKMavteRqzMNw4jivps
+4vUgdfG2KFt1mWOjyYnhSeotesQuj207RCE/V65Ro/44H9bM0gtw7M4sS0Wa2tUq
+mCMZVTknkRne1morj3mDfy5ciyKWuMap7ZiY+xYTG0WpAfLdHTNgxqIo8bJcLYmS
+oPailzD8ZlJWOGCOh1/IKXoi+AZsssjhgZxZ81YOepmKUeNfQ2oSgsGSwu7LDtr+
+dZvoY/TYJzKrRKlMi7Ao/Qg4Vph1Tq3UwEPmD51DG0CU9tVLgagUpeHEQBc/SMO6
+2BT+NDA+Puglmam2mnVa+2PjF5+sF1OdzC+Xf5YSTbkHGnBqXpqRqwLkWrxHid1L
+0ZknVLieno9Bzt7hH8v5OTdc/C2EiQRwpQHXbnFcgpUTqhMlyZ7CcrQ4K7rZ6SDy
+xPobJdh3NEcZJhFwuzItztYP5AuXGklX12Wej/5XyPwxUoqUoLCRUrP9CHTFCOFR
+gtFVx2Jz38ll+9E90hYrDk70F4gcUOyT9a/yESmG22IVM4c9spHb/Qr+8h2jsdtv
+LdRNgMTsp4uVf1yeQnZxNLwB5AryQ/4d2y3oI+fLPjxnzH2ZqxyZ9I+kQNQDUcWa
+Y3zDSXj4rFtx6xmXnJG+C+JHbd8FPVUcfWuWfl3iujfwYZNf9DG51ZzT0ISETaCH
+3/C9im2CQ53Bei9wY5s9Z7rzvIS7exf9uSHw+S9UiSjWqxf1sFKGJ47dar8uYe+o
+PvrZ0E15ZMwnyXAbWHOLixeSV2eXLwb81mlSey1NpQ+hMaDws7onyYvnOKig7j2r
+wCItHpx9xV7Wa+eCy94cHvZpP21WeY0XtjF0RSGUKZzNpSVAcp0NwZK3Xx+Kusjd
+LGf56WRaCachu8YAMYl2j95i05z/YIRLVpDZJi7YCANm4ZdCdd5b2yirN+rj7p+7
+zVbJIQfokvgC+mtWpOuCEjaMSqSDrsI8htxAZonrqX8qAhCPufA8iH3Jv9o7xP8u
+oYF4VKN6EqM7G3VUSjtiyCUPyAsnEbGEXcfI7mj+8c+I02A9riLagn4EGgJ747yt
+nW/1KxA8Osq+l0KG/POQPoWGasst0+4ve1/mGU7mFjbTApL1UwCICyqQja0tsWG4
+8ZcsK6kMAwuqlglz7bYkZ+0p4D7k7SpLhdk04HHL/bAHl6PVmBV4XAaJMBCL6DaE
+xJDS4KGehUNq+Ma+IfaZpOgtu//+oc06dlEilNeBS3MWZ4T/jEGeRUV2oKuvsTC6
+VnqqjoC9YBDcv/1bbsaZTzwxdgPJ0ngs5Zg0Paxv0MUWDvTtqyS4dSfdU0m1cYKj
+YQM5/GmO7KPz3bSIyXzYQX0BmxD2oUTCDNhnE1CcLsEyaa0tfjK4IZ7v7cWRLygk
+YfJ3vGnilQehSNz5dHeffcFM76uhTSyzGq9AVS1QO89UK6IyXgzZXE5DFnuX4rP6
+vl1g2CT9XV+lB9tkK2xnuROi2EEfHLPxTTPEwrwYvvxVJ5T2aENEHaUKSxZEAJ+O
+oqMMvGOYrU3JZbHO6l1cX7n5c2qWIRu+2qp7ZHAOMz2fjQ80nN47MyF4anSh5XFp
+mXwREBoxJEfMiEZolLNn/TloVpusMbbs9/yQX+lRxfLi+iA+nqi3kLzMEZGpUBr0
+TdnFwmsH4rD/RSyggoWzvKTHyXIgy/B/Tz65ymQNUGluM2MFXce2vp2YSVqvK8lj
+fVzaG6+ExEyQmUgS3Ed8GrdSwvMfplj1SxqWCQr2eGaThD/PhDhOor6lKev/qeuV
+BM2kVJulJSFWL2O4/txEdx23cjk8F+y6hWSu4tTidZ0LN/SXX91sjysN1timOJHQ
+s6Yr2D10KNtRu0x0sa1kDs/lgOvU9kmoFjtVHXwfehcYfzQ2mdOHYXHemj+gMTws
+Rd8RB2dWLKP9oac7i7idJnBL/C8v9WaS93aWCeDI9ieHPBdwua8LsPot+evot7Cn
+I4s10ehZxrEXuAxLGWuBl3FsOSpR2pinsxdC2ntlqBdAdqjBxtPit9p/U8yz8h84
+bMYYb9Jbo16y+OOGjOgNKDv4tEqhho88Hpon8egUxEodcPbsVySpKb2TToezUHs4
+l/4UEBqix9IxLXfbsPOKxnpVmBtw6A02q78YoqI5tuwezx7sf0/LQgMHSqFOG+3m
+CSYOug0qfXvXPFcr67OXC4nOoDSqMjdqpo0k3kSzWKaJazvQZVjfYLObn8ghOIi5
+uUBMc3GTS1vnKvSTqkpXnYfLQ7rDpItGCNjrKYkLu9uZqZeLlcsch/AdlYaihAZi
+fY4E6ZmUQ5r0Fiz5uZm5FiXgEWJMtoTApheE9n8vVXRdfq3EASeL1cgugD9uMOfn
+WJXWACPRDCpNvwYOb09jb2bvZBPtSFWR8HI+18zCwxbS1GGrEKmNjAUviZqd6p14
+QUtrqopVnqJmu14a4iHA4q6LK+yR5YJSH95TKVTE5rJAZaE3vwAvkw2nYNyDCtdv
+aUoOnZCz1vOInD5qWZW8+qiKX1i3m65L2m3CVAsd71rZxIrihR4zk2Ec3brOzSwP
+8z4cDfaiwzP9OaI0xM5iki+eC3ntigfAeZ8t2A3crUc6P5zWvYkCGLLhr/eyVIPI
+9qTywQYgVYfiOxlnZ5qXqQXDPNlFYlyZZ7J21cgcwBGbAe+l0QefHOzOLcmVU8DJ
+MCyg726iMbgy1HZoxMZ+bD2aHV0Fy+tehVdkA31mS8d0wjSuOLC8a6+8+ytf8chw
+ewSkpq9oHd8DXFs7uPUqGsOgIEiQ8XiUF7euqkzW1AB0xag2DnH/yHn7LwEDpvQe
+HLlWMmkqvv1ybmdOO/jbu7KZHK71X3dh6itgPU6S4Sd4mYz4fP40R/kELOJ1DA9/
+u3pk7sI9l7WBrhdT4776WK5lgqgDjHdqLmu4lxqfEP8WtT+awhVVe4/UVqdCDA7c
+AKVESz1XJ+8fARh/37WoJTXbPiamfua3fhhn5Ar023euqosY9hoDjv+dimQvb4dr
+cOQ6nRxV0I7HCnrLlxTSZyrlT3hTGYz/FiX5fDkHzFV0zv3nRknJ0P7s6MKD4aAo
+eXIjWbXqiErQ0C8iWv3T+4Z3bnw1eLEbX+ajmmAnvIGzLAWxDsjWHhEvtt3LdjWq
+gAuuYlhLiSx8Paut3C3Tj6Gp7XlYExXDSjEKfhEskdYg7rt5lLLXI4N8bdncZZy+
+iUZZ0jrmBWTystKqWqQC/oji7apMnbRTXpwLcXJN9QQhzmYybEq16YkIagy6OnHJ
+BEWniGbIeIRlv165qnfHPwzXQbcovdw9xCqwINebSZmR9N7EfY/3oMmPsVIgugev
+bWXEVze1+T1tgmNIYFHrkhSyj5yhLFz5vsBc49Byt0gVGzbMy3iOs/X60k/mtTxz
+rUEt2+/5HVhtNy3RPHovu0UGcujHLsWluC5pPBUjCgeaE4DRhoi4yxX+ZXZsgojz
+9w8yUceOiIjB1+igJFCJujNGqrz1k5ok8uN1aDpO8DateBI/YJ+Gh1fQ7cmlZLvD
+mbyvA+JdDwVFI9TdvhjwfIOFcBIH3pgyxkyIpzsIcQQybGm8rGBbK9e7cHznsyqS
+X86FutXJOce7BBYor9ypEpJYsT8e9ZpoK+CX/Tv3/qaEa0QdpZEPnnODf3XLNoeb
+qUYHB3fFjLvA2sxMVFJtX/4mZwRPP7F3j/buVFKgafNHPK5HokLkmEoI3oQDiYlD
+xXDRQSSBzzMF2ICvbPEOd6IPUQz/S8tEhBRZD557agJkTe/9pRotBh2GUVXzX2q1
+pUiXLNkty38h+2AUnCB8h4LpSwsJjodzf6r0QoORz4VuraSs1oBvQszDME21B+V2
+J47juMy69bHRqKHOYasstR+vKQC/6Lv/h1kUQaDsgOryi8gkBTLMyEF5nUNufPYE
+WM4dqwuvxMXZND+i89IKOHif06AVn/cHbcP9g58vZnL+7nIAMHYl23HMyd4FbbaV
+6VlEhPWfi5mmM9h20h4QsM161/mCg5sKR1a7YQEo6r2kEidMkOccnC+w1s2h/Dl4
+Jtk6jgNd/iinI0nYeycv/eZ/FJ69tkxnCwvOswrCS6oxkOyiX5Hkczt5N6IVueTo
+QEZVfNoiuFDqhR35SisQkopTLEnV/n9tEzTTAVvmO0UlLWH/miC2vG4SzRTbno7s
+AzGPytZVC1VaQTg3vAeAJ/KnyGsShbbv6n7nTAOQWLooH3OdPnVBpBnxvQthGNAm
+G3fI2fbh/BRL4SiaE45U0+piUCGatQcyPsRkH1gR4fvcXlgTls3tOTOrB/oZ3cln
+PLeYRpCB2twWPLw/HGH5z32Uf8CUh+btNWjE/DHxxitdscGuEMeis0jwOcEWeBr9
+vEGzTPqjO2i7zEplS6HpCmGDCSAy36G4r3KEJmt3+fU6CSMEKdSl9aVf2G+DThcx
+V0jo583CKyUDmPQAD1xZQhVx/dFW3ZOuuLZGp40nHqPQ0Lg1osWm1PZUjNmKyQoD
+zzWr+LLo5TeA/C99yhMlsU8IpGxRlM7slO4yT+JjZO8KOeCtGAjyqXDaka7sBTFR
+bohMvT+xRni4uwA+HcFp6etMCJ9pW3pe/SXjeOcEyK9IMtPmA00LNCx99d2L58o4
+s2jXZ5kRxfaiQqP1Zqgj7MDawgpmyVvTFbR9IvFO0sfHegcoTVd5XFUDtLmkyBBI
+dnKCi4s7TyjUVezIDvpZCqzgsLhzPguhh1GyGbcdM0dunTaJgxgy8ohybQts3X2y
+XEEofNpb0NnEPH0H4uav5NFaKXjbGhNqIigwkRWUlYzsgELrrY24ECHoQW7TigSQ
+y0Zfc5UWHJJt0IWp7yKnPTigylxi4OfUjhMyPZ+4CHo17koQ9l5TqJIv9YSEjYK8
+yN8m+PXeLARciUSaQvbGsLN5ae+/1Tai8mkRMf4MPUzDtsgjzEIQffWdtY6h6Rw+
+tC/wHJ90AB6h05ZSk8mZDTL7NPzNATe7akYdVZrRE78YJMxrkH2cHxo2vjvHSWxX
+m+/RGmCCWDk7k6fLLxKul5ISGy9l8dphmrfH2r7T31NWzmbmk0EIm2uJE/tMfdQz
+T4Cr2TRlhQYAtmYaaMGz19PBb1j/Rl9LmTgfCC7vMBcIfarAkxaRcMdnOGes7Ycz
+55bWziPDHBB1IhIP6EtQYDXA56s/v+U2KdWT+kDcZj1XgtJbiO+xUThIknfVLSvY
+Ts1EJ869Hab9IerF1lWfyhZ18atPD1zSTDvuzd/qdaGFwBQt1XiSLBr2xcNRLO3t
+ciakp2AbauNz2cuE0nFSyMQPNpYGG4dsbTGk3FQwTgolF8PUTJD6O66GvOpFbt0e
+kG8xFMjrQL/s0w1eWEuhiHPLH9o1US0iVZlLp7nQemaE+/8mpMxKK/UG9FRC04wx
++QWj7OhB9r2jVPOKGoAmlOiZhcwuVamUh6iCiGcmlV6/438zlioD92nZJ+OUoLwc
+NbDzCG6dTpMcO1ED7Ozvjmi/g6Dj3PNJvl4vcoGlwGXcI3QDYfXoarG8Yhsb54IF
+7I8Lsod3YmW85fiZ8wNFvRw4Ac/mqNz18Z1SlHBFXq7QwZgtUffyJbuvMW6ydxK5
+9n3WVsZvi/wI+Y6jsC1uifZNv6KR7mlVy8qRa/lPn9/YbqR+NyKJsWx3CYchxbsK
+hA6thDncXugLDf1/1XwqZTuO53/72eZpOjySYMyeqYwxXXfFIApSHi+4fuLoBSdY
+h30NOy1CAHHTOQoLp/YKBm7dXquoMSeACXanwEwPKqJrhd+RF/fO6HgrOB5WkBH6
+ZVbyIduWfC9SBvMG1Xz84pOzMPp05HegyR1Hq8tFHWM1cOMjeytCZY8gH3AZCjOT
+ZhUSumGJ5Sdiz4Jmsz+sJflCb+hw3/w0HN7Ht8qpegU2sdMPuv5pTn2Fn6NsP6nW
+y2QNpmJQ+hSAe2JafV3P2vIkIAphgOTXFQycXT1RQS2gSK09yq5QgeTMUX3PzGtE
+BTFwnzDi89QhK/E+IT6PAqXhXbyQlsgN0YUssIjS4FLIj8jc0+lnrqpvT8S5KNNp
+tGtKw5N0hJdcRimge67gr6FIW0YOXXcB7esSfLrcS5p9MmhGo2oA8JAjESu8xmhA
+QzIS0dn4uHj14n2AtJJr3InVOzQZr/M5Vd7zcmH4VA4aRTYFEKaI8bSO6WCu1O95
+XQHcEABezT0JqIkOVMxLoaeeTtu664bLGAxRDbVrg/Tn2U8cuh2Db2gaXRe9BXT1
+ZGWJu3HCcG7XDgiG3FW5N9cBsfmgKxx8eay309HQdUnEHnLSbrSd0HngyclbLd0g
+AjOG2w4/+kFLZrW+SFY/ESM/FYnInlo2D5B18Kx/GmM9C1AeghNFV1cuf9j/V8mm
+uqkaDEHdVudxiXX7Idpsvf4K65LZrcqVDSm9xb6C0ErRXV1W7VYFZtLyWkO/u0wT
+yV7mEumX3UrcJPba4Q3zWADI1A9e03eKK3TZfslJFfSvKsiz4aEEfl8IjBKz0DVk
+3x2IyIBA4+m8oUuv4gX7eLzbac1xQ3bDETMUR5OUf51iBjLYlc/y/xWMfxuIgbyn
+cIRfRAXKPaYt/dZ8Y5/qjPbqSKG/H6RmM+0fKd91fECDEOLtWJBZRnWjyEd2YFB/
+2XC5Y4XzkwaO0GMQXkSN4jxX/3i2wk0pOKX3MURoBVK/M80JeTNPDavjYX2nheN0
+WFzrzgZv/4g20b151DkdDdMzG6Lf5w0ogki58/O6Lu8TlHkWHgm9l7QAie7fPuzM
+vS9WYALbgMJehjX/77zsGEN/mGcmA5TyXOUQIXZLjuhgGPYmDQf0eN5vP2ugPHG4
+KXU+JcD4c5YN9hhoeiGCiWj1iX/V6yuM/Al+QAFkY9tLaXsm2dwuLOJjreacHYad
+yxzRyF41Z7j6TYntcdJjt/Y61nwLB5PDiX5T9KmU5PCx+1h1X4ACe3QxMwRTeNs5
+rywSXFGorpQD/981pqEKb81Ju4XED+cRlM/XAN9LRvTXaCp85xgddNOVT6zYMIGc
+CaBFnN0mMDGFmgHMT50AjRYwkuOosEQqehWHnPiPVHPdsKBwN4SZJrr4ftfDtG+V
+lY5Hw+Kr3Zz8ci7Z7FqTJw8Yj1WO+Ja+1pam8PH0c0MfCy7wsxej/CZIMSMsMplS
+z1NkZNuL8v4QblEyBdn4VRiiWYJsHFD3FEsb4fxGRs2fbN1SRJRJW0NS9At50ENu
+HdHHbJDhuxKZOIHiawafJIoIHlk15o/d/EjaPl7+CEn7m3gEBpbUj9mkxj26k8Pm
+vRY3VCle+pEdxItz3jOwAgqfP8HY77xtfx0o9Y74yLJFok0rVNlyu0G1NeQawpMx
+h7/gdQH5gmaTFfm6deCJwXYol/Li5V5MFzTwcxOjnbc1bBRNOONSQ7Qxq436s1ET
+RIHBBAohaLb0ENYIEElD/rRmBGX2xcFpAiHJbQq5YdinBbnXrnvLqruUE5JXKzEn
+5VDwDAmRk+WLv6039uMrqrYYaJHvFVKIsUnQWbOK72CRUZcwNMMtRODQGaAfu9j1
+7b5sSCQQlzO3hUOMqQjAhES9Wf/vbouJUvPYXvl2RoAt8DXsuz0zsBUkUCf4EKgD
+A/ns5Tgjk/rzcKXLlam/te6V7riZXQn32MdpAL5aA4GlKBYHRC83aLaElE1bPjuD
+dN7esax9R5sLQjj+XMl3IliZ4edjZURBlih0LpQIeaZXcXvlt+cpO/2V6o+uN/2p
+QFAZMJUpNCxSALphuK4/UaeTXzrykP1F8JgDkGcp8ExP7BsweCjZB+7i7XDPOARi
+Aea/FhEB/hsHA+enCkue/x4dZ5+oY7CWnybezZNu4oeMlWbGz8r8fPbNhTRs0JIb
+1ObEzigSPgDjXAjJxq5kn8f7sJzbnHgDJvEaCAXgpRu1XGZKYaCb3qXBwryYPRJV
+TI6iD2SWQUZkYSFPt/FOkm74EhFLqGnh+K2BR09Rq4maPCVemJOQau5FhulHpL0J
+NG7zOFN56glc/RYGeI/0b5KPvMvs4xYNdVsqlOy3RHLXvGL5oRiTz+lZn5og/y6i
+kzW12O5hVxa5/fTKCEmtldywARgffD0FYLLwDNIkgv9ybBFn44LIDxec9PCemt2f
+3bzwTSodqFOsbvXmEKrUppMKCndyLT2DfTSDL72QXfeUlJDlrlFNRumEsG2+O+WJ
+jGlHJE4PJ5mGxvOZQ+VVokA0Icn2+UlETVRw49OCCf+/aiT1Th+QpDGm9p0hH46J
+f6b6VHr+gJNXQwNhonTmgJwQzXAB5nKZvM/3XCNbXDiJaeYc9dVJAqVk2W6zXzJC
+Nc2MbkYJ7lTMAUyDCBgNHBqDRv3UORwsNDvRYjY3vX49rgqY+Xw52Scbtioq6DK/
+iF8QBsMH03palbp1E48PGR7h/JlX64+8jtPaHkdP6JVitIj1ikwYNl05j0rGpbPT
+JKrzBYZ3iPmEnhkW0oBEadjvGcl9/Yg4Sc1voJVw80G1nB3odv+CWdoxRFoP5E5o
+y11vB1DRydcgnuQEnIYdXh1JIa/cUPXKxQTf+0TsQ8yN7abjou4VYGvZI1J2YoK1
+5y7jI9wIGve0yM0vhYh2+zQ4ERXXYI/hQ0TWteJDXRj6R1gxfrdRrPrPNo1OGENY
+Q0MHEjNBeweVVs6nVsUEAfA94LEj0HGS5EqClGeR0OOXWgkKWLCw72U6lUEOrCrN
+9FgWVDYlS33gfIT8BpliZu19CYyadE+MUNXa+nWQaGohyJnmaTLTR8z4zbn5sQb3
+y36XgtQk1SsqmkXJT3Zl5hPGv+8ia2hrNo/tZBwlXDCUJtsO3mGbJiT9UGbl/+7k
+njyBz63s3cppjSKhDFHqGsTl5O+a+vNV8r4AdvNBUOe5fYnY7RfeCqfyGHVNaTXf
+T/pIyYeuYjeRAJ0D4tSqSqi5cay4Aw9qyyZeqUfy9lvCkA61U4mhzdGlo+lDtmGA
+paHlQwLTzsYRAgT8SP0z+xNvw6kEtzofXh6+NlpP5kGNOBltX6+nj1WCTP4UxFQT
+1wlscig0ozAklNjTmkrAJGfbQ/HeKApCnDIKpMiQxJtuqx5E8/9qg/HomIRQpmWp
+k10bsmkX9DWmy2EzSU9NCb2bZwHtpYXS4kqzlExBQ34U8Brx9pjPpeW4wm68zWuP
+X8eOqFuJDb9iphLlWSThRCGQpjXc/XCvmm0PGYzCOaWG92HN+lyPKl/fEZmNEtQ4
+YAKJwrWD39cfEr3qyBHaSKh/2ZexzBsS9skR3bFXgOvUwGyNFIMHIuJ+k2u+owZT
+gqKGIGiVi1PWztmb/ICNkPawIweh+1/G/8xLM19xsj/EbHASLRBCAPGdR9bjUesQ
+miwGjDmWkuGl6zvgeTT313jI3gWvrPf8ZBUHSZa0acGy5GMy/HofixQspUPCX5ZL
+KZ9W5hrGw7fmbXxQrtsX+Vyd5/GrL+kemC+qL7vgUVnr0A5lU+LME6mIdGMt7M+1
+9s5FrapfJb/zLk3tR3FP88FWRWh/CLAiDiLLeOSwqz90jx3k7nF8v1T4x0MyRAan
+fKe6R+Cdp2juLHKRV13vdjQOnpzJdsHlEea6dY4GA6WOssxa/NjxE+EIegnDCnRD
+fge97sIP8/ofPeyyAnSH3VVz3+Prce58wYsGjj4VS4yQSJTZ0Bs+xazVWaBPpNZW
+fC7+ZXsRgXCtgvoa3tBmQs27srHjxJc/Hcv7vKzqn5xBNmbdkvM4349Mwmkpawi6
+0RCOOYZ8Oqk+HnhJcGsNFTwHtHwK0r4tZ3bRc8Sck+c7Vk3V+FWaQ17ELmiGxZcB
+luQ/Q6wcwZrwgVp2b069U0tGbMScSeE0KMxHbVkfWlKgVR55QcfmD5G9JY30l2L5
+SC/nbq3dow8CEnKucsf1/bCDPFrH1jqVzekrOSGV/P60IqYaToqXgoip4fAZcCUe
+gNZbBSRi2atNgDTUFTdl/7bzhQR9lgFm7qG/W8FPVKuTxVaf1NzS0T53w/JzFgvr
+PVEyKgSiQjZHOYj/qt5rxVamp9J0uQxo3r5MiiEcuVIzeJiIr87mpEO3F4pG64X8
+gwZr2G1/wPfcRNMTjw4K4O4ElUU5QFe15SRTnOP1As4y1GhjPKbIV8CF96H+MaKl
+1UmZ0tQ6dsR8Nzi1N2P6NaQ1U8/9zOb31F42MxETyhYGbLhdcT0Yr7FKc5crtsKM
+yEsnk2Tq8WKUS4gfERovSCtoifP6O9eJJOwKrfDP5HySmH/W022/nxZveSLpdeTa
+Epe3GxqGigbXCAPZ7kHHc/ddeUdSahw2ZEkv6qUbsoLHlRQndq7RcLdzG3r0l4fn
+gne8MXwp33/9MxEhNWkMrTuFI6gzGF2rVVzMp1Up8/Y8BCggocjDH28ziQOwG8P0
+vxWJ4rZ6I6VmejfxcqImzQi1Gu0N+Gv5pULUl67v5vXZxX1fCmwSi6VD+bPMT+MX
+w7Sr1fiTQvMwOhKjZNqfWOy8BanXI1GIOdv6Z46Ad8jKWqB9FbFVwPfye0BL7RuY
+qY8Cy7MoPYVr2JChtkOEr08AiK5egB06m1jjbYwemb2cqAs/OIEgD2oyuXzbHBxf
+hfVe8m3h5CamnAzCYkyCxXMM+eLUVG/ycpDSf0jZ9ya5E71xM9fIFOabbhOazFCP
+lEHAVj/pad9Uh4EasiqEKSYSBbpS8ttwmULpJHrSbEjH5L2bBrSCtlRtRhMkuhXE
+jDp/RHhkCh9G1PDZYdap0IwVY7WPI3SwSzjDi+SBxr4WL1k1YW2rGqmxTcYXxCHI
+PVkC2l/EYSY/jNGieFqMHmrhuEIbOFpSLkpD+g7U6BNVJukI4QyPj4I/4g6axehr
+XZG2SG6h7UUsWfRhVxi4WFeq/lWvf0hXOpYavzy/Fujr1jBhpviZeK6Rr5IuAQgi
+wXhxSXXQMFyMTogMSH59TTgRbLr/Aaqm9xBxpQFo8Dh1GDS1dt+8mtmuP0xWiufn
+44VN68l790BqNaZE1kI+ZIdcfqDWMU9KhUQybi3KFSodG6GMlHLX322IbhVAIMnu
+tEw6spAFN3+6nO/Jhyu9b5HxkWunULciEKXydpjiyf7nwvt6drHv1/z5GK53j/DG
+iXQutx4+HRMXu+bjJ4xStLFc1rMYvkZg18bad2eNr0E652RH3D/hYQE9z5sxoC+T
+z/6hxsNWZiRRh0KjC2vgOFJSTB5CUKxQQj8Q8ff8QqV51RS0JnwVCYZJE1KevSl9
+/V36zPnU7NwVcIB+HA7TGVFb0qmumR52UrwHXDw6ojhcAqLlQj4wJaVqhn6g8SDD
+7gMfbIg5I8tcKaVRXONQqvxpyGaeYNWLLEskAD9wRP5VmzmolyBAIQlYO9QHLsSZ
+guIJP+8d87uKObDwGzrjbraifXzMXHL45E+fu1a9BgTfqZTAgd/xPdkY0LSPegVt
+14S3SOd6iKeGgEDWHllDhsDeonmMwnbnS3zc04OXGzGdaCP3OmqN566TnQKHP0Yd
+YQEGa5ZCqTOoobci1cY8E15AGmnsSgLD8RbL97CjOJrE7owJUp0o4bce17Yt9fWf
+GyQxwwARsJHg97d44f0m3LzHi7Ow3sH7e/yGoWBJZkGnIz5UlKRRXGdbcCfDs5Jd
+IhbPTgKaYxh1rffFcABBpJ9dk/63z7fzxnYcWckWPCYPgdhEkGWilWvTOLnjSngI
+gDuBY6Bo+q7lW5HLvy67RE1bLjAoArfLUf3Y5Vo4tBgk1zJgYhUe5ngvPWKCASMJ
+LqeiuLilQ5lXgd0I/W/gsUt0jxt3TfdBbZntXtnmp6/LcnghbYCgdFffm0dmwkWO
+vhqdFdfcwEh2inNSrPi07dCVthTRW9nB4TFKphvpwyATrKzCo+INs5fG9eR5DRvb
+q+6lRio8QvqXefv8qh6gRZb27/e7PRcQ5kejSCNfd60isqhN+L6IQoNMpHB7Q52/
+LEOxtcxzHx/wqzPQmBAlDSMcitbJHs+8gu792VXoegVG/bsWae+8MZM38lDx7Vhq
+7mTh6Gx3cNdQSe6gkm/ioRVPZkqC/KgjnJpoZ1qVNzbro7m8F+MV1B75kGAXBgqt
+aEbV3y738nWZv7lx3kXRySTT7YVMyoiij62vuQUvb5NImEwzooKWNf/2Nn4m7/73
+aPDI3dmknkU1Yt1nAV2Z6e4SfZXQP1Csrxi2vwRALy2GZQiDRbqtOJOT5nETZ69l
+Bge8nbcL4jCg5p1c1JzhLzmJ6I490urXLwTo/R5CYCQuYUxMKnvDsnMv1//xHtJK
+GLAhzdxXmVs19FpNTVUNYyxFoU3Ikwo/IgyRNioiSNLbBIE0Na2tM5NxAhahjJyB
+jnDBy7/FxgvwLT19p9xNw3y/4nDlelttrSFJ0E34FtOLnQf19CyvX6agT8SwvRFK
+khgpsT4jWx/WpQou2/TVvxWRi10I4MvYGjliScMhQxf/s1A6NJzhDhVZ4iSGHyBO
+gguwx91+0LVmHCnQOpuI1ZM6frjmUZyM9TVuALzG4N+qghvH76k2qbDTiHGXPvho
+sqgn4nleEatwNoeNqcre3NUMYu5PYAvbHAZF7zkrCAEl/KlzDPSih2B3joSr6YmM
+eIi6tRsX4EeAfXQW70aWfbrKZA72Ttu8dNBFZzPfIkQKEk0hXEa9/FeTwbWN89Yk
+k0s0IIQzgL/txhq1Idu3jBMCY3oK7jSoLuvqeuuD2gsAbXxJ8PKzF9VbPuHRj3YK
+F33Fn8/ZLQqghASIUUllNTWHWQ24X9RenoBRRH0ZEfZAeDHIqefUamgZuaBfmm4a
+5pNVc2fHqj7aKd9TxGmAvDwRFUJYS2Cq0bHmYJ6cZRfmWa0mtJu8nBBgSbfzvtGo
+LZ5ywyouTTHZyamu9+h5WoT59fiGBAOQztPKE+z/g9o58XibIQGD59LX+jOz+eeN
+sLc0Lk+yvNBmXGtfqJS1gpzZhYXk6lqhChqNt+C8HFehVqcSCOOmH5EyIWE4cgwM
+uoXy51xDeC6kvwbFJLJNInubb0WOQMjEf4UpUejMOVnuo3wD2vYR69a1I803Fdxi
+y8qeV9LWJYXWt37f0zhL9Qa+ecdwWX0b+i8xbo4Y9qv15DTuqb+ZBNhGuq0zQ6KX
+Q/mDFnDYMvPpBCnkgl2yLIcpTIm8bHBrPtKCVNoOwlfX03C8420Kg7Nvt+txf1Qy
+IfSGQJVr8OilVzc75xg76iHKtpy8TEcpbEBoB3jUogMXc+daDnZ9M1d+KlFa4QOI
+3Of6XXlVAxeJFYkYriHiu+u1dlIDsYIGJTLav6+fPFOm/fegof+E4MC5w9EpmOOR
+7zDOba1Yw0SfU9psTEaeNmAWpEHsyiBCg8CfG2XBoF8Ua7PIUt5FChydjLo9bd+G
+WV/UIPOhet2SYrrYd//+K+lYeS/3lqqd8VrCyNDfuqiXSRgI2zqBZ2Pu7JWIBpGJ
+22V3CvEclQ0pD/WBOi6IR/uVKxUPnvCOfSgHzUbxHVKJNxIy9LN6O7au/QZaNjli
+WuUCW0Nfwz3EaSv0/5c48Dkf8fwPYnt/7JIqzdKJW1CtaNK68nEC1GMBLYlubIyp
+bn+yNMt87J9ccLHWWHGRq5aaEesZPGcYnlQAopnyyTPPIdL+VKjPf4qELso7ZNYm
+RxFjya7dHI2urUQPLAMfW1KBKbXwGPkPY3GGZNsn83IeSMysxW3rN55P+XM5Rv4y
+xMA0vH8Buc33BsrRBhn/ul7ruXqpJiwSHBgaA76wl5UWDWDKz7vfwj6C9jLEr33N
+lxf8VLZHM3E+/S3NS9bq0bUm3BezsJKtyhVosGbNQtHGCaj5sXlttKZHI33ueXUb
+sGZLI+6qQK51VyhDHT/QOp53GR/X+ILMSekaABCuy6LPnZavP2JH0T7fP7p7xiK8
+VeHmjiwhQ9ICtdIKM/y8/gz6EpfvbUXHi4hbmwr1PErKrxAREDr4wrnyiL1uorpt
+NUFXVcM7epjQ+1j4PnxJT/wzRkeubsuvMQgjYcj7XlMVin00kYS6PLAtgTSzIMZx
+h2Ib+X7/Ibrqdh8LH3z52UtFjffpZozwbLNjIel5FnX3X/uShrdoppTG8slTdK5J
+9DO6+/eAzWhA/lKpuYOQPBRE+tI0BoAXdKOWNFYHqv4nijYApBqfmcQojrDHQ3Uu
+ySI8b12B9KX95RRY3oj02uPlOGzTc6RqSJvEosvrN+cVxqec7KXMDxkxYLRvBs9d
+UjEl80sgnJFSWW3Cm9r80Hasx79KeN09YPGDboluwFdY2hKNXhrcyUHy1nV9bYLR
+qGS22MlpM0QMF8wjRd82faAkhjzGUa1eXEf1w68iMbVqP8yelknpZWglvMjXi9iu
+gUteT2SftOOmcAzlsi3AUAE1wGUJ2+Lp3AfRMzndc3QpFFj4fZ6GB2zFh49U3605
+TjAdmqj6o4qNHge8JSE8eemu+pmfrwkItpKVP11AOqqMiW9+9Lks7nqHPm73lcWY
+OE4tWbg4XxtLRhgj/F0yFq54KyAaZLUXw9sN/yJZsz0KgYh1ml25mXw5n2vmMgsq
+LQ3XMJ0xGxBNKQKhTxGEL6fYB3OylUsF3LDvPGki1kT6u4GXrk+KU9nDgJpnwEiZ
+9UhLWkPwvqwqgABpdQPJWRKL2xsal7qIANzCDXrFDBpdGGbfQiq2bKW6zAStTU67
+PO/7tTS+tAE3TGu0cgq2TQ/yD5C05gdzWw4Qj+uKm+U6V90CSWPJ37JuX5DHmM5H
+nJM/8rhFB98ieNVk6riT86LA7gyDA4uBo2XWLihlGsPcX1Vxhq+oVc7eCU2qO9b1
+7w9jABLEQB7hBsr/BAZG//IYHLfLQX5ir2e17IDlOhEBc8wYHJZd3Qj1dqkhADjG
+S4wLAYdONEKQOUxU5EK1qTpcp0wHmPNsBPRND6BgyuSvSNr7Sve6JekBSJ8SRtJS
+StK8jea/NjvocJyeZiKFA3tNrBL4NnGIhOkj5+IAY+wChrCSC8pXm9PLtGedM9GT
+ZA6uKkkXxLPUsjyCSVsw62TRoSrbvY9RsYVyfbrToa/JrZlTNDSfZWr77ti9eh4c
+IKwVh/g+eOzHysg4lrNY5YgVFpO1MsTkpOUvOaAMsz4BSBKZgimtxvO/Yl3FVAnd
+BC1ApDgevtX08kWlCk2cbMExrF52LjKkJgOXozukI7gzHM1e4PMr8HcqNnXSCA7U
+OAWjlWA3nwy2dEf3SFVmfM+NoOS1UBvVHvbYenpwnC9cOXlzWIomS8r8r+Iy8Ln4
+IC9nW49fyVqxSjGdeExDbJm+9khmsSkWjNjs/aQ3hDzwSAYcnMjbIe0kONfqWlk2
+uSo44lM+usIJLmiSe/R2LkkQinzWim0Ijpwvv/WXBHvEVJkTVbZw7dOQkHUy7Zhg
+oNZtdbGQaPXNhjGJGSMDHBC5mg6uqQsNY6QpTrL+rwns34UPUHY6eLtlwGmyPHnr
+5hy8kNN3R8Qd2PRx6sDgEZz8GiujGxvaCf21bwE2G6M1WAB7frdbTIDKpq/cRbox
+oXA2K2se6rIPTsYmlVPm/UvrYbYdAX8dTkmKMVW4sKSBESgOL0T7F3Ofs7W2TUTX
+8ADfUvTL1QtWfJRMW/F/7Zn4xM7cNzbQACDXY8Z71jXIDso6ZH82Ucw5X9TjH3Ki
+h5WAhgMKLJYGQAfEJrox3n389L4dE0/WMPcJAJ0L18cZwdKAxSawSExEjIE3G6fy
+5/2sof+gpSWVA3pMs4JQP2tXIy/so1FqLuzruerUeeXOajZt32N36E5q/Ox0T5RQ
+Bd7aFH7CdCywFdEa4VvpXd+HqXcka/zRaCdtzwQt6Kh9v1uiz9VfRX0snHsLGtK8
+J7elD/wsqElLiH/wgH8abQBNzePsmnmAplIghLQpOWosD/bJ9ZmesnHt1gwpTTiO
+/sUDpXp4rO+nacLMW9G2ddiJtMOnw5LSgVfvXdGf0PrPD/9DoDn+nY2gTV9ZludN
+RxNfWsnl076RY3H66rHLhP0WeP+a/ImbGV1b8XwNaUTItxsgcO7F6cvIeduqFvP9
+3EZQJFuaGVhMFLIoQFXn7/qkW4pjgWaRIezNUv6GkrRXY/ze8R9JOrCq86UenfGx
+6FO2Kj+A24DojHEnfW9lSSMCSpEPcM/0xNl5C0CHCprN4fUfC+lqcC0BIT79NpWa
+n7i7VSq0ZSTz8OQerB5LXZXbkkBU655/10GWgRoDoCtvD8bQvDriAQCGWUENjDDM
+wmbxmk3u8ylpMgYeQUNxmD+2O/EZ7hhu7yCSbjnTudoF1D8wtr2TVISn0eLr0dpg
+RFDmxboOWUbjX2b51VXjmKatLHxVq0kFlKpeZSWWbkREnSGQ1n5pewZ8wXYc/Wd7
+jHkZSwkpobx0dvqPEl51ygN4fMhOvT+ZqHiVaDUIswd7Fisgsyw4GfX7jH9cQdtO
+/bZ+yWZvkmnS1RoqEMRhhucJQ2NDmFo+zzWG4+Z7729azhCRAqLkhEwSuF4K8Bo0
+k4h6/5BsFe6fpKzK71NtdXuTHv2EF7t2VJrCZTy8rlNeN5+wz7FOX8CpeWm2wDsU
+icUjn+yc1suy9wgqkKhnSIL9R4hUO5T3Mj5e/g0hWGPysssbPFCQNiClXJsIoDFY
+Il/hG7M5l7ZEqyvUqrARRxkaQ18Fda2FSM80COBIXxcf4l7Y9SSbJ5AultYpRjQl
+OYDkRJbbJF+tIPyFBx3WybMmDiuXgssyiQ0wscqgCw7IYAam3rDzwGg50X/l9v9T
+5sRa5iN0qpRDEz6c2B75Hqdxod8hdGtlec9UzwDazgpPwQrztK8llJ6hXb4ms3Hj
+nzNUVAMabJdxWDFaJo4HTH78L4wajdLPts4a2vwLRLCfVCqb0rZYIwCBQDUfIH28
+/jB7mmXNyvR44HhfS9z0gd1kwMNBi9LTWxFF4U8uekxSlYR+hGEU3RAacQG71RYD
+Nt1//73DUK2DQDhUXieMlkd/a3prhufpRj0whd1ML0MTNL4IH0Xze+8HPxS56UGX
+LgF6x2yWBFmqDvAX5gg/IcLNKFlPaIcBsprhtrirMZiGTm1wNEWOfiLn+zLIep02
+fWWtebIhzifIJNmYpBw+rRghi+p/7IDKJAqQ0tTwC6qZ3KYzGz0D8LocghJ7ZEAE
+ZsaGAMcJ89ESNsmBqG6YNNmQyR1F3flFJX0i3XRYWge70uuLMjYqEHJYnqRBgcyo
+Sd/UkABRZRJqJWpsUkbxNZ5OMqqJQTH/RZUw+ISjyJNxWzQlxg9Z3SJJYh2wH3J2
+V0eEwMlVibaJq4Mb67LsPhpfkslD9cBTSv9pZm590MVjd5dr6fG/keHDArJDOdRJ
+18kW3XCOaecYmgc0ZUPMjaJodxKBObeYzwm+quAwQ9ytLvvHWm7PO7ACTc1l/lCa
+9aPdh5g7Rf3uxHK8pNNKqd5i03ugGLXLRIXPlTmhvUO1hpNzMNGPU5AFb/N7paeO
+hjeCaR0QzVti1HxOGC4mc+0Zgk+1xPJBiY3BEumRzsNXzGAHJRkeZXFqoKnYrxIX
+4JY+7WHJGUJ18/M+2sK/UcpTietmfPtZpJzamYU0wNgYxAd5W6wuK71cqNfZZTeI
+l3BwrTQ0q6KQp0KpfPifJJZoZnYkJVg/2mTxeBbK23wDr0hcMmy+2JjmFMcOspYb
+upldaxOKlmDrAXcM9oEbwJAhNr2g0LDk4pArXvk9n99DGTbw6rTvgmAHRij7l7r2
+VZwbNykhhfOTMSB1mv32aoMI25kBjnqJ+TW41jBVtWRkbxq4/ccJ7ZpUrJA3HtzL
+qbu2XEKt3Z5Skb3XQwZfz/mLuePiDzIZls6v0tpHJY8NDvFEKQJpsK7apoqLTVmp
+Hcnxt0Oiol+qavh21GBwwCc8N6Qk4pP6tLKCgYXw3HS97IS/DVkySQib4zx6EtjX
+ooDyXhh/TDtdSz0X6DCtfKsYuQAOvrG0ioIzLLHgBdbcayXlfnEcFcg+r7/+lheM
+DOGELaGmEp4zQRkFhjqsCxFshWp2r4jQAJ0ar0BEcQI94k1Lxs4F2uqdlj2F4BjH
+dsWOvdJVmNqYjJflCcUBnrDUz2yLiMC1MHGiqFpgfl4OrJGfjNVe9V6JO91eQGng
+tQkNNowBks65bqLOa5SAeYGLr9o9M9D2ltYXFlsjPpzhpr09uMAIRhLHaG+WYDWL
+k5WsQa2zHi3O/pFzuRMVcuf4palAl6eHsbIoKROrPzoNbRvk/mAaQQnwGj6VIDIU
+hP5VNn3FkGOBMIeMzeFL7lBWyTwxAgEKqQ9ljC8lfRx6NA6h8re9mFKqpt95k5lj
+t4vlfdq7hn0q9ArpaxurZO7vOQN43hoqTXZfFlC8j8s/yBO0Ib4UtzXac8soxYJy
+BYSjorQcyNrln2aXddEJoxyDNDzgDksf+pVWGcWlOpU+/l5y51bSnZ08Xq0nYQsb
+IvRjkXZ+EFXiw1CPoC69ZZaWLw6jPRDc9oa5kxjE7W1Z1vrBY6fasUmSGfTmhBXp
+1NRWag8d4NDzQVU07lmlLKiO0WB/fUJZAbbgjSseJ4HWlgdXSdHfSlR+pcf1ARNF
+O4WkznnHPvzQP6nUKYe04RU72x4wj6JxrQ6umMRyvLDE7fy1o5rABv4huRMg3VVM
+jsU03rme8mnT/K/bK8TryFCKgwq9eo9eUvzhr4M2CAQKbjbYvg6IQJST/2we9kRy
+oEeD41ME2KAqwK6JsAY4Vj6aEKHQclCkEczEXK+Y9te2quXLqoal42mqxU+EG5zG
+0BLyTjJ2RQ1/hvAd4iyyUazadRJ+GhwXA8+t5GJSvTU+Qrat/uoZO4TE4kQ+rsqx
+AsvEtCBdwd+ghcfdOgE2SU4luFpfD9+ADZsfBBnaJyNBZl8k3yz+o5Lod20vv0U2
+4UqUpNAOUDzapFkUK36Wx4fqfwMf/3dfBhHy0cOmhpn7bhnmEwAtAwjFQkCvP93G
+SanyQNqfAFSU04GAarXhfYU5cS8uW7OOyXGv8Pov19TPDWZu+TjGBDORVuzvpy9Y
+6C1SLDnIrSAjh1/XZwhrAN1W9/0C61Icr1wTQKTocaTSaEx0Xw8G0J0PHZHSOudx
+F2gMF0Q7H7KtQRdp5CvJ9J1dc0pSYOqlg8X8pro6WxVRMU4omqfbcg1IsmGvWHTK
+fOiNR12TLAFni1skWZW12b1oK+eQXeMdn5oKXgWOTilvR8mHgwcZe5s9fnPkyCq2
+E+WBER8T9qZfMqpwj4OxsN8gBkRI+sBgLIOVAIopQvHSbQYHEDL4Xg0j7tO0KxTH
+snK2FXSz6ilbI8xoVHu6ILpzuA2n1emCW1AkKetb5ScBx/RZ66QS+3DDL09ACSy7
+e92BPlpGZcLdgX64ktDcqf4VU9AAIi1Mqu3Inu25ERcC7V85psS2OLVLGX8ey+VI
+aiQO2EfawAz+TEhmlY9A23vHPMQrOFWvOytkPF+d8J8lpdd+4sFrs/2bWch2Sw2X
+YKklcxNC7NZsi1SP65ZjFv/b/feteXIUUrJFKbIsyQmK8Q/vIhOQGCFp8o8dh+Dy
+K6yrVC8zxSRRUroXPcDxNhRV6pG8gi2T0dlFAbVPfY372VauarnU9EaIThWlq5ja
+lt/Y0iTPtsg06bSG3fLBaOmU7YN2yhZVwbbks41Grq8Avd1WP5IJy2VXqNmd9izU
+FzmHqpQmWGcW20QM3Je6+1AI4t6lldYFnPZlcfDyUP8os+RbJbQJorfQWf5Fwhl5
+Cz9FPhlgH2m35YptD0tkeUccY1fhpGn3B3ESSIlFnPoY/5YtrHSHHDdMrGJvzmYl
+x+6Z/D4DBR3cknYDxzOoFDFFkCumWIDjhd78YP2NvWj8Kl4l8p7+He2Fet4rAavN
+CYEo8XC30BvtSDcpWIgoYfaN9vW4Zh8tSj/mIewHxSzg8hpULwujBKjJVVzfnyed
+wf+3a8JmTZhker2PZ1a8lceTz1IJQf4OgTkL2NGr079CYPYCHAmGlzovPOcWtv4q
+rtNCcqZPvEfwFYETZgkVxaNz1pSZ3EPE27pZdSLqSvl1uEPmh3J2KQaJrZfE0YWp
+Ry6gfm3tLxcRKdsCfrP9Bn9rL9F8w/Jbdrsz0od55CgI82WRz8IbWtzdkmxn+cG6
+3kaLNwkIGCy/+bgk3Ct9zktnclOjPRjSQP31xw6T4KJf9ffi/4Rmf8aYBCzSVW7C
+YIZgr8WVVifIhYD4r3YNtJ5o6nLClrE08Blr31M9Vh85Zw6DgJwiqetPsh1ikvsp
+HAxHSgYJuwB+MTWECT6LSrM+Jf5mmHUrdHMTundr3l7wgrKu3aWNzox5Wp4T5Y8W
+rHKUbFSY01haKVaVmriVDU8WO5GCvgLbMDuqKzJy317Hrpp/j6dUr+zRelj2sK0Q
+5VJoVywFxffNS3WFwFzvUbLxuQRbheChUrmYcXDF/FLQm4SlMrBHzqudBg3xZ9kq
+tfVRksQ3WIP6NcbPQMpzS8oRXberhpfPuGlkMVmgfyA9n8zufdyEKQ4/x4vZuFLE
+5V0sin9IjE2lMlhLdYDkzgTfWa/WjMbIk1uxVmzVH6tTZu7HoRv+sSLQotGvLLD/
+mJu4yK4jCXDuIBZHWcPv31U2boCMY8XKhyGHYVzXahnQN7VEJMBRSqLQB42AVOkw
+UJF/v9M+fWNmWDS+jmPCSoHtgvSiFd4EaIfblrSvhdiO9mVrq7Myer3eIjPn2iiK
+PgLA594rT3B/ltRaLh+TIa+Tb7ytbuemkS9pf775vcdj1mrICNTQsLvnSPIfGBtf
+zgoYrB4cWhvdWQVfuWBEZJrtjHHq3QqKNRkjo0nfHr5O/bUBzIov1ffGupg86XhK
+eeZyE1DoitKsCB2/DKe7Mw1Fe0iA7awjwS8QnN47YU0Sxi0UoRtMtnqmse1m1eo6
+X8xXZpSN7ury7uVAzmVyjpSV393eAtTWzhtJKPfxiY2/1FeQMHK37zJdLAs7lPE3
+m0NA9Mc9jQ1M4NHfqGj4svkuphy8es5f29UtXJPYDuEI9o4lhBmjQ6jkqyPZPjTV
+xQbhXAGDwRe4MEj4eZdpncQ9nNFL8PKpBexWq94pQ/5U6JEw+6Qvr5b8jg6OU6xD
+JYqo09ATaZuiFqrSwnZyXM9SDPwKScb/kHcTwGFMUv3vEBemffckrpxcSqS0YmNt
+Krt7np6cCgAi+m0XVUdsbBHywqzXnTs79ciQiioDOyzScJPRvwgnIp3fdewotpDM
+uoI0hR0b/S7kUS9FrUBX2TsRJQN6u+B7QoIiaoJtWFWG9GvOLhtphdBVC3zIzwAl
+bL+N5y2lJhRuMRp5Y9O+Kdzbh3wdOUExnp5sVeCbcRnrHcMP049pUZ111GVPdWsL
+ndTuPI38cujRY6sDQbX6HWmrCxMhbUgC3/VDyUzxM+nqXRmanRmcA01DUwrqcHCO
+J8HMbR1mHf0JmqthCQ09BoBBAQ3iwwqCNait8fGXknY2WdwWtFk0tq+r5n6Pv+oR
+EY1A8jS7Zc+XmJroKLaTcioEK8ipvBKQ46Lc5YAcuUp21yWsEBGYasu5XVC8/TF7
+L7U25KGG1005PPFy8hGD3Uh9j2GhfGU7NKylffILo07r77uYnRh5ff1EYGe0pNIU
+T4EZfLjDtWx4sqIjjK/eaXou5rZ10/UCJDf0fGcbffxdm3ANYAAi4A0udFm7Iupc
+PX7x6Qa8FaxfOfX/xY9ljxPqaiYJJ6OE7aIH3FszufEJCuXZjTz2nj5r+uDW4Hp/
+AOCAfNmncVeLkQUeeyRmH+lYrGn1OpvfYlQKuMIizricKJxilvYD2OTjiKtlyxrv
+5Cr2aCM6KYBs6yX9hcpWshWgHXxkZlAsJS2i9gKicDuE6sNHi07wnkHHhEe71/Na
+zNdp+d6E1Dc8binPMR+n7z0ZerUHrwLr98sqCcAgGQrziv7VkBdOkRZebvLVoOgb
+E3uiwKFACeKm0rQ6ycOmDh2lo/b94Z1KD519BxFpZJht9Hcs0jjlCwxjSNdso4d1
+p3sRcONDpavVXpXB1goCufX+nHncfPh8baOmJq0XPzkKXsX8yW+6xSHe5r9tryMd
+UB11o0Ke4V9HBBocuCAONMGg/NoggSHnr9OJKrFZsuV9UzX2b+boWC8qxXV55wbY
+xjS3ubJ9rm8bLVdadWFzt682xbzokLrJ0JBo0/m4EARuBmuZAjZCsqkAIoG69Lmm
+pCVHl9Q+ZpJYNdrm8cD/cp8R0dmUcElux6Q98VwAy2TE5qwtQUiDeo9OxM2STbeY
+88Rl9MojA48VxLSpkHsTePsBfqDPXWskZtQrgAhjRIKqk593Q2WY8/ajH93uEmhP
+5eZ/GMT+ivXhLDz+QwuApxzfTNFNi9aGp2YoyyGyXah010MGpaxBrgPUdGAkqRAE
+dXJnjEqm6UWbM1yn3NhZMe4X9hhsJTqvNTLjHqGDOKvTFWK+auE6lFyRXLFsCAVs
+WBXdvOjWvraYtv9XfD1WaCpXzy3DLd1qWHnA8ffkeC9ekHTYGI3nQAz5FjVIW+gB
+U0Lyw7XN+aP0nDtf9MrUjcyrQ2xVY6L1daXNxyxGbV9iJ2IZWIC9kaizVRuihefO
+gl6Uwxieq59vr8gI17Ss4XOrHgynt/YPlbSiltzo2RjMsFS/qxfTFP58/YrajvKf
+1+hI86yZkELXo4AoUneVabRwFOGIv9Z91NaGqmEpSZTxPxAS4qYDtQzM2HbCRGUl
+/DbkJPtxVUvqbeOfbJKoVZHsxHwoGj+Oqk1XqWFpTXAeDS628lMKSNA9qfLNatPC
+4cUutj087FFHZ4BCzX3c4wZEc5DVNaaQH1JpG8/7WfCoSXshE5RUsmyek+Rl4zNo
+pfxxuHU56CMKjyZHNmCPup6+dvK+PUKEodsmCrNWANWfP9FQkEvQ98TEAqmjHjGI
+4xqQR4XSU2n7cg7JweSMd2aJ5owU67JOE6pygTutU9nvDM8GOpHxREyOmQRr4dSv
+zkyHBuJZm85RkAUM7VwaEYgQWdS3+TveRfwRfqN7iFiJfi3QwbUsF6QshSgabTMp
+29yGNAnmJRJDFZzhmoUw3shdu59dek8/mDIKwwMcVlrpvESqb6CPxXxYSYAyxY7w
+yAGoudiBDE7xboA3okXkFiVljSlCyDqaEXwNyUoIMn5iVI+ATVdmE/Wkdhr5pPIK
+NVl9FxY/rX94JtDrXoPek/9/dmgedtArgZ5X06MrSVvSg7z2pm+z/dXMHgXSVDGE
+ybLaGjRI0vG8FSEHq511gvxHdraZOCbs+VVp5+JkIt4j1Fh85L1903PKqPS7l+oY
+dig7t4y4rSmDT8sjRU9HxaQnaAsTgV/QjUN4Zx6iE4PgtR7EiZXpqmAAX/dwKWju
+TXYvCQyQHDj7VQ9O0ieTHE5MIHQh9htpO0EjrdupJecgyhy90naNL+7yIamno3kH
+9B9ZinSlLWhQkSw6M8zW3oohryLYwmXOscU29oQ62r393COStNx3Mbg+IyBNHXtf
+QtxWzuG91vJGg0rWGsRAzfLFCV4c2ojdsYhYUJXZAq34zEXlVo69fANE1eUVweVH
+YiXxHCj7EhJy6U0KhfpOy5jIpCNtwFJEa6b/XDvm+C2fbvre0WgTfRngL6BDq+2u
+fX0G4Y/fo/k96oJjVzPFAErOSZtZQ+z2glfcjmX4uWc5HpXsRqD00LLCC6zCPgpb
+DGXrtGYPZAa2B2SElGB/vXxn24LAFhssXklsLqv/FKUUC74dUkPymVlDNTRHwu5E
+BeonhU+Vk9pnUdvTW9MUabU1O+yjh7rRy4Gy5K9uScYUcEIdkIffR01UM9PgGI07
+EITZFZj69fi8k5qajn+6hStmHRHGzE/wTlebrWKob2QmrjBVltoXX3vjUGHPo7S4
+QXubVxNE28S1LigHMN5XLzmEO0Q2C97aOtaapQLYWSyATR+Hv3suOfmcQIHC9Cte
+3QeH+mg56FhWWwLZfhjC9lfrAPmEadtlL15e9iC9BJCyQie4hZFR8TeHWbjqapP6
+4wVTP42FLzrfVbUsm7TDeXV7NBerohSG2gWTqPVA3oQ6r/MRreFfdtMJwhKhU80G
+AY/Ducva/gyUPOWxSq4W0IHkqRX8f3OUq2PBaFVz7E2CkKiDpTsSJk5rMJIY+O0A
+1xX99iMuIvdI40nUgmFhaFT+aPcBXvbE6AcQtspoNvKq2+aje7NfrQxucmZeg57d
+4ePst3eQ6qLgKIAIZbJ1bQZ1skFlW5OWRqAFEwrCutkxMH9LJfFR030EnX9RwEMV
+IRQMuS9BEzuRzgw59jTdZEa1wDHrkIbpNO2vlZqE2F7CkENiZV2sj/2aZd98Q9I6
+dLFCEYmDwqV2ZSpoBci53ILm5qbUndPTXq7ldZlx9mEg2ShpkVfOj5goDrAGsJQa
+NXy7PiE+ntj97yLU8U9l/1uOTcpH6ImlyXXqZStoOwXkb6ZRZgm70klOwW4kwl4D
+3xf1qJ934sEW/zIx3Gehdv1eONJIIDVfiPU9RIg6LxR8GQSqkJlueE4O1dB2jyT1
+muuA7CPvRrOhJEgAWxxtpuG/63ANG3UKUZQxoOEPY+MNQoVg1AYPA/zaIuw83xTW
+qTKRrZzUZsSHWvJwfhf1s2jFMOnvjt1Liv1CBI7SuU3aZ7G8gqrw8GwaWL/Yafqq
+ApqEGUXn3aUhZ+OXzCHy8iWL3eHwS2AgXRnd7XKsnFY0EMcrdXWjn1eNmY/qH4HS
+rWyKdlWm0mpQ+UVXWDIfdigCFc+yflqCLDBu6gA3Zga/VVebEIOXMXruEEHY6YQb
+QaxHfeuCsdg8Deh5mN2jXSWQyp8RchRM0RLjC3OBRfeQW3PxAWHC4t1aWWG1+JP0
+SyQXXbJFoK3VEAUUrgsTZnHB8oolZPxRPGZw3K2EyNbC8bLVfDZNqT3ZgM8v6g2m
+druV969p6/sTMWIuSsXiemaag+eeJLl1IjDio5inZPJvTCFT98FVJTvkY9a0j+t9
+GPXyuljVNxpifoefMhZ0dpncYfTvBmVVFPY5zpwWQFLNsKsrBkmhaBvreWNAp31S
+Q1qF+d2d/XRBc4i1WLwucBGs4aGKw6St4ljDYRytDNKCTuIQ8wS7o3CR37Grmw5F
+JbQwdD/46hznFQSYUM+pThKA9C/atXoh3N3GtWb9Qsr1XjCpEya3YU/v99dzDuew
+ZzkHHu2glq0bdpQ/fccGi0oy5F/kN79toMOYdeBIad5yi022GtNMQJOOM5QvgIz+
+CCttdHAs/rXCX+cR87rQ0CAWqtKEHOm4/TIaE2fRZAOtRvZjMBKC5+SkyCVofAzh
+mdtxvI8c89gfB+8fD3WBbn+GzJDri/gNvFI1j4TrYtYhiBKvBueZkBZNmz1J7fNn
+rkh1EbX8zooAQ48AYDHlMeOZrjZIF2qjDB3MpjhfHyF5CSYo5Y+MHIQAu3ka/CCX
+uxrxPAbBkL8rO7IHPBCz9MT1FBnmAzSImjSaYsfNDN7IKxEgGG2/TwaCFV5cA0Wh
+Y0XVpT9jslkhBX8sWEG2bXEA1eO3nNgCJFU4tnMYW3AzoNL4sD5clD6LbyhI8p3L
+CE2k5r8uYozTxQumlXI6OG9FJblRXnkIzX0X+iO7P1J49jvAzUuaN6yNcuyXJJMj
+qpVccy1414VfhFAdII/9aT4nr0Mzer8jRM7td03Vvwt/x5p9XwGf96CxBNU6ahyP
+eclKlSQ/IJNdhW107HvTK/sHTRArUFteAuTXzVHUGXnFkZo4GY24aIyZ2TNGfb2d
+apJbrnIHLb3PfQm7xloG04gjplpjkfuPAc4ttp2Zu1zDP8zH+myvqHRmHIb+RXa9
+tPgIPlmsrz7inufRuaxRLXkh1CIYQOYCAlJ65OZ+Eo5Tnz7pYrtMObQ0AzWrmrSh
+LkWF1MjhA3hy93uSmYbDDl6CYJE24CNisw0GeeXCKMJhHMdugodtCrnMYOCtHo52
+x5ijA2h5tsQaMrGIGUMkqyHi7hsioDI88Qcu/DryN6WM5CFKByWloIoHdSc4+xmu
+QORAmZMf2A81uw4YjTOGzu9IDU2FFv7rpZ1JprT+4nI4eATsIadDHeJm2LvKD0i1
+lI9zBAyO0UoQJ2wi4NCPqp8kNVYzZFp3OMoI3sZxl2GfU4p0SK7zn3l+gInbovWJ
+t5J4fOfZl6bpzMcNBwlHm3aCxnSMtCasLFMatHKA0lsCn1aGOOwqjqRQnWFSoGTf
+D6ivNiCw17V6atBowNHCitBzJCL1V67ViIrTBD/RQcc3+1Ubz6rTT89AKiVqh+5W
+xiTCMcBIrmrwtdl+XJs8oVzNY2cUFM5EvkvjXdANGw/xBSH3Jv3YkOH8ol/7comv
+ygZJdFa4WfATwBB2VHfnJicWHXGBN+eUqMXe0JQgsyLKhDLoqf/q1j8EOLxdRFvz
+J4iahgHAyb0IME0/HuFgWOCLvqiyVMqcEZycyPKss5jeNuJgknxqZ5QMIC72txYE
+XfVkOFueaJioROGfxAlsA+h9FIMW3xChZgyvlkrhN0W5IW8iyZ2QLtuOIhfc08ya
+wMffRlaeUCyShhWShaZdR5OtT/L4IHsRv2691vcu4B1o+vJWHSB8/HqWewm5KbA4
+sIJ71vegsXBitQadTCgctLbFQUh/XuWnF4nTUNDBZtu4XdkHQQ8hYtbJta0UWgL5
+tpQvoqDuwpQCNkLnpMvka4Yuh2LvakAsA+YwqoGzDm1/hg6hHaHkcTBUghaMnwuP
+KkgjwoDLT4FxhT07KjM2/Z8NdJDXIjeIdHzB9OAHMFKpBc5uSzqH9v55DmY2VsnO
+l6RGDlBGtlHXY2Anec+TZCa0hrjBINeiUIQdggaBRYbEzva81H+UhldADKc1t3/m
+6sQiYxs1XH/Ct+nY802T9ZhZCGGr6e3WjlRJfB4EzoqfEy7YuRgvZKE5wTWMZzyY
+nfs9qzREifxqQnqHOjQq6fGdgYDWBSGak71TbLULe8rPBl1M6QB+tCiQZEUqx9GE
+X0RHBowaD1d5r+s3Qrukegd/tnVTe+ikww1aBCH3L87gmsEu6cXfBDh4GMbrwPXw
+vUjH/lG8ECdA0ux9a5EihAxxf7PE9apygXA2Kr8BYMH59cuXxehKwF34CJQop/H0
+TeSSD+i5g38bMN1uyM+tt5KX3cvnbjBWNmBfzdX+VAc3udwqZ5oF1yK+ZXx/0V5U
+Xm+QfqBpprXoCzAthIeyzVKTVVrH28hNg7dofm/ZaE4qbA4kKB3qvKPHpdVoIJCa
+shld3fvyfcQRiZKhGasuIl5oJPDP/f6EAS8UjejFqPfx3biWIexy8YZjy9zMC0RS
+NRy6PugCwoQmwkl28T5bwjA2jzbcLpQ56u1X19cz7ZyZZTNCclWxZul+Cb/e0D3q
+Wi9xS/kVLH9/NeKBTsiAmC+lG2DwzhW4z5BnqEnGc7EE9o4gFLQ1JZhfH+WOoBkv
+tCJapqiRozYZrNGGQryS99Osadr6A3UgSoAN90adW8K182sAv8/EC+g6xzf8+4ct
+pkO1thakbmN5FYjw5MaWv/6BoDvBfkKO+zYIJ2uTSppteYoU7ySxXOv6Upm2Wa6K
+kV5ZnAACr6pNuzp4czwnOZKu9OYujgAJHHTJe1sie2HrsX9zZslz/n+TyI0/0wic
+4wKAqTz/T8Q/uityYHzQdMGva+ZCu6z76t8pDO9oWgByOKVOE9iOMLEmLq8iaDsv
+aewEOW7yxg1pkhILfLBNlfg9J9cQo3hgHTtjF4HRMjifc4ih2TGDr5lkifFOTKMQ
+NR8s1HINvDpNcryTxUmgTp4+s2+L6hAmjnLwfZySoB+PB+XFjFKKhBQGCfQuC2d7
+U9vX1PVzRD+qrrrV0zJxPJ1b3Tu6Ljh4ht43nJCmFre0cC7AHcM/UMrcs8imrHMM
+9ttQrRxXSeEqQiWR5hDCxUBT41XcMx8HNTDYZmKX8VuT/kQcQf+O0UcX6BKxsF/S
+PwdHjDNX3y9VDhKilMsD2HjsNOhDNJvsDQhhCPijytET2QiL1VYQyKdWywge3QZ8
+W7tZpHtxgmEegDayk8Va7Goo1xGSe0Y0L3BP2UkqN3/9mY9Vzg4j2/mzjFCv7m90
+9UiWjBWnjN8ZMjjrW6LjDipp/oHr0bIJORez9C+hwRq/ib62V8FcUeloQz1VBiu1
+U/J+/nv2TBO/qYItrtFAO7MG6H28gbaeLbN9Qt54MZRyQw7SNYn4VrmhaXMo8kvg
+CyKlqFvLXHDbISNJDUHJgXsSBB8cVuS2IYjZOO10Wd9jNSIi6bYMkfN40P7yX1Ch
+mo7QXuEZE/iIdqnwPcoB7HEyIn3NZdvr+tlQDWxiFdKoxf+nDiSnoan0fBerfHGz
+AulXUBrmqZuBLXiuHJllwGi8ixLuQQm8ZbJMdiwBkfb2ZmytHgUbaOrj8qbO4Ld6
+S6Ccb69/0LHl1fCWUem5TzXJpOZxM9iOVx4iJED7owKqjn9vs0ygRDEWVDdjpfA1
+xrSTTsalJmyu0v0bGN3mPUu8icvNGL4DN2YiojpPLdJ4A8HfIsavCdvgtXFL81Hm
+4hrjmd1x0/VJDnnQt6tpIAsCfzKZeAWNMGbV+kI5h9r0Q3vYiiHNLrKXD93tWJY0
+PSexQcrsF3aBlGs1n3ud35WEM6DmqzhYMtq9HDoWifzrc+z6sQ+A+I5siSnEh1Fj
+VD99y2UfxVRnEWyFl5OzrWjcwMDIoT0dJNrdwGnvqefR4YDFFOfiMg0cWsWpROLn
+hbaY38yGV+M3kYiQHwI6uoUmtsmmOXpDRT5m3kagMSI2kKg1WbVkH40Mo2G7E8kO
+/WUq4wt/V8tX6d9Eq0IZTNncznIr5YlRAQctSf4ivqgiVNkMF8wCKhv4v8C/hAt5
+SLCHTILd4YBPNoBRjcPf3NVXnw5A1Gns382U1/uK+J6GSZcvPSWpGSLcMbkyTP2T
+PkN3QQeKZZwE/vcrCHydppBzQSAwDrorrG7xgvWT0sd94JTf5eltyT38NLT3832F
+02eewtgJomFID0rwAiDtwAzJ0Dpovg6WzJAV6EHNiht7PH3m1UQmYj21RbQymfDC
+rulyrDEoPpQoANC2dYmi46mkyP71Z+YkD/0kQmbqyX+0p972AilyzksHMNJrcG16
+8DGjnsYE6ItocYwnO7XzDvPV58XKJfbxe6RdUUmc2gbrJr1Uub7425Q5FtGKTbk2
+V7U55oFJziKF8UzZfYfDiKdDFloN7Vf6oA5CPQhDVbr7CF77x3V54Hd0YgG7+D4I
+qdHt2k/wKNeMTUYEtWIklYKDbB6mVloTpTZyv4b1z2tgobuiqbgG3eBt0dEWlxlE
+x+9jx+tVR7bMpsTsne+UsiJR3dE/QRV6NkSq+us/+lZGLiRGhwu4qn3QJh631htT
+3iMr4Krp6bigTXcx1MxF1Au7khVZb43DMx3O6xwnGt5rzycH2sLFGjtN4nEbtlVP
+ziqwrZaqnxkDIgGi9TzwwbUXzprQcn5PLktd2lDw/1+K5VQcA88HO1eQTV0qGMFB
+cWW9YCQnK4ZO5bSvb4oRUu29wylju5LIjtzjtBOaSZw6axA+6jOgDy7cD7x54ofF
+K6hnQ8XGNblv5+Pdh9RAt/lMJJtcLoKXUwGDiqf7xcQmx9pXh17zlKFLIcIFZeyx
+jhK9ek+IBHqMzYPHJqbLMweIhjAcp+Z3Yf5xLfK2KSc7Sz+8L1pCr1P+uFpZ1GKg
+w9FFy8GiB+J2X9Szh8Pz99yoYEqsd+Ce4fpRubrKV4xx+ZRqtxEOfAlR0eImM9zR
+LYOP5ZbnSpEojUEWeTifBBdSi40kUu4TZnYiQd4R0iqI7NUtqYLHdSPyOh6XLNn1
+9hur0NRB+Pgrf1ZM1DO974kZDMhqgHy3l19iqsj96nJmtqb0jmF0YN2ducCX+XXI
+4FWqKIXaeHXH3u80RipHk+bsMvfrn4KTzcx//QN+SxEa9BKDVTYVwHffBeEFu1v+
+QWGpVQfKcfNyzL57efwJLmZUcrPGKZZIk5e2HZPszMWXWzshCF86EloHqMjjlYJK
+W5RPxOr1CCLVgjqgQDP9J3BAPhcZO3yaWoowGqXq133A3nZTEhDx91bQUlHABZa4
+cySKchnSBUxDFLqYD3OtPwe7Ra34nNh3p/HPfGfayqVMh6uu+sjvnbzl+NAw1Ml8
+HbmCT55PVknHUOLCqYiElVDALcGxQZz8xf1D3pVpg8DqQK34/XLedcVDcuhITUlT
+qWctOyVU/WBO6JyqphCZqv/9P4hV5AYb5GLss3Tpwunzt3LWjraaBxe4+l7uEFdB
+0wmSmIUKT+a+N/u73FfBuP6S3X3NYmH/lY0hJ96plF3McuuGKcfhUSug5ZGCUNwc
+dF0EIedjcNTC84yvvxZxlSvieS3CE13olk0ZHg3clzGUuO6hnx9CyVP5BN3cJaQC
++EDPxvG1+7LMQ/GQJgt43rSLlrHEaJkuOq7aZn803MqT2HJFxNOaxE2fUvR6All8
+QnTiuRDztivbj7ijxufb7CBufXZXR1NZZRahL70WCWehBbdOdj9o8wF75ZR+zF/h
+QdblRKzeOqnVWUFIVfzWbMnUcJbk0SyeL/FK6zAYbQYJ6Oa869ODjESlZ2FsptdV
+DCJN4Hg3cxTHWuJAUHNCv3p6MASwBFPMUUjoEq2MSepzOpQqPMmMmhL0Kh8MpBZC
+sJA87RLoWceyJiWwuXdIQtAOAYzPkA8gwvF6t00sHXgSCsFcpXOgmkH806WOJHGe
+dHtladTml8eP0lunLIk1t5eUT0SbxARYdZy+lQ/B5XE1lJ5Qx+WNCQOX7XcpNnt3
+WKKpvfASFncNNizee1abYs+f8HEpD7wqKYo95XYApbVqD8STn/PpahZFwoWhQgDY
+Imu2L81iqetdooFuYObzVt/SZ6nUveEN9FmY1an8oncwAC1eyj4f3ABJRS71oWIt
+2At17ymJ0U4Jm5Ge0KmbH5l17LbOaEqh+6wQimzQyMdG24OxRv3ChcDiDCjjhG2H
+5xHowVQoSChlIn+/M6ejPPMsUHIqYZmxMqj0IATPP/wPa3xvWAd+4TIjSZ5ihnen
+qYC3mD4Ms0K9+rqbwSNKCw4V8YxSeLovL99PUZwJ+Xhzl/mOpOA1QqPepkaHkE+t
+sBM1DV26dsERBSi9JZi0Ka8pbShk6SUr89VhcltntGmmacgtA6ds/8WS83waLEFr
+/m5SoSwQ4B+X5NhDtR+w/7H7D97xuv/uaC2r4uSK0Yfp8U8sZLFYHBC8tU5xi3Rm
+M0sUaYSB3QMZZmMoyZTijFafmROgM9BOEFWDMU3/0MTRD328ccSimVFbLKoywWU0
+uW8iaclArIhsBkZx41lLHpTgvKkXWBFT3TaqparCPlzQiUJyOrZIzYltDi17iS1J
+2Y/4FXm1Wvuk1seTS3PcbJJnZnEvzAx+mI7LmaVXoUkrhDIkxrISBoR1WXfJhblL
+1UeUOXt6HSGBarwCNPYYYPdWWR3C7+aGsQDBQw33M65Ta1A6LYUIOnak2Q5Po4Cr
+MG0qdeDj8LDDL4XL2knpur1QtY5AtyVXZ7vwxFEWCThr5MIfLNWRZUiQWzO5YfpD
+/LmkQBSKfeTa+Lui5RmkE6c0rCzSDwJ5iecWwAczh7hvrsR5lyHaweeOttmjpTrj
+Ie4untBkuWwnl8IJuaPvTiyaBF702Q/BkSTbcd2NUvtk61dzWYSwjcWCMKwirWQ9
+c8V+VmiQwucqpRc7o6YJvl04BWWYlcEGYm4ffxV4frMR//6q3R3uolOGBIKX8pE1
+c08x72vmA0f4Dl7CLRk2cgWLh4BicGON3ULyJj7zu2gygxkAFf1DbA6WFdJqO8KO
+Y+9LxXR6GDG1J/WREUHkweXrHj3NPu1AS4qwCqSOaJOhQ6qlHPiPgGWpgEdboEo9
+CYNEZQMjBSdM/cSPEsMDBDNFyc6UgbE+Lmcyh0LgFcu/r54ziz70Ax3G7rEVvjgP
+SCJqJ/Xw4HinyGTpfC1N4KHfX7OELtbkcI/+bycOzPN54jk18W8P0VOoGlM730IL
+1rUi9BO5OxhbA/vViCfeg1z8zVkvRS1L8qnbNRnbWXBbvszwbXiH5yN6Ck9M3xvI
+1Uh4a9qT3kS9y9RNEVjdeG7fX+wtoGv8ciASQapLiGP+BCLTxJfwdFYvuMvsCOwa
+dH34d0T9ywnx3gjLDq9h5uInqZ+3VLE08DZkW1LDnUwLrPbrWcpUu6DXHZk2Dn3o
+hlC3LXS0t7izwmCTSwtCvXSobRvAWjYtBx6L8bNwWzkK6ODJEPLAjZzYWbhBICPI
+nnsDXe35kLgSHsyohjGbUy+wltwiERwwtdlZmrkw5zy26M82hQeqHYAhbLbpoFOa
+dr5sr3F0IrVjrRLDZWLv+Ogvbon5PCWh5uXczPk/W9NhEMgUlynSjU62nV7Z1983
+9Dz2ooIPsrqzOY4zfJU/fthEK6ZPPQq76wCRZrKPRyvJKDQ5lRJ6vPMwWZg9aJIo
+THkcBDNWB+UEG/dKpu+57xTmEEPboST/r/WYbysYMT40R407XKEl0Mn01DBPHzIr
+l1OWtw21c9MZLWDgge8R6sm6U5Sw9FndhvwX3pX17ekcQ7K9KZkVt/7bnt8wC+qr
+9tgvSM1NjKkuAViwLnvQkSluqU9gJchufkPgsWyBTo5tXwktLmw3u9+d1CD8oj73
+bhdnCz7vanaY2Hs9jMzMK+1djFEm11C6PUHTww8g5Ev5Si5jCyUURXAI3g6szOas
+lQf9xRKegkNqDCUEFvjqTf3HYWkDtjQLGdvjy3jPH3O0f8ksbqC383HZ/Q7Cu5+d
+KiTh30SNBNjpNmghNihQVijeqo1Ay9mH3P6qgFCbtxMJ0lR1WyE5Qo++Mt01sofs
+C7MZIhjPqLsdeARqnTRS1beJlozxiLBdqynR17qjqYws5d7iEU8OhqAKQ4TQiEAK
+21rtYKpmFWFPOlOP/769LWR3xzPWKMzDLQXt+TBHGiIKZ9AHr8dze/ShqAJI7QlO
+txokG98tagfN0LRH2lwPqNa5T9MMmedfc+dtJ7VnpNzVDv4DkHae7B0mnkSxbw9+
+f0bSee3QgEyxyaL0QF92zJJwZEClUOlI9uEFEj+Ncwxg082UH3UcBZxC60xiqnY3
+HPyxcCzejMRBeDvyfBafGfCuUJyYseWgKnrzFtHu526tECcXcBT/lYCKf1Ms1J+5
+lqwsAMC0jm39ilNdhP4CTgJ5GGzPr/AOiIzq5quFBZ6EcQFt44wSSUwhACVtICVR
+sml0+IMICGrh+Qoaix81zf39WV87DjtATH3rNwDr0F81U81SXiPJyHKnAMgUwzDz
+5hD2dsgXFH9asq5D+OPD45XsdWuoYIMh7DgpnKpJE5hZX2X657V9RwWSa+jDrbyk
+j0IFobnJuENSbSYL28j5//z2Lbt9RtTEvs57DS+u91SicWmGMN1pd0bSYP8TFys9
+gwgJcX60TM34ZoGgsYQqnd2n+vzh8vFOb7DfGpohBNwW7nwm24BM7OFteC9DbEFa
+7z4FZzwEw4E61DflnilBu6KPlbDZh4y2EjETEVHplhu9YTX4JkAqa2l+Nw0pid8B
+Evx7H1ZNOypkAZO6ykSlEot75ZeGyRIHFK+EKxufGOMB9zx7BLT5UrDVpFgT8hkr
+cywYmKu2t+TzzLX5CHJcS+l/MbtMGvWxvUM1GueCNkTTHShmlpT8XsUfe8ODI1VY
+LVDd7ZX3DVCbz0+VyTIaKvyCN2IZ2XnILGy26mdY3riF3src+6Yp11Ssi5SjC/iL
+gL5WiU6RD4dT0BLOS8ZGcg87t/ci/7CpJUHnu2YnP2Rfg7AQ4wTGUJvykB+pR18M
+AlnkG8zYIX0g3xLp9hx2huNix8SStDH5Yc+WEOvPd9Z93HwUjRlmRlLbuUYfrNSv
+fHltc4WlIPIX/U9H6zt/rulbSh7nXHFooYdG4uNi8p7a9C95LeWczoBFyGH7ZV1w
+OJB+XzCvc2XBupHrF+hyjyy2vJHcgRcbc2OSBqmguGB0gzoBmV3wmKXwtnMDek5S
+NyK7sUftAm+MSS78abj+n4qB5dHSdKTu5rHOXWPjdJcUodDqVYGNDsDqev1Bb3E+
+7/6jCYlpTp6GUvNUa8k1INMISQd+5vQlrNtwVJf7f4kwwYgpZE/se7OOU6kG5Z9Z
+neiSYE1Z/xKH+oI5OCu5C3XXl8ljDQbQ7YZnq051NoSaGqMq7Ta/vHfnD0fIbCAq
+8Z8zO2oXSrgBd5wEsG0R1ozShy1iIBFkvRN+MXs/WidDe2IJF269kbSSd68riS59
+g/lL+9ZHQGMf0/KtG7yJ7H0cN/KF2n2omU8SIqzw2W1lQYl38lbPyRFU3D+ZJdQS
+qgyJvWcwYBU8HT77V1T3N76zUAmVZS+LizYPqUJwWvcEtmyhuHZQIBYMkOU65tCD
+Kgm1V5R8qZi0x6VpZZEByFZbo6VGcyxgDiXmAVABrOde+jPWlee7McbTRqGB+KxJ
+sA9+MU56FcTsMNDCAdIAhsEWbE8J93HbN3/odsvB6kUPp0guuHOrPsbhRVtsYBRx
+ikc+a4DcaDywr/+ajZNl4oz5PYHB+JLenNwba6faiAzHlBZQfve/hiSHj934DH17
+fXiP71qOWE3kxm1hDN+XmcGpPvMbEOuI46kirleH9EtK3f7huP/iAQI1im744KZl
+CRWXGu3jJHAGXJRoeDXRq9SNAc0dE9g2efREV1bS45pVSwZK8D9RGEyPZ+PmPujl
+zFAr9RJ3pBNeF/X/jinS4japDrLKJs5IRwxG/7lFkoIONzBTE6dZULugBGxbv8pq
+gSejF7zVj/KR6+rj6MbSv33PB3L355JHjK1eNUTj84/U2DOPm9rnAbReTVERwi2k
+73Z9eXJ5KpvxDTokQfnRJNnz+BDrPH+weNP3yZVp3Gb51SDAwClUpjCFNuX6K7iY
+jmCFmTSBgNc3fJyMmj8XiF+IYRWM4BA1Oz03hV+7MRWurYDIV5sLRDmME9uRo6wQ
+h+wmn4wkl0ymAVkC0Vi9Qyj5wxq2vjA1Yr1hkPWg0BytRIxt65fViHupEsD3AiWs
+nKxDliVxPooTcAYHocdebw9M9zBencmNHywRtWpkJJ62S2us5bMvlCAF/GAjiDvW
+I2/msAoyK8BJoS4t9489INM/IBrd7ngf6I7xunAznNJPnqOf3b+hlVnCPX8FGyZe
+TzrLJReyuXlEdMYHHL53V+v5oWffYq9sQFOik2rkFsdU8jhdNRALwV2VKvys8Z1b
+85dkcC0akCA1RJMjVuNQuBl+EZcexUdFVQ4kRN0RNCK5TEnNk0qNhhJdw8I2Vp0D
+cZrZL2joovUWbW81lSbkO7B0AzM/A1X6CDxEmDa+CAgbMGguQ/1mPkQJEWpPZW+x
+SDb9DGJPkrVOHNvrK0fW25mNqb/0lYmd0+Lg+ba8ja6zTKrV0b/PtB2Vt2YvzSuy
++PqVLxiL+2685B4bCUqQale5tzsB5xoCP/L3ZR2caVTteu1MQlO916qVqEDi05EK
+RW9I3Zz2UB4WdX6ZR4JSAEPtEW+SeoFvR4TDE+Xi10hybaABJMngpeRkSYB57CMI
+PEPbMBh/MwU1iVPNxqwuac5xbXjK9Cenkywt5nlV+He03InmnFItX5ilcH85nvGu
+shr/urEQmSHRn3sYA908DouhOJE07KdQqO1+P/HRbHC4ZJHSZ2e2HmbodsqIdx0r
+8/XxxRsmvCB9mTz63l4f2DzAFF4V8YN8pvsDwBxXJcffljh59sKsWlxNQ8gv41bo
+EXikqOHVHn7YGYnrPjgPSiajaU/jQ+L5cCdG2UlJ14YAbmOjVa5Z8//jdsm4sks1
+wbFE81iKEyiVSp1LThbVWLseTgnFyxL9isgQxecnYB9lOTSUGKzAPcIllf1OhvQX
+TUCKblFBaOPwBJ3gvChxn17BxC6NUZbEpgzq+bJ3oBxS8UOnn3uDsnhqk1Yko6qX
+llF03iZ9/RgfbkKn60gmodJ6GKNivW8L6O/sBzQ59Wh6cPLhxBuXj8mIhHvbOAn+
+8KBzoDlPgBRZsDxF+0TkpcV+A8bSnN95ZZ2Q7J2kc7a8PawPi5qIlxY0x2/KSxhK
+8aqMpkWPKkVYnoKVrVf3dfpEIf1Rs25ZLFkY2VHVw4NqFzgoyNtkVPO068EWXuSQ
+0G4HKKz1gsKF7XdlVq+HJoQDll+q2Pp2VlJjJJgeroxj3joAX2AHpmY1b7YjmXm6
+TNg5jTIQsVYDHtIrcjGd/+GG1WGMEcNpm0+5aA0c4czndcsQ/1j33O3OEtOsgihL
+iyV3WipxTJS4com6h0lBr8Q2BsuXOlgQ3zVAWhMVikujSwP36Je9oQJfijJY8xXG
+tADqHAV/2MFa8gG1ourXHzDrCzov/QREpEijv93I5WQqmviFxKnEUBsd0LhOai08
+I3ptuQCy2J+Q76xeJ+jXWNpijn8uTpHWkJDMHLbsg1PrJlQXdWVBM0Gm2Vr83zYB
+9dEh4b7pXRUYSbTx5Inej+Ho/pP3jy7fyDB1af9CsBExDLE+8TWfd3R0iX7B8jOF
+XMm6EnHtKGM0iyViylevySeicVPIbIsd/Rel0Ujg92B4+pIRUOWQfYnyY5swWh8z
+jhp7SSVWicNsOoRG5gXRn5lbQdI3xr4sFgDvp7mqDSpS+qtVO7i8u6eZpPvmELv6
+tsz1Owl+fjHkniAjV8TSe4AsK0r4xd++xVhAe9/JVfSRQYKlwoVpNLvIuOFexCq9
+jPybSZ/WhCDWYI31+XsTe9OYRCDYLd4WRKZG/wrDOc2TA8pPbB9TkIY8SEMscel0
+DAD5nOSNuUnPwDuNAfcRgYuiWWgWKXwUk81cMf7psWfWWIZ1E54hxZNE0yVf432b
+PPjpEsSG5ap0mVhILnCX5QLR6Pqyp65lvg1Wga+CGFEiq4/jSVq3j3C/25mQmTOt
+iACmQ1hFzz1mziQUe8jT/b7hRLgwyavFrXEu5i9/OVDxxJrwzOcwTWUIPa1CmuaE
+Rxkriw9Id0pAVsqvkGRXXuyk8Jrmzwx0e20LOszTuZq7QnTlVKS3HKnyQiR64nTv
+/4TA1c5YVhRNPu6zJlnkAvbH363lAQkKoCLVrb8nWnyVWmB9/1zHnWVuopf3mmwL
+rx6sEsyeKqHZh044c3EBrF0kkS50eem99nfg279zp6PC733cyM7fF+BjLftGEhtE
+IreHHmCzw2a7qrH/Y+Dfjz4WB0a0s2/xA/2IlVUmtIW0PW82u3ri2GrO8mTTDDmR
+8Mkb8k6ZQgpM58k8bkQA7TPKGLxkcqgvNCQYTc2hIB+/dVkA48tw+fNDp68/25KC
+sDBdYkFmbjWRmsEs7jpi+Ug45GsXanPpxSSUSc2HfM18ggM/fU1NNwU87ws5CcsB
+tTLQk0hAsI6UnakHaDKThJGLeI7Wv/0eG8y1OFm4BGD3rB/5cr6E8Xcu/ElLzDFy
+6UnwvmGlLzTbfuTcyWF7Qs80dEH/MkV65vHeP/OYgAOz94xr6aZfv1vHz+x2Htot
+HBe5ajVefrsrLnC77kNYgc4KrnzziiNWP3Ee/8OCCJ+mO9gEAWZMaRdY5XlVg/lY
+hpxLr1QcRl+pvYBS16P7GpVnw38w61J+ZUZYVIS6U2nQ0Vyc09v7k8iaYxvEJDRC
+d5aH/U3UlwWLb0QZq4Kva66pZ3U1c6S4eBK3CCa0eHFl6hrP/CYXGmjMNMm8dP0q
+hWovuC6q+gJ5kZHJXfT3IXEdGhr11FenCssfu9mBsYqV/h0rE5FuNFLcooqHYvJX
+UYIST1otiD6mBLBEW69pVMQE5ht198d3U1RZgdZY86qXslyWeGJFYCmUDo28qUV9
+v2KnCOzsXV4W0L61S/wDpIrzKc8VBDGvuCShJFA4Tg/t5CaPx2s9hsxDdz7OtvcF
+FozI1bpWDLQyLQfQjPPG3/Llmdyq3AR1t3T+rN2F/nBliboelA6vVih1xh6cZ6MP
+Hi0whGSPkucU/GeofaqT2qmd8nDWV0YQyGpwVWIspqeiiPyWspQsAgYiofKxnLOV
+kmt+jtJdvgu2T0QZmUKCd5dBIPI2/2nMy43isvfGQf70uCVzFqE9XBBbcm1MI9R4
+Lw2MbaKm8AnSzE9uqukYRbriVbClS1yFptJnM5jcM8dro2dl0Ss4S5TkN1zsd/Ao
+mgw0rqLytOcLjEm0uuszBzvCxmorJpln4qv6rhwSfKlmYguwYpjk8X59u/6Mr2+v
+zAlxAYoMmnNgvNqVH5v922vKA3nABkgGH6x3yWgIsRnJPtCPBhSeymypjHd/Gvb/
+prs2Y/TkN4Qkdu6ZtgpClsgYNP5Bl+u4zOa7m8DxqBv0zH5wv/GWqiDbQdtJfX75
+1FSZe/HG5NJi/L/OLTVTJTPGKdkwd+AjLkgMY+tjIXMxwrBewiaD56D14fTQUvhQ
+GxoyPEyXAJ8jcOVTAXJvWJyLdLKf8bXUzc4L6ED+pJlTFiTDGdbB+fA1aA8vOjhT
+TrBnOOiiWzpGCc3FEjb/jfzW39FBLraZyHfoWBUkkmSK2x/GLoZABQKOtPpjEQH3
+7RDjsLT1czkmXIEZqujjPaIRS+gmsvS4qEvr/o9SJbAoIt+1DMBntSoKbKIX9ead
+i2SB1nWYeEi/GXOHucsy0DfVPD/nO9vIbgkHQ6WfDZ2KguCPcs34gEX6SrO0BEQa
+1WIuDxw2tdIYQrD64WnW7bfYTjFQ7XGgfn+yjsimxgU+x5hSgrOxH08BU3C2oD3w
+3tZqmXsMoGXN16UHjXBlKsOqjAzYRHGe2gcLqV6TOiMcISEK4GJnDN/VW1nQM3Gx
+kQx68bBjubLaylT87m9K4xwCaxY0aqQar7eKaZn6Gqe6mpzjKhZqi/AGUXIWcFgW
+EsfYVOHhwHqR1eIyuXvjWT3YXd9jMbM/S0QcRkgejCq34ERTlcix/7gRuuYk2mWo
+SYc58cixvN5XMuuR8QL9ZruYLaTrO9hkcKcOhOILFU74hETjlsdsJEWzCaqgBfTh
+Yc9GdauU2CKEITA9n1Zm97jLpxEjP/2WcfrH5j1uLwZCXwFo0f3bsp3Sk3sdt5FS
+mBfvBVbYpV2ZRhnN1u0VU5BcXACXjM0NsJphJiwYw9OyqLjH09p410WEFLQibPuW
+ceJ5am5nAPcazX62hfhynYOkhBOkWZRqQoBURG2fp0zG+ptZPCPTw3lnrhFjTqOd
+xY/NQW+9jl+BR0R4qDtYs23KoTBEhufyFNqE6Q/IE8G9nna5Q4rVF211V451pD+8
+sJGK3QiTjS/c4IxG8T/p6AhQhDwBuPSI90S2FSjq1iKK8gCmnYWsinzpSWsRV+5+
+YeMEMtU8tDjCblnRFnmJd8jWlvEIkA0SJ3kWKzm5P7xMT9bcKKr5TH03VtwWAJ6a
+DcyRV7iX7j14Q2HWtHBVSak1e8NNUWo+YPT8bSTUUgfgTEdT8UEeDcRPdROodSiu
+rc7uOI04XeVBnjEfziN5/ADMNjSj9kLdl9jhS6GTZQ2bV4GwPLFOuwgjW7dG5k5w
+6L2sr5ulEgzZlFG3CLGJAC7ijIk/xBojxTYF1cih7zPkoyLY3kLIvipz18PtXFxp
+bl1IJ5DXwglUwQluIoaBIITl7MRxXNj9Tlp88iEd+dSzXYMIRBdACihM25GNPHUm
+RjADduwNl06iopl1y2NkExdh2lzDGzZmur+Zvratj1pMdkyoGuRrBQzo+/ufVto5
+sSgY70X6l20bnsq/lSB0TqtERd3SklitzpXdDAaA2nHzJD5RySaOXK7oJfSnjxtJ
+Jk8nIsPqWqxnJwtOeq8Lk2c6MH3GN/HYNMTAPtv/KkwhPpzAdJQlDVTDcLqj5QIv
+YMTlrAKtNo+wPl7okIhYYW6OALyPWR1Rnwcv0suwniLiQGh3voag2obwcrkpIoeT
+muYqajCtzYLwc3KAX9pjKg1NX5Uwf25JH6r5LJH1PD04bBl+/vv3R0klB+a3Njwy
+WA1uxgsFEh+H0LMpV1qisWUXkoytn3dbVhQfSIjapvyk2UYk0EuzwD6poqipl7jL
+duGPXxhJY4CH8ue0l/bKUR6rheBcyGOq/ILnzSBfeH9ID2IUFBuX1TbbFcc6AAcX
+vsc7cChOHEYfYsewKCkPDXN77+mlEeoVLWscGHw85YEEO+AsK6R42hH+0JW7R5pF
+SnpzvmiXzrKehKiZloBVXaQFUY9RM+bcryv49ZXsEb7QGVd0sGdQkv9WEwC4qmMY
+7PLIszaUr37URfJJaQFDujYXDivt2FaaAHOxVEnngZWYvatQbdo/hKmgGRrhqyUn
+RbeH8r0Rr41xCK54unEoTCjqjodv2kM5QZCnkg5TYWdSm5gD4ooLV3SEnRlDL3hP
+h5U1X+0tdmO+aRryyTQ8n0wcVNtqeyUxXPlKdsMQMUaxQkbpzf/LN4f1vdvdrn4d
+kOXY2o3M9XXcZqcQAPpuqK+uilGORY4dVxTrBIOyCsoL7izWVjkmst7MLs8/zyWN
+lroZuKAOYo0LpooFZZNqkJFCH3TipnVoepLNjzrsnvsL0+RBYMRmVb68hkRrqqhz
+qznDGjiwc9d5QE5O75QrhOGojpEyLNVuOUHSnfBl6H8z1HL23YH0kp3nX3XxMLgo
+xFIN7Z9LwH5RB/4MOML41ONffe4EFXrPRRlACNp6StbCN1qc+k5ajQHZF1WB+58M
+Fcoo2mMTZWpQ+CMq98E4UTwh5Dgo9ye4Ws8sZFn+9wgXXWWTnKOyr6/0nVQZ/Yki
+m2fcR4JGlUQ4OxbvjmyMBuSv11DFNDIb6wfWk9VMnNEf0ZgyEjTZJIHkBR/fzwYl
+a6n/K6upKoxtRibv8V6wuCqqMCb7mEu5z7llagydwbs/preer+sIJqryjMtGtgeB
+xnSVRP5/za/nC8c/PXacv3EsoMuvj6H0TS0cI8TlHUboOunMm5fcBWoo4Ewmcq8Y
+KKaWW0M17zQvgFkCfIN7eZVNP827ThAu9nQk7Ylgt3A/FLXMhliMYr9/zntBAUv8
+NwvnABtx7lvb8/MPQgEGYP0n5EqxnuKRvXR4BaLtsGEZDghcIR4YbiT4GKpp1NIY
+/tqgKbAesczpTF2Gk8FqzYcLRxmklC7hYw8Js3oxaIqcnJl8WrIMv2ixeF6NZp3T
+7Sax1/rztU+VI6jYQr0vkHao7j97l7X6gKXsaTiTpFgsCo5xF57pVdaIuVnnLlUg
+/zosLrqIZ6gOgFI5bMYxqP1EXendr8MkDyQWMuy0jnd7bmAoCMknyXpjkvyToDMi
+uZCal+kak+nil0od1G64kbvbpvblHY4XwrG7tuBCdJne49sClydCVTQdDnXXyhJ8
+9+Xa0WHxIlAjrrsFRpDH/OheRn9xDnSwpHkip9FkkklrsPia9Q4o7sNuknneGgPU
++wmBxQ1SUMGS6gYLrog3sbVVBzAImt94BfGVopLQFrFodEe1162o2ZJva06IYu6U
+ZLvIYBSm1nt/w043zKVdvM4Hup9jKmHzCv1Mb4IcZN9ex1laJ9LEXclWN1EJTIMW
+iIvI0zERheyY1p8k27TsTAG8zkXuFY0JbMY9kXkRD0P4jvQCrIeBk10vRO8uVoZr
+oy89+IsKYfDwuUDgR+F6e2+jdyjVive27vuAS5yrxxwVaupZAb6MBh67+u7zf7IL
+78a8eAbaFKRk1IosCX9NggaGOVw0VZE0B8WDQhcymnZRx6g47dkkIbZes2+hVxXq
+j+6XQnbsdWpX7g82vWyIne5ZNDCUrlU3BBknDP+CYdD1bj7MFP85WfgwZmBUmP1i
+14UdgDLbQYn7Fr6eLBvIat3W0nbYxzy7UdwaJcpHOeFocHsyrD2LyH06oMmvAPIs
+1QKhnYauE6TvU7IF2pAdr7ds660Joba9mOuvhkm+2v4IQexXkdDfAziaL932xWu2
+oUmtKI0TTptEJbt3zGLbEaY/HZ/5n9W1WcxX4yZLqPvTEI2q3kgUoxoJehVNelTZ
+dRNo3Qt2nUG8tLw8jv99mIyITu3ruNw3evE/3XazqaWFQi13xOX0fN2pGcxvbc/4
+WuOurtUmO5vAIdEBBSflhEC82OsCqimvgW3NpuEzDUKVSlUpgLN9R0HO3OOWkWbI
+MZkky+Kjz/2HbPvZEygkvLGr5biGSZCsbg7l2m8aHnX8tBxbzXPKi6evi0ZM4rHB
+Eb4QZc4XK/fFikOxDu9iobG/fowemZq/bfTOaTxcLmABEhJtCz09h40XSQMEtVlt
+k/sRCVYS+LcAMpoKtT/0PLILt29qXk2oaxPqsaDzUx2bU3FOJCgoqc558riKyuNZ
+WROpGENwcmlhoXuAluHHPqLtzqClzNzZ+y7j5CLE0t93e4B8lVPawiZNbMOmZ/s9
++PirhY9fk526mLJ2nmDNzuTrPrcB04pPrA+TAMbTz9eM1zerHp1GRAS6JLt0gBte
+vdNMp2Ph8E4EeYWl/60Qnl7oLdtFgyRH7DoQHLPcTsI2774rT+blF9M1kGxwEz2m
+/G+CbrT6ff2jF8P7DKAdaipjVm1M58ED6PheN69xdZgYhswDc8bZ5s6ZFrDaQnGR
+UBKfeubfh5nVsB10cf4grtxAFGED7ZtuTnDSpzmJGT5/8yqd6ph0ONmrv510wxH3
+oWRoqLA+7trCqtG/QYQXRXN+ncuZUxkkcAmdcNeoeL6UIc+aLlic8SqgZsudxG7Q
+fhbHpqja+2HQBmVlmdf3wKlTFnxY5XYvkk5yRJac9xtmhPPrLeBSuNQ2gn2YLvf/
+dmrREMFV+R7oVqyFsDmsy9E2+wZ9BjcO0fz0o0azW8R6kJtXBzPR4y8XN8oUBx9J
+PkYppfoAZhdGDv3gUfZpMFE0ANTuhSHUBo9x/wtaBfwjJtIOgAwJAGukwNsJRr1R
+En7xFI8wI7SPpL5y06SF7GWU+pT5ATJA1GLOoPq3VSXnj48NmEf+St1KfBdgVZI7
+HYRmsjQozO7JUID4c7XgwfI56Xzc86m/TUF2Nd1waGFAyNHC1Hf0xTv5B23J84GD
+Hdk/QEv6r6kDbCV1b4qhOxHvEk+r2msMdDLG00JZmDffhdL9AVP/J0BtQmAlXZW+
+IKreyHEry3l5JdxG8jpu62Jqsy5H/Ft/eFTPsQoXEdrsqg4QHe3Ss7eqRb7cS9l3
+n83kOYelHr05DqxeEI/JyKsqapF+3Jawqsg0KfX5Hb9DM4J6OfbKfAz5LVhVDsLL
+Hwr33dv8DZc0vkdsUT/8wbcaR2LaP7Renv8Pc3ijAK250BmTq0CaSd+J11+6Q3ke
+kpzv7zTE0AwdYq6D5p8Euu8H2HtBqumr9P8RPoLWOU0rIMxzgGHhmYRBU/7i5Pjm
+URCwlnBLtzbr9V6jKRiAGTNUx88xrt4ekkFpi4x3bgxhLP0LHt4BET0TIXOSrpkA
+KbYJeOuDdwvUzU/YBLvLoBLs0X6D6RJvNxLaZUwCHo09rrsk1aqwrhOByidQUkab
+/sLcCs1BGihLDlo2kAJhO9GCEsOCqxWTjuESnSyZcFHKuFukKZBy0/BEwyI69m/K
+hbwtvvMiKwqUJRyODjRpoZd1f0a42Qq5vZG//awWlJ5eZiSa+AoTLE9OomF6FQls
+JdRszwIz8P6Qg5un0ul35IGMx64fqOyAG30xObwwCN7iKX+UhKNkk/z4auD2Errp
+HdYO/FldbFlH2VJnWojmFMw5l6n2yudKboKmTu9QsWieQ7uTvPq8iH0Y5eBe9y3E
+7HnU8rpFL5LsqLlIGm4zv0d7zAO+Ii6E2CMttsiTDFUYaWtVJdelMq8iVKNO2k7u
+cqR2snTjL0mrCu/jlCreALeHap4uwntQi5hHlppP7D9/sqUDs91cnJ5KgcKEEMBn
+Fjygr01tIHxW5hhkhdcrQ8pxRUSqRd65Xrtv98ntkSjJ8kUYTdwBP80xk6nRTd5Q
+DPaR1nR64pUNyX7+HnqBY2SYfLWEaC7oauM21Yt0qtlEUSO1KNQvWito7ssQge1f
+svkodyrmsKqwc8XTId9O+IiaFIlt0eVUI6UK+vUe2MJazFEY6u4jsE5pk+DN/13F
+FmGtvMRPXp3fBWwLubeoc9KTJ69upEsejmG3K2TIy4TmyNJC0x4j1heI253gBsq3
+w7CVgSAYd4lH8mHSorqsNyXAT7YfwUcC17+IHffzmy9kOJ5Vu8UUHY2nt9hHej5w
+EnYYKXemEAO3ApDuoVyroWsD12PK7PybrWjk2kPHWUB+rlinyikL0o0tdGbwPUgD
+6SGfGKG4lCdmMZOdJe/dK4dZAmdhLwTNmJ+XQHoegLoLKs35Am1F3BjkullYloM5
+dZM2w0Rm7T2N/6nKNCVPdJWvG3NH05aDQhIvVAqMPkUjvGCUZcYgfvELtf7Eq+1m
+mNsgZsu1kM3ONxgfpmVP3e0HbpXn66cJydApHkGtPHRJq7ylSVwpm30gmB3pDMCs
+IsQLUmQfnNHjXNbPBGpMLLOY+iCbKmrt3zjyU/k6xIa8yx7xeiMkFo+JTKV133sS
+XMuzLuR0caZVT4gDXSV7YRzDyn+loMO5C3G9qKtu0VrK2mpSHAFbSxlghg11J5e0
+ynDQpv9z30ncPi0lPYVOuiFWGwrsNJ9kaFpaa3QMYoqSwkGZvZ8Cvy6hnHGmwlx3
+mVTquCt7HNKaOSwNI3N7ThmamaXulVz2SYahGwrGoaJQPdnagSj7pPX7LqPcLZX8
+HoofGpPvhp6i7tRD7mUlMUF7j1QqGrfncqR3wo4H+jsNSI0eI4P1O7YzyyG7itnO
+K1hmZCpgv7fpEeM/aEyvtjc2B205vz6sYLbV/tYWneedpUHRoCjcw850kRsuMZz1
+FU77mAwB62tR0RQG0WlUqAM742wkbYInTcQ7l9N3fJNyahhYeJJLO8HVuh4Vhh/h
+avcV1IlO05Cn2z6nkeEP7TH04Z8aVWUpJbquaF2/owI5khNTjRUtTSGTPmfPzn6i
+yEfvpCBB9uGUdXWDDo4dst8K3YK1qMCuwLVGgDAK5DgoUR3Y2bB6fFPOslf8jWz2
+qfgWMCIfE+uiCdpOKguzsqYYSftluMK5u2kFoJSupmEZXLyJBejhwQLp7XAZpdVf
+SK11dqeJIA/FXS+IkpNQm6+NyL9+PjCvO/LHQBicsAXfPEagoT8RyYC0mvFrTc0U
+dEetIowar4Y0a4iBjsszvPJaz4wEbIMgIwtFXcDHSETcaXEdnW8wydFHPUU3CLdV
+XPHc5FCFftGo9zhb2F3w5Ww1Xuu6oKs4x104sM5xx4RMxG2sKmb3xNXvglUNIjDw
+0zOFFQudEMxGb1l5BhPuNE8jbdd8Krh3XgtMszQ4MbeZ3xLBNI4vbPmlqJrdPbWw
+CvEP1gP2IsuEwT9Eq2z5P6YG1KMl7SgpPxRKSfy11AmaOW4BMj6PeMqslmsAX408
+J9vm6TtL29aftdOgeWMPUM0pIMS9P0LpoIgEeEIVqyFlFObykfEFEgOSHl2adMJD
+NZgjcR8mJZNNOZf0iMrKCxpd+mB5YRsQ8td2a00wPBOwGrHYC/nAcXEzUZGS7vwr
+EAG7e0HytASlHs2vuNy9Gr4lBhfnzuJWRK+8nSRphxYIWCik17p2+aox7B/V3YLA
+/j3Zy1N8gOpIOcEuXYYOXAhiuZNDmBzRA+HKCoXHhviR9p8f8MJJf/Xbe2+Kr6Zf
+mGKdj343JzG+jM4UtD62GjltZELjYhr6ZX2y1kACiqswhnGuc+55ZSZ4oovEGblZ
+m+dZU2OobZJSOo5ZweRWBvhbuEPa0BEcp+HuilTlr9k8hfDXbaMYTsZgLi3JVbOn
+E5qByeiDhIQffuq9j5MQq2XsK97Ew12R/BMyhgRMQx/9Ohpt1f4xfGZcM55ufOBx
+Y2/USOsK8AGLbmFV16uPfGn+qjYQNl1WiE2/JmOTzj8t+D6XRIZ16ioKlfos0lTe
+e6iKKNs0GlC+FG9E6MJpttAsR5E2R8c3LORyNTP6YQo2PhwXlfSaixWOt8+nUXN1
+zwz0kTh+dbLtHSfWXcIH6LyOGNJEwplaTf4ecUShEv2U0WIpkRa/6HUzoI24nVzd
+ejKt1xEp3tJX7RJwfIfMtgsLXqn/R5In9R77Hil1OkpveA5xzlQP7lspoeNpSLZs
+4uDds0lTzRv4FUCP4/1ScaVDIf3rx5ph8rutefrjm4iAkBRWsEtnBY7owjbGYs5A
+sJxf87nRk7Ua448U2YF0vepVrxGXqOcsHEoYFab5PKcQMOg5bOFrWdEgHAALO2cA
+XEMNz7tELKplV/xq+rw2UYad0RfBzUtlE2mErLcnf0e6EAanv/9ef9iVe+gUcQjF
+0qNlWhF69iB1gdmxj/3NAWwpEq0yA94vdmwQNGbSrLIevlOdJolOZx59k40KyMXw
+aLsgDMdwLhle2QfzUBR+72+hiJGHYQxBH7ZyH7KEZctR6lTxoerM29KwDanDU377
+bGJ57O9c+G3ecE3Oh2SkYUOTKIn2ZJsfDd91f6zDRCgXq/dq92z42fp+U8kWrhct
+Xz8S4/lPjgHDS13YMCvbtyR1/Vf6diCIWsJdlzSonZvVzuDS2m+KrDpjkoVUrgfe
+18jrBiMfB7wGdgitwKILvQ+vKuTjhg1biKrWf4p4oen1c92QHiDTO9PM3XQ68FBh
+K4GuRoE/SVnpuBQec+/NkXfqkR1uEcGszfZmsaMI2IGxut2l6VDKOHw3Ok0On8pA
+WbBzvNgULB2qgx7duLJUcHhH9u8Vy543cqsALOyk+5ZC15Kb9udZlWJzqkz6Ce9m
+a2LvYECcsde9JJzXJpLq72+s6mDN7aF3AjNS7KUwYdu37BmY8wgHEJenN0cmnJMg
+s89I0L1rsr2SLCLtPfpU+/ke9k5njl+NS8GlbTkQFcx+xM2CkGxgBMu2KOgkeMZ/
+kjGCjzR2XSewRaPWVlFB4alVKsQFUYoZ3rB1rNlF5oc+OEE0HgrlnLDrikxwmr0A
+JmZ4qCRvG4XYJo1NJpuiJYC7P6ua5VDJVepBPddjMHNh7oZdk22Hyw4b0LsXkPpu
+gsJZ3DntS2LJ3IRUysxMIHz5UVdtyvF0TR1+53l08zEJfLbXlZeob8PP34A8G3zd
+uticD+/m41nlUIpycal1PfKdjInQi8gR9FFK1cDZqOTn8Jorh89HZXa7ETBx9RT5
+lanhbCLI1ZTJi+P0TzHvuG0rnv2cyLqlop+uOt3rA68tgy6YVAOUbdsrWBcxa5L3
+fnP+2NwoWOF11WBvUk8S+db/qRzCa6x3a3RcavYUA05TDTJRJvziGQ3Gdz1jYWGK
+5AIBuQbBF3+6aexbgRaFk2FfRs68KYVmej/ia6VyzoRjkD4pRPeSnGCCYQC8Sibk
+kh1f3BWvxctLbbtUBN4453AgxgzG1T2pJGkcrk6QNUQzH+YudXhYmng37JW1iAsx
+KgUV0XHZ4qsn9yMk9bFDnAc8k/oeyeRKRLzZbwrNcVuTLY62WArB5XoHd1fbj3RE
+NI0jn2+O/65KcYnaEeQcH9s97PkELjQzA1Di5rmDEzq0FM7b7CfuDhGSHmQ+pUy5
+fNcQ9y1uZxRxiGy5jhHffreIoaNE1jw/8jAKKFEBPmv8vuBEyHxlCTyBMOfHl9Qr
+VRD+iNn/QpLh55rtnfzHLwC5rm+gj6PkKnprzHU64uCUmUAhHoyNRO0JgE1IBTY7
+4rnXtj5rlp6zNfdSFIYAJ7QGlmIHvCiN8zQMXUUgEEYzxyp1cDJuC2OjdkrMoFdb
+z5TusWxyT4CFRY9jyVZZybfkCsfVW+sYKiZsuTePgRiB3AQIh5XaA/mWvorOlVaZ
+mhejturtr2tKGWzhRPgPc+lTeoxNKQgml1z4CVaI0+v2rH304ay/QyhEhLHsREpy
+zNFzQzp+znRc1FV5508P7JZliKfAcrbuqxQwjzYmMQkilYkdZV8nnVcdLVHbHvAA
+k/+ZLmsgb4d/oHQepgiD9alSPL4p8DnUV7kMkgxrF26EeHjSzibMSs1AINl5OkoB
+slxpLmrRs3ACnGAkmUhq1CPAv0RfEReuEp0xryJ/YzP710aIKu4KDayecSWj96YD
+6BF5XEDO3d8UAzM7B7lWQ5yaPjuvUtf39EAI1PI3WFyMakMlPA021TfmeLCEIuFH
+jY77EBHklGNvTRJFGVzZpvC3+0gHqRUnZH/5BR7mz/eUn/PlN96LDCFVshAjhEoB
+rQj9E5MGJXOPTOuLCxhHswNhNBnOiUBbiXVEaOfevr8LAtWa0aoX0pQmd9cZS9At
+gNvbyIp6Ds4/ayPfJ6UdroTAXQOzrO9VIiw2xBG8IuV+x/80DuuJoO7o0R1IEj/v
+O6ZjpbzjAL3GJlPPGGYCpwjkYfyAKCgeZyj/gqJqZsmvCZoPbQFavhWvwJt9QHUi
+ayFXddJtugDqBfNMtRMHxu3x97XilfxJKbzk3DPKlGJ/XdAPfYMjDXp2gjhsI+lA
+wnhX/3BDliGV7VaUfiY+NAeKUelQQD3yYJrsZUqCcub3qAYx2lem2Tcic0FSc7Uw
+l7F9TSY72r7sEeGJC2EfpX3ebUDJCfzps0vCmD7XB4Q9gSiiwrKbvDFKpmzG9e/t
+ONoMD8dlxJznT1TrAcYJXWacaLCsAHQIy1M4woYBslAijIoN2jyg1zQXxbg6TdXb
+9XmQbHoolEtM2MtYTkLArO6USvG1jicw1a+oHjwtxO/+mAvltUqiSzawtGTCQJY7
+JMXp6l65bHRrOeA/6dRqexHFL5z21bKYf/wFVitDACMv2eNiy26e18IewqOvzuLf
+y3cl1mkAX8evJonkb3Ucm+yRisAJwdVGwzDDCuKF4M/DCWHWqTFxS9xXN/9SeD1o
+aeKpn/O9T9gk7L0Dabu1fO2Lv4oVtqtemNHK3xnl5xVZdM1UNFWQjnO17X6SGGsi
+kyW6y+inJpAWOBDBVTzmWWzVIMt69glmwfxVCcf6Z4d4nHSTGz7POoTAL3RQ3bkm
+slIkUntlK0doVmx6SLWkV+UWbZgc46/izktWbcmpUuQ4tTLsjfrKCJl6egEsPj4D
+yXJEQLgT+7worT7lGvI6Sm+XM9WICCs1pYDRhGNI3d6/0wR24wvbjzuogFo8Zb5q
+9v+rYqTAKR8nFLaurEhV8LZAT4H71JNwLHRgfbL3RpPO8TbyfsjavDkYaxUq2x5l
+zQK4wWSxmT/AtkStuaJX3C9BUnog6wBp+z3AIjb7nwRYhZwjlExHSFZ6qn8phTC/
+hoNqwYNMD/jmDFDfAlOEguMX7uyXE6EOIRFxXaopAQjt8BjZFBbIIL5jj+23zqME
+Y6Hu+qszXP1d1yDg7QaaF1T9WvFG8hMY9nj0Zpp+/vLiUnzXq6AaBBX+4giiLRcF
+HhkVU9SupWtfLUxSPj4wktqto+zf1YUuPx5hA4OsGsGq9inN25OFk05Gma1ftQoX
+Qx/JAxQqnWLTYhPDFKgj0Q1usN7zj8YcIQSAWtjEWMRivtsPZymo9u7MFHsCdcKl
+EPmWRAZu7KiPJP4m76zMzU7pzX7Voe/MH5VBq3Xsgz4Taz/7Mlx967alNccqxKgX
+hXk7KUYUwp2jMwl2kmQ7YoedIyj/fFYnaNS7o4ZtUtiOh61t1QHiHk/O7sxtoBl5
+kJrebpC4yT/j+OBx1RR+0tzTOjExWNVDHdDuuBB+qAnbfAbzCFWptOKdZi8jHXU7
+nU2WGVQbZRzRLCu2ZdmFQcA7AKXfF0sCuLzPEKFI3eqhMm3V8zmWk01W+e4yNEh7
+4pEQSJw/bmlcrF6x1tW5M+ZmKtqpKDEIZgDV6KRMj/VgwtEmz4j9pLmIwAAPJWZl
+C3KG+AFeLQcfg1bnZpBsSXjsqLiLUDJXriBb4H27FnE5QvbiPzvLfW0o6VvOJcvL
+3EvQNd+CzZbvHVDRDRE7BZPIPY6yn4rhPcNkvPUqkLyHdc2HexOe777fJ+5NJVRv
+JlMyEDCKOv+b+bws/qSbyAz8FhBcZEFSwSKfkqvCFYHmkV46oZiXK9+JL2DA9Q3k
+a9BryFi59n4WOZSeaPjNlFQxskT0runbORgQUHRQn7Drqx2nkO49ezuHIskuLjTE
+v7k4n6BqHDh1xeh0BicuclPyexzIC8wh+yvvjNxNKRWndgLGN6QpInLlIgE/xypZ
+rIbcqAwRno/IRtywGzvQnVQs9MK8tEAhtEVR0+McRI5lWv8+kf+nIdXnVuFf26JP
+iKzl95XcwdtlGoypeI8Po3cUXuSfq4cFActMlegaic9WTBmrpzhDGhag5yhKSw2H
+MCmGp8KgxyTjitHU8TLA/Bp4Ewz4izYUthxCm+tELW/PYwNH4cLPMdyBK+VH0Nvk
+wZnU2NqB6fOFxJFaAJpwwIYbFb4bOHTe3exx+sUPQ8SY5WSHQ9tOBCvC9GuClzNe
+nAHnsRDiMUtBxvq5ONPWUxRd7fAj40x+T5Iib0iFUyc99ffFYn6KvhjkYPNBDpDn
+MSewjk4hulXtONlRVt12W1Sdoime2FLpAekkST73k31RCzoICMzG5C0UUtFbJ9eZ
+VRivfp2Kwiz4gWnK9xirJyaK8jZyt8dM5WPpQ9WYPpbCrvzkm1QFYxtCJgh83pVX
+XonY7H4zqFmwqtWYbjvIsEfcC559T3/LMtZnMMHSlLu9XWvhgtSQX7YCNajDOOlE
+1tWRAkwlfGgmbavMQfk32SIwv2rU8He4aGiBf7I9TjB7DE6lHFhaUP9Gh7G14bBS
+29M3chTK495a9LNd/zhfRs0zonaZDlpyZDMAzHtoLxb775BCmadgbcaAc9y9YfeL
+9QQq4desZqm/hLZO9NoSvPKIcwkGoUzu4ID+vjEw9tkDGwRVbkJUvzUEfkxXKpwF
+VqsvaHu+AUOWTqNTf7065dD1TgTdayHzs2UuXNvN8b+10LVDo/GeX2biHJcEFzdb
++hi1dPBLe9e0cKb7d9egL9GSWYJYvc53dV07I2gaj/f5sQojjitHRQCaFh/CZxOw
+4zsZuuTn1titgXH2gM7jMTtuJeef0yRUhCDkna3nQxxBSQukBEJV2ADfBXBwi/3i
+BjkLif/s4NTxN4iObiOJVgkZo/pOikEn8w9FwUq+Ni4ozkX6ou/dfY+eK1lxOcx0
+YNMTaphl+i892aUC98nIc0Go3iYd33Wr/7VbnBSs0VBTS2gKosHK8HGKZkipWnCw
+yHQJPTwtJRoKxb3lLTCfFky3BWWWgMTr0yv3Hxp89gplxkv1CLYOEt8tqCqX8LWy
+bQ8onjffzHUU6WqmjPTANLnhln9COvUeIIckqMP+d1iN+t8RlenjLnaocW75c0xX
+3ISJjvVPTyJY4vGIasrHd0vZ4QCF/tun1qftJnQ1VEWZMElelFfCCkQ12TkqIcmH
+r8dR4ksgMpN5mumTBoGRoaZ1Mx9roO0BZh1A8MA30YP5h3vTBUXLGc4+NNGsDAoj
+LeggvKPjoEm78cyB/cT0Yz5NaRV13MLJ1OUcs+8uKsmQZqdWFPkYibUiTt+zeGHp
+exfVbQYsX6BYJe977qDhQ0gO3FfYHRtSIE6aGDks8uikzJZw8pYswprfTr6eLwFu
+Je4NmVlu2tuXdITXLmElrNj0fU4V/8AlqwfjvBmrc4G3JucGPhCbi7RLZvrZ08pk
+gpXXlUAFuwhppt8cAazRpnvQ9aafKsRIBFk0ERAC4yp6vBAasx9nTYpSlc5aPVRU
+zCoGwn2QZ3eKu1ckSs34eND/Khg3WtDWWW143QTuuXcOsRvDxd/1V4eSQPUQmpmU
+e6LKBlTjaSlqKIbXrTqJsSHhG7tGzbgpKpl8GR5DhxflapAu0a57DhcSdtCOBldU
+Srhjicmvv3pmlvyRxsXgB8ZzpDlzxWaAzkeSZup0UnoiNPJVOudXObSJkky4/Jze
+BAp64Y5CnwJxMZEzLIJhvw5Hxngza/Pzq65MA4Evk+hMaaLvkrui3/kpspdI7eUb
+aO0jbDUSvp7mTsz//3AMiQ9OWeTgiSc8ChCkHjrRZ4tuD887MUJyW3HZW2C2PBKh
+rHVXWtYU7MDtP39SykrrC3No3Ea4H1KItuAQl+knjVhSEaIsiMCHvm8Y7JXTSDey
+4ponbx1lb5vWJOVL6gue49ZfogIQLqGQI+5kymml28OUKRGLiQmTqw9k+PgoYSxQ
+1JXloM9GhqxQj3viMWelGrEes18ewhEmQjp+Riwc5J/VSukt7rDLUq8Y9wcGhMf6
+hG/VpPReBiX/H2Q4muIzc1fze8S1qDpUAvWpPAIs8EllTqZhbxr785C5gcQAZIu3
+emCnbt/G4Cgvc6nXZ0i85XSyTYIvJnylEa+nmhyCl/QMnxLThgrD6fMbzo2gAxLU
+EYEZkp0vEZ+v1Hhll6kPPilg0G3edJCxcH+WwGCBXVfYmR1CFpo9fAyi3eo8CffJ
+bLahA9bg2uOZjGAgcsA48Dhj4eLoTqCOvzq1qDn0pq+N9/zwYXV5oQmxESu7M9rk
+r6G1xrRS4EKupruVlgzZ24wzWckSYfs/KW04IcWhYAz+I7vJMGCVBGLRliUJEnhe
+FQIImLcdDqR8qPxENyhFIRmUfM8JPfOQHcFgbxoOPwzgEI6WxzJg/WWNHeZtqjHX
+nAoTnZ3xeN5p/Uaot16N5RtJqyda2KCdFLjIa/CPKwVhqH6+42H4sFtehu+7SKt3
+k8VEF7gGJ4xzSBoomtPtRgUrxbQeP16R1r1b2Om8MYK2ZOvsoRsmWKT7Ke4gOetj
+oeWtsFU3jrqCXfHZpJkl0WiU7k9a7b55Yhi+08y7OehHthbC3NQpsN6YdVpinWYj
+nimoSxQUNCgeoxyGSW+1vLpVx21U0dKUw9khh8gIQko7JLDP6E+cnZcKUpZA8OoV
+lQp5J7C9xhahq9iZRtuH0leLOHaFsD/gqFV7KKhKNNPddFraAwWF7PW+IOQpOCzs
+eCCiws7Iwo/fxRAKXNwW+tJDPmsCqykl9bGyiC18kEMnCBkGW8naZEfbaES8u8NH
+d29sHo2WwYfn8DYnxHknvpnWHoj8PVIgonf/C5kamC5enpd7JgEwn9GyZCWrq/pT
+u+UCI08v/gEUZY1P2QfEzvTrk5vIR/TpHH7wdRYa4tiicyXvPJKBTCx8nI0pUqO/
+1le/JtKgCxcJ7bMcmTaNhSTsHiUVuVd170M1VizR6JjbTZ/eqLcXS8kGkHIbXPRF
+6myIyBXncAP3CLw0ZoxL9WR7oX42gbZSRkk6ctw2jTspLptJt8WkrW43kvCb/RFn
+iGzfK6QuKtkA9adsiegi5PopGQcB3VFXp3OkHSjMWiJMiQC4pLA0Ja1wFuRSYVy5
+vTI/sHN9KaGigq2jViV2VR51OjOGXvjMqOh6XphnHAqTG/eaw8o93EMD+0qmFVAp
+EPvezi/j+Arfm+pDwJTI0sDY3x2yHkiU9i2tY9RJpaBGmHquTc0Lrz7NGCNBGZSg
+phA3zvS/cB4moBl6imi8pWdHmSLZ4JxGHDbDAc5wLFc3kowuF5qx9D8XuOAIYR59
+C0aZmfnAw1DuhajDVRHL1QEnFq+mLoevJY+dpJAzLbJ7AO8hWui68CgXnB8Ca4c7
+nfTGxD0JG4QzICj1c8Z0hXOMp0AKEIg25+rbV67+PeEdO2QhERz+IGWMDCPsNITf
+9H5X/dzi4Lg7LJHAx/4oqBts7ogCelcrr0yBONsqNTaGM2Zas+KYU4Gr/VNRdjbW
+/iGAQRa7oBtNBRIZfzcK+7lYdPnvb6BRT4p3iZT1eegdUzIoUwAjDpS20FicG4Vy
+z2UDpVC1IHuWDVz1nxdxib88oRxenzyliFxxSnEFPfF6fUZcDKpztNTo4NAaq5El
+ZWKX/NstzPWW1jXUiZFIL6dmj6NDmokNXz9QR9mO7uzJO9VjG56DO9/w+Kj/otwI
+efBuOTfh2taFGv2eFZDMMiXENKlCHLgNBHtJs14gpXQjnqy5runoM0q2PFwUlKn8
+oMh7ruu7F4c2fc/WeTt0LkMJ3ndljVrS5dt6CusY/YS0wDavP+6M4b3Gq5AlAAur
+srznlLri9MGUlXIej23CxSqoDKvqNPItez1bTY/V7vqxHk65EQLBku4Pz3QR3zSe
+WlraGGwMVtf730QzMZt2vlBw7bfG9rQPHjHvfl3mXwY2MQcxsesjdtL2F8ylKREo
+Z32ELXHz+iIVb1pQPPnAzGLOLegLYS3a4d37efyLODV/G/C90g+BB9yES8E/LQBs
+OflW68YiXmZDvWQKzvcK+W+6RmrAz6dLxkO55fVpm4FT8Yy6isKbni2GMPJrwDRu
+2shbKPNWDaKip1pn4ILZmWZASiy0X8g82JjvAgRKouWcYBdO9fXLYO4zmq36CJmB
+AHInkfFChWqIeWX6xWSfp6biL36+cc02dJBKf1cwPNCNYfEF6tWZp58UmOw7cTV/
+YjlD6PV4ED6AT5RRuavJx+3O2yk/gfAUc7O5CbRmZSN7v+deoz6o362fMXwy2cJI
+QWNpgNpezFUo78ixaEyPJhDde4UyfYl2uf0ekekcPGtdNfJvwEsADesDrZuObguW
+a9C3ECLi/0bdtZf4EDXK/oKnTeIVGDovk09GMyM88b77WT1Lwncm8SGx1d1em3Pt
+KGxIlzf9/GsvpMRZfr9u9GcF20O7rKwH9lyYXWAfPZoXOWIGS+7mSt3DNbiZWJVY
+M8bmo/06hbWWdgPOCjJyXGLbI29FCFohZ1a4PxwiHu8apNQQDuzbkY8aghCr3zML
+Jnfgq/GRDoLbKBlO5Mma7obqo0ijVSQ97I23anax9kVJDBxpbsZuRwTBgZbLJ01G
+lOsZbY0PDnArcsh2DyGeAWKwBhDZGPO3zt6Am2GBK/rihkM0EDctG7KmXjqiB0gm
+ZieEbddv9Ayj1Smjmeq333PmEzzdNIRVpBMWDixOsYGGpTRfdNVLcJKu2lFZEAfX
+3cGmabPXHPGQZq0gqzBA+OimAYqqGEZ4FwjLKVuSWGUNL6PrGQkPO/v7E6oycrRE
+whmkKnw0D6qR3yj6K2pFC1iPcNKOYgDJl/Q3/XdP/5nVSrvIpQeYAkl9GV1TYXH4
+a+MDiyBl8UU0x/IbfBn+SpDUOY3Nmvy9N/yFzjrwdONr9FHrO2zzk6gnlCxtZX35
+t9FVtWF/7IZqRveN+rqprOzu822W9kWnZeLF5y62q4syZrD6z4A1NZ7v3QgucrEq
+WAsmssX1tS9SJnlW2pmMfD0guS+Z/xa8JFqvqnAT68ohRANw6fhxk6OVWOTCDluC
+tl+j1YetcU/KxICxUfv+DdjGYbHpLnOTv6gVFK6fJxPAP/7t+Mdyt/txale2Dmcl
+2rsRxxNCTBbuQbhMaihZl/zR4StkRhzhnGCPBDcC81vXeXXsXPKUFaAgwBIFoRIv
+bNAips8qq/SU1cNjlKu8sjlynHvgToV+i0o0EYnUddBhU27aPSjy2M/NWbVzwdbT
+jxHlAxPj1KO6Q/UOEJSQX+yg2Osa2sGKHc088ZrB+dq3xOBSNF52Dns3KUhrUKZq
+T0kJznTYMnU+ztonVS0nxSxfjSC4liKLkDhPSLXsoJZSS4V/P0DabSjDQifdf014
+YpZqRBYlXJy2/8yUNJVcJBYKsyZPrjpoijUGrxKO0ku/DNI0r833+3nEM9su+VpM
+I+Tko00md/53WnDBu246geKVh0Q4FqexoJQ/z+DuAuS0ddzcvqSZCWCsGIzHSw3O
+GGdek+e7NijkTI+dkQ1Lt4KQJ0PviBpKpVrUDizCxwijjt2njv6R/XXIB2ei03fd
+He2hmjcRIBttxSG1AjnJdPjA4Fqmmv7Gj9+Z4zUJR9tL7B/D1z8V/CYwuaUNp5XN
+u1FE8ZNcWKFR/ovahWymxdvMqLWZH7PzdY/MjKfkr+KmQeN5xKKUeM/1HlgwDA5v
+YkiJab0VrhGOb0fNx+rPI8fsARU+0pF3ISDtY8WkNKaYQQJDZnq92SEeiDL/SNdQ
+4VqQA10oeqnr81oO7xqsSMIcsEkUSCyB+91Ktxgb+zfRCou63HUEeWTeaEQpFgY2
+uiYdU4Pgp3T+kFpCTr5bPGQ2bwZYQ81Qpg+Yg2C7I3d8rnTETsjeDxcIyxM8c41E
+2YIpv3WI4eNhdiOg4u47dY2AQFHeWNh6jnhUz4K2LQKf0B/fiTEINlcUxb40fx0X
+W4woeQHCxIDfZLAhT/dqSQNRGI/6S9qQvqFkYFi1AzVvlIavM0D241Wy0lCbGG6E
+aTYg2hj26ukStEmJVWvby6YslCzPPFCCMPvYJ2Qikox8YhJd6Cz9kZ301ylz7um4
+84W9xLxvPARjGALZ2m6AyXOXTM1WMGu8FOtuaaTwRcRX3ROeR2zPaOUAY8n/1RBi
+1NrM5HX45/VNZzlI33851NfM3JaKNuhfZWHgJ6L2YCgF+o1j7ZLxH+ldykUnzmE6
++48zerDWFOfHXQEqiH2QkexReLkSqEv0VkVDSHm3cNUtXI+714SNsmY9qsZHFEyN
+I04EU9pTPYck+0gUQQ1C2tAbdQvUYBJADQNIdeG7a9/dFYCQoi9QqixOWU/01yju
+D6V3bTeeKWuTEnkvhkBhKK79Th/oo2VB2cYySuh8hm2oldhZo8J1Run1YL2WcRdw
+cMzvtBNmVt66RQR5zfN9Dl4rhmn8zfYeaK7EzMHg7YdnBz3DI/9Ui6GFQZEuJIhO
+r6PKkXJvG5pZyk+T42+ywdwPhIVkziyQUvKVJu9T1Ubqjtm7K2KQ5SXs3iyATlXX
+QL2HdrIicqtn+TXA/7wEprmzBboNAnfdfHrR6z5ex6muZjfRBCPm+zXrBnOfSCFk
+is7zcyvyjkacTM06kR2rIK24ovo7i1hlkJe9ggui5mcayFd3HOACl3ukz+czQE+r
+BYLYKGNQupXX2Sa8c7dSVoTzUgHmQg+reSeyvljncZ035DKUCY2msCRIMO1MXPvZ
+HtoovotrRztSqmU91M64Zdy/g73ZwFxUCJDqKZGcC+Br2Fl4dYAdYuv2+mTufysG
+RXch0IcwUlaXi+VapboOYBtSoBddZYpIMthB9wNW2eCeWGhJ8WXmTxFLBpQJhfEF
+H7M28mymgzmYWeS+O77L9CjnfwE+bFlRchPAUhbOHraWf0qfUGsL6al2DCJ7G19+
+Da3CWde8l4jsTjsGowZk8lfY8KpUWFBiMDdiKB3U5iuA0DSO0XibY2xe5saveqZC
+Co7rg3WmwIE12twcFT4PQSASMglTwv6Wl5kV5bWdonTV7Rsv+k9jduPF0v0FuvqL
+e5ISXKxDqd3oEHgQJ9r0L8sxnJ+PZkaOVD3mkKBcPc97QwOUFpvtFRXL0854Opqj
+9HlBs8g72H8jD7rikMqnoToRF59ljnyN9n8viVdcYShSMBiv5qszOqUMDLOlvFeD
+RdsiMl9xmGayeIC/xsHwfQzwqScnhjm0VUESeJvW0oLgQuhX2wQCg4M5ZgHd+jfL
+MvD7ivEQ50HPW3CRFtfVNk8I8Qo0qsKby6g2JSwONRB6yiIsjwLpapjdGBzk1a2G
+dy3tfkvy+7EHxG3H1ITFop7uUnKV5WIzzFOJKlVVDn7Lsblsw4mj7wQIbzGv+Q1s
+hb4kotU1nEhzIIy5+72S3oDC10jIWuB+P3J3//C/d+HfefCzVHRusYRxYCALSMoE
+H9cX3hYiyN68RmuzQaLEn1IT2+nNBHDlce2ok+6mraWANziqjrR5JmoNrJrKa+gY
+xrGgg+yfgpwYqy4KaTJ1W11FBSF1JpRdxdlhJnol4x3oknqRJ+3Km1dx6gon+A+r
+1iqqNfiHg6T7DmURC1ecqoz3DT5XnJxBfsWBzvAb0jgAk9GpWjBy4ROI3azvAUVw
++xWOdEPa6B49ns54ErsrjoN2gO1RkvUHxtOeXBRwU7HQ85c1aTgtKBSBktkFXyb7
+sfDx4keXwgHndIs9ku1cZL24uYkbGyLd2nzfUDZIvF0tPOqP9mX0eM8MKeqtHQ9I
+gD+9B1CXaRMkMhjaZLz1ZRoAu3klT3oXpxynMSiRgHghTByOJ7WrMSa+8jsK8BFD
+fFkjxycw6vl6keqUQaxrO8JQhAsrQpadvbSLcd6Vbt/7u0o64RGbbiU5HfvOxZVf
+1k3YtHUmVE99xK+fY0fcjv562Tt8Hr6+fY2jY7+/udPp9DmRE/19+dNaKdVtT+qa
+9sH75iZ7h3OquWnZNwaWImlSccWuxfPggBlceBtj6pjphDx7osROwGFsrMft3F0A
+dzZdQB6v/moKfwofSXrFvEe+aNYWeWMncVK3Smki/LdtH/EHXaGCnwiRtX2u4z2p
+GFdp5tH/iFfbtcdGlvGwIosVWlxptv2nrkmcwVzEWIPxY0btA6nM+VV+wq8AZmbZ
+zkysuPmfrC8GHqwoVpXviKW22vYE84rgmfbi2xW6FByPcJmNBRIdr86w3UEACT6p
+GbkbSVsgvDbIGXLyIov6jSTaHUNmx5XDftq+31lmWL3PLUahZMrpnD2GC4tXCrgT
+ZQKnDLqXwtyeEvPpc1r9qajntHk9h7wxwzPyNOoPl8U1/b8CZ0LTGnr0RdkrVzny
+dmsmURCGla/uWVDhNrqXLXRZgMK7rolikFgQ+81gIMMdK3Ucv87j5GVdpVhJhNt7
+7k1FHD/RmUKErwRz0H3ggGhMLTF8dRQymYNqjqQfofcejw4OmspCJf0hTPpq+t2D
+67sCG4ZvLzvBvIIvU+kwW/+YWn/eU3vN/RcxkRLHyIgV9NNgSjO2qWzV5bYRuElW
++b2VfdFC7hkpMV7t4Scf1eikFIIOHCQXiTcc5nLtPoDM0N/YBp2BfLO/LWQDE7Vg
+/F4Mx+CU+4MGyYvuJ6eIwmTS7TJvTLP4BEvsIJzTot7kFP0DyXKGlDeRTYA6qmu7
+FomQYvPA3EKF2tSJRKI/pltUAW1Qgd5noS59frw7ntnX3RAuZk+mexv+4JKLkY9c
+kPWUf++EYGCiQ4LvlvEhMofC4JwnVx2cC1uqmMq9iDBgsHOqNOP6htrq93x8JaqN
+hdE4gpq+CKy0gmiAMW+7oiYAb7VNonvAoR+AKJFiRhCWPFvzC+HR6O5f7aErWqGs
+kTw/M4tU+yQKm3zs2ismphBl3MgQ9YZzjDOKcJ8SJtfaNlZemHJqCqJJfz0LCZOk
+b0VLVh9tipTAg1OClZtiyGZpzeeLHgtGizzQ6M7K040eUZ3KLWCxuDQvEmlDzp1P
+DwVwS56WTMc/6KURkPiVifRvzlaF2iMJm7ndQVWGOEnvwNEhWzl9kbeMgsXTwvh6
+dXfYM826rOuRwpzeWS/qJH9ln7ZefM1fjQ3AV4z7iRowUM+M3RlyaU0Wm2TYHW7N
+PV0k7xQPkaOrJhDl29EiydKZItSAM9GIq5tP7dWe4/G4JpSYCXqxsqZHhWA7I+T/
+TJSV3thDHOhjImFcRR8FqaQY/1d++swbW+wSMZDBD6xrfz9UEfloVcwy7461xjxh
+DsQh7MWiKJwJaegaGTVYx6xPgfqH8WhA4AqLuUa1QTJ1ia59Hx5kzlPvz4QJzbQc
+cs2nFW1yBsz2y/wleyj5zZE6D77H3xxgn8g0wPtZhLaEJuxwgLB+bnIiZWZ3sMhS
+1v/fDKVPClBbzmSprku9cVKmhCn75+y6wv6hO54MsVT5X9GX1iLVqzwipi51ZyhR
+lKiz10IXIQWdb6NyxCm7hgAOd6VNrPBAGXkfMONpoDX4EEr7lix+fz45fs/jx+gp
+5h0mr10JBWDYOPLJyAzWdXTgzKpdfpbCYY1aOslLG9cBmSmwr/uUPRJiRxfyEITm
+qaNM31VCV0HtjsOPnWn3N/35k1NOSm1c3RvV5Uj1DsWuuE5/CGPgxJgnIqVwUQwu
+9zZw+3Q6YXCJW+XnNunTmvO0up9qDn0CmZOINgYU+phPsIOVd52u+Igfs/vhYBHf
+A1jS9KnIAQUFfCTqHxAx+BdDNzHRCqqV7U1FJn/VieuW2GqC4JfZ9ijEs1jFE1kA
+sWHkRJ2Y5NSjV1+inHOkiNF8BPKVAmERCzsw8szGgDpUtvvwrvnpsPZRsdD4OPs0
+tDXkNe9VzbcvuHzfQrKKVYu2wQMntGy9IMwGTMKE2PlCcnBZbzcEAg4g6hFO0aoc
+iKYj5JI7To0TtSB3EXEq4TtniSZtahOuESBOPAxlSpVDzTqOzLPy0QgErxYaJaCd
+erN/CvcLNVLzLsNADP5AjKKDKd8bcJmvonKLPw/tu5St7pgqLa8GYB1erxL1jdgp
+sQX34a/usMWhoO1g+d8Sw7VroFxC7pCTjyW01Pe9E0eMDA1ogIoPJSD/1R9DBGmU
+Y5lB4Tb3gwiLBMRbMqg3qHC2TwxEG1lbVwM3fsoZzy/i6fAW2aklq571a4C/kHUv
+ZG/N/RlJeAeNrHj7O503DXijOFmaKjdp9y0/IF7EjZXTYxLeesk60al+HjMJJhuf
+Ro+109HQhoa+/FRC7naqYsai3CdkyNGhcsey93fJA/toTh4PeKeiTH+awvZ2YmNH
+XQIKcjrPd5EkCgmzfv51cEyyOdAoBiU5wZgLCnVESkHhCRI/TsLI9azLl7TIEDNf
+3sjMAr/YXHnz6LVnThf3866hkHq2hMjUIZ9jA3TsRazBU1jB1LZ41R2NyGA//B9p
+oa3T0fdMIPqhxTsdOXPmVGAM+uYulq7Gk102NY9dG9MfebCpa0LJ2011xen5js9L
+ZmJSsK3/SGXb7gESXYDkiXJFU0rErHNDQps/8fPRvFIKYHW5F/LP/6rXuB4lHu15
+O0WCFjiKs+Yvt1HM1DkTuhe1xyBeL7cL2WRiwDBKonYUTQ697g5OQY1+7aIhC2ka
+awRdettbGYYnrtxzR9ddkg+M5nXJjzCE0riEFVJpsOm/81Z+nPFucBshm6CDFbKJ
+QnXLG/9+M7DGXZT/HnNtk4y9YgWGWN9IpWR6Tf8ibzW5jwBvo05p0m0YGXdXXV+t
+ZKhf0Vu5ghpmJ+xadsMfsYFHdC9M5YOclsjMBZYvrB3YuDiswjm61gI1dkACQsdt
+Ztn8oTalACX2NEutOC0cvCzDqxMxpmV4W5+xhXJaVPQrboZv5dhxoRkIJ+R1qUa1
+JKFows8d2t2180pz7PU7bA2sHaebFBggOhsH7QGiaPI51aP5OxAifDRpAqloROiC
+zcn1VHy4TNl6o383csaslAzUv1Fd30O3gUhGDIUwdUkKaASSaqj3Ww92icWZB7xb
+/Qg+TQiLshC8iZuvgvmepCWAIYqmtihaIK5AmqS8CQYbm1eglTzDxeQa0XI7KYvi
+tiXU76zdVpggcmRXDae/P5nsYu9NIUzbXe6/8TPYcsDoKvSqikAvSpZElOCe0zyq
+E3SghcdxfOxwrFgblP1fGaOzEAfzW5aDK9jAtYEYsC5r0D1QD4rknwtMGSITCoR8
+qVANHkL1oayMs+xDxQT0GrF1nQyxRnxseXYcOJZMWZLyjuJGej8oOL/HoXwWLowc
+9Nn55P6RZ8HyFUiyqzRo/JPBRf4UkPuE7QWmSyy+/wtRpIi+69Si/rsIx2sj1O7v
+OPUfmw5Flhw3HPJ4tzGDC/yJlw4yY5CkzUC6qfMmq0+kaKJWxcoTC4JeN9RGc9XB
+rOvyrAaS1OcKywYSh6AlERDEiL1k8Sth8ufHHQant9Vhvba/88qz+ppWA9LY2+7E
+WGB2EQ93po65+FUpRwzJJLQfC7FeOgZ8J4ue68z3wXCcBS6ahV3dHsjCJ88OyaVq
+mPi8HIkuCO4Du/byTJpde8CzsH5hVGlW8dk8ZZydRz+VPOsFHJ+sXJg2MFVGwQE2
+puN49KsuAEYQHXI1tD6/2dic2mPnH27pADizC5JMUkWvbGSr0ZOpWbcnYrTftxnR
+67yM4mlVFbW3FBSG4oI6LPZIS4U+yd3RlJBSLRmFWXwZSLI2HhLTN7yd6KvTxTch
+CrAS6qjfjnpmHjYSc4JJy7KnB29YwWbjVnf3Hqf2UEqubWhWVpF0nn/6CEIiqZb+
+pdj5xAlps/VY+ykYn0Mb1mAFsA2w3Sd2eORxmyIMEcO8H5ApfOb1iLe5Wz8yLtCZ
+JldhcuV/Lv/yBhaE2pNymCsprXu3toUtcqyZcvKf7xHshCqIqNWrFxupX0hIvUjz
+7d8NN9Umn61yK5G4BNkABb3bhyxgBDuWXMth0JB2SqUcncypc6YAcxRmC+KK3stl
++E4/ULe/c89m0ud/Buip6cdKWwWbIoLzci+VTtD5yP+OrjjiFmVdg7b4FjpGRtfX
+rJ5xtB2B0bA3Wi91BgLcK7PCpgkJr3JPQ6ISeAM/kEXSFJpAECc9RcK/HZIUy/ie
+Jro+g2VyCIg67AwmpJcKVQLItye+A0k072/VMpEfNp+t2B+kb/MmIhAewSRG7p/T
+xl9SFsYWJVota5zFn+lDhOOnNeYu1j3kCURq4V5hjq//2AEBXwnKSGUbyjCE/DhI
+KQ06L61G64ZWhETPB3hFHP7txvbV+hTepof9DL6l5MJBESbnh/UAIBSPpcZLXJKu
+PjnOimyhYq30wOQaoekPlDrkxe56aaat2Kxzmukiw8WYaK7hTlXihT1jnJutsgkG
+YmZdeiYhMgz78kS9mJaMt+82KjzWKzPFziVmXksDjKHNrsgOiMzMWBdaIY5iYZfG
+4Nev7YiA8EZAtYBoDpzG4wkcgNx84SCJqxMj3EJHKrnpQaMuQ/48f2qkSYTQMgZm
+TyXvBzSNdgWO/pOzxA9sG2wgGbZ76JL6rgD9uyCq9+b/G8qtZGajg1VLhSFfK/tJ
+HFPrr1IceQMODf5rBRpW1bEFGBxGu+kqa+jRYxJb9uSzs/Y7qSRwtpjs/MfBTkd1
+Az0c0W19/+MB50gQHFwv85AD26TVfzw/ue0TdgZ3yml+SfF00+OKqFVPZNUiIMxh
+0tuhgMievkPZeGNjZTvoVnms0ff8mRfEi+wvt4EXFXOXA9UHLWDBmTQTTS5Ai71G
+rd9G74LFkmZ/WM9tIex14PR6WZ1g0H85tegCvdzUrGy9bSs4dfXlXSjK6b1B2whK
+LgmOvIGsMLYJaa0fpYTGpV0Trneb4q+BzXEFKmnnIsleRJUjsKIkjOZc3Dw/Gw1e
+Ie7rv9Gxu04OkFh/HR83EjwGSLdnhPeUbJxElaGZkxEIKE9f+4IhTR5KsR8omgJb
+h50b/FpoGTzLk/llVKZE/Qio195+7h/JqqmUsvOK43SzAfHDnoNC8aaIcNmC4DL8
+SlfSxc6Jxpxo0LTPd1MzQlBdKTxBi62nhyLNkkOHxOuRlYtvKgrsTt4TLdA8BIZD
+1Dp4tjj0wWyjIJfqB6ypktvLNN4jjEPY2Ckaja1v5jGrkXjcZjpOOW+Dp+olfyFO
+SH8kEg2nBDY5HTho4RmE4NbkvCJ2wQqW0Ak5UMaLL8fTwmJr/cwRvyr4XygfSvOC
+ldgDYrOt+CDn8j4JrR15RgGGpBPSgVBEnSTMO+rRu4ci9T8ocUTmUJAkNbtetozd
+v0Sk/LZGhshAq1gnN68K36yLQ1lwt016KrWNxaJqWXthiRmrVygUqxlCwMmOVx/8
+AkFMQ4TVyv2o2ytLLXVf2U7I25rvcdwFHRXBuVg3rObWii9GHCzbGFsusmn0E4lp
+UTBtQvwIniImv6IxwV4CwQEcJHtt6UxwueqvvQXafhsGcexffeiWNo37g864/cYL
+GLzIakejNC1FcCj4g9gsMMfWMoNHnBN4Zc/2ovZwI4T8FTvP1CEUKl/L4UTN9eLN
+6G926joauCF5IuySoFIchz615Jv/aldCIHB3tEjrkTFPQwpjivm9tdG51kpPNMzc
+ym+oaSXd7WQlMo/KhuibpmUzcWaay6v7JG2LqjAxGVV6aFKbCEZXMVukiK+SQgEq
+CgtjMukSCC81akDYLme0Z1HyvihEz7QwnXDEwFKRRLrOmKu4i9nbbeqwWba6ng51
+yk7NS82uQAbIcEsn4YC8Msm6uCSVQsBmvId3yllg5ppEySObPd0lL/B+zcycaddq
+imOrtwp8uvpOqG4xcwL8ZBYf3OdhcKaFoLPWGMyMppazMtTz0Ov9ccxt0RWlGtVZ
+OjPkTyAnE9lReMUSLmmJvzjXU8C/6SIirWHr98B7Z6XCUqr5cnPWduq+0BWU3Pcz
+CrjEU7LzTlk6dLfszkwvqZwP+1XUv038IYJLZmSbFqJsKp+1EaNnXROz85C1OdCG
+sA29pu9MsPjEd59Zmc2x9M/p7rpUvUhX2+8Nc1lHUkcJasoYgheXkcRRtYgmewp+
+WT+ynBWEyDbzRm1Rgglj+oKi7m+LJzkl6y2ihhktYYoCh84mavgxMg78n7u1FDdL
+sv1IPIWU5SF1NosZVUQnUX8TJ1hzbIv4i4oqUyyaBHM53pZeiPkpWNgzsECIdd+P
+qLR5V13AEeG65q623tfEaPXLYrl9zrAMJ5FtWOYUoLhHJgFyygNt74QtweP7p7dN
+GfjzITDiZDPvM+ZvEzZEadJxD/lhSTJbaBiYUoVxEXwfaxJTy3fYcnwXl5jXDuy3
+571PouVSR7AA/pWIZT4k7ubnp6LRZGAu8GgtCIcYAi2pT5nMOPvu+vk1dO43vPvY
+dvqzOrJOkpOxXN5kVx/T7uckYnDAXE/9SD5VBMmUERQ9Dsp8QdhwhPQnAEfvwLWa
+tLJ6nYzfYzKp9XpzHpZdNPM1HQ5YGWffOjRKWN3ZOpy1Cakz3d9nN8uUPsF2DRO6
+n7DwP3e/7Izc3E8rSu75C/XsWDUFgOSssswKMg68jM8OCwAXwJJsEzHCiuppCVW0
+oYn0xm9h/Tvm1d8LchCHFhq+V2fN0BnieWAkHixN3iT1tXU7f0OKYBo0XQROW6hE
+S5/QSKUZrVSnS7XSB47oRQutFUi6Dtk+IluID24kEk/98yAITSvISy6KGtW1fSrf
+cv6yEGB9y8Osaa5Fl/rGpCPyhw2dO7e9n0PlogFmcvc44ioFsUMDOAeRJtD8RHMz
+l9aXq+M0zmYduvisFbm6GfU4p32fK0EGt22PfkSZqmpTohxhs6tD5nzVnHzIIr1Y
+18QOwIQxSufHC1JxsjEja3Icy480dyIY3gGAi5h4fyj1NlOIYWl9hyZimAzQoPWj
+x2VTO78iOMV0U9TOLb+kVdF8kEerySwUpCl6IcJLZnMGkUbJ/dDYGOJVhYU5lgHO
+p5xYcQKbK8SGuYj2j1ZLHQ/OHLPOsfKGMzOSRzmfiKoCebv+HEKZcWVCt837fIPZ
+sXCj99eTWr3Y3vFyX6mBhvE95OpVlJVgkWvHDZBJmWOf/oRGMFNuZTxuvscE0J3u
+eVKavhV6X9EXkCQ4iZFCb2yWAXxDpAdzz1UmXeMiu0Hx+CJ3k7NO66tW/wb3jZ3E
+tFHusCVNQOyx7/aqpS9yd6UvN9txCAxvwhMZooUHtdsoJaNmny+n5j0w6i0MuCH7
+RjxMVCuXU+NsEFntMA9PtyGgl2fDaa5yWEWJARACNBapE8aauEvS6fIaWefJyh8D
+9m28fJdehkM4ftFHfcfZzyukhn5OJhGSFBjC4SdnEl4gwNRE5kqIgvRgtPRMJPK4
+xUyStTB/e/JaDcz0MbtMGbrHT3J5uVjDSJQIbEctYDTWEtMNAUn1mV2V4yz2gwP1
+QBtJRvEKqyXctbLZ9Ac/QpYsiyY/3Y5IpxUz1K8F2ZFcwynWODKByH2BlhiNItsK
+2cizmXT5atL+7FIb2tF2J3iX+SKbOg7UOVB3idxYCJFVN/Go2R62g+Ty8pvILQ5m
+20mvSh4WwSFlTatKeoUWMyTef46YiUNgYvZp5Z1W3ehek6qD5VEZHNI/ziQYKrl/
+MGEedVxzi9YBxuIuR68zroOFj6eGsIFMAsJBoW/uaYDTVvsQYN3TAGRhnyJCn+tH
++DPRYQQ9Oi7fTZY1S6mv1qSXOUiWeN0Jehqi7qG9zoyDMh9tpg6/2tP+fJGnwqtf
+t5urvEUjG+D/NdZh9GVmBvbPv32tY3onvjyLRcqnMrgMh0C+zEOD4qxMVkppX9xU
+qUqCXfE88kmRsuCsxTDOC0GBvKGBKau2OwtHjbFsX0F5oM+GjVJGYh/nDxGgTQas
+A/w5IRN9zI+/6qVKU377HlStPyQBpwMo3Rwv6T2+p0i+rKmCh09TNnvcbqs67K5C
+02eVSaac8Ks+zR0XfrUYR99SHUoOp3kM/nVEoElh5Dxsf3ScLrpLsmZpkSdnRLle
+r9KaMV74LCNjKbnJ5uLMSCWZoej7z7g5gkdnNaBKt5pTx0OYV5DfTlU0NqTYDTdo
+5TOrvrSGWnpTeVuI9wlTE4Q94FEBeGVpZsAB/esztdasBJDadgZ6rX7pVrf6nmBF
+n0xu+pUk1qzzWYOLLWzIoLNBVj58ylMYYluQwMMnmNi6T4LoUQpjesETEdMykSOw
+32B+bdJO6ZCRTuYBhdhzUzB1h9/ePvpIBAAYcNoK9zDbZ0nlHMd1fPKKaRsf1F0Z
+H9/z1wrZ7AkgMvThAiAD+Qt7aarjd/mYj1cVTMsPMnQ+kjGcNwy+ay/TkuJEBSIB
+H6Zfm0ioxVo7ITAAE5SAw3efKySA8MqvxxtlZf2ILI/V/f7VcfFRYGhimyYGHrFk
+7zAaejktaJeyol8m52opjoOiQv+BxOZa0N81TEOMQJS57nds10PWg2aOityk9R+n
+Mkf2+QPgbrifIPr/TuknC1+7EG29qOJgkAxt9Pu7GUcPSkzgSNpJWAJcHYREABOK
+wHCGCriuH0d6pDUcV1Ke7YZnWbyvP5mkfXz8IWuZsXhrYbX5iPct3USEaGQuSDiO
+f9J+vcjZdVr6nMdNmNZ6VT4YBGoGdY+/rBz54eGwAn/Rfwbh61e87g8Ke396935T
+CdSfH0aewGDiiLuInhltUpwkC3tLTmj3F+Fhvanmib8NSRCGxfhgW6LNQImAeRz3
+ZFk3+gDtxi0oOVZkmMoWwDAHgBanONgPYbEc09/TU69a+9OA4G5HNAyJB45HetZ9
+9qtyw0aXMPnTvnDbpCmW5r9RcaryDC6ghznD8vUGIHJQllqsG0TLmeRmnvbS/AeZ
+7ge6qRQsMdEZ5Tm4qUMBx/DJh7jrQIdF7/Keydb6qdQoTURxiFTnr73wLLtTAB4t
+MJCbYQSnfceNeX02Z3+qFiTyVUmaUk/edqaSTRqd8uCGNuv/6UjuRi/5wAtUzWVN
+2+ALrcZ37JZPXr6qdTj/SiibWAKDW9e8Mnhfj3eUW8nE45cMbh0Ghv1JdrfzbhFQ
+9+NHlqCfYgdEuJXI+aT+7uQ5hqxd+roFVR6BEDM7MeKchW337Jio2hGStROn8Frz
+tWZxTd0PixOjzKIP0WSUAJzYdyjaE0gi4SwuV9TiisqdkEYkKHMi+5FE1mdEnQ3v
+ZtO354FPUji45NekL0O11kIQEU/mRRgRaCjuIhVwLbX7Q4br47XKkvPXg1hJ4/1f
+JsCFVi0LWDEWX5dKTzM8n/74fKoEF0/ZQQIJOrc6WAHxFduvNaznJ/tdpxIj7+DL
+0kinLTsi4OxngEyMXAgjyrp8R3Q7HkCxhquUvjCTzF6u6sI99IIbieww7RvW+d/8
+SpGvELmRHIOPAlBCOzkon3IoW4uCp3P8uh+9Vh39aWCbQQM4yO/lntzo0mw1xJZm
+iJgZj/jJzI3sVQf7WE68QGTi+Tx8RTn8tuwGSW64B53tG+C5isjliqE8fT5pDSm8
+gG8PrLTpqPb4KkmQkeR8xd0VtdymW35JAii7iGhECA8ehOoXh0rkfVJp3HR1cBfq
+OqnkLX5w/TIYKd4b9VBLYTZb7VjvoINP4nbDa1CRk2zdpj8EI+5yPyPWCVL3OGHT
+HFa3awDTRPlKdYWlpQmV7XoW2UeD7xLScl0fLuH6NTfVgF9vrNJ6VObwrLbUJjeN
+ECMGEtOft49hXd7QQS52X1U25Vivg45uxfY/kb8i4Bqv/3GyDdd8oWsoWcYfMj1j
+Hq40LZE28JJ1CYgY17oFIRsmGK5+CyjPdRv1RrPB4rKzjz+T9yWgLk9YOtVQCik1
+x3RMSvu7tZ5U6aJ6VYFE1O01YbBvMYm8laZzO2t92mKTadBVBxBsiajZV31+DnPG
+Oq+m1LwEXJ/22V5pAZ+DpkSiJ5XrozpxiTr51AZlP8rLDsin5MZpU/EegetW8U9X
+d+WwMF1uFhM/fZpaS2rBp0E84BuRvogXaUlYG4HXgDzMm/azFXxhEohdpfz8PW7/
+zbCyP5986DwBl+cUAFe5WCnof8wTEiZ4Av7d9C1n8NWbrhBG5RRpIUbIltsyLI5f
+9vqe0pvZ+SDTQdkYwcfh/VFKQ6jsMMPULM28f6Z23JE4TrLMhPUnz6128E8ko+tN
+dREpSkssRyJYN4WtoXJ80P9SgE/L5mSNexa8y+aCyl3wl5Pjc08F7kFORqR1M5cP
+zFcNFQwnJsi4PtDB4gI2EzEn7ecVhfI05TZXm7lZLKCkmKJKmHMx2qc/t+mg1S1v
+mDpWkCL4Du0ZCALhI/yC40Y1kP7ROgd/BmimNWTrpbzhgAhBztDc00DTcR/H1MJz
+cyOp/5iYsHg1jsyDlYn925TjYCJPvRhgDEyeW5UVBz1gcxzH7VLN2UocpCPB7iYE
+zkvHXZFjku/4s8MTu0RQH7q6stCEPG6ywtUFL7kXCmjUWEbbxdur0xyWqZFj/IPC
+NxAB2M9Y8e9z7cMudy72GTo7/eFlYos676NIJyk8Ezgii27bxdjXV8CvELf+sNE8
+bOCRPnRgmzHe+nb1SjBMPeAahIS9Hb7NNYxuOj+kkE+rO/CRnizysgLdWqqGOyX8
+fF4pBi927rWI9bl3tfboaXdZB9pgj7qT/n1CNvyBMX94wvhGPnYZ9cYxMtz/GIt7
+GDgHSRQ0gB5RRaGN4Ewr+Ai6eamY33HvFGCk64pctWMhEv4AgwtPW38CWbB0E/3Q
+RpkFi2djKyzfSB0AIdinyt1MDwXl+xYWi3WoTEx+cUzwTKkx5gBsV6AeJP8pq7KI
+KOCqdcDl3Tf/oqJSNoIfKOfmVzo9MhveLw9pFUQhuJTvBk4i0tavByqIokO+OvC4
+vKT2ewgX47bmJhd4293UONJdvvgSNPtgLs8OJYKsbY+HXDOWMHxOgK+OZ1NUM2ca
+vF5+3hVm6Ij5UdlCNirZ1Oq5tzYHeE1emxaC9eyIcqpNgV9rKQEJkJlk7xkGoOPj
+U/V6ltsC0RRc2ahRIcL9kQgEEpf06b24TBWmTp1S9C3sOwvB4UjQ9QsyTnt1joKp
+HwmP2FjKjGSNvx6xGRqTKLGV9fePJohdhkbhUZb3TzwC8NCzkvuJUjru6OD7VgFk
+b5v/WYrT3JSgflU4Hy/QBVSHh9KkbZBfWbo85IXwDCAFb10eUBts14aSYQklmvCy
+PfRbEL28aaj5CMEUGyI2Fgrv3muebbBoGNk+HNPLkr3BooxWOwW1Nzd1ztcOuPjt
+cCHPyZ6atZ25xDBUbPn2zjwZ89Ozyq4Mrji/JCGVz+z0lnp3jLQ7S3qnltl4ilvZ
+cW4cvMYV5BqC9AQj8eJRJQiiPGhCaNHunFaZvUOARzSJgurVow+/6xj8tfSDTjz9
+IISj41DVZK7asvRm3SDvjIceUJyHVd5exXBXAdyMXYmU9lhoDKuWpRG18MZappEI
+jYhBLeWmiyRiBtPg/JdkU4XCUVYyZhP/vv36Xja9+MQBGqtHGMtcx9sWZg7nPqHe
+He5dxlVS1GcTKI3BaXq/DrB2SwkH6gUksNnfmnz5QsZaf8J6lT7pdeL2T9g5drCY
+f+pm7/UAQFKr5lCKv262i8z81W7Wa3S6WvUaSl0K6oCtA07Wv7gx3nFIRN+DOzib
+gXfnYkzNyuynG/6i44smuK8DIaAtYNEOG/MmmfehOU4t8vELG6ORbcArrr1EjG39
+xnxT8Xwt3QlAn1Jgo7APXVrJZpwXs7d22410tyc169uT19lPvt754JyAZlJOJvOR
+79Yuwow/uzP5wHh/4C2yKR5nGtI2cezBjWFwI3a7QHNkEhYx4H9nPi72gz+zxMyR
+4/ftQiWjYWcjBFBrKve0E0p3cnerzSznNI15dfyBGMFkGm8Q8Yy7kH1ax6KaCNA0
+KjUZVQxEsRNCOKRsjHUb8EFN1+jEeVKVMKJJOppvGZdwxJ7S3xHKbwOPMsf9iDzn
+SLihModxhXb7kpkIStsDl0CmbHWlpbCoSoiPFYWZUyMESqpBR1Ti5I4QeG9ZQonx
+xvfbTN2EjNlNKVrZIVulUJC28z52p1OkRCKJ3vAOoHdJMDP1WDYW2hxc/r3uXtpf
+ixc2oSdPD4VBxpmHuxQjTZhX0t+Db1kXZrV9jQ+HSwgsumx9hfJ8qksQrIsloaxr
+DgEaiZEMQH6TJAbT3lkMdYmfGocb/tax9Mo6jl1qYEU+GNF8iErxuCQMJcY8AUO5
+MLWPxjehNdA+3xuLPxMyF8b3aMegm3OeaXG/6sOFi8zBPCmFkeicCCPBAX8wSMBb
+hSHUUTAkl4MtABg4TiFFCB/qMG/oFL3/wUZBwUvq4U9cLDfWTC5N246SXnSJtB6S
+xHmw6BrozhheI2qoyKaL4HVodIKvPeX58x95tqr3CLCw/WZyXzZ+yOA75MyRW572
+7l0e/L61GYJwc+ILLAL6YNv5XF2lcxODZO1RMMGZFXPxikKUoyVZgUDyX65INvIS
+hJ38m8uBBK8Xbb8FjC2jz8Snv/FgTRBVAsC6uOzghn3E+1yU5x2dhSwAmcTj9mIi
+neXQ1o2OQ/Ghk3aZ2stIr3LugTi1STPaMy5DdYrBC+NMyB5kYxs+uw7cge37jxSm
+DDirlKU6FHqCv+n70/ey8fp+fqi/KyBByw1fc8kcVZkuiUA6ywvd4MNyNwbPekP5
+CIqE5txsfkNv9oRvw2Yo8a8bYdJwKQ6xRCb3CaCRSqO+OTB2zxLZoi+J8fkb3kJU
+W2UCkqKNSEnhTXo0v6fe9zBzvtPc9sCyIsk7qvGrYGINGcblb+8imxouTv2zBe1M
+DGfBFSdIfgADrFHvWQQ7oXhBm05zyFsTOMMIreQ3T1q52gKguLIHkacbrD6hFkCb
+6dDMzMRjKGqxQRTJzyjqeEuKpYumi0EEwM0eo4tD9hJJWPz2AVDa1BiFTpdd8b7m
+2cggn7UiQfbG0mel3PPM4xiWT34UVxZsLJaz2jeLXbGY669LF65AY4izyHtdICl2
+2S3RzOIBB53AluU2TdIwr9+bVjzlme1Joo1OKjDXoM1zHYAmG0hkYpakuHZazlpJ
+kz8mai3eiJ5zfZXLm6ps2PrtANbWeHaLqAhzb+OODHX+f9RyQMsPl1S1IGa2U+ph
+Tp7LVEAtLR9+tfsm65P6XEmZ/BXHcsWT/hIBZHeObUFK4qIO6R52OaDjxEqYiC4g
+tYb3DQbIC8SPA2NNPA63lBIt6UfhKdVQMKExEqA1CAtIO4+rizMWgM3Fp34k3lsK
+dfHyEJ7IEliiKEIP6fxphUvwCKgX6hkcET9jPUozC89HkCg0ITEYUVE3VQQx9pe8
+u0CoBwTl+PLj7V+jtmhYvzfDCHNc58ZJmo3cJURyFtvdTdlQryYG8gV1hJl3igaO
+FjWsQFtwp1tQHn0nOkGmfIdfJTMF1RL1qN58XG0wbGrSCbL227wIapgIQFutTbNx
+AdcULQpDJMx5aZPyBUMlAsXsvGwUbk5cCtN3Ff9E0dFUrzvzbNPwL9nsB5vI9YL6
+BnEGneCcLnM8BX3fCbDuqCWZPf+gLwIc+xijY4+fnAZpEPE51wphjm5GbVBVyGYk
++QN6ARWPfo58iwa5ikH18BhLYen9TOVMXqsyk8O9phybU6UzLkZjP3bcoVBgABPP
+zXo8R5wplOJjxKmxFVZWNnbMK0Qdt5L/atz3W97WEIFNrfn6ThVepIvAHh4G3MuJ
+Wg2ASKIf1iCI3dg17O1ZgWxvN48UXZMRa2rIH1R+kApeLvxPPSOYbI07WeeFG5az
+IB9YD7HIgYGdc4AiAsa7dCzztsEhQGAA/2tJMqXCtrfUKJuzNbkyuPda4LNRkeo7
+AJqiTCTlvOKFRb9dL6IMQj7e+9j6Mc8WuPxicWMMs9ZzwDZ1Olu5BCZQ6RYgtZrg
+QgN586x4ePuj11p74TDI4gblkKJtptMJrBy5Qk5y9gEIW+ykRgjXZs0kA2DbZlmh
+wo3t5EhVSlj7YpcXrtbKwZn1uvuovF7zLHBUPKWsQcUTBzxGBB1SI52DGRvEYPd5
+bNoUglm88npbpNsAaXY/AMJA7d+M5duUNom2XibrJE9+kD58WwHJPGSiLsVwIZAt
+VgeI+yD4TkblSbCAoFmYoSe599LKFwbhwbFo27bCxNb46LqJiwHDS5MocDN+Li2y
+zFAiDT5rfMrIRnFJLrxw9Addp+lGVtAWVHEcJPSVQ+rRb1rvTD573LTDMPt83v1n
+fLslV6r5CMwCRgcGkgZlXb3JxXf6aa0qmHcZhf3POM3kZtQUn2H2wEEKg8XLi7er
+keBBviMr8Oo41fW5wbIQLqU+d+22ML7ETKKF7xcZcWEDUUE8yNOM1nZfKcP8OTyo
+gLhTf7OQZl9xjVhsFQOlcEF4KyTJcaWNVaBqq3tTHEfzacRlQzUitdVm3yEIRlHx
+6K6BBp2cXSDaOqYQ/lbPAhqu3k1ilPMe/g1qScSWJHZCJOo/BU/f8pIHLYKdozQT
+zpOQA1aEndECmBPyiMBxW3zXuysTMnY9T1n0EBmSzYw8nHdjxPbuKbG5oEGyy0AC
+7QfLW2Ad5a8Sv15U4YGpIPIAX5mefXUksz3jm4n4EqkWwD7mTFdqvT3X6wYBaQEH
+3XrRbFMmEwU+birra2up6bEoDvkb7SDbnbxBxztEIvE0tr8t69HTkBiTl4KAA23F
++kMcKLuWxQcm6bD/HngFoGq2mboFgyUPaqtT0Yye619ohW509cuk6+zY28tnEedY
+S7iqnfztVzRZ1r/uJBJEedje5w3GeASoZlh6PXnbpUFPKwhisnd8Y6AZnlaMjFpR
+A+V5jtt9cJHZaFKj8MAUqXAOAD4K1wWxW4qZk3983hQKYS2ohYSawsG1hZQ4YaN5
+1nej87FGAGk3rNcUI4YZKugcvyDL+eXRMxb/IqFtJM4wHVZjcgc6VSREZ7ZR0I8O
+Zp8+ZGpMDPzzRSaHjKuuBl+Uasqz6yidZ2XH7eIv5h1+JNeQTL9/FOna9AYNjd4y
+uQu/lCtCgIkhKUVUjIZaCBH9L4bUgGXNpVlZydXajg+jTUkonAmgfAuLoZrhdB4b
+8sbOfqf9vGeL3GJJKHQoMF7H8GgGVgrt8PUkwbmbGtnHdggvFPuwarKrp4DnpHD6
+OPL+pTuayWqYd93MkWVrvbko57q8sXXfA03bQwU3sLCnhQupXmYY6AKmlnfB5KSZ
+bhqVaqf4D1LkqFKhuQGqY//uPzCQi4zonrVjTF432hV7r2kO6JXzExQUS6Fa/1Xb
+w2k5/dCV8Ei/kn1c3kHZyDe8DmohD9JncMuIRsBrylbCSAvZ+bOB/Ag9m+1M98S2
+/ZEp2Jy3aVVlIatiZHkQTeVxwch+ef03r6pwL30VgKql8u9JoTvmsFRuJzE5OA3J
+BSi5JIYOgQDu1JURRVMkkpnHOg/8BP9yrzeCBtHf559teqoZ14tAxdbf8o0msv72
+mmQlcYCcJal29TjC0pWaySXuWDzSs0PqpKrygXTPKTJ3IgUsJ6zFNQQJkDvR2rsI
+IwnYfRF9s3CPZ5SYZ78dZMdRtbDBqo6gESg0qmrzNJ/f8rPMXeh+Yo1UEdB+4v5o
+LRpNORorQ2ZbVgldjW+9i57wWvfTXtvvADLj41HlqwocVgf17zt9geOwUoOWFRi8
+ue92YS9GzkN6YRmhOSZRlbDDgEidp1Yn4apCCXj2xm4Az397NeNZ6FuJEsS4Eb9q
+qm6imMrO6tSXCjk4t2qcx7Am8H+Tw/Z43yyyrJlm3Hety3Wj9lILyRipZVuPj4fc
+JJUjnBJTMepYBHts73iUfY75OqtzOVJHs+eZl1s8RK/lxY6lgH6rl8TYFjGRYOEE
+o+oUqbHH1MM21dCl8dGXbFNojH4oCOyMIlUasdls5s5EPO4UkJ3Gg5SRXj4EE/LF
+6HyNaKwUY/hTe3dKUMhRP7A/uImXCzkcfL/HACHJ1iOn8p0MYHiICVsiy14ScC7y
+kz0bknXrVb6k2pu7ebD8+2aH2C1MDezFJ56mDoKJSSDNwzgM9cUkBA1r4jZjsk5H
+EXHfPWPBcmTjk/i3atjk0tMNtl5V9zW1f6+FK9LKO4EhbWTqYJxilRCZwDxpuDET
+NaiZg6qgYMnB1Tj/imbpsPoHR893qCsqRL3vY0hfo8dYfM8HLm9SLpOwR60no5uy
+2HKYPw/dYNCHkMnMfPLeU/nK4zj7CqKgklpPxef6zQNiBm5dCiT9gnPSEglAJNzS
+UI8Xsf0dQg32wM4UExTxI93Hu9YXvBEMop6icH5g8bg+Bb1y1EPDHMpPB4BGmCyU
+LdHqV1qWm3JO2zT479BnmgaUDmLmOW+9FhngrQEQr02+FtiiHJQDgSMGBgTkmmJ2
+KBjXrGmckcNOrzWokPZv2goS4VNo7g/RZnVlmNgP04w8s7XQK53vq/lCSimyHWAJ
+p+tZODyWK+/yyeQMtSxUTkO/+am57al5j4BzGQ3nJ+Juu2X8ZD/s+PE5+RcRqoEt
+6QjP5Gd7A23/d6xbLUJISanNuNGjn3D0Or7oFrPuTCTyOR/2BlNzQdzEP8AfZPKS
+cM/Ca6UD5pS7ow2uXrccIXmMdAtz53wCF1BOdHi9vW7T0SetnwgL7RKaODXF+l68
+VsipCoz2nSE+pjEvfE3z6/FOUeguF1itnsRYbHsNPbjizbZhW2De7ceyJV9/tCRp
+wlXVnt/WNYPbgKzbzkvgiYCukSj0vsrqst2J5coO3cIiaFvfxTrQTG/chQtodyOg
+5GeamcoIqMaxfw+ZKxifZEIav8HB/zUFHqNXDf0gAop/3631ox1a42L0yfMhQxbN
+EJrcINFt3HBkvQmNMBDNu4GT9rWuH6YWHDC98u2VtcWVFgBB42rqgUYrSdsggvyg
+ijHT/ikAlD/J+/dcAHGl6GNTPHso+Y/lYqo8YTyM0QvVzoDrjYyh4QC4cdp/n6pN
+HztZsTI4AUEphRr4ZmSFWtdFKvgYlz1LIPJS82M79i8dXn894x5twLdjIDcZcxy7
+IftFyNmfMCF9Ptb1ew8Ne32Jy7C4WoXv3HNqf4sORtvRTvjb7FZbwRNT/Z3uhWsz
+FJyhpL07B1TfJ/pyjMoS5kYUOKdZ+5DeffH5aNckzMOO2IZyV70kyoqLqXygCIKr
+iSiui/h5cIypqBPn23r19ptBVp+gkW4pab2EiaFqTfj+CgKBLXwDAJ2gkLv7EZ9y
+Okr5W/ud1EARKa0Mt/mVWIhjbks3D6Q02QRDtuuDCUSZrW2Y9nb8TIKzBynEMXFm
+bY4DxVMm0mzVNssecHIQku3ng/NJ+mktXTQfe+ocjn0W93Bt5SME7yoIFnnuv5i9
+TZETg8cwpvnrZYQgUzzRu/LopaScZ3Bs6S/KZqDn2jBlV+H9ZgOIG0S31BWwLoek
+POGoM9ag/Z8FsMaMGQ+n8VhaBMWfzxvldNk1s5oxXSO032TsfhhHrvTaj6bArfG5
+gQXFE+imCSNEbVecdkS4y+qwZ/fck2y8g+K7KECl6QGYs5OclzYlQeg9txG4A3uy
+EURUi3f2wLnlkkUf4SeYMO4KP/xto6BcadozXVo0+nIrGnubI6/6wRj7UNRwL7pO
+vL3KkUDhZtoZgsgtEKfubIgFOYhBJD41VMEH+7bcpi7nSYZtd/mOQPy6KfDehpgB
+21/a5Lvd8hXP9yFUVwY26BjU0iVmi4iFzqTJCgJShdW0j20Sd4rZmr0eJeEKOjNS
++G8hBPhJ7PS8m6dvf52quKbenAVCWx9gDf1uKyQtubIY7aW6QjgLBYM3NIKsy69x
+aLwgJ+iUqJjU0buBqgOjS4WvEDvnKH31bmNoYuyP4hCJzBX6MjNbBVM3dCfEAFLn
+FUSe8HtQrE0DxqgGWqi0vJ83/21BekVD3+QuTuklg/FAzIiqTBdQhF3diHjobe1O
+SMLd7vIo/sNb8EK3yNr9O+A/8+JlAg9X3DoOgQALna/+oea/R/8VrYK124oHtY5E
+rStDraiMfSlZzGjt7rnt0Cq3a6/MNOXzaU2R11B6xbUhY55OOw6mocpnuPDKxzzg
++sJi0NdwdMJoimTlUjt/z9yfvTSXddeFDl9dpn2BiR6GJ2GTw76PW2lcSZFYqihc
+tG/Mx97/7Us7pRPpYzhTs6+q9JIG8+GXeRtDJHJ2R8/MJzAKTtr+h5M9/UNVjAkI
+YymCMmB2wzRHY4QC73puQ3HPGdQ1s5fPI1HD43ycVA3/FiArnqE0i+U1t7PH+409
+aDWVpu4/IwvbsoRK4Uv+UX7dvjPmdnd6/MWMrWrCpl8cfYVKqO6xrUpKYMQRboga
+gnDhOvJe4i0rJxM3Ks1KZwWfpU10olcEnyPataaFS5dCQVd4+8tYVogKM5MPRroh
+2iFw3sDt2n+NDVpbrahCAVgCHV5FUCNqdqnGYGskf5ddIOkcSHbrmIryAbvJOZ2X
+zfrQlfuzLvJklHbuDm8NKta5ydSmypuvjK2vdP4PVi6PiSXQwlGqS04WA0edhmm4
+0xWV9re7IO90Rga4nGT5mOYE6MxBdKnVD3PqPIMTmCAIKsf6ERzUEWU7jhsrT8+o
+VCyh9hXSIHbFJZfMm0IrUZVhywK9+cnEq9Xhj2eYdJ0idHbhwXc8KAdHsKqKwTfM
+rZIMz5oI1M/YVOs+w3HIjSwNs3ViOom9NoZ0NmGe+Dh63yTbAQqko7e3DzmnCFzs
+pNau5qcbvkm3WGtpdPvvvLStT5P4wgrSehnTvmlCwkP6/0mI4TOZTmC3fYO3RdtT
+lZ1RFN3P5vD72wviR33t7xMOYGkNENkO0tzoF+Sf/2ELel2azz7v1Qj1zPr4Hn7U
+IRdqNvlDvmvwqM2CvLmukD8WZ5Nk4TlTvjxJlwUojB027EEdBJBApktv8rkUqTyP
+GykpEWL24jxM2qJqgLo9YIw0Vdchsla722unq/g+GloGZeUR5ZM3ihs0TnM1Vhjf
+yqDpW7RJxz1r7TaNY72PVCUCZy6UNjrm6yzJbRQt1Iw8NMglvSV9FPCQ1iBXzKC4
+uLcT/Ur9ISlEN5H1qHS/YMdKoOcuy75iOFOcbbs7UUWdxHDMIiv6zcfSndmnj1nn
+GbJ+UgSsK8MFwVd2C4OFYWY2adWEw980qy6rh8aLVxv0Siqs+dI9D2xS2XvemmTW
+UX75nrXRUz6sAqbesURz751CjzfcHWxLLBO8ayDgQC5MouR711t1haN9VjM5e3NJ
+w+FVK8bIJFKzE20y5j6j3KrE1a4GSApBCSdnZQK0DOGGF0Fv+5rY8pUnkDUTxLsw
+CBuRhc3/+vXvB/ZujN6N08j0/skwYYxDJC6Y2hUhyiAaMK5M1npp8vk9hEp7Z/a6
+3lvSDEMGLm+hFcss+7ks3D8N2YgkF9nvI9VsR/g8fcx15ZXxOO+/+1O7j/zkeKvg
+LEdxLYS+mfwZFF7Sv7Qz7m0QCHAOB8VO+E9DXSqS67xlSp6q1jBEWiihIU8+b45g
+D42I8eiAj6CZJmNJDIlFxDxOh6Nz9EmYwSO3iNnUfAhke8AWOxMZlmXlzt4k2wgo
+AwvaV+eJ76cih4HWY06SmJjyK+zfECReBF3uBWoh3ogFw595B8CTk3TmVPYKxK9v
+xERIDDzMFcbvICyWOSL4UMlJAg6sI07BVXkVcqd2Ky4VrW2DxL96SsWh3hwpSmlY
+SHTrKbl/UsjV4DhKMCBP4oTHSAYNGBiS1v/5YShLRIi/l3QeMD/Dmw0mIOdsSjlQ
+y4anPzPmtZZUOgrDr9Q2KrWdco6Ah0BSuBun1T5zhOHT567fmt4ljc0OIOcr0UaN
+fOnWA4tWcV+RO53b6PaKMdabFf/mY/5ExNmQQRB0wwU+P4xE3WAlo/rDcpyqv53B
+k7bavr7xDY9ZH6ynpUMXSY4djUxohIA/kL11yQqn5ym7t0Uu06p938IYk9VJTmdb
+eyWheELn11q+OY9M7+lx/ObvdTS8tV88ytd7mGQObFwR7PESr6K1TXMg9jWLQV6u
+Q6cld61ac7Z/ROTiywqJnfv0+COsQ5AyZoqJ+FIWOVhbK7AMKf0KmH8x7faWgiF3
+8SfUKQ+4j4Hpyo0QhWcFYpQA2eFTocKIEI8am+4uUk/yBy/D6gEu0WiaCwkMum3e
+h7HeRWDqrdTa9OTQT75Mn2ahUKMjWsGhrLyZvqW+QnRposjfWrm1L8hlgpCivGY3
+iWVJH17BKvsXSByohG9OaSh2ZC5VitDTxmJe2sGvMi7cjnAg0IHoOFraQf5gBvaS
+mdiM6E9E9GektCgj7uto8Kq045p6i9DUCh4N3zF7KwRzgO6RSfBYFe8XfsbUd920
+1JtpfM3RQ6I0QJnB+CC6qTePkbe686QoDs+rqVIR276i9Nu/CIGgTcBqjYGg6N5j
+OwwOm8tuk8XfQHn+QVdIh8qqCPqoDlv2Y6ZI8Tfu8RISll5+91thdZB3iR+iAHCu
+AsVc1+6dhBV5KrvM8MSV9j0SQmrTMBnYoPty4fsG5kyMoMQTFRmedDht7/IqYsbb
+Vft2bjndHPalr/PFxeHZgrY3/2LKICiY6Q+NZpFoSfpgDQ8mUON7ueu2Za4j3PNL
+U9tAP3X2gMiLFBQbVzJI7ZM2ZiYdSPIqflrE4xyhVI14mhrYNrDdcQRytzpORdl/
+fz7hjQavx8cu0RgpN4F+fPX6qp9rzUc9F9VIVG/ZaNclwtjibN16piGKgzHNO58M
+BhBv30+vyj8UxLTm3ZVti8viXmgH1GsaDyaK+RzIceL4VQfP6UmAHUqf7pv0eXau
+X1kWj2cFjptir1Vku3B4V7euRr8dHYrSFGYw/cMtx2Sd4ZEUFRewTiQG9KeN/VeX
+40zJwHcBL/n+H509UmMCxF57rKcz5N02rVMz0TalPCkFec22rqCW7Dx6BG/6Dgx6
+V45J7nOwakUI05fqRL2GwP94Hz5AWhW72aeYZMVxghVoFt2KMqdHVdfYZ7nYp4S3
+DETUD5Ovcm0yIO72vMBvn14NUAWMY0NKwjq6g+rl3cpP6q3ob8GyxuLC/P/u7hB2
+zchxJaCviPqMsp6ldi4qn4kIbmi4EPGTUZjGSWK6x50QW+dKyoVFgBw2TbcpNx3W
+i6wFdkCqUgHpS9fjxO7Amj9XyP6r2f7zXwYiejHkbVySHmVupBpyYI3MSh9TL+sg
+PI1SEzng1ovYWfepCoGRSv3oWOsjrMpMeA7Y0zoDktVsxxHWmIZCG3VuWaUbhrJp
+9wdq/GezkUuLRW/MKBZjsd3WfgzQH5rYeXEYfOQPkYKNsSKZECCrrAil7eqFl/I+
+BGIV8JYkXAFLh/nHk7h9O3joP/uO0bZIbH81Sh3cO4buST7ovfPNv7QuG2JnJ0rm
+7cTJ4ZorwvDvSdqAA4v9lJ+RDzyIfvi0QUuM7LmNBSB3CpfVfa3LMjmWL0vs0jaF
+nKCIV1SBDmEfe2iBdJbkEIklEf0BefDyDwYppj553HwboAWWeKNm6gJnM/+s96NS
+cBBsj3yiGKoDiqC4L0YK9RxZT2F2jcTmSlHDoaZ65PCfmSmnESR790R3/MUuvXou
+fnS+z6F3WAv7bFF3upST8JeGRixD5psR3XbYwlAoLcf4n2TjxV5i7ksvSwWqsCHu
+qqIALDNCwV72ihjWxRsCDcbFzsT6MIoxAGvcoPEJCNgGPAELk70RntCISJEXXUu3
+vfbsqFLAbyEW5JMBU11bL6KeXNaCd8wfftmJ5jA/Tcl0ae2U8cEeZz4LpZPTzSun
+GBbRVVI7W7m/eSGvFcVxoOtCt7nlEQfWnWziz7LYufzchAwuIHg9M5LiZCBvY+3F
+fZ2FjGc+mY+5qQn300n67rmG1HZGpC9z7u1U6Y4lzcEpKVqZvBW6hp/OTf7LPHR6
+fN49CbcGZ3JzhFxB5/p/np7PjGiGsstMNWNaiHAjyWoaeT8Lj/yF0J3lfzT/Z9Mv
+yeSrzn1KgQhk7zAUsDywedJq27uAPbQs3MOkZPA7kImSBIr4QRkeQ8ygEp2zQnxa
+Ehq5KBLnRCDOYc54qQixlqjgr9DoxtN2bdi7nOEnNNbWFu/mVQX2nHSV0nwSwF7U
+zPSrN1WIzgJERF+nWL99RQD1VEz/QXL7zRPhax2P4fQkJ30bUZyeZZEDoXzj0c/O
++EySYCsgak3JMzjfd8Tq8Gi4y1Hrp2gp92R2Kn1awFvQqtntvTm8ulorllJT8c0J
+v0jUZx1fBbqwmakqboj77LNadNIwl/LE/TxxXo53bPXP7bKpn6YClTgtCDqq3jNr
+ZKdcbUm2aIGHQxUwbWStU03nrt1QKbN2rnfbrJjtWnXG3ledAziN7JtwgF4V6FT9
+gMw9AwbuTnKHwRrJKp/oUGM3pSOQOv+xnhSfpWXBW7VIoO8PK1SFDbJOdHpjq1zy
+Jr6ltUL+UBL8X7LhAvNcxQGiTaHFHQgaTFzxl7fNIveq19CPVXArtgfZCBhx/4dz
+hMGFBlN0kIHP+vM5VZFqNe+jmZGKohd4dbMNUlb8Rx3CskMcTWjP9vJbL06Pv0i1
+d0lpps9D8CblS6j5KA9bB9sQ4uTrpUrS2fhfsotWud96OKiRP8v8fkWSRCBgXNY8
+RQalhD3dDcj5erWGamTR3CS2kM9lho7IG0GdY8fsbNjUoSXrXKkCtzmqR2nluRjG
+qf9ov72FgMp7mPg8A9PaUYlxj13OLCZRYAKSKeh4NKKpcxUybPSF0inH5CEyZWsR
+ySmSHMTihUgR3tG7YqRPhtYMnm+imxqEmtMhHSFJbxKYqDG/qWQ69oRsjCRYn+jQ
+L3ahX4YKthqe2oFh8gzs8sMlLFGjHF34Yu/f3oYtO6bUNgcbUhI6xDVfYCMloJ+g
+iGcvcBTp8MC537Jcy0GoYo1p5XROJQBFXemB+YoZAN/VjOpHUcYbY37Sstmj1Uuo
+Kc8xBy8ezQ3as4soFn9OHRLhsU4T3P/fYDcFDIj3gIzDmrzRWn8wwW+I8aFBODOo
+DdeuvegCRbk1MzffYUJ+gyqXecM+STCBZmmlbd3eFuBgWEe9Wne4byFrLzUAjYFm
+BF8bUUZuB4NQr/zt9vofb+vAP6Ru9cx1UbEHUivwceZE3vllbW6oKS7OX12gLlEz
+btUXgfUfVWsZ0HJcfULyRT2aLC7X05QixZcXP8wXPl+Tgyb1Hu3PKO5QFP59gTNR
+JHIHBryp7wG3192UYih+LMLqvq9YIuM2BYdvvDK0OAVAYp2xYOnxdLtp1cblMQ25
+JEDiz63kMFRStOzQUg614AK4RGwtPhPPkjKqZDrp7RLzeRcSfoeGgvtD0s0wybg0
+x0I1fGmajyDCixXMFdOzWnO76xaSIIa+uZQu8S/SYQVGnOKAb0OhBO87AlcyKlIH
+mDCS7SpdBSxPJNaJsaioHovXVKDeyPzul0E4DuWm69Zz+KXuzxmQoCqCC2MfOM/0
+nPy3X5VonPfmhI6PjSZ756I5smcHTu/iBQp4+L3wivlRGGCbERYS+Uld6c0mD90M
+f8Pw4jeF9gBMwmjjlmeB6q6eLAHVNZur18SYgd7kqpbQt2KsfnL2RJsERuzs6nGr
+0BKG1nwvnNVR+n2COy3qyByoM0DufGctZTS+QSCUeWuryRe5mhdR5nugKJgHl0Ac
+naxQZ2aV27B2QroaPPj/Z2kb1+K67PFNB3DELE3WUY2I/Z2toLUox8NLv3DUxcjQ
+cOXlgQ+fmHZEFlTXxdcPlGbySpNI5M+5uXrJwTDnEe/IZa9n/1fWUUcEyKUH/mQj
+8kNr7omevtPxVGSTZQ4E5aTVRbIRgJpEI2zBvuCrUiXSlL6QiK3e3yDxAgFRZyc3
+ZN2QFhyGIMsMhkzZAhyMyUGrCu4DpCX7kQYRz+zLy6EWdX5FkWJht0gmQAiCcRva
+lLeQxYWw8LYvrdO9JpqJkZTNHg8i5f/zsi0nsemOjy/5ap1UFNSLeymB+zQ/U2vq
+Hx6lskKdzpCB27ClK9QEilfEshh1UUDV+NDdKEtCL/KDaCYY2oNDkhUsevhfvpvr
+YWFxJdpgsCBFEH2BQGkf5l8D1/3GRPOAK6mV6HjYmN5VcjPhIK5qOtjMTXZTjI8a
+qSeDw8Hmp3WSfDVxVlBAaLx0Bloh9zy6KCfnb8ragzW956MBVNlsU6tAjvK69+1v
+Z4s4aCNRch45hYByn0CzBVcVdQP90Po63Qk4sYDEhZo0poyGxGK4Xi1tKI5rNcQF
+BIMKhdiJ446Fm3zoBrpFyQpUT3ysSfu4ZF99lZDN9Vj9a3SJl6EEPFJxdgLsBpTl
+bHhIhmXVSVUzg3F+gRp+qx59EyyMdrVbEf6Its3mOYi3oXTt2dyPdfITXefStcKl
+PgEr0cSMP0aOg5TClhK1webHcaHgFFdYxen3EyFsQBZnESFxqVhGu86vaZTCI1BR
+IqDgmouiPN5CxfN62c0+INC7x2KzPpf6wNkzmHn4RlJpZPQFTuicnnn5uHfQIf+7
+RoKTRBJ247bJxNszfS8exTvTNnKhXGqmOTs+Q9OA9GVk0T7uY1SR/JT6TCZ0DjAg
+9P7uXO1PLha1G6kuNv4m3Xl/qrEG8E9gJv9fyA5Oy7PTq5+JBuo4qj7ubYyGapt5
+AHKFuvA1HoUph13dLoah2zJ8FFuyAdfrzv12LVzETihU8zo35SZKV5XlrTtyP0Rl
+l1GtTdT2KI4rOnujnzB2ljOb3lFZZMHeBqAbABxvyIPIWjggRf1qbA633BYHhmRQ
+s/Yk3mNHJn1mvDCIc1rNsd9mGW44ffZ0jXm2yw2pb9EyLkq+35QiWw5ZiGuDuhI/
+u3Cm8iHbBChpHC46qmJBmtgsvSpO9Io0IoJIVtDfDHNSk8fXMozbam3KV1gFr1n9
+sucqHfs+e1fvD4fVarYp1sdmEX+UHjdVYq9up2S+ByaHEoqaBNUjONIiVsqHljL1
+ObpuBOXGwGytHZmaPMKfmbSXxvDEge1A/v/89zDLE3gDLEouwNVtFiru/EAP4KBe
+sL8Hz2L4DaCKla8xRxilritfGnsaRDiYlHcsuW+BmCohlQ7T/LMj2R5+8wCxNqkO
+8y1+X6KSEkJ+od0PMfZKhGfaWkw5C3Q2n+gvw5BhNvlQc8GnFpZVj7tbk4MUcDag
+Xas9EP1F0Bda7H0iqlyYkvfrcEsb1hEHs6XbTvbpOTyU9E7pdfhJcctPF+cHp5Cl
+buWwfggEQXzbeUmmZ8ft37FsqxaWckY/biCRC0dtsFMNa8xXuIhkO3wwNZkndBc3
+jLzUroTJSGsmE4k3GZBP8x4IOlaZ1ZCcheNFVPcNiyD7IqxtmKK7qiUlYjNa70ah
+5gorOxLiqihmUf1yygBrKRbM1KuGBabL4rgQpfxGzmKy4EtY1A+Z+5/HoHpOHKqu
+h1sWzgbWTVFISOhl9ZNvRPPX3oRYMVZZeVxzXzQQ/ztA7pwiXEDaL0jxNLh1XHDV
+ifN+E80awjHZ9g907wSmbxTh3JiaRoOCFRYwDZbdRFi6ncDrdTb4lMnXcq12OLUE
+U4veQaRJiNq3UQh6mtBCUegZZ4qDeL+mvn1H5b5cplu70FK+GcC15gEKYHZGEBEE
+5k3c7Y0Q1o9UyuLb+rB9BWKdiZjUp60OdvVy2ifGPMYXtkTDEeYXvHCxVYGvF/sW
+8cX8VbnINyBfLaUnNZYE5FKlt4GG228PWUdYre1cecnskT28ovRIiZllS6QaZ7et
+PJDmydciBHO6XeJbdyR4VfcxAuCvGJ+Zg6dxlKAh0FRBW1WcSJUgl/3hjHlvJ0SK
+lGGryloIWk5QP858+eOscMKgOan4Y0tvRB032qNO4k8RqsoQ5Mp4YeXKV4eb9JUn
+GUUB6aqRsVg5EekEHMieRw291ZdvyI7Tgf+JXY68gYMO2K7GMUCW+dakOUYn9i43
+2RFVSo9ywM76AMH1pFQudFYxmOJNx+6y1oGDCfm9AWmL1UecNEj/Z7C4yXPg7+zG
+JmNeKYeSzENkrRhQUUjJbjukocyNZ+AlmlqqOWOrlNmudezQNhLs2WDGjBYv3c6i
+2+z9Kb0IWkzh15y0+jmqLqTHb8bXNUqeh5B4dL1uGh+4HeUQaJHKJX/l8SOdtg1F
+mxc5BS7jx+pKr6dxjKVYif1qSgAeQDefHxQh9KTJkK1jBtD2BK+fNRILz5k3ptou
+VPbu5AIUv1DquLJ8ymSlWYjpKCFTAL+AW2fqSv/Zc93lOTF+fHTH1Ff/QEQDX33e
+l9qZ9avJbQLa0ajCLLwHZvw3ZqoF6AV0iIS3NXIg77yXWoecJdGvW7/l5OR8ZCoe
+vV6ArWYatu2ruV6BoCpcDWIyMe2vLzEKez4ObvHRceHxdrXI4P78hr+J8Q+u7c4Q
+JqRgX/mWKK3iE9NdKNE15nibZHuGMA2YCF++pnxks5XkBkzYJ1ICns5iz5wq4FgS
+CFNOSNG4D2q4VAjItf7/CPW+anu0KRnmg9PPD87aC14gDahgiUhbXVqgBPUJbeVf
+Rcrt7zYok0ezcGAqPL1IVNrZP27GN0Ka3cCvapklIkMBMTU5wMOTeuH+F9SLLbbc
+UhLOLq1WkmQTcpZ8Rrwo78lFrVJswL1vd+ZOu/Re2wTzqPhZhSkxHS1IZ1mrwHSN
+FopFuTw/1tJN2F5oaoTG8f1Pdac2w1g1ZmrFA3v8tG+QskIdZTmAos0LyVwiqtn8
+npxYmsvWsQbo3ukvp043eDgDPNL6ANkRTovkEyBvnFQ7LrVmzZrIaw7rf+iG/caV
+1JgUgGKemnaxFATkGElhm37/fx7LRAHaKfofDy2DzLukOQ+7hKQEMWaHPZczAzbY
+mvDb97dFAPLltyikeoYKBwgNx8cKvoydpRospJtSmJeHr4xKX5O3OdAVoBdZDu+w
+5NL9I4zfyx7OQQEX9GZ3SfgDTCH7y8SOJUDGENIIMS2ukX2hwizpFy9YNVI/96nk
+HJzrRcb7Ke0xNOWti2c8DbXHkjsh8QXdlzmxcrnPpaAcwoA2T8K6l4G4nyyLRfCG
+O2awhlV0yaqVfmo9iQdj+qEujN/81DQ4ehZ9aONp8CxV0bQYn3OktuFtIkMLUnM0
+H49AkHa1IrPQd+Pd+X1O6X/TH5njAJ2LY2HOePpI7RPopSE17CW1gCluSI8FyBvG
+qIcLXwYQVDBAlPYXEqMaww7Z6n8Y6uN89kjjDkNK00jbkU1MXN83BXMSNWn70KZe
+/a8ppFpyrN6GBEKW3EdMojGoijcrN5t9T93ssQAiir8ehGXziiJj5xOuRHhnMoEj
++o6cZDllxiD4zUJAUEl73SI/xIFCSBFHlY+QD3Aq4WPxriGRWQLiYRhY4e3M9CBG
+1YuuZFhehGfbUFCWf8eb3MnM5RXB0XsnW9CROrvFp5EFscde8q8T63Wv/d4O2S6Z
+aeXPzlIbNCMh2+no+gPBrbrXmCR5IY9WOwvq3GQNa+X1yflXSOjcXWC4sK11T5sw
+IJLozeqUeJsb5gxa7IL5VpKt0hxRLYGesD+BS5KhUpnVdHRbL8iAJGjHct9hDBjy
+nyjh4ai0mcStCCJ+GuJUvZadSTPhEBBYuWovZ9+ijMGf2CZYlC+KlPv4pDP1g1Pk
+Gxg3QY1qXNmrbonszBlTMYR7+mVK0/1CxE4WBKYaimdYxdha8rddgpNwSwwPX+BK
+fUVHfeZ9ntkwJ6lt7pidVoqDhg8KIa3b0tk/CG2G5qixxoVRgHl7GWpLjoWUHxcU
+JDei2IbxoRMlE1xxm8fA2LKSGOh84I5KqSMuDAqUQT5xoSnXOqC74c88kbkRPIAR
+kfU4Go8KPq50YDXIDDufnEwEVyCLrF8hudNtb0+jCOWp9woOEPe9yR9GjSwdGbYb
+IOBpgDi+nNK3HYiUB8ldVjNkSVlYY4qwoURkvVSNjTwvuw0Tg4G2sI4LB9aGK8CH
+XjQ+iRGKBhfG7z1Y74yekuEOa+VC496PUilLU2BcKYJHTQnsmybzABmKSuDc3gyc
+hH0=
+=wbbp
 -----END PGP MESSAGE-----
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index a6cb3794..d2bd70fe 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -558,7 +558,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 
 	& "/etc/aliases" `File.hasPrivContentExposed` ctx
 		`onChange` Postfix.newaliases
-	& hasJoeyCAChain
+	& hasStartSslCAChain
 	& hasPostfixCert ctx
 
 	& "/etc/postfix/mydomain" `File.containsLines`
@@ -622,7 +622,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 		, "milter_default_action = accept"
 
 		, "# TLS setup -- server"
-		, "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"
+		, "smtpd_tls_CAfile = /etc/ssl/certs/startssl.pem"
 		, "smtpd_tls_cert_file = /etc/ssl/certs/postfix.pem"
 		, "smtpd_tls_key_file = /etc/ssl/private/postfix.pem"
 		, "smtpd_tls_loglevel = 1"
@@ -632,7 +632,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 		, "smtpd_tls_session_cache_database = sdbm:/etc/postfix/smtpd_scache"
 
 		, "# TLS setup -- client"
-		, "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"
+		, "smtp_tls_CAfile = /etc/ssl/certs/startssl.pem"
 		, "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"
 		, "smtp_tls_key_file = /etc/ssl/private/postfix.pem"
 		, "smtp_tls_loglevel = 1"
@@ -751,6 +751,10 @@ hasJoeyCAChain :: Property (HasInfo + UnixLike)
 hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
 	Context "joeyca.pem"
 
+hasStartSslCAChain :: Property (HasInfo + UnixLike)
+hasStartSslCAChain = "/etc/ssl/certs/startssl.pem" `File.hasPrivContentExposed`
+	Context "startssl.pem"
+
 hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
 hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props
 	& "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
-- 
cgit v1.2.3


From 3eb5876d8810cc55f105ce564b4192ef52b8102d Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 22:20:01 -0400
Subject: Revert "propellor spin"

This reverts commit 947e73a2021fcad36a806a224f171e0dba9ee7da.

When I tried to use startssl cert with postfix, darkstar complained:
Server certificate not verified
---
 privdata/.joeyconfig/privdata.gpg                | 2721 +++++++++++-----------
 src/Propellor/Property/SiteSpecific/JoeySites.hs |   10 +-
 2 files changed, 1342 insertions(+), 1389 deletions(-)

diff --git a/privdata/.joeyconfig/privdata.gpg b/privdata/.joeyconfig/privdata.gpg
index 458f1d93..027c5972 100644
--- a/privdata/.joeyconfig/privdata.gpg
+++ b/privdata/.joeyconfig/privdata.gpg
@@ -1,1386 +1,1343 @@
 -----BEGIN PGP MESSAGE-----
 Version: GnuPG v1
 
-hQIMA7ODiaEXBlRZAQ/+LIwdo0dZpnlj27p25hQ8AXf288zNaI0eICp3Cfu0c4Zn
-wLFC68iUWe5Px4AZoDhq9dM47R9JaDzI0lRWcb2P82Vg4eFUw5505Zis7wBp19TO
-dC9LsekoAayIrOHr9F0B00NHn80C5uvgd8X7g+SLHdpKFB1qdCarPspTjIRXesKQ
-0BKn4LtW3tKabYMQf2V3oMpUm80p1daEXwf12ubvKnOd8gAr+t8nO8sI7rG/X6u2
-Eby9sSBbjHejGOwGuEE1QgOaSPVIBFRzWRhvwSb7xsiYNhO07JMpTF6XZ1W3Y1uu
-ZrWjiOcD1FtNRHBVDSUBLPBagVDtDWYbiFp7mS5slcEB8BdIwMPHJPGYhw1gbaLX
-jpAgjpptmNBpPVNQF9FfMnaRfOvMTxy4MA66WZxwbNYDzycHD/GE+c3bGB6dt9w/
-x/xGNcMlnspu/K+7D4kDOCdQG6qGi3AgUVUhwSe3yJHZMseWI6M6YXj/9bmKkUTQ
-qqbZObom/8ChCiZly+nntReGA59zcNAMQl9C1QqYbsrulCBwVPMruZB9Sg2CmSmC
-97de7tVDOOpZ37iq0bgD4Kt5fq7KD8qGQQHJ3dNUR5N45NCeeeH20Sn4jqOW9Yq5
-+l5+iG7VZ4QYWYB0Ts4HBi+6yV0pFFFR05uppu6mBL7xXujYDKvVyTaxFbkvt1jS
-7QFlm5RfLdxLmps+vpxYzYs9kvsJ9BqllORi+5jCMm65NBbqZZNuALuioHGY/aqM
-gULJdc4OPWY398JyKmouVj+0pnxmAp0jYf5HgNHhFL7nSP+ijvAVCfhLAkI/cZ2X
-+5axYj/1TT+lXcqDXdEWHm/bW1Xe1MN/JvAaXHYas9EIou7gTLk/fNKyrAoJOq9z
-7lXcpElF6H6rqA5ZmGBOBfRXod7wb1I6EmNtMsRAQfcBsyUVqT5GPsLI+Ko12XPm
-f0SPRwoaOBftncGNLm/F3QdpucwAqXO6YtugqyOxZ7hDyIi5yY0YGWpWcibXc3uT
-AqeapdfjwFGPA0DO7+mv8hU82O3jZZO5ci9RTG74CwRJ7hIKO3udiyhoDTJgdBTB
-GKi0Bd4F5zkNo48UnKP6seHzylkM6uuvkWbNaHK1nMqS7W3f1BuObtQLVw7DUF6Z
-n5V8OxTXCG7HJCO/xnyGz76+ImLf9dYoMF6U5H5F4+xR0W71GWmxNUSPEBf5inTD
-tC98Kbd5uLHu1s0rQyKNjz1G7XIBaX9cqmG1u+Ycvm3pwFcPu4kQMmehhKmvH6ou
-o9J7qED/EneDjCm4zwCg/VlWhz0NlE6aD7343bmcmpZy1kEFtcQx3kQHXvvIu896
-TXV4Uj69nw2JPBZlCpHHMFim9anK5murbV9zkfEm9baSYrzTL2O/4BdEhcxiH5IR
-MAu9m8JKmkh8Hlg1TqTBDxtyw/9rcjpHAD2hOtD7hnioRxutrepk2x6ElZgEMDyM
-X0cvkbCA1+abgEisXX1K9ns4Y6zEtXUfNkw+XFKYcBhM0XlcVRqfUc6mmnf3eEId
-jzR5oDNcrtAeynOy/7OYHzJ5USwIDAzyczypCvmI895kU5yh6xtiCki3qeKqqsjg
-5ptl82vvLBlPb+eB3UNYacgmYbB3m1lgmG6IHQnL3PVfSJl3oo/5kkIMMbXyljFb
-YCGLT87ACuf3LoyWK3xMtGWVBtexNajhPSMyrKVJe84WNHMkjUA0Y2fv5hZ9wQVP
-+EvDOyrSiE45U9ZwynJ8N0e2+Y5Qt8oEWnlPs2qiPgj+rheoxnWEj8PfTZceL5LO
-w7AoT0NFpEbsyc36X6J4gusA4S6tj2y3XcQg1gsfVNhh5l/C9JzycBPJhMePL7Sz
-jyHolgujHOAKHGaS8BTajqR166E4KsKsK77lK+j3HpBlS0Pard/upn3JTdm2jxOR
-B9js5yJ5ouclXiQA0S1NskADB0WA0ZPZW80XZ2YL1v8lbVNZeCwftvpnkxX+UVmI
-iJsQM+ME8OmO7i8btNRsAwwf77Ocbtvfijg+wcuPHDy3EPaYZOchl0vqdCiWyKWW
-oC+nhIxaWrztAnDuufiE1qcGXCRpiEwHSftsypx3yi8vBHe6gjvAgUs4vdmBTIEL
-IVIRlthj0aJocK6j9fnTDozrDu+CCLw4676+gn+zfmuDpj7HCn5aDYH45B/8Dk2O
-73OEoSJcGKq5aL1BIyjtnbYLdrHhjdyAvaRwWam/fu7vNNcTZWp8i3dTrLztDrU9
-L8oDWzwdJ2X9a1zbpMxOsCVxHWSk9mi+ZEI9ijvQcOi6sGTSgVtj8hVch99E9p3+
-W09TKcpN6EKaA0SUcC+WFamCAMbo5Mv1FS2IaGrHAKvMor1iOceYYSoKfJgeSBgh
-oxMry10qob8xnAYXOPOAr+j40fDnChVT2VCEXdRpKsc9gtou9IjUmKAwE/pFloJp
-u2tdvmmfoKtsF1pHg2jujLNdoPeZ4bsePPrE3xjsfEoO5Jku0yEvgu6Z2yiO5Paj
-gcPJ2wKAh+UXr4LFeR+RBmmXw+/j/VAkZXKjuCwnQuula6SfUVEgU+pyvwU0pKE2
-I+uUPTpXH4WaEtcG+6VsOPAjrgLwnwJihgdCIyis3EPOI+EuQP6TkA+cK9x3gv3e
-gvY3Tfps8cBHBL9lRIlDLEE23KhQSl0V6D9YKGxAS67M2wXQ/BSeo2UeMZTYkpbV
-Rh6oPcZjJVXyupmLX8Z69Gl628akkQs/S47DSBgM56OB9RaJYkKXDGpH+gNDYegT
-BWyUUcefmfoDlKZlpY+rqHBXUNlm0kZFHABrNJeYPfSYQ9vRZWdUv81Cfi69JpUE
-Hzhr0ptkl8HaFin56jSuDmwvZ77O4VsTOC3YiTnqMqoEYISx2HX8jHm81L45FTUA
-yzlAWk0iI+eyX5GKDBkSRTVPtynSRAotzRdz2/297bucZX1rxcnhT7SyQWCkeQfh
-ynCZND1ZwWii9jLNfmcOtmuMRl3GBg/xfDPn6dOq65CqzZQpPCuBfN1n+EYClj3M
-6vsch7S8r81JjD6vtEboFaBdhUbythJ8pAQ1QqudVmcoxSWfOY32+IfXrlzKRGv8
-e/27xkTCZY2Co8oFNczztN34TlWf/hFPvr6A2SyUxUQELGJXIX6h9I7SKLe73Tn/
-S9V7SegD0o2fiwX2Rs1TPTBODYIa47JTLSzkqraDb1X2NyKMavteRqzMNw4jivps
-4vUgdfG2KFt1mWOjyYnhSeotesQuj207RCE/V65Ro/44H9bM0gtw7M4sS0Wa2tUq
-mCMZVTknkRne1morj3mDfy5ciyKWuMap7ZiY+xYTG0WpAfLdHTNgxqIo8bJcLYmS
-oPailzD8ZlJWOGCOh1/IKXoi+AZsssjhgZxZ81YOepmKUeNfQ2oSgsGSwu7LDtr+
-dZvoY/TYJzKrRKlMi7Ao/Qg4Vph1Tq3UwEPmD51DG0CU9tVLgagUpeHEQBc/SMO6
-2BT+NDA+Puglmam2mnVa+2PjF5+sF1OdzC+Xf5YSTbkHGnBqXpqRqwLkWrxHid1L
-0ZknVLieno9Bzt7hH8v5OTdc/C2EiQRwpQHXbnFcgpUTqhMlyZ7CcrQ4K7rZ6SDy
-xPobJdh3NEcZJhFwuzItztYP5AuXGklX12Wej/5XyPwxUoqUoLCRUrP9CHTFCOFR
-gtFVx2Jz38ll+9E90hYrDk70F4gcUOyT9a/yESmG22IVM4c9spHb/Qr+8h2jsdtv
-LdRNgMTsp4uVf1yeQnZxNLwB5AryQ/4d2y3oI+fLPjxnzH2ZqxyZ9I+kQNQDUcWa
-Y3zDSXj4rFtx6xmXnJG+C+JHbd8FPVUcfWuWfl3iujfwYZNf9DG51ZzT0ISETaCH
-3/C9im2CQ53Bei9wY5s9Z7rzvIS7exf9uSHw+S9UiSjWqxf1sFKGJ47dar8uYe+o
-PvrZ0E15ZMwnyXAbWHOLixeSV2eXLwb81mlSey1NpQ+hMaDws7onyYvnOKig7j2r
-wCItHpx9xV7Wa+eCy94cHvZpP21WeY0XtjF0RSGUKZzNpSVAcp0NwZK3Xx+Kusjd
-LGf56WRaCachu8YAMYl2j95i05z/YIRLVpDZJi7YCANm4ZdCdd5b2yirN+rj7p+7
-zVbJIQfokvgC+mtWpOuCEjaMSqSDrsI8htxAZonrqX8qAhCPufA8iH3Jv9o7xP8u
-oYF4VKN6EqM7G3VUSjtiyCUPyAsnEbGEXcfI7mj+8c+I02A9riLagn4EGgJ747yt
-nW/1KxA8Osq+l0KG/POQPoWGasst0+4ve1/mGU7mFjbTApL1UwCICyqQja0tsWG4
-8ZcsK6kMAwuqlglz7bYkZ+0p4D7k7SpLhdk04HHL/bAHl6PVmBV4XAaJMBCL6DaE
-xJDS4KGehUNq+Ma+IfaZpOgtu//+oc06dlEilNeBS3MWZ4T/jEGeRUV2oKuvsTC6
-VnqqjoC9YBDcv/1bbsaZTzwxdgPJ0ngs5Zg0Paxv0MUWDvTtqyS4dSfdU0m1cYKj
-YQM5/GmO7KPz3bSIyXzYQX0BmxD2oUTCDNhnE1CcLsEyaa0tfjK4IZ7v7cWRLygk
-YfJ3vGnilQehSNz5dHeffcFM76uhTSyzGq9AVS1QO89UK6IyXgzZXE5DFnuX4rP6
-vl1g2CT9XV+lB9tkK2xnuROi2EEfHLPxTTPEwrwYvvxVJ5T2aENEHaUKSxZEAJ+O
-oqMMvGOYrU3JZbHO6l1cX7n5c2qWIRu+2qp7ZHAOMz2fjQ80nN47MyF4anSh5XFp
-mXwREBoxJEfMiEZolLNn/TloVpusMbbs9/yQX+lRxfLi+iA+nqi3kLzMEZGpUBr0
-TdnFwmsH4rD/RSyggoWzvKTHyXIgy/B/Tz65ymQNUGluM2MFXce2vp2YSVqvK8lj
-fVzaG6+ExEyQmUgS3Ed8GrdSwvMfplj1SxqWCQr2eGaThD/PhDhOor6lKev/qeuV
-BM2kVJulJSFWL2O4/txEdx23cjk8F+y6hWSu4tTidZ0LN/SXX91sjysN1timOJHQ
-s6Yr2D10KNtRu0x0sa1kDs/lgOvU9kmoFjtVHXwfehcYfzQ2mdOHYXHemj+gMTws
-Rd8RB2dWLKP9oac7i7idJnBL/C8v9WaS93aWCeDI9ieHPBdwua8LsPot+evot7Cn
-I4s10ehZxrEXuAxLGWuBl3FsOSpR2pinsxdC2ntlqBdAdqjBxtPit9p/U8yz8h84
-bMYYb9Jbo16y+OOGjOgNKDv4tEqhho88Hpon8egUxEodcPbsVySpKb2TToezUHs4
-l/4UEBqix9IxLXfbsPOKxnpVmBtw6A02q78YoqI5tuwezx7sf0/LQgMHSqFOG+3m
-CSYOug0qfXvXPFcr67OXC4nOoDSqMjdqpo0k3kSzWKaJazvQZVjfYLObn8ghOIi5
-uUBMc3GTS1vnKvSTqkpXnYfLQ7rDpItGCNjrKYkLu9uZqZeLlcsch/AdlYaihAZi
-fY4E6ZmUQ5r0Fiz5uZm5FiXgEWJMtoTApheE9n8vVXRdfq3EASeL1cgugD9uMOfn
-WJXWACPRDCpNvwYOb09jb2bvZBPtSFWR8HI+18zCwxbS1GGrEKmNjAUviZqd6p14
-QUtrqopVnqJmu14a4iHA4q6LK+yR5YJSH95TKVTE5rJAZaE3vwAvkw2nYNyDCtdv
-aUoOnZCz1vOInD5qWZW8+qiKX1i3m65L2m3CVAsd71rZxIrihR4zk2Ec3brOzSwP
-8z4cDfaiwzP9OaI0xM5iki+eC3ntigfAeZ8t2A3crUc6P5zWvYkCGLLhr/eyVIPI
-9qTywQYgVYfiOxlnZ5qXqQXDPNlFYlyZZ7J21cgcwBGbAe+l0QefHOzOLcmVU8DJ
-MCyg726iMbgy1HZoxMZ+bD2aHV0Fy+tehVdkA31mS8d0wjSuOLC8a6+8+ytf8chw
-ewSkpq9oHd8DXFs7uPUqGsOgIEiQ8XiUF7euqkzW1AB0xag2DnH/yHn7LwEDpvQe
-HLlWMmkqvv1ybmdOO/jbu7KZHK71X3dh6itgPU6S4Sd4mYz4fP40R/kELOJ1DA9/
-u3pk7sI9l7WBrhdT4776WK5lgqgDjHdqLmu4lxqfEP8WtT+awhVVe4/UVqdCDA7c
-AKVESz1XJ+8fARh/37WoJTXbPiamfua3fhhn5Ar023euqosY9hoDjv+dimQvb4dr
-cOQ6nRxV0I7HCnrLlxTSZyrlT3hTGYz/FiX5fDkHzFV0zv3nRknJ0P7s6MKD4aAo
-eXIjWbXqiErQ0C8iWv3T+4Z3bnw1eLEbX+ajmmAnvIGzLAWxDsjWHhEvtt3LdjWq
-gAuuYlhLiSx8Paut3C3Tj6Gp7XlYExXDSjEKfhEskdYg7rt5lLLXI4N8bdncZZy+
-iUZZ0jrmBWTystKqWqQC/oji7apMnbRTXpwLcXJN9QQhzmYybEq16YkIagy6OnHJ
-BEWniGbIeIRlv165qnfHPwzXQbcovdw9xCqwINebSZmR9N7EfY/3oMmPsVIgugev
-bWXEVze1+T1tgmNIYFHrkhSyj5yhLFz5vsBc49Byt0gVGzbMy3iOs/X60k/mtTxz
-rUEt2+/5HVhtNy3RPHovu0UGcujHLsWluC5pPBUjCgeaE4DRhoi4yxX+ZXZsgojz
-9w8yUceOiIjB1+igJFCJujNGqrz1k5ok8uN1aDpO8DateBI/YJ+Gh1fQ7cmlZLvD
-mbyvA+JdDwVFI9TdvhjwfIOFcBIH3pgyxkyIpzsIcQQybGm8rGBbK9e7cHznsyqS
-X86FutXJOce7BBYor9ypEpJYsT8e9ZpoK+CX/Tv3/qaEa0QdpZEPnnODf3XLNoeb
-qUYHB3fFjLvA2sxMVFJtX/4mZwRPP7F3j/buVFKgafNHPK5HokLkmEoI3oQDiYlD
-xXDRQSSBzzMF2ICvbPEOd6IPUQz/S8tEhBRZD557agJkTe/9pRotBh2GUVXzX2q1
-pUiXLNkty38h+2AUnCB8h4LpSwsJjodzf6r0QoORz4VuraSs1oBvQszDME21B+V2
-J47juMy69bHRqKHOYasstR+vKQC/6Lv/h1kUQaDsgOryi8gkBTLMyEF5nUNufPYE
-WM4dqwuvxMXZND+i89IKOHif06AVn/cHbcP9g58vZnL+7nIAMHYl23HMyd4FbbaV
-6VlEhPWfi5mmM9h20h4QsM161/mCg5sKR1a7YQEo6r2kEidMkOccnC+w1s2h/Dl4
-Jtk6jgNd/iinI0nYeycv/eZ/FJ69tkxnCwvOswrCS6oxkOyiX5Hkczt5N6IVueTo
-QEZVfNoiuFDqhR35SisQkopTLEnV/n9tEzTTAVvmO0UlLWH/miC2vG4SzRTbno7s
-AzGPytZVC1VaQTg3vAeAJ/KnyGsShbbv6n7nTAOQWLooH3OdPnVBpBnxvQthGNAm
-G3fI2fbh/BRL4SiaE45U0+piUCGatQcyPsRkH1gR4fvcXlgTls3tOTOrB/oZ3cln
-PLeYRpCB2twWPLw/HGH5z32Uf8CUh+btNWjE/DHxxitdscGuEMeis0jwOcEWeBr9
-vEGzTPqjO2i7zEplS6HpCmGDCSAy36G4r3KEJmt3+fU6CSMEKdSl9aVf2G+DThcx
-V0jo583CKyUDmPQAD1xZQhVx/dFW3ZOuuLZGp40nHqPQ0Lg1osWm1PZUjNmKyQoD
-zzWr+LLo5TeA/C99yhMlsU8IpGxRlM7slO4yT+JjZO8KOeCtGAjyqXDaka7sBTFR
-bohMvT+xRni4uwA+HcFp6etMCJ9pW3pe/SXjeOcEyK9IMtPmA00LNCx99d2L58o4
-s2jXZ5kRxfaiQqP1Zqgj7MDawgpmyVvTFbR9IvFO0sfHegcoTVd5XFUDtLmkyBBI
-dnKCi4s7TyjUVezIDvpZCqzgsLhzPguhh1GyGbcdM0dunTaJgxgy8ohybQts3X2y
-XEEofNpb0NnEPH0H4uav5NFaKXjbGhNqIigwkRWUlYzsgELrrY24ECHoQW7TigSQ
-y0Zfc5UWHJJt0IWp7yKnPTigylxi4OfUjhMyPZ+4CHo17koQ9l5TqJIv9YSEjYK8
-yN8m+PXeLARciUSaQvbGsLN5ae+/1Tai8mkRMf4MPUzDtsgjzEIQffWdtY6h6Rw+
-tC/wHJ90AB6h05ZSk8mZDTL7NPzNATe7akYdVZrRE78YJMxrkH2cHxo2vjvHSWxX
-m+/RGmCCWDk7k6fLLxKul5ISGy9l8dphmrfH2r7T31NWzmbmk0EIm2uJE/tMfdQz
-T4Cr2TRlhQYAtmYaaMGz19PBb1j/Rl9LmTgfCC7vMBcIfarAkxaRcMdnOGes7Ycz
-55bWziPDHBB1IhIP6EtQYDXA56s/v+U2KdWT+kDcZj1XgtJbiO+xUThIknfVLSvY
-Ts1EJ869Hab9IerF1lWfyhZ18atPD1zSTDvuzd/qdaGFwBQt1XiSLBr2xcNRLO3t
-ciakp2AbauNz2cuE0nFSyMQPNpYGG4dsbTGk3FQwTgolF8PUTJD6O66GvOpFbt0e
-kG8xFMjrQL/s0w1eWEuhiHPLH9o1US0iVZlLp7nQemaE+/8mpMxKK/UG9FRC04wx
-+QWj7OhB9r2jVPOKGoAmlOiZhcwuVamUh6iCiGcmlV6/438zlioD92nZJ+OUoLwc
-NbDzCG6dTpMcO1ED7Ozvjmi/g6Dj3PNJvl4vcoGlwGXcI3QDYfXoarG8Yhsb54IF
-7I8Lsod3YmW85fiZ8wNFvRw4Ac/mqNz18Z1SlHBFXq7QwZgtUffyJbuvMW6ydxK5
-9n3WVsZvi/wI+Y6jsC1uifZNv6KR7mlVy8qRa/lPn9/YbqR+NyKJsWx3CYchxbsK
-hA6thDncXugLDf1/1XwqZTuO53/72eZpOjySYMyeqYwxXXfFIApSHi+4fuLoBSdY
-h30NOy1CAHHTOQoLp/YKBm7dXquoMSeACXanwEwPKqJrhd+RF/fO6HgrOB5WkBH6
-ZVbyIduWfC9SBvMG1Xz84pOzMPp05HegyR1Hq8tFHWM1cOMjeytCZY8gH3AZCjOT
-ZhUSumGJ5Sdiz4Jmsz+sJflCb+hw3/w0HN7Ht8qpegU2sdMPuv5pTn2Fn6NsP6nW
-y2QNpmJQ+hSAe2JafV3P2vIkIAphgOTXFQycXT1RQS2gSK09yq5QgeTMUX3PzGtE
-BTFwnzDi89QhK/E+IT6PAqXhXbyQlsgN0YUssIjS4FLIj8jc0+lnrqpvT8S5KNNp
-tGtKw5N0hJdcRimge67gr6FIW0YOXXcB7esSfLrcS5p9MmhGo2oA8JAjESu8xmhA
-QzIS0dn4uHj14n2AtJJr3InVOzQZr/M5Vd7zcmH4VA4aRTYFEKaI8bSO6WCu1O95
-XQHcEABezT0JqIkOVMxLoaeeTtu664bLGAxRDbVrg/Tn2U8cuh2Db2gaXRe9BXT1
-ZGWJu3HCcG7XDgiG3FW5N9cBsfmgKxx8eay309HQdUnEHnLSbrSd0HngyclbLd0g
-AjOG2w4/+kFLZrW+SFY/ESM/FYnInlo2D5B18Kx/GmM9C1AeghNFV1cuf9j/V8mm
-uqkaDEHdVudxiXX7Idpsvf4K65LZrcqVDSm9xb6C0ErRXV1W7VYFZtLyWkO/u0wT
-yV7mEumX3UrcJPba4Q3zWADI1A9e03eKK3TZfslJFfSvKsiz4aEEfl8IjBKz0DVk
-3x2IyIBA4+m8oUuv4gX7eLzbac1xQ3bDETMUR5OUf51iBjLYlc/y/xWMfxuIgbyn
-cIRfRAXKPaYt/dZ8Y5/qjPbqSKG/H6RmM+0fKd91fECDEOLtWJBZRnWjyEd2YFB/
-2XC5Y4XzkwaO0GMQXkSN4jxX/3i2wk0pOKX3MURoBVK/M80JeTNPDavjYX2nheN0
-WFzrzgZv/4g20b151DkdDdMzG6Lf5w0ogki58/O6Lu8TlHkWHgm9l7QAie7fPuzM
-vS9WYALbgMJehjX/77zsGEN/mGcmA5TyXOUQIXZLjuhgGPYmDQf0eN5vP2ugPHG4
-KXU+JcD4c5YN9hhoeiGCiWj1iX/V6yuM/Al+QAFkY9tLaXsm2dwuLOJjreacHYad
-yxzRyF41Z7j6TYntcdJjt/Y61nwLB5PDiX5T9KmU5PCx+1h1X4ACe3QxMwRTeNs5
-rywSXFGorpQD/981pqEKb81Ju4XED+cRlM/XAN9LRvTXaCp85xgddNOVT6zYMIGc
-CaBFnN0mMDGFmgHMT50AjRYwkuOosEQqehWHnPiPVHPdsKBwN4SZJrr4ftfDtG+V
-lY5Hw+Kr3Zz8ci7Z7FqTJw8Yj1WO+Ja+1pam8PH0c0MfCy7wsxej/CZIMSMsMplS
-z1NkZNuL8v4QblEyBdn4VRiiWYJsHFD3FEsb4fxGRs2fbN1SRJRJW0NS9At50ENu
-HdHHbJDhuxKZOIHiawafJIoIHlk15o/d/EjaPl7+CEn7m3gEBpbUj9mkxj26k8Pm
-vRY3VCle+pEdxItz3jOwAgqfP8HY77xtfx0o9Y74yLJFok0rVNlyu0G1NeQawpMx
-h7/gdQH5gmaTFfm6deCJwXYol/Li5V5MFzTwcxOjnbc1bBRNOONSQ7Qxq436s1ET
-RIHBBAohaLb0ENYIEElD/rRmBGX2xcFpAiHJbQq5YdinBbnXrnvLqruUE5JXKzEn
-5VDwDAmRk+WLv6039uMrqrYYaJHvFVKIsUnQWbOK72CRUZcwNMMtRODQGaAfu9j1
-7b5sSCQQlzO3hUOMqQjAhES9Wf/vbouJUvPYXvl2RoAt8DXsuz0zsBUkUCf4EKgD
-A/ns5Tgjk/rzcKXLlam/te6V7riZXQn32MdpAL5aA4GlKBYHRC83aLaElE1bPjuD
-dN7esax9R5sLQjj+XMl3IliZ4edjZURBlih0LpQIeaZXcXvlt+cpO/2V6o+uN/2p
-QFAZMJUpNCxSALphuK4/UaeTXzrykP1F8JgDkGcp8ExP7BsweCjZB+7i7XDPOARi
-Aea/FhEB/hsHA+enCkue/x4dZ5+oY7CWnybezZNu4oeMlWbGz8r8fPbNhTRs0JIb
-1ObEzigSPgDjXAjJxq5kn8f7sJzbnHgDJvEaCAXgpRu1XGZKYaCb3qXBwryYPRJV
-TI6iD2SWQUZkYSFPt/FOkm74EhFLqGnh+K2BR09Rq4maPCVemJOQau5FhulHpL0J
-NG7zOFN56glc/RYGeI/0b5KPvMvs4xYNdVsqlOy3RHLXvGL5oRiTz+lZn5og/y6i
-kzW12O5hVxa5/fTKCEmtldywARgffD0FYLLwDNIkgv9ybBFn44LIDxec9PCemt2f
-3bzwTSodqFOsbvXmEKrUppMKCndyLT2DfTSDL72QXfeUlJDlrlFNRumEsG2+O+WJ
-jGlHJE4PJ5mGxvOZQ+VVokA0Icn2+UlETVRw49OCCf+/aiT1Th+QpDGm9p0hH46J
-f6b6VHr+gJNXQwNhonTmgJwQzXAB5nKZvM/3XCNbXDiJaeYc9dVJAqVk2W6zXzJC
-Nc2MbkYJ7lTMAUyDCBgNHBqDRv3UORwsNDvRYjY3vX49rgqY+Xw52Scbtioq6DK/
-iF8QBsMH03palbp1E48PGR7h/JlX64+8jtPaHkdP6JVitIj1ikwYNl05j0rGpbPT
-JKrzBYZ3iPmEnhkW0oBEadjvGcl9/Yg4Sc1voJVw80G1nB3odv+CWdoxRFoP5E5o
-y11vB1DRydcgnuQEnIYdXh1JIa/cUPXKxQTf+0TsQ8yN7abjou4VYGvZI1J2YoK1
-5y7jI9wIGve0yM0vhYh2+zQ4ERXXYI/hQ0TWteJDXRj6R1gxfrdRrPrPNo1OGENY
-Q0MHEjNBeweVVs6nVsUEAfA94LEj0HGS5EqClGeR0OOXWgkKWLCw72U6lUEOrCrN
-9FgWVDYlS33gfIT8BpliZu19CYyadE+MUNXa+nWQaGohyJnmaTLTR8z4zbn5sQb3
-y36XgtQk1SsqmkXJT3Zl5hPGv+8ia2hrNo/tZBwlXDCUJtsO3mGbJiT9UGbl/+7k
-njyBz63s3cppjSKhDFHqGsTl5O+a+vNV8r4AdvNBUOe5fYnY7RfeCqfyGHVNaTXf
-T/pIyYeuYjeRAJ0D4tSqSqi5cay4Aw9qyyZeqUfy9lvCkA61U4mhzdGlo+lDtmGA
-paHlQwLTzsYRAgT8SP0z+xNvw6kEtzofXh6+NlpP5kGNOBltX6+nj1WCTP4UxFQT
-1wlscig0ozAklNjTmkrAJGfbQ/HeKApCnDIKpMiQxJtuqx5E8/9qg/HomIRQpmWp
-k10bsmkX9DWmy2EzSU9NCb2bZwHtpYXS4kqzlExBQ34U8Brx9pjPpeW4wm68zWuP
-X8eOqFuJDb9iphLlWSThRCGQpjXc/XCvmm0PGYzCOaWG92HN+lyPKl/fEZmNEtQ4
-YAKJwrWD39cfEr3qyBHaSKh/2ZexzBsS9skR3bFXgOvUwGyNFIMHIuJ+k2u+owZT
-gqKGIGiVi1PWztmb/ICNkPawIweh+1/G/8xLM19xsj/EbHASLRBCAPGdR9bjUesQ
-miwGjDmWkuGl6zvgeTT313jI3gWvrPf8ZBUHSZa0acGy5GMy/HofixQspUPCX5ZL
-KZ9W5hrGw7fmbXxQrtsX+Vyd5/GrL+kemC+qL7vgUVnr0A5lU+LME6mIdGMt7M+1
-9s5FrapfJb/zLk3tR3FP88FWRWh/CLAiDiLLeOSwqz90jx3k7nF8v1T4x0MyRAan
-fKe6R+Cdp2juLHKRV13vdjQOnpzJdsHlEea6dY4GA6WOssxa/NjxE+EIegnDCnRD
-fge97sIP8/ofPeyyAnSH3VVz3+Prce58wYsGjj4VS4yQSJTZ0Bs+xazVWaBPpNZW
-fC7+ZXsRgXCtgvoa3tBmQs27srHjxJc/Hcv7vKzqn5xBNmbdkvM4349Mwmkpawi6
-0RCOOYZ8Oqk+HnhJcGsNFTwHtHwK0r4tZ3bRc8Sck+c7Vk3V+FWaQ17ELmiGxZcB
-luQ/Q6wcwZrwgVp2b069U0tGbMScSeE0KMxHbVkfWlKgVR55QcfmD5G9JY30l2L5
-SC/nbq3dow8CEnKucsf1/bCDPFrH1jqVzekrOSGV/P60IqYaToqXgoip4fAZcCUe
-gNZbBSRi2atNgDTUFTdl/7bzhQR9lgFm7qG/W8FPVKuTxVaf1NzS0T53w/JzFgvr
-PVEyKgSiQjZHOYj/qt5rxVamp9J0uQxo3r5MiiEcuVIzeJiIr87mpEO3F4pG64X8
-gwZr2G1/wPfcRNMTjw4K4O4ElUU5QFe15SRTnOP1As4y1GhjPKbIV8CF96H+MaKl
-1UmZ0tQ6dsR8Nzi1N2P6NaQ1U8/9zOb31F42MxETyhYGbLhdcT0Yr7FKc5crtsKM
-yEsnk2Tq8WKUS4gfERovSCtoifP6O9eJJOwKrfDP5HySmH/W022/nxZveSLpdeTa
-Epe3GxqGigbXCAPZ7kHHc/ddeUdSahw2ZEkv6qUbsoLHlRQndq7RcLdzG3r0l4fn
-gne8MXwp33/9MxEhNWkMrTuFI6gzGF2rVVzMp1Up8/Y8BCggocjDH28ziQOwG8P0
-vxWJ4rZ6I6VmejfxcqImzQi1Gu0N+Gv5pULUl67v5vXZxX1fCmwSi6VD+bPMT+MX
-w7Sr1fiTQvMwOhKjZNqfWOy8BanXI1GIOdv6Z46Ad8jKWqB9FbFVwPfye0BL7RuY
-qY8Cy7MoPYVr2JChtkOEr08AiK5egB06m1jjbYwemb2cqAs/OIEgD2oyuXzbHBxf
-hfVe8m3h5CamnAzCYkyCxXMM+eLUVG/ycpDSf0jZ9ya5E71xM9fIFOabbhOazFCP
-lEHAVj/pad9Uh4EasiqEKSYSBbpS8ttwmULpJHrSbEjH5L2bBrSCtlRtRhMkuhXE
-jDp/RHhkCh9G1PDZYdap0IwVY7WPI3SwSzjDi+SBxr4WL1k1YW2rGqmxTcYXxCHI
-PVkC2l/EYSY/jNGieFqMHmrhuEIbOFpSLkpD+g7U6BNVJukI4QyPj4I/4g6axehr
-XZG2SG6h7UUsWfRhVxi4WFeq/lWvf0hXOpYavzy/Fujr1jBhpviZeK6Rr5IuAQgi
-wXhxSXXQMFyMTogMSH59TTgRbLr/Aaqm9xBxpQFo8Dh1GDS1dt+8mtmuP0xWiufn
-44VN68l790BqNaZE1kI+ZIdcfqDWMU9KhUQybi3KFSodG6GMlHLX322IbhVAIMnu
-tEw6spAFN3+6nO/Jhyu9b5HxkWunULciEKXydpjiyf7nwvt6drHv1/z5GK53j/DG
-iXQutx4+HRMXu+bjJ4xStLFc1rMYvkZg18bad2eNr0E652RH3D/hYQE9z5sxoC+T
-z/6hxsNWZiRRh0KjC2vgOFJSTB5CUKxQQj8Q8ff8QqV51RS0JnwVCYZJE1KevSl9
-/V36zPnU7NwVcIB+HA7TGVFb0qmumR52UrwHXDw6ojhcAqLlQj4wJaVqhn6g8SDD
-7gMfbIg5I8tcKaVRXONQqvxpyGaeYNWLLEskAD9wRP5VmzmolyBAIQlYO9QHLsSZ
-guIJP+8d87uKObDwGzrjbraifXzMXHL45E+fu1a9BgTfqZTAgd/xPdkY0LSPegVt
-14S3SOd6iKeGgEDWHllDhsDeonmMwnbnS3zc04OXGzGdaCP3OmqN566TnQKHP0Yd
-YQEGa5ZCqTOoobci1cY8E15AGmnsSgLD8RbL97CjOJrE7owJUp0o4bce17Yt9fWf
-GyQxwwARsJHg97d44f0m3LzHi7Ow3sH7e/yGoWBJZkGnIz5UlKRRXGdbcCfDs5Jd
-IhbPTgKaYxh1rffFcABBpJ9dk/63z7fzxnYcWckWPCYPgdhEkGWilWvTOLnjSngI
-gDuBY6Bo+q7lW5HLvy67RE1bLjAoArfLUf3Y5Vo4tBgk1zJgYhUe5ngvPWKCASMJ
-LqeiuLilQ5lXgd0I/W/gsUt0jxt3TfdBbZntXtnmp6/LcnghbYCgdFffm0dmwkWO
-vhqdFdfcwEh2inNSrPi07dCVthTRW9nB4TFKphvpwyATrKzCo+INs5fG9eR5DRvb
-q+6lRio8QvqXefv8qh6gRZb27/e7PRcQ5kejSCNfd60isqhN+L6IQoNMpHB7Q52/
-LEOxtcxzHx/wqzPQmBAlDSMcitbJHs+8gu792VXoegVG/bsWae+8MZM38lDx7Vhq
-7mTh6Gx3cNdQSe6gkm/ioRVPZkqC/KgjnJpoZ1qVNzbro7m8F+MV1B75kGAXBgqt
-aEbV3y738nWZv7lx3kXRySTT7YVMyoiij62vuQUvb5NImEwzooKWNf/2Nn4m7/73
-aPDI3dmknkU1Yt1nAV2Z6e4SfZXQP1Csrxi2vwRALy2GZQiDRbqtOJOT5nETZ69l
-Bge8nbcL4jCg5p1c1JzhLzmJ6I490urXLwTo/R5CYCQuYUxMKnvDsnMv1//xHtJK
-GLAhzdxXmVs19FpNTVUNYyxFoU3Ikwo/IgyRNioiSNLbBIE0Na2tM5NxAhahjJyB
-jnDBy7/FxgvwLT19p9xNw3y/4nDlelttrSFJ0E34FtOLnQf19CyvX6agT8SwvRFK
-khgpsT4jWx/WpQou2/TVvxWRi10I4MvYGjliScMhQxf/s1A6NJzhDhVZ4iSGHyBO
-gguwx91+0LVmHCnQOpuI1ZM6frjmUZyM9TVuALzG4N+qghvH76k2qbDTiHGXPvho
-sqgn4nleEatwNoeNqcre3NUMYu5PYAvbHAZF7zkrCAEl/KlzDPSih2B3joSr6YmM
-eIi6tRsX4EeAfXQW70aWfbrKZA72Ttu8dNBFZzPfIkQKEk0hXEa9/FeTwbWN89Yk
-k0s0IIQzgL/txhq1Idu3jBMCY3oK7jSoLuvqeuuD2gsAbXxJ8PKzF9VbPuHRj3YK
-F33Fn8/ZLQqghASIUUllNTWHWQ24X9RenoBRRH0ZEfZAeDHIqefUamgZuaBfmm4a
-5pNVc2fHqj7aKd9TxGmAvDwRFUJYS2Cq0bHmYJ6cZRfmWa0mtJu8nBBgSbfzvtGo
-LZ5ywyouTTHZyamu9+h5WoT59fiGBAOQztPKE+z/g9o58XibIQGD59LX+jOz+eeN
-sLc0Lk+yvNBmXGtfqJS1gpzZhYXk6lqhChqNt+C8HFehVqcSCOOmH5EyIWE4cgwM
-uoXy51xDeC6kvwbFJLJNInubb0WOQMjEf4UpUejMOVnuo3wD2vYR69a1I803Fdxi
-y8qeV9LWJYXWt37f0zhL9Qa+ecdwWX0b+i8xbo4Y9qv15DTuqb+ZBNhGuq0zQ6KX
-Q/mDFnDYMvPpBCnkgl2yLIcpTIm8bHBrPtKCVNoOwlfX03C8420Kg7Nvt+txf1Qy
-IfSGQJVr8OilVzc75xg76iHKtpy8TEcpbEBoB3jUogMXc+daDnZ9M1d+KlFa4QOI
-3Of6XXlVAxeJFYkYriHiu+u1dlIDsYIGJTLav6+fPFOm/fegof+E4MC5w9EpmOOR
-7zDOba1Yw0SfU9psTEaeNmAWpEHsyiBCg8CfG2XBoF8Ua7PIUt5FChydjLo9bd+G
-WV/UIPOhet2SYrrYd//+K+lYeS/3lqqd8VrCyNDfuqiXSRgI2zqBZ2Pu7JWIBpGJ
-22V3CvEclQ0pD/WBOi6IR/uVKxUPnvCOfSgHzUbxHVKJNxIy9LN6O7au/QZaNjli
-WuUCW0Nfwz3EaSv0/5c48Dkf8fwPYnt/7JIqzdKJW1CtaNK68nEC1GMBLYlubIyp
-bn+yNMt87J9ccLHWWHGRq5aaEesZPGcYnlQAopnyyTPPIdL+VKjPf4qELso7ZNYm
-RxFjya7dHI2urUQPLAMfW1KBKbXwGPkPY3GGZNsn83IeSMysxW3rN55P+XM5Rv4y
-xMA0vH8Buc33BsrRBhn/ul7ruXqpJiwSHBgaA76wl5UWDWDKz7vfwj6C9jLEr33N
-lxf8VLZHM3E+/S3NS9bq0bUm3BezsJKtyhVosGbNQtHGCaj5sXlttKZHI33ueXUb
-sGZLI+6qQK51VyhDHT/QOp53GR/X+ILMSekaABCuy6LPnZavP2JH0T7fP7p7xiK8
-VeHmjiwhQ9ICtdIKM/y8/gz6EpfvbUXHi4hbmwr1PErKrxAREDr4wrnyiL1uorpt
-NUFXVcM7epjQ+1j4PnxJT/wzRkeubsuvMQgjYcj7XlMVin00kYS6PLAtgTSzIMZx
-h2Ib+X7/Ibrqdh8LH3z52UtFjffpZozwbLNjIel5FnX3X/uShrdoppTG8slTdK5J
-9DO6+/eAzWhA/lKpuYOQPBRE+tI0BoAXdKOWNFYHqv4nijYApBqfmcQojrDHQ3Uu
-ySI8b12B9KX95RRY3oj02uPlOGzTc6RqSJvEosvrN+cVxqec7KXMDxkxYLRvBs9d
-UjEl80sgnJFSWW3Cm9r80Hasx79KeN09YPGDboluwFdY2hKNXhrcyUHy1nV9bYLR
-qGS22MlpM0QMF8wjRd82faAkhjzGUa1eXEf1w68iMbVqP8yelknpZWglvMjXi9iu
-gUteT2SftOOmcAzlsi3AUAE1wGUJ2+Lp3AfRMzndc3QpFFj4fZ6GB2zFh49U3605
-TjAdmqj6o4qNHge8JSE8eemu+pmfrwkItpKVP11AOqqMiW9+9Lks7nqHPm73lcWY
-OE4tWbg4XxtLRhgj/F0yFq54KyAaZLUXw9sN/yJZsz0KgYh1ml25mXw5n2vmMgsq
-LQ3XMJ0xGxBNKQKhTxGEL6fYB3OylUsF3LDvPGki1kT6u4GXrk+KU9nDgJpnwEiZ
-9UhLWkPwvqwqgABpdQPJWRKL2xsal7qIANzCDXrFDBpdGGbfQiq2bKW6zAStTU67
-PO/7tTS+tAE3TGu0cgq2TQ/yD5C05gdzWw4Qj+uKm+U6V90CSWPJ37JuX5DHmM5H
-nJM/8rhFB98ieNVk6riT86LA7gyDA4uBo2XWLihlGsPcX1Vxhq+oVc7eCU2qO9b1
-7w9jABLEQB7hBsr/BAZG//IYHLfLQX5ir2e17IDlOhEBc8wYHJZd3Qj1dqkhADjG
-S4wLAYdONEKQOUxU5EK1qTpcp0wHmPNsBPRND6BgyuSvSNr7Sve6JekBSJ8SRtJS
-StK8jea/NjvocJyeZiKFA3tNrBL4NnGIhOkj5+IAY+wChrCSC8pXm9PLtGedM9GT
-ZA6uKkkXxLPUsjyCSVsw62TRoSrbvY9RsYVyfbrToa/JrZlTNDSfZWr77ti9eh4c
-IKwVh/g+eOzHysg4lrNY5YgVFpO1MsTkpOUvOaAMsz4BSBKZgimtxvO/Yl3FVAnd
-BC1ApDgevtX08kWlCk2cbMExrF52LjKkJgOXozukI7gzHM1e4PMr8HcqNnXSCA7U
-OAWjlWA3nwy2dEf3SFVmfM+NoOS1UBvVHvbYenpwnC9cOXlzWIomS8r8r+Iy8Ln4
-IC9nW49fyVqxSjGdeExDbJm+9khmsSkWjNjs/aQ3hDzwSAYcnMjbIe0kONfqWlk2
-uSo44lM+usIJLmiSe/R2LkkQinzWim0Ijpwvv/WXBHvEVJkTVbZw7dOQkHUy7Zhg
-oNZtdbGQaPXNhjGJGSMDHBC5mg6uqQsNY6QpTrL+rwns34UPUHY6eLtlwGmyPHnr
-5hy8kNN3R8Qd2PRx6sDgEZz8GiujGxvaCf21bwE2G6M1WAB7frdbTIDKpq/cRbox
-oXA2K2se6rIPTsYmlVPm/UvrYbYdAX8dTkmKMVW4sKSBESgOL0T7F3Ofs7W2TUTX
-8ADfUvTL1QtWfJRMW/F/7Zn4xM7cNzbQACDXY8Z71jXIDso6ZH82Ucw5X9TjH3Ki
-h5WAhgMKLJYGQAfEJrox3n389L4dE0/WMPcJAJ0L18cZwdKAxSawSExEjIE3G6fy
-5/2sof+gpSWVA3pMs4JQP2tXIy/so1FqLuzruerUeeXOajZt32N36E5q/Ox0T5RQ
-Bd7aFH7CdCywFdEa4VvpXd+HqXcka/zRaCdtzwQt6Kh9v1uiz9VfRX0snHsLGtK8
-J7elD/wsqElLiH/wgH8abQBNzePsmnmAplIghLQpOWosD/bJ9ZmesnHt1gwpTTiO
-/sUDpXp4rO+nacLMW9G2ddiJtMOnw5LSgVfvXdGf0PrPD/9DoDn+nY2gTV9ZludN
-RxNfWsnl076RY3H66rHLhP0WeP+a/ImbGV1b8XwNaUTItxsgcO7F6cvIeduqFvP9
-3EZQJFuaGVhMFLIoQFXn7/qkW4pjgWaRIezNUv6GkrRXY/ze8R9JOrCq86UenfGx
-6FO2Kj+A24DojHEnfW9lSSMCSpEPcM/0xNl5C0CHCprN4fUfC+lqcC0BIT79NpWa
-n7i7VSq0ZSTz8OQerB5LXZXbkkBU655/10GWgRoDoCtvD8bQvDriAQCGWUENjDDM
-wmbxmk3u8ylpMgYeQUNxmD+2O/EZ7hhu7yCSbjnTudoF1D8wtr2TVISn0eLr0dpg
-RFDmxboOWUbjX2b51VXjmKatLHxVq0kFlKpeZSWWbkREnSGQ1n5pewZ8wXYc/Wd7
-jHkZSwkpobx0dvqPEl51ygN4fMhOvT+ZqHiVaDUIswd7Fisgsyw4GfX7jH9cQdtO
-/bZ+yWZvkmnS1RoqEMRhhucJQ2NDmFo+zzWG4+Z7729azhCRAqLkhEwSuF4K8Bo0
-k4h6/5BsFe6fpKzK71NtdXuTHv2EF7t2VJrCZTy8rlNeN5+wz7FOX8CpeWm2wDsU
-icUjn+yc1suy9wgqkKhnSIL9R4hUO5T3Mj5e/g0hWGPysssbPFCQNiClXJsIoDFY
-Il/hG7M5l7ZEqyvUqrARRxkaQ18Fda2FSM80COBIXxcf4l7Y9SSbJ5AultYpRjQl
-OYDkRJbbJF+tIPyFBx3WybMmDiuXgssyiQ0wscqgCw7IYAam3rDzwGg50X/l9v9T
-5sRa5iN0qpRDEz6c2B75Hqdxod8hdGtlec9UzwDazgpPwQrztK8llJ6hXb4ms3Hj
-nzNUVAMabJdxWDFaJo4HTH78L4wajdLPts4a2vwLRLCfVCqb0rZYIwCBQDUfIH28
-/jB7mmXNyvR44HhfS9z0gd1kwMNBi9LTWxFF4U8uekxSlYR+hGEU3RAacQG71RYD
-Nt1//73DUK2DQDhUXieMlkd/a3prhufpRj0whd1ML0MTNL4IH0Xze+8HPxS56UGX
-LgF6x2yWBFmqDvAX5gg/IcLNKFlPaIcBsprhtrirMZiGTm1wNEWOfiLn+zLIep02
-fWWtebIhzifIJNmYpBw+rRghi+p/7IDKJAqQ0tTwC6qZ3KYzGz0D8LocghJ7ZEAE
-ZsaGAMcJ89ESNsmBqG6YNNmQyR1F3flFJX0i3XRYWge70uuLMjYqEHJYnqRBgcyo
-Sd/UkABRZRJqJWpsUkbxNZ5OMqqJQTH/RZUw+ISjyJNxWzQlxg9Z3SJJYh2wH3J2
-V0eEwMlVibaJq4Mb67LsPhpfkslD9cBTSv9pZm590MVjd5dr6fG/keHDArJDOdRJ
-18kW3XCOaecYmgc0ZUPMjaJodxKBObeYzwm+quAwQ9ytLvvHWm7PO7ACTc1l/lCa
-9aPdh5g7Rf3uxHK8pNNKqd5i03ugGLXLRIXPlTmhvUO1hpNzMNGPU5AFb/N7paeO
-hjeCaR0QzVti1HxOGC4mc+0Zgk+1xPJBiY3BEumRzsNXzGAHJRkeZXFqoKnYrxIX
-4JY+7WHJGUJ18/M+2sK/UcpTietmfPtZpJzamYU0wNgYxAd5W6wuK71cqNfZZTeI
-l3BwrTQ0q6KQp0KpfPifJJZoZnYkJVg/2mTxeBbK23wDr0hcMmy+2JjmFMcOspYb
-upldaxOKlmDrAXcM9oEbwJAhNr2g0LDk4pArXvk9n99DGTbw6rTvgmAHRij7l7r2
-VZwbNykhhfOTMSB1mv32aoMI25kBjnqJ+TW41jBVtWRkbxq4/ccJ7ZpUrJA3HtzL
-qbu2XEKt3Z5Skb3XQwZfz/mLuePiDzIZls6v0tpHJY8NDvFEKQJpsK7apoqLTVmp
-Hcnxt0Oiol+qavh21GBwwCc8N6Qk4pP6tLKCgYXw3HS97IS/DVkySQib4zx6EtjX
-ooDyXhh/TDtdSz0X6DCtfKsYuQAOvrG0ioIzLLHgBdbcayXlfnEcFcg+r7/+lheM
-DOGELaGmEp4zQRkFhjqsCxFshWp2r4jQAJ0ar0BEcQI94k1Lxs4F2uqdlj2F4BjH
-dsWOvdJVmNqYjJflCcUBnrDUz2yLiMC1MHGiqFpgfl4OrJGfjNVe9V6JO91eQGng
-tQkNNowBks65bqLOa5SAeYGLr9o9M9D2ltYXFlsjPpzhpr09uMAIRhLHaG+WYDWL
-k5WsQa2zHi3O/pFzuRMVcuf4palAl6eHsbIoKROrPzoNbRvk/mAaQQnwGj6VIDIU
-hP5VNn3FkGOBMIeMzeFL7lBWyTwxAgEKqQ9ljC8lfRx6NA6h8re9mFKqpt95k5lj
-t4vlfdq7hn0q9ArpaxurZO7vOQN43hoqTXZfFlC8j8s/yBO0Ib4UtzXac8soxYJy
-BYSjorQcyNrln2aXddEJoxyDNDzgDksf+pVWGcWlOpU+/l5y51bSnZ08Xq0nYQsb
-IvRjkXZ+EFXiw1CPoC69ZZaWLw6jPRDc9oa5kxjE7W1Z1vrBY6fasUmSGfTmhBXp
-1NRWag8d4NDzQVU07lmlLKiO0WB/fUJZAbbgjSseJ4HWlgdXSdHfSlR+pcf1ARNF
-O4WkznnHPvzQP6nUKYe04RU72x4wj6JxrQ6umMRyvLDE7fy1o5rABv4huRMg3VVM
-jsU03rme8mnT/K/bK8TryFCKgwq9eo9eUvzhr4M2CAQKbjbYvg6IQJST/2we9kRy
-oEeD41ME2KAqwK6JsAY4Vj6aEKHQclCkEczEXK+Y9te2quXLqoal42mqxU+EG5zG
-0BLyTjJ2RQ1/hvAd4iyyUazadRJ+GhwXA8+t5GJSvTU+Qrat/uoZO4TE4kQ+rsqx
-AsvEtCBdwd+ghcfdOgE2SU4luFpfD9+ADZsfBBnaJyNBZl8k3yz+o5Lod20vv0U2
-4UqUpNAOUDzapFkUK36Wx4fqfwMf/3dfBhHy0cOmhpn7bhnmEwAtAwjFQkCvP93G
-SanyQNqfAFSU04GAarXhfYU5cS8uW7OOyXGv8Pov19TPDWZu+TjGBDORVuzvpy9Y
-6C1SLDnIrSAjh1/XZwhrAN1W9/0C61Icr1wTQKTocaTSaEx0Xw8G0J0PHZHSOudx
-F2gMF0Q7H7KtQRdp5CvJ9J1dc0pSYOqlg8X8pro6WxVRMU4omqfbcg1IsmGvWHTK
-fOiNR12TLAFni1skWZW12b1oK+eQXeMdn5oKXgWOTilvR8mHgwcZe5s9fnPkyCq2
-E+WBER8T9qZfMqpwj4OxsN8gBkRI+sBgLIOVAIopQvHSbQYHEDL4Xg0j7tO0KxTH
-snK2FXSz6ilbI8xoVHu6ILpzuA2n1emCW1AkKetb5ScBx/RZ66QS+3DDL09ACSy7
-e92BPlpGZcLdgX64ktDcqf4VU9AAIi1Mqu3Inu25ERcC7V85psS2OLVLGX8ey+VI
-aiQO2EfawAz+TEhmlY9A23vHPMQrOFWvOytkPF+d8J8lpdd+4sFrs/2bWch2Sw2X
-YKklcxNC7NZsi1SP65ZjFv/b/feteXIUUrJFKbIsyQmK8Q/vIhOQGCFp8o8dh+Dy
-K6yrVC8zxSRRUroXPcDxNhRV6pG8gi2T0dlFAbVPfY372VauarnU9EaIThWlq5ja
-lt/Y0iTPtsg06bSG3fLBaOmU7YN2yhZVwbbks41Grq8Avd1WP5IJy2VXqNmd9izU
-FzmHqpQmWGcW20QM3Je6+1AI4t6lldYFnPZlcfDyUP8os+RbJbQJorfQWf5Fwhl5
-Cz9FPhlgH2m35YptD0tkeUccY1fhpGn3B3ESSIlFnPoY/5YtrHSHHDdMrGJvzmYl
-x+6Z/D4DBR3cknYDxzOoFDFFkCumWIDjhd78YP2NvWj8Kl4l8p7+He2Fet4rAavN
-CYEo8XC30BvtSDcpWIgoYfaN9vW4Zh8tSj/mIewHxSzg8hpULwujBKjJVVzfnyed
-wf+3a8JmTZhker2PZ1a8lceTz1IJQf4OgTkL2NGr079CYPYCHAmGlzovPOcWtv4q
-rtNCcqZPvEfwFYETZgkVxaNz1pSZ3EPE27pZdSLqSvl1uEPmh3J2KQaJrZfE0YWp
-Ry6gfm3tLxcRKdsCfrP9Bn9rL9F8w/Jbdrsz0od55CgI82WRz8IbWtzdkmxn+cG6
-3kaLNwkIGCy/+bgk3Ct9zktnclOjPRjSQP31xw6T4KJf9ffi/4Rmf8aYBCzSVW7C
-YIZgr8WVVifIhYD4r3YNtJ5o6nLClrE08Blr31M9Vh85Zw6DgJwiqetPsh1ikvsp
-HAxHSgYJuwB+MTWECT6LSrM+Jf5mmHUrdHMTundr3l7wgrKu3aWNzox5Wp4T5Y8W
-rHKUbFSY01haKVaVmriVDU8WO5GCvgLbMDuqKzJy317Hrpp/j6dUr+zRelj2sK0Q
-5VJoVywFxffNS3WFwFzvUbLxuQRbheChUrmYcXDF/FLQm4SlMrBHzqudBg3xZ9kq
-tfVRksQ3WIP6NcbPQMpzS8oRXberhpfPuGlkMVmgfyA9n8zufdyEKQ4/x4vZuFLE
-5V0sin9IjE2lMlhLdYDkzgTfWa/WjMbIk1uxVmzVH6tTZu7HoRv+sSLQotGvLLD/
-mJu4yK4jCXDuIBZHWcPv31U2boCMY8XKhyGHYVzXahnQN7VEJMBRSqLQB42AVOkw
-UJF/v9M+fWNmWDS+jmPCSoHtgvSiFd4EaIfblrSvhdiO9mVrq7Myer3eIjPn2iiK
-PgLA594rT3B/ltRaLh+TIa+Tb7ytbuemkS9pf775vcdj1mrICNTQsLvnSPIfGBtf
-zgoYrB4cWhvdWQVfuWBEZJrtjHHq3QqKNRkjo0nfHr5O/bUBzIov1ffGupg86XhK
-eeZyE1DoitKsCB2/DKe7Mw1Fe0iA7awjwS8QnN47YU0Sxi0UoRtMtnqmse1m1eo6
-X8xXZpSN7ury7uVAzmVyjpSV393eAtTWzhtJKPfxiY2/1FeQMHK37zJdLAs7lPE3
-m0NA9Mc9jQ1M4NHfqGj4svkuphy8es5f29UtXJPYDuEI9o4lhBmjQ6jkqyPZPjTV
-xQbhXAGDwRe4MEj4eZdpncQ9nNFL8PKpBexWq94pQ/5U6JEw+6Qvr5b8jg6OU6xD
-JYqo09ATaZuiFqrSwnZyXM9SDPwKScb/kHcTwGFMUv3vEBemffckrpxcSqS0YmNt
-Krt7np6cCgAi+m0XVUdsbBHywqzXnTs79ciQiioDOyzScJPRvwgnIp3fdewotpDM
-uoI0hR0b/S7kUS9FrUBX2TsRJQN6u+B7QoIiaoJtWFWG9GvOLhtphdBVC3zIzwAl
-bL+N5y2lJhRuMRp5Y9O+Kdzbh3wdOUExnp5sVeCbcRnrHcMP049pUZ111GVPdWsL
-ndTuPI38cujRY6sDQbX6HWmrCxMhbUgC3/VDyUzxM+nqXRmanRmcA01DUwrqcHCO
-J8HMbR1mHf0JmqthCQ09BoBBAQ3iwwqCNait8fGXknY2WdwWtFk0tq+r5n6Pv+oR
-EY1A8jS7Zc+XmJroKLaTcioEK8ipvBKQ46Lc5YAcuUp21yWsEBGYasu5XVC8/TF7
-L7U25KGG1005PPFy8hGD3Uh9j2GhfGU7NKylffILo07r77uYnRh5ff1EYGe0pNIU
-T4EZfLjDtWx4sqIjjK/eaXou5rZ10/UCJDf0fGcbffxdm3ANYAAi4A0udFm7Iupc
-PX7x6Qa8FaxfOfX/xY9ljxPqaiYJJ6OE7aIH3FszufEJCuXZjTz2nj5r+uDW4Hp/
-AOCAfNmncVeLkQUeeyRmH+lYrGn1OpvfYlQKuMIizricKJxilvYD2OTjiKtlyxrv
-5Cr2aCM6KYBs6yX9hcpWshWgHXxkZlAsJS2i9gKicDuE6sNHi07wnkHHhEe71/Na
-zNdp+d6E1Dc8binPMR+n7z0ZerUHrwLr98sqCcAgGQrziv7VkBdOkRZebvLVoOgb
-E3uiwKFACeKm0rQ6ycOmDh2lo/b94Z1KD519BxFpZJht9Hcs0jjlCwxjSNdso4d1
-p3sRcONDpavVXpXB1goCufX+nHncfPh8baOmJq0XPzkKXsX8yW+6xSHe5r9tryMd
-UB11o0Ke4V9HBBocuCAONMGg/NoggSHnr9OJKrFZsuV9UzX2b+boWC8qxXV55wbY
-xjS3ubJ9rm8bLVdadWFzt682xbzokLrJ0JBo0/m4EARuBmuZAjZCsqkAIoG69Lmm
-pCVHl9Q+ZpJYNdrm8cD/cp8R0dmUcElux6Q98VwAy2TE5qwtQUiDeo9OxM2STbeY
-88Rl9MojA48VxLSpkHsTePsBfqDPXWskZtQrgAhjRIKqk593Q2WY8/ajH93uEmhP
-5eZ/GMT+ivXhLDz+QwuApxzfTNFNi9aGp2YoyyGyXah010MGpaxBrgPUdGAkqRAE
-dXJnjEqm6UWbM1yn3NhZMe4X9hhsJTqvNTLjHqGDOKvTFWK+auE6lFyRXLFsCAVs
-WBXdvOjWvraYtv9XfD1WaCpXzy3DLd1qWHnA8ffkeC9ekHTYGI3nQAz5FjVIW+gB
-U0Lyw7XN+aP0nDtf9MrUjcyrQ2xVY6L1daXNxyxGbV9iJ2IZWIC9kaizVRuihefO
-gl6Uwxieq59vr8gI17Ss4XOrHgynt/YPlbSiltzo2RjMsFS/qxfTFP58/YrajvKf
-1+hI86yZkELXo4AoUneVabRwFOGIv9Z91NaGqmEpSZTxPxAS4qYDtQzM2HbCRGUl
-/DbkJPtxVUvqbeOfbJKoVZHsxHwoGj+Oqk1XqWFpTXAeDS628lMKSNA9qfLNatPC
-4cUutj087FFHZ4BCzX3c4wZEc5DVNaaQH1JpG8/7WfCoSXshE5RUsmyek+Rl4zNo
-pfxxuHU56CMKjyZHNmCPup6+dvK+PUKEodsmCrNWANWfP9FQkEvQ98TEAqmjHjGI
-4xqQR4XSU2n7cg7JweSMd2aJ5owU67JOE6pygTutU9nvDM8GOpHxREyOmQRr4dSv
-zkyHBuJZm85RkAUM7VwaEYgQWdS3+TveRfwRfqN7iFiJfi3QwbUsF6QshSgabTMp
-29yGNAnmJRJDFZzhmoUw3shdu59dek8/mDIKwwMcVlrpvESqb6CPxXxYSYAyxY7w
-yAGoudiBDE7xboA3okXkFiVljSlCyDqaEXwNyUoIMn5iVI+ATVdmE/Wkdhr5pPIK
-NVl9FxY/rX94JtDrXoPek/9/dmgedtArgZ5X06MrSVvSg7z2pm+z/dXMHgXSVDGE
-ybLaGjRI0vG8FSEHq511gvxHdraZOCbs+VVp5+JkIt4j1Fh85L1903PKqPS7l+oY
-dig7t4y4rSmDT8sjRU9HxaQnaAsTgV/QjUN4Zx6iE4PgtR7EiZXpqmAAX/dwKWju
-TXYvCQyQHDj7VQ9O0ieTHE5MIHQh9htpO0EjrdupJecgyhy90naNL+7yIamno3kH
-9B9ZinSlLWhQkSw6M8zW3oohryLYwmXOscU29oQ62r393COStNx3Mbg+IyBNHXtf
-QtxWzuG91vJGg0rWGsRAzfLFCV4c2ojdsYhYUJXZAq34zEXlVo69fANE1eUVweVH
-YiXxHCj7EhJy6U0KhfpOy5jIpCNtwFJEa6b/XDvm+C2fbvre0WgTfRngL6BDq+2u
-fX0G4Y/fo/k96oJjVzPFAErOSZtZQ+z2glfcjmX4uWc5HpXsRqD00LLCC6zCPgpb
-DGXrtGYPZAa2B2SElGB/vXxn24LAFhssXklsLqv/FKUUC74dUkPymVlDNTRHwu5E
-BeonhU+Vk9pnUdvTW9MUabU1O+yjh7rRy4Gy5K9uScYUcEIdkIffR01UM9PgGI07
-EITZFZj69fi8k5qajn+6hStmHRHGzE/wTlebrWKob2QmrjBVltoXX3vjUGHPo7S4
-QXubVxNE28S1LigHMN5XLzmEO0Q2C97aOtaapQLYWSyATR+Hv3suOfmcQIHC9Cte
-3QeH+mg56FhWWwLZfhjC9lfrAPmEadtlL15e9iC9BJCyQie4hZFR8TeHWbjqapP6
-4wVTP42FLzrfVbUsm7TDeXV7NBerohSG2gWTqPVA3oQ6r/MRreFfdtMJwhKhU80G
-AY/Ducva/gyUPOWxSq4W0IHkqRX8f3OUq2PBaFVz7E2CkKiDpTsSJk5rMJIY+O0A
-1xX99iMuIvdI40nUgmFhaFT+aPcBXvbE6AcQtspoNvKq2+aje7NfrQxucmZeg57d
-4ePst3eQ6qLgKIAIZbJ1bQZ1skFlW5OWRqAFEwrCutkxMH9LJfFR030EnX9RwEMV
-IRQMuS9BEzuRzgw59jTdZEa1wDHrkIbpNO2vlZqE2F7CkENiZV2sj/2aZd98Q9I6
-dLFCEYmDwqV2ZSpoBci53ILm5qbUndPTXq7ldZlx9mEg2ShpkVfOj5goDrAGsJQa
-NXy7PiE+ntj97yLU8U9l/1uOTcpH6ImlyXXqZStoOwXkb6ZRZgm70klOwW4kwl4D
-3xf1qJ934sEW/zIx3Gehdv1eONJIIDVfiPU9RIg6LxR8GQSqkJlueE4O1dB2jyT1
-muuA7CPvRrOhJEgAWxxtpuG/63ANG3UKUZQxoOEPY+MNQoVg1AYPA/zaIuw83xTW
-qTKRrZzUZsSHWvJwfhf1s2jFMOnvjt1Liv1CBI7SuU3aZ7G8gqrw8GwaWL/Yafqq
-ApqEGUXn3aUhZ+OXzCHy8iWL3eHwS2AgXRnd7XKsnFY0EMcrdXWjn1eNmY/qH4HS
-rWyKdlWm0mpQ+UVXWDIfdigCFc+yflqCLDBu6gA3Zga/VVebEIOXMXruEEHY6YQb
-QaxHfeuCsdg8Deh5mN2jXSWQyp8RchRM0RLjC3OBRfeQW3PxAWHC4t1aWWG1+JP0
-SyQXXbJFoK3VEAUUrgsTZnHB8oolZPxRPGZw3K2EyNbC8bLVfDZNqT3ZgM8v6g2m
-druV969p6/sTMWIuSsXiemaag+eeJLl1IjDio5inZPJvTCFT98FVJTvkY9a0j+t9
-GPXyuljVNxpifoefMhZ0dpncYfTvBmVVFPY5zpwWQFLNsKsrBkmhaBvreWNAp31S
-Q1qF+d2d/XRBc4i1WLwucBGs4aGKw6St4ljDYRytDNKCTuIQ8wS7o3CR37Grmw5F
-JbQwdD/46hznFQSYUM+pThKA9C/atXoh3N3GtWb9Qsr1XjCpEya3YU/v99dzDuew
-ZzkHHu2glq0bdpQ/fccGi0oy5F/kN79toMOYdeBIad5yi022GtNMQJOOM5QvgIz+
-CCttdHAs/rXCX+cR87rQ0CAWqtKEHOm4/TIaE2fRZAOtRvZjMBKC5+SkyCVofAzh
-mdtxvI8c89gfB+8fD3WBbn+GzJDri/gNvFI1j4TrYtYhiBKvBueZkBZNmz1J7fNn
-rkh1EbX8zooAQ48AYDHlMeOZrjZIF2qjDB3MpjhfHyF5CSYo5Y+MHIQAu3ka/CCX
-uxrxPAbBkL8rO7IHPBCz9MT1FBnmAzSImjSaYsfNDN7IKxEgGG2/TwaCFV5cA0Wh
-Y0XVpT9jslkhBX8sWEG2bXEA1eO3nNgCJFU4tnMYW3AzoNL4sD5clD6LbyhI8p3L
-CE2k5r8uYozTxQumlXI6OG9FJblRXnkIzX0X+iO7P1J49jvAzUuaN6yNcuyXJJMj
-qpVccy1414VfhFAdII/9aT4nr0Mzer8jRM7td03Vvwt/x5p9XwGf96CxBNU6ahyP
-eclKlSQ/IJNdhW107HvTK/sHTRArUFteAuTXzVHUGXnFkZo4GY24aIyZ2TNGfb2d
-apJbrnIHLb3PfQm7xloG04gjplpjkfuPAc4ttp2Zu1zDP8zH+myvqHRmHIb+RXa9
-tPgIPlmsrz7inufRuaxRLXkh1CIYQOYCAlJ65OZ+Eo5Tnz7pYrtMObQ0AzWrmrSh
-LkWF1MjhA3hy93uSmYbDDl6CYJE24CNisw0GeeXCKMJhHMdugodtCrnMYOCtHo52
-x5ijA2h5tsQaMrGIGUMkqyHi7hsioDI88Qcu/DryN6WM5CFKByWloIoHdSc4+xmu
-QORAmZMf2A81uw4YjTOGzu9IDU2FFv7rpZ1JprT+4nI4eATsIadDHeJm2LvKD0i1
-lI9zBAyO0UoQJ2wi4NCPqp8kNVYzZFp3OMoI3sZxl2GfU4p0SK7zn3l+gInbovWJ
-t5J4fOfZl6bpzMcNBwlHm3aCxnSMtCasLFMatHKA0lsCn1aGOOwqjqRQnWFSoGTf
-D6ivNiCw17V6atBowNHCitBzJCL1V67ViIrTBD/RQcc3+1Ubz6rTT89AKiVqh+5W
-xiTCMcBIrmrwtdl+XJs8oVzNY2cUFM5EvkvjXdANGw/xBSH3Jv3YkOH8ol/7comv
-ygZJdFa4WfATwBB2VHfnJicWHXGBN+eUqMXe0JQgsyLKhDLoqf/q1j8EOLxdRFvz
-J4iahgHAyb0IME0/HuFgWOCLvqiyVMqcEZycyPKss5jeNuJgknxqZ5QMIC72txYE
-XfVkOFueaJioROGfxAlsA+h9FIMW3xChZgyvlkrhN0W5IW8iyZ2QLtuOIhfc08ya
-wMffRlaeUCyShhWShaZdR5OtT/L4IHsRv2691vcu4B1o+vJWHSB8/HqWewm5KbA4
-sIJ71vegsXBitQadTCgctLbFQUh/XuWnF4nTUNDBZtu4XdkHQQ8hYtbJta0UWgL5
-tpQvoqDuwpQCNkLnpMvka4Yuh2LvakAsA+YwqoGzDm1/hg6hHaHkcTBUghaMnwuP
-KkgjwoDLT4FxhT07KjM2/Z8NdJDXIjeIdHzB9OAHMFKpBc5uSzqH9v55DmY2VsnO
-l6RGDlBGtlHXY2Anec+TZCa0hrjBINeiUIQdggaBRYbEzva81H+UhldADKc1t3/m
-6sQiYxs1XH/Ct+nY802T9ZhZCGGr6e3WjlRJfB4EzoqfEy7YuRgvZKE5wTWMZzyY
-nfs9qzREifxqQnqHOjQq6fGdgYDWBSGak71TbLULe8rPBl1M6QB+tCiQZEUqx9GE
-X0RHBowaD1d5r+s3Qrukegd/tnVTe+ikww1aBCH3L87gmsEu6cXfBDh4GMbrwPXw
-vUjH/lG8ECdA0ux9a5EihAxxf7PE9apygXA2Kr8BYMH59cuXxehKwF34CJQop/H0
-TeSSD+i5g38bMN1uyM+tt5KX3cvnbjBWNmBfzdX+VAc3udwqZ5oF1yK+ZXx/0V5U
-Xm+QfqBpprXoCzAthIeyzVKTVVrH28hNg7dofm/ZaE4qbA4kKB3qvKPHpdVoIJCa
-shld3fvyfcQRiZKhGasuIl5oJPDP/f6EAS8UjejFqPfx3biWIexy8YZjy9zMC0RS
-NRy6PugCwoQmwkl28T5bwjA2jzbcLpQ56u1X19cz7ZyZZTNCclWxZul+Cb/e0D3q
-Wi9xS/kVLH9/NeKBTsiAmC+lG2DwzhW4z5BnqEnGc7EE9o4gFLQ1JZhfH+WOoBkv
-tCJapqiRozYZrNGGQryS99Osadr6A3UgSoAN90adW8K182sAv8/EC+g6xzf8+4ct
-pkO1thakbmN5FYjw5MaWv/6BoDvBfkKO+zYIJ2uTSppteYoU7ySxXOv6Upm2Wa6K
-kV5ZnAACr6pNuzp4czwnOZKu9OYujgAJHHTJe1sie2HrsX9zZslz/n+TyI0/0wic
-4wKAqTz/T8Q/uityYHzQdMGva+ZCu6z76t8pDO9oWgByOKVOE9iOMLEmLq8iaDsv
-aewEOW7yxg1pkhILfLBNlfg9J9cQo3hgHTtjF4HRMjifc4ih2TGDr5lkifFOTKMQ
-NR8s1HINvDpNcryTxUmgTp4+s2+L6hAmjnLwfZySoB+PB+XFjFKKhBQGCfQuC2d7
-U9vX1PVzRD+qrrrV0zJxPJ1b3Tu6Ljh4ht43nJCmFre0cC7AHcM/UMrcs8imrHMM
-9ttQrRxXSeEqQiWR5hDCxUBT41XcMx8HNTDYZmKX8VuT/kQcQf+O0UcX6BKxsF/S
-PwdHjDNX3y9VDhKilMsD2HjsNOhDNJvsDQhhCPijytET2QiL1VYQyKdWywge3QZ8
-W7tZpHtxgmEegDayk8Va7Goo1xGSe0Y0L3BP2UkqN3/9mY9Vzg4j2/mzjFCv7m90
-9UiWjBWnjN8ZMjjrW6LjDipp/oHr0bIJORez9C+hwRq/ib62V8FcUeloQz1VBiu1
-U/J+/nv2TBO/qYItrtFAO7MG6H28gbaeLbN9Qt54MZRyQw7SNYn4VrmhaXMo8kvg
-CyKlqFvLXHDbISNJDUHJgXsSBB8cVuS2IYjZOO10Wd9jNSIi6bYMkfN40P7yX1Ch
-mo7QXuEZE/iIdqnwPcoB7HEyIn3NZdvr+tlQDWxiFdKoxf+nDiSnoan0fBerfHGz
-AulXUBrmqZuBLXiuHJllwGi8ixLuQQm8ZbJMdiwBkfb2ZmytHgUbaOrj8qbO4Ld6
-S6Ccb69/0LHl1fCWUem5TzXJpOZxM9iOVx4iJED7owKqjn9vs0ygRDEWVDdjpfA1
-xrSTTsalJmyu0v0bGN3mPUu8icvNGL4DN2YiojpPLdJ4A8HfIsavCdvgtXFL81Hm
-4hrjmd1x0/VJDnnQt6tpIAsCfzKZeAWNMGbV+kI5h9r0Q3vYiiHNLrKXD93tWJY0
-PSexQcrsF3aBlGs1n3ud35WEM6DmqzhYMtq9HDoWifzrc+z6sQ+A+I5siSnEh1Fj
-VD99y2UfxVRnEWyFl5OzrWjcwMDIoT0dJNrdwGnvqefR4YDFFOfiMg0cWsWpROLn
-hbaY38yGV+M3kYiQHwI6uoUmtsmmOXpDRT5m3kagMSI2kKg1WbVkH40Mo2G7E8kO
-/WUq4wt/V8tX6d9Eq0IZTNncznIr5YlRAQctSf4ivqgiVNkMF8wCKhv4v8C/hAt5
-SLCHTILd4YBPNoBRjcPf3NVXnw5A1Gns382U1/uK+J6GSZcvPSWpGSLcMbkyTP2T
-PkN3QQeKZZwE/vcrCHydppBzQSAwDrorrG7xgvWT0sd94JTf5eltyT38NLT3832F
-02eewtgJomFID0rwAiDtwAzJ0Dpovg6WzJAV6EHNiht7PH3m1UQmYj21RbQymfDC
-rulyrDEoPpQoANC2dYmi46mkyP71Z+YkD/0kQmbqyX+0p972AilyzksHMNJrcG16
-8DGjnsYE6ItocYwnO7XzDvPV58XKJfbxe6RdUUmc2gbrJr1Uub7425Q5FtGKTbk2
-V7U55oFJziKF8UzZfYfDiKdDFloN7Vf6oA5CPQhDVbr7CF77x3V54Hd0YgG7+D4I
-qdHt2k/wKNeMTUYEtWIklYKDbB6mVloTpTZyv4b1z2tgobuiqbgG3eBt0dEWlxlE
-x+9jx+tVR7bMpsTsne+UsiJR3dE/QRV6NkSq+us/+lZGLiRGhwu4qn3QJh631htT
-3iMr4Krp6bigTXcx1MxF1Au7khVZb43DMx3O6xwnGt5rzycH2sLFGjtN4nEbtlVP
-ziqwrZaqnxkDIgGi9TzwwbUXzprQcn5PLktd2lDw/1+K5VQcA88HO1eQTV0qGMFB
-cWW9YCQnK4ZO5bSvb4oRUu29wylju5LIjtzjtBOaSZw6axA+6jOgDy7cD7x54ofF
-K6hnQ8XGNblv5+Pdh9RAt/lMJJtcLoKXUwGDiqf7xcQmx9pXh17zlKFLIcIFZeyx
-jhK9ek+IBHqMzYPHJqbLMweIhjAcp+Z3Yf5xLfK2KSc7Sz+8L1pCr1P+uFpZ1GKg
-w9FFy8GiB+J2X9Szh8Pz99yoYEqsd+Ce4fpRubrKV4xx+ZRqtxEOfAlR0eImM9zR
-LYOP5ZbnSpEojUEWeTifBBdSi40kUu4TZnYiQd4R0iqI7NUtqYLHdSPyOh6XLNn1
-9hur0NRB+Pgrf1ZM1DO974kZDMhqgHy3l19iqsj96nJmtqb0jmF0YN2ducCX+XXI
-4FWqKIXaeHXH3u80RipHk+bsMvfrn4KTzcx//QN+SxEa9BKDVTYVwHffBeEFu1v+
-QWGpVQfKcfNyzL57efwJLmZUcrPGKZZIk5e2HZPszMWXWzshCF86EloHqMjjlYJK
-W5RPxOr1CCLVgjqgQDP9J3BAPhcZO3yaWoowGqXq133A3nZTEhDx91bQUlHABZa4
-cySKchnSBUxDFLqYD3OtPwe7Ra34nNh3p/HPfGfayqVMh6uu+sjvnbzl+NAw1Ml8
-HbmCT55PVknHUOLCqYiElVDALcGxQZz8xf1D3pVpg8DqQK34/XLedcVDcuhITUlT
-qWctOyVU/WBO6JyqphCZqv/9P4hV5AYb5GLss3Tpwunzt3LWjraaBxe4+l7uEFdB
-0wmSmIUKT+a+N/u73FfBuP6S3X3NYmH/lY0hJ96plF3McuuGKcfhUSug5ZGCUNwc
-dF0EIedjcNTC84yvvxZxlSvieS3CE13olk0ZHg3clzGUuO6hnx9CyVP5BN3cJaQC
-+EDPxvG1+7LMQ/GQJgt43rSLlrHEaJkuOq7aZn803MqT2HJFxNOaxE2fUvR6All8
-QnTiuRDztivbj7ijxufb7CBufXZXR1NZZRahL70WCWehBbdOdj9o8wF75ZR+zF/h
-QdblRKzeOqnVWUFIVfzWbMnUcJbk0SyeL/FK6zAYbQYJ6Oa869ODjESlZ2FsptdV
-DCJN4Hg3cxTHWuJAUHNCv3p6MASwBFPMUUjoEq2MSepzOpQqPMmMmhL0Kh8MpBZC
-sJA87RLoWceyJiWwuXdIQtAOAYzPkA8gwvF6t00sHXgSCsFcpXOgmkH806WOJHGe
-dHtladTml8eP0lunLIk1t5eUT0SbxARYdZy+lQ/B5XE1lJ5Qx+WNCQOX7XcpNnt3
-WKKpvfASFncNNizee1abYs+f8HEpD7wqKYo95XYApbVqD8STn/PpahZFwoWhQgDY
-Imu2L81iqetdooFuYObzVt/SZ6nUveEN9FmY1an8oncwAC1eyj4f3ABJRS71oWIt
-2At17ymJ0U4Jm5Ge0KmbH5l17LbOaEqh+6wQimzQyMdG24OxRv3ChcDiDCjjhG2H
-5xHowVQoSChlIn+/M6ejPPMsUHIqYZmxMqj0IATPP/wPa3xvWAd+4TIjSZ5ihnen
-qYC3mD4Ms0K9+rqbwSNKCw4V8YxSeLovL99PUZwJ+Xhzl/mOpOA1QqPepkaHkE+t
-sBM1DV26dsERBSi9JZi0Ka8pbShk6SUr89VhcltntGmmacgtA6ds/8WS83waLEFr
-/m5SoSwQ4B+X5NhDtR+w/7H7D97xuv/uaC2r4uSK0Yfp8U8sZLFYHBC8tU5xi3Rm
-M0sUaYSB3QMZZmMoyZTijFafmROgM9BOEFWDMU3/0MTRD328ccSimVFbLKoywWU0
-uW8iaclArIhsBkZx41lLHpTgvKkXWBFT3TaqparCPlzQiUJyOrZIzYltDi17iS1J
-2Y/4FXm1Wvuk1seTS3PcbJJnZnEvzAx+mI7LmaVXoUkrhDIkxrISBoR1WXfJhblL
-1UeUOXt6HSGBarwCNPYYYPdWWR3C7+aGsQDBQw33M65Ta1A6LYUIOnak2Q5Po4Cr
-MG0qdeDj8LDDL4XL2knpur1QtY5AtyVXZ7vwxFEWCThr5MIfLNWRZUiQWzO5YfpD
-/LmkQBSKfeTa+Lui5RmkE6c0rCzSDwJ5iecWwAczh7hvrsR5lyHaweeOttmjpTrj
-Ie4untBkuWwnl8IJuaPvTiyaBF702Q/BkSTbcd2NUvtk61dzWYSwjcWCMKwirWQ9
-c8V+VmiQwucqpRc7o6YJvl04BWWYlcEGYm4ffxV4frMR//6q3R3uolOGBIKX8pE1
-c08x72vmA0f4Dl7CLRk2cgWLh4BicGON3ULyJj7zu2gygxkAFf1DbA6WFdJqO8KO
-Y+9LxXR6GDG1J/WREUHkweXrHj3NPu1AS4qwCqSOaJOhQ6qlHPiPgGWpgEdboEo9
-CYNEZQMjBSdM/cSPEsMDBDNFyc6UgbE+Lmcyh0LgFcu/r54ziz70Ax3G7rEVvjgP
-SCJqJ/Xw4HinyGTpfC1N4KHfX7OELtbkcI/+bycOzPN54jk18W8P0VOoGlM730IL
-1rUi9BO5OxhbA/vViCfeg1z8zVkvRS1L8qnbNRnbWXBbvszwbXiH5yN6Ck9M3xvI
-1Uh4a9qT3kS9y9RNEVjdeG7fX+wtoGv8ciASQapLiGP+BCLTxJfwdFYvuMvsCOwa
-dH34d0T9ywnx3gjLDq9h5uInqZ+3VLE08DZkW1LDnUwLrPbrWcpUu6DXHZk2Dn3o
-hlC3LXS0t7izwmCTSwtCvXSobRvAWjYtBx6L8bNwWzkK6ODJEPLAjZzYWbhBICPI
-nnsDXe35kLgSHsyohjGbUy+wltwiERwwtdlZmrkw5zy26M82hQeqHYAhbLbpoFOa
-dr5sr3F0IrVjrRLDZWLv+Ogvbon5PCWh5uXczPk/W9NhEMgUlynSjU62nV7Z1983
-9Dz2ooIPsrqzOY4zfJU/fthEK6ZPPQq76wCRZrKPRyvJKDQ5lRJ6vPMwWZg9aJIo
-THkcBDNWB+UEG/dKpu+57xTmEEPboST/r/WYbysYMT40R407XKEl0Mn01DBPHzIr
-l1OWtw21c9MZLWDgge8R6sm6U5Sw9FndhvwX3pX17ekcQ7K9KZkVt/7bnt8wC+qr
-9tgvSM1NjKkuAViwLnvQkSluqU9gJchufkPgsWyBTo5tXwktLmw3u9+d1CD8oj73
-bhdnCz7vanaY2Hs9jMzMK+1djFEm11C6PUHTww8g5Ev5Si5jCyUURXAI3g6szOas
-lQf9xRKegkNqDCUEFvjqTf3HYWkDtjQLGdvjy3jPH3O0f8ksbqC383HZ/Q7Cu5+d
-KiTh30SNBNjpNmghNihQVijeqo1Ay9mH3P6qgFCbtxMJ0lR1WyE5Qo++Mt01sofs
-C7MZIhjPqLsdeARqnTRS1beJlozxiLBdqynR17qjqYws5d7iEU8OhqAKQ4TQiEAK
-21rtYKpmFWFPOlOP/769LWR3xzPWKMzDLQXt+TBHGiIKZ9AHr8dze/ShqAJI7QlO
-txokG98tagfN0LRH2lwPqNa5T9MMmedfc+dtJ7VnpNzVDv4DkHae7B0mnkSxbw9+
-f0bSee3QgEyxyaL0QF92zJJwZEClUOlI9uEFEj+Ncwxg082UH3UcBZxC60xiqnY3
-HPyxcCzejMRBeDvyfBafGfCuUJyYseWgKnrzFtHu526tECcXcBT/lYCKf1Ms1J+5
-lqwsAMC0jm39ilNdhP4CTgJ5GGzPr/AOiIzq5quFBZ6EcQFt44wSSUwhACVtICVR
-sml0+IMICGrh+Qoaix81zf39WV87DjtATH3rNwDr0F81U81SXiPJyHKnAMgUwzDz
-5hD2dsgXFH9asq5D+OPD45XsdWuoYIMh7DgpnKpJE5hZX2X657V9RwWSa+jDrbyk
-j0IFobnJuENSbSYL28j5//z2Lbt9RtTEvs57DS+u91SicWmGMN1pd0bSYP8TFys9
-gwgJcX60TM34ZoGgsYQqnd2n+vzh8vFOb7DfGpohBNwW7nwm24BM7OFteC9DbEFa
-7z4FZzwEw4E61DflnilBu6KPlbDZh4y2EjETEVHplhu9YTX4JkAqa2l+Nw0pid8B
-Evx7H1ZNOypkAZO6ykSlEot75ZeGyRIHFK+EKxufGOMB9zx7BLT5UrDVpFgT8hkr
-cywYmKu2t+TzzLX5CHJcS+l/MbtMGvWxvUM1GueCNkTTHShmlpT8XsUfe8ODI1VY
-LVDd7ZX3DVCbz0+VyTIaKvyCN2IZ2XnILGy26mdY3riF3src+6Yp11Ssi5SjC/iL
-gL5WiU6RD4dT0BLOS8ZGcg87t/ci/7CpJUHnu2YnP2Rfg7AQ4wTGUJvykB+pR18M
-AlnkG8zYIX0g3xLp9hx2huNix8SStDH5Yc+WEOvPd9Z93HwUjRlmRlLbuUYfrNSv
-fHltc4WlIPIX/U9H6zt/rulbSh7nXHFooYdG4uNi8p7a9C95LeWczoBFyGH7ZV1w
-OJB+XzCvc2XBupHrF+hyjyy2vJHcgRcbc2OSBqmguGB0gzoBmV3wmKXwtnMDek5S
-NyK7sUftAm+MSS78abj+n4qB5dHSdKTu5rHOXWPjdJcUodDqVYGNDsDqev1Bb3E+
-7/6jCYlpTp6GUvNUa8k1INMISQd+5vQlrNtwVJf7f4kwwYgpZE/se7OOU6kG5Z9Z
-neiSYE1Z/xKH+oI5OCu5C3XXl8ljDQbQ7YZnq051NoSaGqMq7Ta/vHfnD0fIbCAq
-8Z8zO2oXSrgBd5wEsG0R1ozShy1iIBFkvRN+MXs/WidDe2IJF269kbSSd68riS59
-g/lL+9ZHQGMf0/KtG7yJ7H0cN/KF2n2omU8SIqzw2W1lQYl38lbPyRFU3D+ZJdQS
-qgyJvWcwYBU8HT77V1T3N76zUAmVZS+LizYPqUJwWvcEtmyhuHZQIBYMkOU65tCD
-Kgm1V5R8qZi0x6VpZZEByFZbo6VGcyxgDiXmAVABrOde+jPWlee7McbTRqGB+KxJ
-sA9+MU56FcTsMNDCAdIAhsEWbE8J93HbN3/odsvB6kUPp0guuHOrPsbhRVtsYBRx
-ikc+a4DcaDywr/+ajZNl4oz5PYHB+JLenNwba6faiAzHlBZQfve/hiSHj934DH17
-fXiP71qOWE3kxm1hDN+XmcGpPvMbEOuI46kirleH9EtK3f7huP/iAQI1im744KZl
-CRWXGu3jJHAGXJRoeDXRq9SNAc0dE9g2efREV1bS45pVSwZK8D9RGEyPZ+PmPujl
-zFAr9RJ3pBNeF/X/jinS4japDrLKJs5IRwxG/7lFkoIONzBTE6dZULugBGxbv8pq
-gSejF7zVj/KR6+rj6MbSv33PB3L355JHjK1eNUTj84/U2DOPm9rnAbReTVERwi2k
-73Z9eXJ5KpvxDTokQfnRJNnz+BDrPH+weNP3yZVp3Gb51SDAwClUpjCFNuX6K7iY
-jmCFmTSBgNc3fJyMmj8XiF+IYRWM4BA1Oz03hV+7MRWurYDIV5sLRDmME9uRo6wQ
-h+wmn4wkl0ymAVkC0Vi9Qyj5wxq2vjA1Yr1hkPWg0BytRIxt65fViHupEsD3AiWs
-nKxDliVxPooTcAYHocdebw9M9zBencmNHywRtWpkJJ62S2us5bMvlCAF/GAjiDvW
-I2/msAoyK8BJoS4t9489INM/IBrd7ngf6I7xunAznNJPnqOf3b+hlVnCPX8FGyZe
-TzrLJReyuXlEdMYHHL53V+v5oWffYq9sQFOik2rkFsdU8jhdNRALwV2VKvys8Z1b
-85dkcC0akCA1RJMjVuNQuBl+EZcexUdFVQ4kRN0RNCK5TEnNk0qNhhJdw8I2Vp0D
-cZrZL2joovUWbW81lSbkO7B0AzM/A1X6CDxEmDa+CAgbMGguQ/1mPkQJEWpPZW+x
-SDb9DGJPkrVOHNvrK0fW25mNqb/0lYmd0+Lg+ba8ja6zTKrV0b/PtB2Vt2YvzSuy
-+PqVLxiL+2685B4bCUqQale5tzsB5xoCP/L3ZR2caVTteu1MQlO916qVqEDi05EK
-RW9I3Zz2UB4WdX6ZR4JSAEPtEW+SeoFvR4TDE+Xi10hybaABJMngpeRkSYB57CMI
-PEPbMBh/MwU1iVPNxqwuac5xbXjK9Cenkywt5nlV+He03InmnFItX5ilcH85nvGu
-shr/urEQmSHRn3sYA908DouhOJE07KdQqO1+P/HRbHC4ZJHSZ2e2HmbodsqIdx0r
-8/XxxRsmvCB9mTz63l4f2DzAFF4V8YN8pvsDwBxXJcffljh59sKsWlxNQ8gv41bo
-EXikqOHVHn7YGYnrPjgPSiajaU/jQ+L5cCdG2UlJ14YAbmOjVa5Z8//jdsm4sks1
-wbFE81iKEyiVSp1LThbVWLseTgnFyxL9isgQxecnYB9lOTSUGKzAPcIllf1OhvQX
-TUCKblFBaOPwBJ3gvChxn17BxC6NUZbEpgzq+bJ3oBxS8UOnn3uDsnhqk1Yko6qX
-llF03iZ9/RgfbkKn60gmodJ6GKNivW8L6O/sBzQ59Wh6cPLhxBuXj8mIhHvbOAn+
-8KBzoDlPgBRZsDxF+0TkpcV+A8bSnN95ZZ2Q7J2kc7a8PawPi5qIlxY0x2/KSxhK
-8aqMpkWPKkVYnoKVrVf3dfpEIf1Rs25ZLFkY2VHVw4NqFzgoyNtkVPO068EWXuSQ
-0G4HKKz1gsKF7XdlVq+HJoQDll+q2Pp2VlJjJJgeroxj3joAX2AHpmY1b7YjmXm6
-TNg5jTIQsVYDHtIrcjGd/+GG1WGMEcNpm0+5aA0c4czndcsQ/1j33O3OEtOsgihL
-iyV3WipxTJS4com6h0lBr8Q2BsuXOlgQ3zVAWhMVikujSwP36Je9oQJfijJY8xXG
-tADqHAV/2MFa8gG1ourXHzDrCzov/QREpEijv93I5WQqmviFxKnEUBsd0LhOai08
-I3ptuQCy2J+Q76xeJ+jXWNpijn8uTpHWkJDMHLbsg1PrJlQXdWVBM0Gm2Vr83zYB
-9dEh4b7pXRUYSbTx5Inej+Ho/pP3jy7fyDB1af9CsBExDLE+8TWfd3R0iX7B8jOF
-XMm6EnHtKGM0iyViylevySeicVPIbIsd/Rel0Ujg92B4+pIRUOWQfYnyY5swWh8z
-jhp7SSVWicNsOoRG5gXRn5lbQdI3xr4sFgDvp7mqDSpS+qtVO7i8u6eZpPvmELv6
-tsz1Owl+fjHkniAjV8TSe4AsK0r4xd++xVhAe9/JVfSRQYKlwoVpNLvIuOFexCq9
-jPybSZ/WhCDWYI31+XsTe9OYRCDYLd4WRKZG/wrDOc2TA8pPbB9TkIY8SEMscel0
-DAD5nOSNuUnPwDuNAfcRgYuiWWgWKXwUk81cMf7psWfWWIZ1E54hxZNE0yVf432b
-PPjpEsSG5ap0mVhILnCX5QLR6Pqyp65lvg1Wga+CGFEiq4/jSVq3j3C/25mQmTOt
-iACmQ1hFzz1mziQUe8jT/b7hRLgwyavFrXEu5i9/OVDxxJrwzOcwTWUIPa1CmuaE
-Rxkriw9Id0pAVsqvkGRXXuyk8Jrmzwx0e20LOszTuZq7QnTlVKS3HKnyQiR64nTv
-/4TA1c5YVhRNPu6zJlnkAvbH363lAQkKoCLVrb8nWnyVWmB9/1zHnWVuopf3mmwL
-rx6sEsyeKqHZh044c3EBrF0kkS50eem99nfg279zp6PC733cyM7fF+BjLftGEhtE
-IreHHmCzw2a7qrH/Y+Dfjz4WB0a0s2/xA/2IlVUmtIW0PW82u3ri2GrO8mTTDDmR
-8Mkb8k6ZQgpM58k8bkQA7TPKGLxkcqgvNCQYTc2hIB+/dVkA48tw+fNDp68/25KC
-sDBdYkFmbjWRmsEs7jpi+Ug45GsXanPpxSSUSc2HfM18ggM/fU1NNwU87ws5CcsB
-tTLQk0hAsI6UnakHaDKThJGLeI7Wv/0eG8y1OFm4BGD3rB/5cr6E8Xcu/ElLzDFy
-6UnwvmGlLzTbfuTcyWF7Qs80dEH/MkV65vHeP/OYgAOz94xr6aZfv1vHz+x2Htot
-HBe5ajVefrsrLnC77kNYgc4KrnzziiNWP3Ee/8OCCJ+mO9gEAWZMaRdY5XlVg/lY
-hpxLr1QcRl+pvYBS16P7GpVnw38w61J+ZUZYVIS6U2nQ0Vyc09v7k8iaYxvEJDRC
-d5aH/U3UlwWLb0QZq4Kva66pZ3U1c6S4eBK3CCa0eHFl6hrP/CYXGmjMNMm8dP0q
-hWovuC6q+gJ5kZHJXfT3IXEdGhr11FenCssfu9mBsYqV/h0rE5FuNFLcooqHYvJX
-UYIST1otiD6mBLBEW69pVMQE5ht198d3U1RZgdZY86qXslyWeGJFYCmUDo28qUV9
-v2KnCOzsXV4W0L61S/wDpIrzKc8VBDGvuCShJFA4Tg/t5CaPx2s9hsxDdz7OtvcF
-FozI1bpWDLQyLQfQjPPG3/Llmdyq3AR1t3T+rN2F/nBliboelA6vVih1xh6cZ6MP
-Hi0whGSPkucU/GeofaqT2qmd8nDWV0YQyGpwVWIspqeiiPyWspQsAgYiofKxnLOV
-kmt+jtJdvgu2T0QZmUKCd5dBIPI2/2nMy43isvfGQf70uCVzFqE9XBBbcm1MI9R4
-Lw2MbaKm8AnSzE9uqukYRbriVbClS1yFptJnM5jcM8dro2dl0Ss4S5TkN1zsd/Ao
-mgw0rqLytOcLjEm0uuszBzvCxmorJpln4qv6rhwSfKlmYguwYpjk8X59u/6Mr2+v
-zAlxAYoMmnNgvNqVH5v922vKA3nABkgGH6x3yWgIsRnJPtCPBhSeymypjHd/Gvb/
-prs2Y/TkN4Qkdu6ZtgpClsgYNP5Bl+u4zOa7m8DxqBv0zH5wv/GWqiDbQdtJfX75
-1FSZe/HG5NJi/L/OLTVTJTPGKdkwd+AjLkgMY+tjIXMxwrBewiaD56D14fTQUvhQ
-GxoyPEyXAJ8jcOVTAXJvWJyLdLKf8bXUzc4L6ED+pJlTFiTDGdbB+fA1aA8vOjhT
-TrBnOOiiWzpGCc3FEjb/jfzW39FBLraZyHfoWBUkkmSK2x/GLoZABQKOtPpjEQH3
-7RDjsLT1czkmXIEZqujjPaIRS+gmsvS4qEvr/o9SJbAoIt+1DMBntSoKbKIX9ead
-i2SB1nWYeEi/GXOHucsy0DfVPD/nO9vIbgkHQ6WfDZ2KguCPcs34gEX6SrO0BEQa
-1WIuDxw2tdIYQrD64WnW7bfYTjFQ7XGgfn+yjsimxgU+x5hSgrOxH08BU3C2oD3w
-3tZqmXsMoGXN16UHjXBlKsOqjAzYRHGe2gcLqV6TOiMcISEK4GJnDN/VW1nQM3Gx
-kQx68bBjubLaylT87m9K4xwCaxY0aqQar7eKaZn6Gqe6mpzjKhZqi/AGUXIWcFgW
-EsfYVOHhwHqR1eIyuXvjWT3YXd9jMbM/S0QcRkgejCq34ERTlcix/7gRuuYk2mWo
-SYc58cixvN5XMuuR8QL9ZruYLaTrO9hkcKcOhOILFU74hETjlsdsJEWzCaqgBfTh
-Yc9GdauU2CKEITA9n1Zm97jLpxEjP/2WcfrH5j1uLwZCXwFo0f3bsp3Sk3sdt5FS
-mBfvBVbYpV2ZRhnN1u0VU5BcXACXjM0NsJphJiwYw9OyqLjH09p410WEFLQibPuW
-ceJ5am5nAPcazX62hfhynYOkhBOkWZRqQoBURG2fp0zG+ptZPCPTw3lnrhFjTqOd
-xY/NQW+9jl+BR0R4qDtYs23KoTBEhufyFNqE6Q/IE8G9nna5Q4rVF211V451pD+8
-sJGK3QiTjS/c4IxG8T/p6AhQhDwBuPSI90S2FSjq1iKK8gCmnYWsinzpSWsRV+5+
-YeMEMtU8tDjCblnRFnmJd8jWlvEIkA0SJ3kWKzm5P7xMT9bcKKr5TH03VtwWAJ6a
-DcyRV7iX7j14Q2HWtHBVSak1e8NNUWo+YPT8bSTUUgfgTEdT8UEeDcRPdROodSiu
-rc7uOI04XeVBnjEfziN5/ADMNjSj9kLdl9jhS6GTZQ2bV4GwPLFOuwgjW7dG5k5w
-6L2sr5ulEgzZlFG3CLGJAC7ijIk/xBojxTYF1cih7zPkoyLY3kLIvipz18PtXFxp
-bl1IJ5DXwglUwQluIoaBIITl7MRxXNj9Tlp88iEd+dSzXYMIRBdACihM25GNPHUm
-RjADduwNl06iopl1y2NkExdh2lzDGzZmur+Zvratj1pMdkyoGuRrBQzo+/ufVto5
-sSgY70X6l20bnsq/lSB0TqtERd3SklitzpXdDAaA2nHzJD5RySaOXK7oJfSnjxtJ
-Jk8nIsPqWqxnJwtOeq8Lk2c6MH3GN/HYNMTAPtv/KkwhPpzAdJQlDVTDcLqj5QIv
-YMTlrAKtNo+wPl7okIhYYW6OALyPWR1Rnwcv0suwniLiQGh3voag2obwcrkpIoeT
-muYqajCtzYLwc3KAX9pjKg1NX5Uwf25JH6r5LJH1PD04bBl+/vv3R0klB+a3Njwy
-WA1uxgsFEh+H0LMpV1qisWUXkoytn3dbVhQfSIjapvyk2UYk0EuzwD6poqipl7jL
-duGPXxhJY4CH8ue0l/bKUR6rheBcyGOq/ILnzSBfeH9ID2IUFBuX1TbbFcc6AAcX
-vsc7cChOHEYfYsewKCkPDXN77+mlEeoVLWscGHw85YEEO+AsK6R42hH+0JW7R5pF
-SnpzvmiXzrKehKiZloBVXaQFUY9RM+bcryv49ZXsEb7QGVd0sGdQkv9WEwC4qmMY
-7PLIszaUr37URfJJaQFDujYXDivt2FaaAHOxVEnngZWYvatQbdo/hKmgGRrhqyUn
-RbeH8r0Rr41xCK54unEoTCjqjodv2kM5QZCnkg5TYWdSm5gD4ooLV3SEnRlDL3hP
-h5U1X+0tdmO+aRryyTQ8n0wcVNtqeyUxXPlKdsMQMUaxQkbpzf/LN4f1vdvdrn4d
-kOXY2o3M9XXcZqcQAPpuqK+uilGORY4dVxTrBIOyCsoL7izWVjkmst7MLs8/zyWN
-lroZuKAOYo0LpooFZZNqkJFCH3TipnVoepLNjzrsnvsL0+RBYMRmVb68hkRrqqhz
-qznDGjiwc9d5QE5O75QrhOGojpEyLNVuOUHSnfBl6H8z1HL23YH0kp3nX3XxMLgo
-xFIN7Z9LwH5RB/4MOML41ONffe4EFXrPRRlACNp6StbCN1qc+k5ajQHZF1WB+58M
-Fcoo2mMTZWpQ+CMq98E4UTwh5Dgo9ye4Ws8sZFn+9wgXXWWTnKOyr6/0nVQZ/Yki
-m2fcR4JGlUQ4OxbvjmyMBuSv11DFNDIb6wfWk9VMnNEf0ZgyEjTZJIHkBR/fzwYl
-a6n/K6upKoxtRibv8V6wuCqqMCb7mEu5z7llagydwbs/preer+sIJqryjMtGtgeB
-xnSVRP5/za/nC8c/PXacv3EsoMuvj6H0TS0cI8TlHUboOunMm5fcBWoo4Ewmcq8Y
-KKaWW0M17zQvgFkCfIN7eZVNP827ThAu9nQk7Ylgt3A/FLXMhliMYr9/zntBAUv8
-NwvnABtx7lvb8/MPQgEGYP0n5EqxnuKRvXR4BaLtsGEZDghcIR4YbiT4GKpp1NIY
-/tqgKbAesczpTF2Gk8FqzYcLRxmklC7hYw8Js3oxaIqcnJl8WrIMv2ixeF6NZp3T
-7Sax1/rztU+VI6jYQr0vkHao7j97l7X6gKXsaTiTpFgsCo5xF57pVdaIuVnnLlUg
-/zosLrqIZ6gOgFI5bMYxqP1EXendr8MkDyQWMuy0jnd7bmAoCMknyXpjkvyToDMi
-uZCal+kak+nil0od1G64kbvbpvblHY4XwrG7tuBCdJne49sClydCVTQdDnXXyhJ8
-9+Xa0WHxIlAjrrsFRpDH/OheRn9xDnSwpHkip9FkkklrsPia9Q4o7sNuknneGgPU
-+wmBxQ1SUMGS6gYLrog3sbVVBzAImt94BfGVopLQFrFodEe1162o2ZJva06IYu6U
-ZLvIYBSm1nt/w043zKVdvM4Hup9jKmHzCv1Mb4IcZN9ex1laJ9LEXclWN1EJTIMW
-iIvI0zERheyY1p8k27TsTAG8zkXuFY0JbMY9kXkRD0P4jvQCrIeBk10vRO8uVoZr
-oy89+IsKYfDwuUDgR+F6e2+jdyjVive27vuAS5yrxxwVaupZAb6MBh67+u7zf7IL
-78a8eAbaFKRk1IosCX9NggaGOVw0VZE0B8WDQhcymnZRx6g47dkkIbZes2+hVxXq
-j+6XQnbsdWpX7g82vWyIne5ZNDCUrlU3BBknDP+CYdD1bj7MFP85WfgwZmBUmP1i
-14UdgDLbQYn7Fr6eLBvIat3W0nbYxzy7UdwaJcpHOeFocHsyrD2LyH06oMmvAPIs
-1QKhnYauE6TvU7IF2pAdr7ds660Joba9mOuvhkm+2v4IQexXkdDfAziaL932xWu2
-oUmtKI0TTptEJbt3zGLbEaY/HZ/5n9W1WcxX4yZLqPvTEI2q3kgUoxoJehVNelTZ
-dRNo3Qt2nUG8tLw8jv99mIyITu3ruNw3evE/3XazqaWFQi13xOX0fN2pGcxvbc/4
-WuOurtUmO5vAIdEBBSflhEC82OsCqimvgW3NpuEzDUKVSlUpgLN9R0HO3OOWkWbI
-MZkky+Kjz/2HbPvZEygkvLGr5biGSZCsbg7l2m8aHnX8tBxbzXPKi6evi0ZM4rHB
-Eb4QZc4XK/fFikOxDu9iobG/fowemZq/bfTOaTxcLmABEhJtCz09h40XSQMEtVlt
-k/sRCVYS+LcAMpoKtT/0PLILt29qXk2oaxPqsaDzUx2bU3FOJCgoqc558riKyuNZ
-WROpGENwcmlhoXuAluHHPqLtzqClzNzZ+y7j5CLE0t93e4B8lVPawiZNbMOmZ/s9
-+PirhY9fk526mLJ2nmDNzuTrPrcB04pPrA+TAMbTz9eM1zerHp1GRAS6JLt0gBte
-vdNMp2Ph8E4EeYWl/60Qnl7oLdtFgyRH7DoQHLPcTsI2774rT+blF9M1kGxwEz2m
-/G+CbrT6ff2jF8P7DKAdaipjVm1M58ED6PheN69xdZgYhswDc8bZ5s6ZFrDaQnGR
-UBKfeubfh5nVsB10cf4grtxAFGED7ZtuTnDSpzmJGT5/8yqd6ph0ONmrv510wxH3
-oWRoqLA+7trCqtG/QYQXRXN+ncuZUxkkcAmdcNeoeL6UIc+aLlic8SqgZsudxG7Q
-fhbHpqja+2HQBmVlmdf3wKlTFnxY5XYvkk5yRJac9xtmhPPrLeBSuNQ2gn2YLvf/
-dmrREMFV+R7oVqyFsDmsy9E2+wZ9BjcO0fz0o0azW8R6kJtXBzPR4y8XN8oUBx9J
-PkYppfoAZhdGDv3gUfZpMFE0ANTuhSHUBo9x/wtaBfwjJtIOgAwJAGukwNsJRr1R
-En7xFI8wI7SPpL5y06SF7GWU+pT5ATJA1GLOoPq3VSXnj48NmEf+St1KfBdgVZI7
-HYRmsjQozO7JUID4c7XgwfI56Xzc86m/TUF2Nd1waGFAyNHC1Hf0xTv5B23J84GD
-Hdk/QEv6r6kDbCV1b4qhOxHvEk+r2msMdDLG00JZmDffhdL9AVP/J0BtQmAlXZW+
-IKreyHEry3l5JdxG8jpu62Jqsy5H/Ft/eFTPsQoXEdrsqg4QHe3Ss7eqRb7cS9l3
-n83kOYelHr05DqxeEI/JyKsqapF+3Jawqsg0KfX5Hb9DM4J6OfbKfAz5LVhVDsLL
-Hwr33dv8DZc0vkdsUT/8wbcaR2LaP7Renv8Pc3ijAK250BmTq0CaSd+J11+6Q3ke
-kpzv7zTE0AwdYq6D5p8Euu8H2HtBqumr9P8RPoLWOU0rIMxzgGHhmYRBU/7i5Pjm
-URCwlnBLtzbr9V6jKRiAGTNUx88xrt4ekkFpi4x3bgxhLP0LHt4BET0TIXOSrpkA
-KbYJeOuDdwvUzU/YBLvLoBLs0X6D6RJvNxLaZUwCHo09rrsk1aqwrhOByidQUkab
-/sLcCs1BGihLDlo2kAJhO9GCEsOCqxWTjuESnSyZcFHKuFukKZBy0/BEwyI69m/K
-hbwtvvMiKwqUJRyODjRpoZd1f0a42Qq5vZG//awWlJ5eZiSa+AoTLE9OomF6FQls
-JdRszwIz8P6Qg5un0ul35IGMx64fqOyAG30xObwwCN7iKX+UhKNkk/z4auD2Errp
-HdYO/FldbFlH2VJnWojmFMw5l6n2yudKboKmTu9QsWieQ7uTvPq8iH0Y5eBe9y3E
-7HnU8rpFL5LsqLlIGm4zv0d7zAO+Ii6E2CMttsiTDFUYaWtVJdelMq8iVKNO2k7u
-cqR2snTjL0mrCu/jlCreALeHap4uwntQi5hHlppP7D9/sqUDs91cnJ5KgcKEEMBn
-Fjygr01tIHxW5hhkhdcrQ8pxRUSqRd65Xrtv98ntkSjJ8kUYTdwBP80xk6nRTd5Q
-DPaR1nR64pUNyX7+HnqBY2SYfLWEaC7oauM21Yt0qtlEUSO1KNQvWito7ssQge1f
-svkodyrmsKqwc8XTId9O+IiaFIlt0eVUI6UK+vUe2MJazFEY6u4jsE5pk+DN/13F
-FmGtvMRPXp3fBWwLubeoc9KTJ69upEsejmG3K2TIy4TmyNJC0x4j1heI253gBsq3
-w7CVgSAYd4lH8mHSorqsNyXAT7YfwUcC17+IHffzmy9kOJ5Vu8UUHY2nt9hHej5w
-EnYYKXemEAO3ApDuoVyroWsD12PK7PybrWjk2kPHWUB+rlinyikL0o0tdGbwPUgD
-6SGfGKG4lCdmMZOdJe/dK4dZAmdhLwTNmJ+XQHoegLoLKs35Am1F3BjkullYloM5
-dZM2w0Rm7T2N/6nKNCVPdJWvG3NH05aDQhIvVAqMPkUjvGCUZcYgfvELtf7Eq+1m
-mNsgZsu1kM3ONxgfpmVP3e0HbpXn66cJydApHkGtPHRJq7ylSVwpm30gmB3pDMCs
-IsQLUmQfnNHjXNbPBGpMLLOY+iCbKmrt3zjyU/k6xIa8yx7xeiMkFo+JTKV133sS
-XMuzLuR0caZVT4gDXSV7YRzDyn+loMO5C3G9qKtu0VrK2mpSHAFbSxlghg11J5e0
-ynDQpv9z30ncPi0lPYVOuiFWGwrsNJ9kaFpaa3QMYoqSwkGZvZ8Cvy6hnHGmwlx3
-mVTquCt7HNKaOSwNI3N7ThmamaXulVz2SYahGwrGoaJQPdnagSj7pPX7LqPcLZX8
-HoofGpPvhp6i7tRD7mUlMUF7j1QqGrfncqR3wo4H+jsNSI0eI4P1O7YzyyG7itnO
-K1hmZCpgv7fpEeM/aEyvtjc2B205vz6sYLbV/tYWneedpUHRoCjcw850kRsuMZz1
-FU77mAwB62tR0RQG0WlUqAM742wkbYInTcQ7l9N3fJNyahhYeJJLO8HVuh4Vhh/h
-avcV1IlO05Cn2z6nkeEP7TH04Z8aVWUpJbquaF2/owI5khNTjRUtTSGTPmfPzn6i
-yEfvpCBB9uGUdXWDDo4dst8K3YK1qMCuwLVGgDAK5DgoUR3Y2bB6fFPOslf8jWz2
-qfgWMCIfE+uiCdpOKguzsqYYSftluMK5u2kFoJSupmEZXLyJBejhwQLp7XAZpdVf
-SK11dqeJIA/FXS+IkpNQm6+NyL9+PjCvO/LHQBicsAXfPEagoT8RyYC0mvFrTc0U
-dEetIowar4Y0a4iBjsszvPJaz4wEbIMgIwtFXcDHSETcaXEdnW8wydFHPUU3CLdV
-XPHc5FCFftGo9zhb2F3w5Ww1Xuu6oKs4x104sM5xx4RMxG2sKmb3xNXvglUNIjDw
-0zOFFQudEMxGb1l5BhPuNE8jbdd8Krh3XgtMszQ4MbeZ3xLBNI4vbPmlqJrdPbWw
-CvEP1gP2IsuEwT9Eq2z5P6YG1KMl7SgpPxRKSfy11AmaOW4BMj6PeMqslmsAX408
-J9vm6TtL29aftdOgeWMPUM0pIMS9P0LpoIgEeEIVqyFlFObykfEFEgOSHl2adMJD
-NZgjcR8mJZNNOZf0iMrKCxpd+mB5YRsQ8td2a00wPBOwGrHYC/nAcXEzUZGS7vwr
-EAG7e0HytASlHs2vuNy9Gr4lBhfnzuJWRK+8nSRphxYIWCik17p2+aox7B/V3YLA
-/j3Zy1N8gOpIOcEuXYYOXAhiuZNDmBzRA+HKCoXHhviR9p8f8MJJf/Xbe2+Kr6Zf
-mGKdj343JzG+jM4UtD62GjltZELjYhr6ZX2y1kACiqswhnGuc+55ZSZ4oovEGblZ
-m+dZU2OobZJSOo5ZweRWBvhbuEPa0BEcp+HuilTlr9k8hfDXbaMYTsZgLi3JVbOn
-E5qByeiDhIQffuq9j5MQq2XsK97Ew12R/BMyhgRMQx/9Ohpt1f4xfGZcM55ufOBx
-Y2/USOsK8AGLbmFV16uPfGn+qjYQNl1WiE2/JmOTzj8t+D6XRIZ16ioKlfos0lTe
-e6iKKNs0GlC+FG9E6MJpttAsR5E2R8c3LORyNTP6YQo2PhwXlfSaixWOt8+nUXN1
-zwz0kTh+dbLtHSfWXcIH6LyOGNJEwplaTf4ecUShEv2U0WIpkRa/6HUzoI24nVzd
-ejKt1xEp3tJX7RJwfIfMtgsLXqn/R5In9R77Hil1OkpveA5xzlQP7lspoeNpSLZs
-4uDds0lTzRv4FUCP4/1ScaVDIf3rx5ph8rutefrjm4iAkBRWsEtnBY7owjbGYs5A
-sJxf87nRk7Ua448U2YF0vepVrxGXqOcsHEoYFab5PKcQMOg5bOFrWdEgHAALO2cA
-XEMNz7tELKplV/xq+rw2UYad0RfBzUtlE2mErLcnf0e6EAanv/9ef9iVe+gUcQjF
-0qNlWhF69iB1gdmxj/3NAWwpEq0yA94vdmwQNGbSrLIevlOdJolOZx59k40KyMXw
-aLsgDMdwLhle2QfzUBR+72+hiJGHYQxBH7ZyH7KEZctR6lTxoerM29KwDanDU377
-bGJ57O9c+G3ecE3Oh2SkYUOTKIn2ZJsfDd91f6zDRCgXq/dq92z42fp+U8kWrhct
-Xz8S4/lPjgHDS13YMCvbtyR1/Vf6diCIWsJdlzSonZvVzuDS2m+KrDpjkoVUrgfe
-18jrBiMfB7wGdgitwKILvQ+vKuTjhg1biKrWf4p4oen1c92QHiDTO9PM3XQ68FBh
-K4GuRoE/SVnpuBQec+/NkXfqkR1uEcGszfZmsaMI2IGxut2l6VDKOHw3Ok0On8pA
-WbBzvNgULB2qgx7duLJUcHhH9u8Vy543cqsALOyk+5ZC15Kb9udZlWJzqkz6Ce9m
-a2LvYECcsde9JJzXJpLq72+s6mDN7aF3AjNS7KUwYdu37BmY8wgHEJenN0cmnJMg
-s89I0L1rsr2SLCLtPfpU+/ke9k5njl+NS8GlbTkQFcx+xM2CkGxgBMu2KOgkeMZ/
-kjGCjzR2XSewRaPWVlFB4alVKsQFUYoZ3rB1rNlF5oc+OEE0HgrlnLDrikxwmr0A
-JmZ4qCRvG4XYJo1NJpuiJYC7P6ua5VDJVepBPddjMHNh7oZdk22Hyw4b0LsXkPpu
-gsJZ3DntS2LJ3IRUysxMIHz5UVdtyvF0TR1+53l08zEJfLbXlZeob8PP34A8G3zd
-uticD+/m41nlUIpycal1PfKdjInQi8gR9FFK1cDZqOTn8Jorh89HZXa7ETBx9RT5
-lanhbCLI1ZTJi+P0TzHvuG0rnv2cyLqlop+uOt3rA68tgy6YVAOUbdsrWBcxa5L3
-fnP+2NwoWOF11WBvUk8S+db/qRzCa6x3a3RcavYUA05TDTJRJvziGQ3Gdz1jYWGK
-5AIBuQbBF3+6aexbgRaFk2FfRs68KYVmej/ia6VyzoRjkD4pRPeSnGCCYQC8Sibk
-kh1f3BWvxctLbbtUBN4453AgxgzG1T2pJGkcrk6QNUQzH+YudXhYmng37JW1iAsx
-KgUV0XHZ4qsn9yMk9bFDnAc8k/oeyeRKRLzZbwrNcVuTLY62WArB5XoHd1fbj3RE
-NI0jn2+O/65KcYnaEeQcH9s97PkELjQzA1Di5rmDEzq0FM7b7CfuDhGSHmQ+pUy5
-fNcQ9y1uZxRxiGy5jhHffreIoaNE1jw/8jAKKFEBPmv8vuBEyHxlCTyBMOfHl9Qr
-VRD+iNn/QpLh55rtnfzHLwC5rm+gj6PkKnprzHU64uCUmUAhHoyNRO0JgE1IBTY7
-4rnXtj5rlp6zNfdSFIYAJ7QGlmIHvCiN8zQMXUUgEEYzxyp1cDJuC2OjdkrMoFdb
-z5TusWxyT4CFRY9jyVZZybfkCsfVW+sYKiZsuTePgRiB3AQIh5XaA/mWvorOlVaZ
-mhejturtr2tKGWzhRPgPc+lTeoxNKQgml1z4CVaI0+v2rH304ay/QyhEhLHsREpy
-zNFzQzp+znRc1FV5508P7JZliKfAcrbuqxQwjzYmMQkilYkdZV8nnVcdLVHbHvAA
-k/+ZLmsgb4d/oHQepgiD9alSPL4p8DnUV7kMkgxrF26EeHjSzibMSs1AINl5OkoB
-slxpLmrRs3ACnGAkmUhq1CPAv0RfEReuEp0xryJ/YzP710aIKu4KDayecSWj96YD
-6BF5XEDO3d8UAzM7B7lWQ5yaPjuvUtf39EAI1PI3WFyMakMlPA021TfmeLCEIuFH
-jY77EBHklGNvTRJFGVzZpvC3+0gHqRUnZH/5BR7mz/eUn/PlN96LDCFVshAjhEoB
-rQj9E5MGJXOPTOuLCxhHswNhNBnOiUBbiXVEaOfevr8LAtWa0aoX0pQmd9cZS9At
-gNvbyIp6Ds4/ayPfJ6UdroTAXQOzrO9VIiw2xBG8IuV+x/80DuuJoO7o0R1IEj/v
-O6ZjpbzjAL3GJlPPGGYCpwjkYfyAKCgeZyj/gqJqZsmvCZoPbQFavhWvwJt9QHUi
-ayFXddJtugDqBfNMtRMHxu3x97XilfxJKbzk3DPKlGJ/XdAPfYMjDXp2gjhsI+lA
-wnhX/3BDliGV7VaUfiY+NAeKUelQQD3yYJrsZUqCcub3qAYx2lem2Tcic0FSc7Uw
-l7F9TSY72r7sEeGJC2EfpX3ebUDJCfzps0vCmD7XB4Q9gSiiwrKbvDFKpmzG9e/t
-ONoMD8dlxJznT1TrAcYJXWacaLCsAHQIy1M4woYBslAijIoN2jyg1zQXxbg6TdXb
-9XmQbHoolEtM2MtYTkLArO6USvG1jicw1a+oHjwtxO/+mAvltUqiSzawtGTCQJY7
-JMXp6l65bHRrOeA/6dRqexHFL5z21bKYf/wFVitDACMv2eNiy26e18IewqOvzuLf
-y3cl1mkAX8evJonkb3Ucm+yRisAJwdVGwzDDCuKF4M/DCWHWqTFxS9xXN/9SeD1o
-aeKpn/O9T9gk7L0Dabu1fO2Lv4oVtqtemNHK3xnl5xVZdM1UNFWQjnO17X6SGGsi
-kyW6y+inJpAWOBDBVTzmWWzVIMt69glmwfxVCcf6Z4d4nHSTGz7POoTAL3RQ3bkm
-slIkUntlK0doVmx6SLWkV+UWbZgc46/izktWbcmpUuQ4tTLsjfrKCJl6egEsPj4D
-yXJEQLgT+7worT7lGvI6Sm+XM9WICCs1pYDRhGNI3d6/0wR24wvbjzuogFo8Zb5q
-9v+rYqTAKR8nFLaurEhV8LZAT4H71JNwLHRgfbL3RpPO8TbyfsjavDkYaxUq2x5l
-zQK4wWSxmT/AtkStuaJX3C9BUnog6wBp+z3AIjb7nwRYhZwjlExHSFZ6qn8phTC/
-hoNqwYNMD/jmDFDfAlOEguMX7uyXE6EOIRFxXaopAQjt8BjZFBbIIL5jj+23zqME
-Y6Hu+qszXP1d1yDg7QaaF1T9WvFG8hMY9nj0Zpp+/vLiUnzXq6AaBBX+4giiLRcF
-HhkVU9SupWtfLUxSPj4wktqto+zf1YUuPx5hA4OsGsGq9inN25OFk05Gma1ftQoX
-Qx/JAxQqnWLTYhPDFKgj0Q1usN7zj8YcIQSAWtjEWMRivtsPZymo9u7MFHsCdcKl
-EPmWRAZu7KiPJP4m76zMzU7pzX7Voe/MH5VBq3Xsgz4Taz/7Mlx967alNccqxKgX
-hXk7KUYUwp2jMwl2kmQ7YoedIyj/fFYnaNS7o4ZtUtiOh61t1QHiHk/O7sxtoBl5
-kJrebpC4yT/j+OBx1RR+0tzTOjExWNVDHdDuuBB+qAnbfAbzCFWptOKdZi8jHXU7
-nU2WGVQbZRzRLCu2ZdmFQcA7AKXfF0sCuLzPEKFI3eqhMm3V8zmWk01W+e4yNEh7
-4pEQSJw/bmlcrF6x1tW5M+ZmKtqpKDEIZgDV6KRMj/VgwtEmz4j9pLmIwAAPJWZl
-C3KG+AFeLQcfg1bnZpBsSXjsqLiLUDJXriBb4H27FnE5QvbiPzvLfW0o6VvOJcvL
-3EvQNd+CzZbvHVDRDRE7BZPIPY6yn4rhPcNkvPUqkLyHdc2HexOe777fJ+5NJVRv
-JlMyEDCKOv+b+bws/qSbyAz8FhBcZEFSwSKfkqvCFYHmkV46oZiXK9+JL2DA9Q3k
-a9BryFi59n4WOZSeaPjNlFQxskT0runbORgQUHRQn7Drqx2nkO49ezuHIskuLjTE
-v7k4n6BqHDh1xeh0BicuclPyexzIC8wh+yvvjNxNKRWndgLGN6QpInLlIgE/xypZ
-rIbcqAwRno/IRtywGzvQnVQs9MK8tEAhtEVR0+McRI5lWv8+kf+nIdXnVuFf26JP
-iKzl95XcwdtlGoypeI8Po3cUXuSfq4cFActMlegaic9WTBmrpzhDGhag5yhKSw2H
-MCmGp8KgxyTjitHU8TLA/Bp4Ewz4izYUthxCm+tELW/PYwNH4cLPMdyBK+VH0Nvk
-wZnU2NqB6fOFxJFaAJpwwIYbFb4bOHTe3exx+sUPQ8SY5WSHQ9tOBCvC9GuClzNe
-nAHnsRDiMUtBxvq5ONPWUxRd7fAj40x+T5Iib0iFUyc99ffFYn6KvhjkYPNBDpDn
-MSewjk4hulXtONlRVt12W1Sdoime2FLpAekkST73k31RCzoICMzG5C0UUtFbJ9eZ
-VRivfp2Kwiz4gWnK9xirJyaK8jZyt8dM5WPpQ9WYPpbCrvzkm1QFYxtCJgh83pVX
-XonY7H4zqFmwqtWYbjvIsEfcC559T3/LMtZnMMHSlLu9XWvhgtSQX7YCNajDOOlE
-1tWRAkwlfGgmbavMQfk32SIwv2rU8He4aGiBf7I9TjB7DE6lHFhaUP9Gh7G14bBS
-29M3chTK495a9LNd/zhfRs0zonaZDlpyZDMAzHtoLxb775BCmadgbcaAc9y9YfeL
-9QQq4desZqm/hLZO9NoSvPKIcwkGoUzu4ID+vjEw9tkDGwRVbkJUvzUEfkxXKpwF
-VqsvaHu+AUOWTqNTf7065dD1TgTdayHzs2UuXNvN8b+10LVDo/GeX2biHJcEFzdb
-+hi1dPBLe9e0cKb7d9egL9GSWYJYvc53dV07I2gaj/f5sQojjitHRQCaFh/CZxOw
-4zsZuuTn1titgXH2gM7jMTtuJeef0yRUhCDkna3nQxxBSQukBEJV2ADfBXBwi/3i
-BjkLif/s4NTxN4iObiOJVgkZo/pOikEn8w9FwUq+Ni4ozkX6ou/dfY+eK1lxOcx0
-YNMTaphl+i892aUC98nIc0Go3iYd33Wr/7VbnBSs0VBTS2gKosHK8HGKZkipWnCw
-yHQJPTwtJRoKxb3lLTCfFky3BWWWgMTr0yv3Hxp89gplxkv1CLYOEt8tqCqX8LWy
-bQ8onjffzHUU6WqmjPTANLnhln9COvUeIIckqMP+d1iN+t8RlenjLnaocW75c0xX
-3ISJjvVPTyJY4vGIasrHd0vZ4QCF/tun1qftJnQ1VEWZMElelFfCCkQ12TkqIcmH
-r8dR4ksgMpN5mumTBoGRoaZ1Mx9roO0BZh1A8MA30YP5h3vTBUXLGc4+NNGsDAoj
-LeggvKPjoEm78cyB/cT0Yz5NaRV13MLJ1OUcs+8uKsmQZqdWFPkYibUiTt+zeGHp
-exfVbQYsX6BYJe977qDhQ0gO3FfYHRtSIE6aGDks8uikzJZw8pYswprfTr6eLwFu
-Je4NmVlu2tuXdITXLmElrNj0fU4V/8AlqwfjvBmrc4G3JucGPhCbi7RLZvrZ08pk
-gpXXlUAFuwhppt8cAazRpnvQ9aafKsRIBFk0ERAC4yp6vBAasx9nTYpSlc5aPVRU
-zCoGwn2QZ3eKu1ckSs34eND/Khg3WtDWWW143QTuuXcOsRvDxd/1V4eSQPUQmpmU
-e6LKBlTjaSlqKIbXrTqJsSHhG7tGzbgpKpl8GR5DhxflapAu0a57DhcSdtCOBldU
-Srhjicmvv3pmlvyRxsXgB8ZzpDlzxWaAzkeSZup0UnoiNPJVOudXObSJkky4/Jze
-BAp64Y5CnwJxMZEzLIJhvw5Hxngza/Pzq65MA4Evk+hMaaLvkrui3/kpspdI7eUb
-aO0jbDUSvp7mTsz//3AMiQ9OWeTgiSc8ChCkHjrRZ4tuD887MUJyW3HZW2C2PBKh
-rHVXWtYU7MDtP39SykrrC3No3Ea4H1KItuAQl+knjVhSEaIsiMCHvm8Y7JXTSDey
-4ponbx1lb5vWJOVL6gue49ZfogIQLqGQI+5kymml28OUKRGLiQmTqw9k+PgoYSxQ
-1JXloM9GhqxQj3viMWelGrEes18ewhEmQjp+Riwc5J/VSukt7rDLUq8Y9wcGhMf6
-hG/VpPReBiX/H2Q4muIzc1fze8S1qDpUAvWpPAIs8EllTqZhbxr785C5gcQAZIu3
-emCnbt/G4Cgvc6nXZ0i85XSyTYIvJnylEa+nmhyCl/QMnxLThgrD6fMbzo2gAxLU
-EYEZkp0vEZ+v1Hhll6kPPilg0G3edJCxcH+WwGCBXVfYmR1CFpo9fAyi3eo8CffJ
-bLahA9bg2uOZjGAgcsA48Dhj4eLoTqCOvzq1qDn0pq+N9/zwYXV5oQmxESu7M9rk
-r6G1xrRS4EKupruVlgzZ24wzWckSYfs/KW04IcWhYAz+I7vJMGCVBGLRliUJEnhe
-FQIImLcdDqR8qPxENyhFIRmUfM8JPfOQHcFgbxoOPwzgEI6WxzJg/WWNHeZtqjHX
-nAoTnZ3xeN5p/Uaot16N5RtJqyda2KCdFLjIa/CPKwVhqH6+42H4sFtehu+7SKt3
-k8VEF7gGJ4xzSBoomtPtRgUrxbQeP16R1r1b2Om8MYK2ZOvsoRsmWKT7Ke4gOetj
-oeWtsFU3jrqCXfHZpJkl0WiU7k9a7b55Yhi+08y7OehHthbC3NQpsN6YdVpinWYj
-nimoSxQUNCgeoxyGSW+1vLpVx21U0dKUw9khh8gIQko7JLDP6E+cnZcKUpZA8OoV
-lQp5J7C9xhahq9iZRtuH0leLOHaFsD/gqFV7KKhKNNPddFraAwWF7PW+IOQpOCzs
-eCCiws7Iwo/fxRAKXNwW+tJDPmsCqykl9bGyiC18kEMnCBkGW8naZEfbaES8u8NH
-d29sHo2WwYfn8DYnxHknvpnWHoj8PVIgonf/C5kamC5enpd7JgEwn9GyZCWrq/pT
-u+UCI08v/gEUZY1P2QfEzvTrk5vIR/TpHH7wdRYa4tiicyXvPJKBTCx8nI0pUqO/
-1le/JtKgCxcJ7bMcmTaNhSTsHiUVuVd170M1VizR6JjbTZ/eqLcXS8kGkHIbXPRF
-6myIyBXncAP3CLw0ZoxL9WR7oX42gbZSRkk6ctw2jTspLptJt8WkrW43kvCb/RFn
-iGzfK6QuKtkA9adsiegi5PopGQcB3VFXp3OkHSjMWiJMiQC4pLA0Ja1wFuRSYVy5
-vTI/sHN9KaGigq2jViV2VR51OjOGXvjMqOh6XphnHAqTG/eaw8o93EMD+0qmFVAp
-EPvezi/j+Arfm+pDwJTI0sDY3x2yHkiU9i2tY9RJpaBGmHquTc0Lrz7NGCNBGZSg
-phA3zvS/cB4moBl6imi8pWdHmSLZ4JxGHDbDAc5wLFc3kowuF5qx9D8XuOAIYR59
-C0aZmfnAw1DuhajDVRHL1QEnFq+mLoevJY+dpJAzLbJ7AO8hWui68CgXnB8Ca4c7
-nfTGxD0JG4QzICj1c8Z0hXOMp0AKEIg25+rbV67+PeEdO2QhERz+IGWMDCPsNITf
-9H5X/dzi4Lg7LJHAx/4oqBts7ogCelcrr0yBONsqNTaGM2Zas+KYU4Gr/VNRdjbW
-/iGAQRa7oBtNBRIZfzcK+7lYdPnvb6BRT4p3iZT1eegdUzIoUwAjDpS20FicG4Vy
-z2UDpVC1IHuWDVz1nxdxib88oRxenzyliFxxSnEFPfF6fUZcDKpztNTo4NAaq5El
-ZWKX/NstzPWW1jXUiZFIL6dmj6NDmokNXz9QR9mO7uzJO9VjG56DO9/w+Kj/otwI
-efBuOTfh2taFGv2eFZDMMiXENKlCHLgNBHtJs14gpXQjnqy5runoM0q2PFwUlKn8
-oMh7ruu7F4c2fc/WeTt0LkMJ3ndljVrS5dt6CusY/YS0wDavP+6M4b3Gq5AlAAur
-srznlLri9MGUlXIej23CxSqoDKvqNPItez1bTY/V7vqxHk65EQLBku4Pz3QR3zSe
-WlraGGwMVtf730QzMZt2vlBw7bfG9rQPHjHvfl3mXwY2MQcxsesjdtL2F8ylKREo
-Z32ELXHz+iIVb1pQPPnAzGLOLegLYS3a4d37efyLODV/G/C90g+BB9yES8E/LQBs
-OflW68YiXmZDvWQKzvcK+W+6RmrAz6dLxkO55fVpm4FT8Yy6isKbni2GMPJrwDRu
-2shbKPNWDaKip1pn4ILZmWZASiy0X8g82JjvAgRKouWcYBdO9fXLYO4zmq36CJmB
-AHInkfFChWqIeWX6xWSfp6biL36+cc02dJBKf1cwPNCNYfEF6tWZp58UmOw7cTV/
-YjlD6PV4ED6AT5RRuavJx+3O2yk/gfAUc7O5CbRmZSN7v+deoz6o362fMXwy2cJI
-QWNpgNpezFUo78ixaEyPJhDde4UyfYl2uf0ekekcPGtdNfJvwEsADesDrZuObguW
-a9C3ECLi/0bdtZf4EDXK/oKnTeIVGDovk09GMyM88b77WT1Lwncm8SGx1d1em3Pt
-KGxIlzf9/GsvpMRZfr9u9GcF20O7rKwH9lyYXWAfPZoXOWIGS+7mSt3DNbiZWJVY
-M8bmo/06hbWWdgPOCjJyXGLbI29FCFohZ1a4PxwiHu8apNQQDuzbkY8aghCr3zML
-Jnfgq/GRDoLbKBlO5Mma7obqo0ijVSQ97I23anax9kVJDBxpbsZuRwTBgZbLJ01G
-lOsZbY0PDnArcsh2DyGeAWKwBhDZGPO3zt6Am2GBK/rihkM0EDctG7KmXjqiB0gm
-ZieEbddv9Ayj1Smjmeq333PmEzzdNIRVpBMWDixOsYGGpTRfdNVLcJKu2lFZEAfX
-3cGmabPXHPGQZq0gqzBA+OimAYqqGEZ4FwjLKVuSWGUNL6PrGQkPO/v7E6oycrRE
-whmkKnw0D6qR3yj6K2pFC1iPcNKOYgDJl/Q3/XdP/5nVSrvIpQeYAkl9GV1TYXH4
-a+MDiyBl8UU0x/IbfBn+SpDUOY3Nmvy9N/yFzjrwdONr9FHrO2zzk6gnlCxtZX35
-t9FVtWF/7IZqRveN+rqprOzu822W9kWnZeLF5y62q4syZrD6z4A1NZ7v3QgucrEq
-WAsmssX1tS9SJnlW2pmMfD0guS+Z/xa8JFqvqnAT68ohRANw6fhxk6OVWOTCDluC
-tl+j1YetcU/KxICxUfv+DdjGYbHpLnOTv6gVFK6fJxPAP/7t+Mdyt/txale2Dmcl
-2rsRxxNCTBbuQbhMaihZl/zR4StkRhzhnGCPBDcC81vXeXXsXPKUFaAgwBIFoRIv
-bNAips8qq/SU1cNjlKu8sjlynHvgToV+i0o0EYnUddBhU27aPSjy2M/NWbVzwdbT
-jxHlAxPj1KO6Q/UOEJSQX+yg2Osa2sGKHc088ZrB+dq3xOBSNF52Dns3KUhrUKZq
-T0kJznTYMnU+ztonVS0nxSxfjSC4liKLkDhPSLXsoJZSS4V/P0DabSjDQifdf014
-YpZqRBYlXJy2/8yUNJVcJBYKsyZPrjpoijUGrxKO0ku/DNI0r833+3nEM9su+VpM
-I+Tko00md/53WnDBu246geKVh0Q4FqexoJQ/z+DuAuS0ddzcvqSZCWCsGIzHSw3O
-GGdek+e7NijkTI+dkQ1Lt4KQJ0PviBpKpVrUDizCxwijjt2njv6R/XXIB2ei03fd
-He2hmjcRIBttxSG1AjnJdPjA4Fqmmv7Gj9+Z4zUJR9tL7B/D1z8V/CYwuaUNp5XN
-u1FE8ZNcWKFR/ovahWymxdvMqLWZH7PzdY/MjKfkr+KmQeN5xKKUeM/1HlgwDA5v
-YkiJab0VrhGOb0fNx+rPI8fsARU+0pF3ISDtY8WkNKaYQQJDZnq92SEeiDL/SNdQ
-4VqQA10oeqnr81oO7xqsSMIcsEkUSCyB+91Ktxgb+zfRCou63HUEeWTeaEQpFgY2
-uiYdU4Pgp3T+kFpCTr5bPGQ2bwZYQ81Qpg+Yg2C7I3d8rnTETsjeDxcIyxM8c41E
-2YIpv3WI4eNhdiOg4u47dY2AQFHeWNh6jnhUz4K2LQKf0B/fiTEINlcUxb40fx0X
-W4woeQHCxIDfZLAhT/dqSQNRGI/6S9qQvqFkYFi1AzVvlIavM0D241Wy0lCbGG6E
-aTYg2hj26ukStEmJVWvby6YslCzPPFCCMPvYJ2Qikox8YhJd6Cz9kZ301ylz7um4
-84W9xLxvPARjGALZ2m6AyXOXTM1WMGu8FOtuaaTwRcRX3ROeR2zPaOUAY8n/1RBi
-1NrM5HX45/VNZzlI33851NfM3JaKNuhfZWHgJ6L2YCgF+o1j7ZLxH+ldykUnzmE6
-+48zerDWFOfHXQEqiH2QkexReLkSqEv0VkVDSHm3cNUtXI+714SNsmY9qsZHFEyN
-I04EU9pTPYck+0gUQQ1C2tAbdQvUYBJADQNIdeG7a9/dFYCQoi9QqixOWU/01yju
-D6V3bTeeKWuTEnkvhkBhKK79Th/oo2VB2cYySuh8hm2oldhZo8J1Run1YL2WcRdw
-cMzvtBNmVt66RQR5zfN9Dl4rhmn8zfYeaK7EzMHg7YdnBz3DI/9Ui6GFQZEuJIhO
-r6PKkXJvG5pZyk+T42+ywdwPhIVkziyQUvKVJu9T1Ubqjtm7K2KQ5SXs3iyATlXX
-QL2HdrIicqtn+TXA/7wEprmzBboNAnfdfHrR6z5ex6muZjfRBCPm+zXrBnOfSCFk
-is7zcyvyjkacTM06kR2rIK24ovo7i1hlkJe9ggui5mcayFd3HOACl3ukz+czQE+r
-BYLYKGNQupXX2Sa8c7dSVoTzUgHmQg+reSeyvljncZ035DKUCY2msCRIMO1MXPvZ
-HtoovotrRztSqmU91M64Zdy/g73ZwFxUCJDqKZGcC+Br2Fl4dYAdYuv2+mTufysG
-RXch0IcwUlaXi+VapboOYBtSoBddZYpIMthB9wNW2eCeWGhJ8WXmTxFLBpQJhfEF
-H7M28mymgzmYWeS+O77L9CjnfwE+bFlRchPAUhbOHraWf0qfUGsL6al2DCJ7G19+
-Da3CWde8l4jsTjsGowZk8lfY8KpUWFBiMDdiKB3U5iuA0DSO0XibY2xe5saveqZC
-Co7rg3WmwIE12twcFT4PQSASMglTwv6Wl5kV5bWdonTV7Rsv+k9jduPF0v0FuvqL
-e5ISXKxDqd3oEHgQJ9r0L8sxnJ+PZkaOVD3mkKBcPc97QwOUFpvtFRXL0854Opqj
-9HlBs8g72H8jD7rikMqnoToRF59ljnyN9n8viVdcYShSMBiv5qszOqUMDLOlvFeD
-RdsiMl9xmGayeIC/xsHwfQzwqScnhjm0VUESeJvW0oLgQuhX2wQCg4M5ZgHd+jfL
-MvD7ivEQ50HPW3CRFtfVNk8I8Qo0qsKby6g2JSwONRB6yiIsjwLpapjdGBzk1a2G
-dy3tfkvy+7EHxG3H1ITFop7uUnKV5WIzzFOJKlVVDn7Lsblsw4mj7wQIbzGv+Q1s
-hb4kotU1nEhzIIy5+72S3oDC10jIWuB+P3J3//C/d+HfefCzVHRusYRxYCALSMoE
-H9cX3hYiyN68RmuzQaLEn1IT2+nNBHDlce2ok+6mraWANziqjrR5JmoNrJrKa+gY
-xrGgg+yfgpwYqy4KaTJ1W11FBSF1JpRdxdlhJnol4x3oknqRJ+3Km1dx6gon+A+r
-1iqqNfiHg6T7DmURC1ecqoz3DT5XnJxBfsWBzvAb0jgAk9GpWjBy4ROI3azvAUVw
-+xWOdEPa6B49ns54ErsrjoN2gO1RkvUHxtOeXBRwU7HQ85c1aTgtKBSBktkFXyb7
-sfDx4keXwgHndIs9ku1cZL24uYkbGyLd2nzfUDZIvF0tPOqP9mX0eM8MKeqtHQ9I
-gD+9B1CXaRMkMhjaZLz1ZRoAu3klT3oXpxynMSiRgHghTByOJ7WrMSa+8jsK8BFD
-fFkjxycw6vl6keqUQaxrO8JQhAsrQpadvbSLcd6Vbt/7u0o64RGbbiU5HfvOxZVf
-1k3YtHUmVE99xK+fY0fcjv562Tt8Hr6+fY2jY7+/udPp9DmRE/19+dNaKdVtT+qa
-9sH75iZ7h3OquWnZNwaWImlSccWuxfPggBlceBtj6pjphDx7osROwGFsrMft3F0A
-dzZdQB6v/moKfwofSXrFvEe+aNYWeWMncVK3Smki/LdtH/EHXaGCnwiRtX2u4z2p
-GFdp5tH/iFfbtcdGlvGwIosVWlxptv2nrkmcwVzEWIPxY0btA6nM+VV+wq8AZmbZ
-zkysuPmfrC8GHqwoVpXviKW22vYE84rgmfbi2xW6FByPcJmNBRIdr86w3UEACT6p
-GbkbSVsgvDbIGXLyIov6jSTaHUNmx5XDftq+31lmWL3PLUahZMrpnD2GC4tXCrgT
-ZQKnDLqXwtyeEvPpc1r9qajntHk9h7wxwzPyNOoPl8U1/b8CZ0LTGnr0RdkrVzny
-dmsmURCGla/uWVDhNrqXLXRZgMK7rolikFgQ+81gIMMdK3Ucv87j5GVdpVhJhNt7
-7k1FHD/RmUKErwRz0H3ggGhMLTF8dRQymYNqjqQfofcejw4OmspCJf0hTPpq+t2D
-67sCG4ZvLzvBvIIvU+kwW/+YWn/eU3vN/RcxkRLHyIgV9NNgSjO2qWzV5bYRuElW
-+b2VfdFC7hkpMV7t4Scf1eikFIIOHCQXiTcc5nLtPoDM0N/YBp2BfLO/LWQDE7Vg
-/F4Mx+CU+4MGyYvuJ6eIwmTS7TJvTLP4BEvsIJzTot7kFP0DyXKGlDeRTYA6qmu7
-FomQYvPA3EKF2tSJRKI/pltUAW1Qgd5noS59frw7ntnX3RAuZk+mexv+4JKLkY9c
-kPWUf++EYGCiQ4LvlvEhMofC4JwnVx2cC1uqmMq9iDBgsHOqNOP6htrq93x8JaqN
-hdE4gpq+CKy0gmiAMW+7oiYAb7VNonvAoR+AKJFiRhCWPFvzC+HR6O5f7aErWqGs
-kTw/M4tU+yQKm3zs2ismphBl3MgQ9YZzjDOKcJ8SJtfaNlZemHJqCqJJfz0LCZOk
-b0VLVh9tipTAg1OClZtiyGZpzeeLHgtGizzQ6M7K040eUZ3KLWCxuDQvEmlDzp1P
-DwVwS56WTMc/6KURkPiVifRvzlaF2iMJm7ndQVWGOEnvwNEhWzl9kbeMgsXTwvh6
-dXfYM826rOuRwpzeWS/qJH9ln7ZefM1fjQ3AV4z7iRowUM+M3RlyaU0Wm2TYHW7N
-PV0k7xQPkaOrJhDl29EiydKZItSAM9GIq5tP7dWe4/G4JpSYCXqxsqZHhWA7I+T/
-TJSV3thDHOhjImFcRR8FqaQY/1d++swbW+wSMZDBD6xrfz9UEfloVcwy7461xjxh
-DsQh7MWiKJwJaegaGTVYx6xPgfqH8WhA4AqLuUa1QTJ1ia59Hx5kzlPvz4QJzbQc
-cs2nFW1yBsz2y/wleyj5zZE6D77H3xxgn8g0wPtZhLaEJuxwgLB+bnIiZWZ3sMhS
-1v/fDKVPClBbzmSprku9cVKmhCn75+y6wv6hO54MsVT5X9GX1iLVqzwipi51ZyhR
-lKiz10IXIQWdb6NyxCm7hgAOd6VNrPBAGXkfMONpoDX4EEr7lix+fz45fs/jx+gp
-5h0mr10JBWDYOPLJyAzWdXTgzKpdfpbCYY1aOslLG9cBmSmwr/uUPRJiRxfyEITm
-qaNM31VCV0HtjsOPnWn3N/35k1NOSm1c3RvV5Uj1DsWuuE5/CGPgxJgnIqVwUQwu
-9zZw+3Q6YXCJW+XnNunTmvO0up9qDn0CmZOINgYU+phPsIOVd52u+Igfs/vhYBHf
-A1jS9KnIAQUFfCTqHxAx+BdDNzHRCqqV7U1FJn/VieuW2GqC4JfZ9ijEs1jFE1kA
-sWHkRJ2Y5NSjV1+inHOkiNF8BPKVAmERCzsw8szGgDpUtvvwrvnpsPZRsdD4OPs0
-tDXkNe9VzbcvuHzfQrKKVYu2wQMntGy9IMwGTMKE2PlCcnBZbzcEAg4g6hFO0aoc
-iKYj5JI7To0TtSB3EXEq4TtniSZtahOuESBOPAxlSpVDzTqOzLPy0QgErxYaJaCd
-erN/CvcLNVLzLsNADP5AjKKDKd8bcJmvonKLPw/tu5St7pgqLa8GYB1erxL1jdgp
-sQX34a/usMWhoO1g+d8Sw7VroFxC7pCTjyW01Pe9E0eMDA1ogIoPJSD/1R9DBGmU
-Y5lB4Tb3gwiLBMRbMqg3qHC2TwxEG1lbVwM3fsoZzy/i6fAW2aklq571a4C/kHUv
-ZG/N/RlJeAeNrHj7O503DXijOFmaKjdp9y0/IF7EjZXTYxLeesk60al+HjMJJhuf
-Ro+109HQhoa+/FRC7naqYsai3CdkyNGhcsey93fJA/toTh4PeKeiTH+awvZ2YmNH
-XQIKcjrPd5EkCgmzfv51cEyyOdAoBiU5wZgLCnVESkHhCRI/TsLI9azLl7TIEDNf
-3sjMAr/YXHnz6LVnThf3866hkHq2hMjUIZ9jA3TsRazBU1jB1LZ41R2NyGA//B9p
-oa3T0fdMIPqhxTsdOXPmVGAM+uYulq7Gk102NY9dG9MfebCpa0LJ2011xen5js9L
-ZmJSsK3/SGXb7gESXYDkiXJFU0rErHNDQps/8fPRvFIKYHW5F/LP/6rXuB4lHu15
-O0WCFjiKs+Yvt1HM1DkTuhe1xyBeL7cL2WRiwDBKonYUTQ697g5OQY1+7aIhC2ka
-awRdettbGYYnrtxzR9ddkg+M5nXJjzCE0riEFVJpsOm/81Z+nPFucBshm6CDFbKJ
-QnXLG/9+M7DGXZT/HnNtk4y9YgWGWN9IpWR6Tf8ibzW5jwBvo05p0m0YGXdXXV+t
-ZKhf0Vu5ghpmJ+xadsMfsYFHdC9M5YOclsjMBZYvrB3YuDiswjm61gI1dkACQsdt
-Ztn8oTalACX2NEutOC0cvCzDqxMxpmV4W5+xhXJaVPQrboZv5dhxoRkIJ+R1qUa1
-JKFows8d2t2180pz7PU7bA2sHaebFBggOhsH7QGiaPI51aP5OxAifDRpAqloROiC
-zcn1VHy4TNl6o383csaslAzUv1Fd30O3gUhGDIUwdUkKaASSaqj3Ww92icWZB7xb
-/Qg+TQiLshC8iZuvgvmepCWAIYqmtihaIK5AmqS8CQYbm1eglTzDxeQa0XI7KYvi
-tiXU76zdVpggcmRXDae/P5nsYu9NIUzbXe6/8TPYcsDoKvSqikAvSpZElOCe0zyq
-E3SghcdxfOxwrFgblP1fGaOzEAfzW5aDK9jAtYEYsC5r0D1QD4rknwtMGSITCoR8
-qVANHkL1oayMs+xDxQT0GrF1nQyxRnxseXYcOJZMWZLyjuJGej8oOL/HoXwWLowc
-9Nn55P6RZ8HyFUiyqzRo/JPBRf4UkPuE7QWmSyy+/wtRpIi+69Si/rsIx2sj1O7v
-OPUfmw5Flhw3HPJ4tzGDC/yJlw4yY5CkzUC6qfMmq0+kaKJWxcoTC4JeN9RGc9XB
-rOvyrAaS1OcKywYSh6AlERDEiL1k8Sth8ufHHQant9Vhvba/88qz+ppWA9LY2+7E
-WGB2EQ93po65+FUpRwzJJLQfC7FeOgZ8J4ue68z3wXCcBS6ahV3dHsjCJ88OyaVq
-mPi8HIkuCO4Du/byTJpde8CzsH5hVGlW8dk8ZZydRz+VPOsFHJ+sXJg2MFVGwQE2
-puN49KsuAEYQHXI1tD6/2dic2mPnH27pADizC5JMUkWvbGSr0ZOpWbcnYrTftxnR
-67yM4mlVFbW3FBSG4oI6LPZIS4U+yd3RlJBSLRmFWXwZSLI2HhLTN7yd6KvTxTch
-CrAS6qjfjnpmHjYSc4JJy7KnB29YwWbjVnf3Hqf2UEqubWhWVpF0nn/6CEIiqZb+
-pdj5xAlps/VY+ykYn0Mb1mAFsA2w3Sd2eORxmyIMEcO8H5ApfOb1iLe5Wz8yLtCZ
-JldhcuV/Lv/yBhaE2pNymCsprXu3toUtcqyZcvKf7xHshCqIqNWrFxupX0hIvUjz
-7d8NN9Umn61yK5G4BNkABb3bhyxgBDuWXMth0JB2SqUcncypc6YAcxRmC+KK3stl
-+E4/ULe/c89m0ud/Buip6cdKWwWbIoLzci+VTtD5yP+OrjjiFmVdg7b4FjpGRtfX
-rJ5xtB2B0bA3Wi91BgLcK7PCpgkJr3JPQ6ISeAM/kEXSFJpAECc9RcK/HZIUy/ie
-Jro+g2VyCIg67AwmpJcKVQLItye+A0k072/VMpEfNp+t2B+kb/MmIhAewSRG7p/T
-xl9SFsYWJVota5zFn+lDhOOnNeYu1j3kCURq4V5hjq//2AEBXwnKSGUbyjCE/DhI
-KQ06L61G64ZWhETPB3hFHP7txvbV+hTepof9DL6l5MJBESbnh/UAIBSPpcZLXJKu
-PjnOimyhYq30wOQaoekPlDrkxe56aaat2Kxzmukiw8WYaK7hTlXihT1jnJutsgkG
-YmZdeiYhMgz78kS9mJaMt+82KjzWKzPFziVmXksDjKHNrsgOiMzMWBdaIY5iYZfG
-4Nev7YiA8EZAtYBoDpzG4wkcgNx84SCJqxMj3EJHKrnpQaMuQ/48f2qkSYTQMgZm
-TyXvBzSNdgWO/pOzxA9sG2wgGbZ76JL6rgD9uyCq9+b/G8qtZGajg1VLhSFfK/tJ
-HFPrr1IceQMODf5rBRpW1bEFGBxGu+kqa+jRYxJb9uSzs/Y7qSRwtpjs/MfBTkd1
-Az0c0W19/+MB50gQHFwv85AD26TVfzw/ue0TdgZ3yml+SfF00+OKqFVPZNUiIMxh
-0tuhgMievkPZeGNjZTvoVnms0ff8mRfEi+wvt4EXFXOXA9UHLWDBmTQTTS5Ai71G
-rd9G74LFkmZ/WM9tIex14PR6WZ1g0H85tegCvdzUrGy9bSs4dfXlXSjK6b1B2whK
-LgmOvIGsMLYJaa0fpYTGpV0Trneb4q+BzXEFKmnnIsleRJUjsKIkjOZc3Dw/Gw1e
-Ie7rv9Gxu04OkFh/HR83EjwGSLdnhPeUbJxElaGZkxEIKE9f+4IhTR5KsR8omgJb
-h50b/FpoGTzLk/llVKZE/Qio195+7h/JqqmUsvOK43SzAfHDnoNC8aaIcNmC4DL8
-SlfSxc6Jxpxo0LTPd1MzQlBdKTxBi62nhyLNkkOHxOuRlYtvKgrsTt4TLdA8BIZD
-1Dp4tjj0wWyjIJfqB6ypktvLNN4jjEPY2Ckaja1v5jGrkXjcZjpOOW+Dp+olfyFO
-SH8kEg2nBDY5HTho4RmE4NbkvCJ2wQqW0Ak5UMaLL8fTwmJr/cwRvyr4XygfSvOC
-ldgDYrOt+CDn8j4JrR15RgGGpBPSgVBEnSTMO+rRu4ci9T8ocUTmUJAkNbtetozd
-v0Sk/LZGhshAq1gnN68K36yLQ1lwt016KrWNxaJqWXthiRmrVygUqxlCwMmOVx/8
-AkFMQ4TVyv2o2ytLLXVf2U7I25rvcdwFHRXBuVg3rObWii9GHCzbGFsusmn0E4lp
-UTBtQvwIniImv6IxwV4CwQEcJHtt6UxwueqvvQXafhsGcexffeiWNo37g864/cYL
-GLzIakejNC1FcCj4g9gsMMfWMoNHnBN4Zc/2ovZwI4T8FTvP1CEUKl/L4UTN9eLN
-6G926joauCF5IuySoFIchz615Jv/aldCIHB3tEjrkTFPQwpjivm9tdG51kpPNMzc
-ym+oaSXd7WQlMo/KhuibpmUzcWaay6v7JG2LqjAxGVV6aFKbCEZXMVukiK+SQgEq
-CgtjMukSCC81akDYLme0Z1HyvihEz7QwnXDEwFKRRLrOmKu4i9nbbeqwWba6ng51
-yk7NS82uQAbIcEsn4YC8Msm6uCSVQsBmvId3yllg5ppEySObPd0lL/B+zcycaddq
-imOrtwp8uvpOqG4xcwL8ZBYf3OdhcKaFoLPWGMyMppazMtTz0Ov9ccxt0RWlGtVZ
-OjPkTyAnE9lReMUSLmmJvzjXU8C/6SIirWHr98B7Z6XCUqr5cnPWduq+0BWU3Pcz
-CrjEU7LzTlk6dLfszkwvqZwP+1XUv038IYJLZmSbFqJsKp+1EaNnXROz85C1OdCG
-sA29pu9MsPjEd59Zmc2x9M/p7rpUvUhX2+8Nc1lHUkcJasoYgheXkcRRtYgmewp+
-WT+ynBWEyDbzRm1Rgglj+oKi7m+LJzkl6y2ihhktYYoCh84mavgxMg78n7u1FDdL
-sv1IPIWU5SF1NosZVUQnUX8TJ1hzbIv4i4oqUyyaBHM53pZeiPkpWNgzsECIdd+P
-qLR5V13AEeG65q623tfEaPXLYrl9zrAMJ5FtWOYUoLhHJgFyygNt74QtweP7p7dN
-GfjzITDiZDPvM+ZvEzZEadJxD/lhSTJbaBiYUoVxEXwfaxJTy3fYcnwXl5jXDuy3
-571PouVSR7AA/pWIZT4k7ubnp6LRZGAu8GgtCIcYAi2pT5nMOPvu+vk1dO43vPvY
-dvqzOrJOkpOxXN5kVx/T7uckYnDAXE/9SD5VBMmUERQ9Dsp8QdhwhPQnAEfvwLWa
-tLJ6nYzfYzKp9XpzHpZdNPM1HQ5YGWffOjRKWN3ZOpy1Cakz3d9nN8uUPsF2DRO6
-n7DwP3e/7Izc3E8rSu75C/XsWDUFgOSssswKMg68jM8OCwAXwJJsEzHCiuppCVW0
-oYn0xm9h/Tvm1d8LchCHFhq+V2fN0BnieWAkHixN3iT1tXU7f0OKYBo0XQROW6hE
-S5/QSKUZrVSnS7XSB47oRQutFUi6Dtk+IluID24kEk/98yAITSvISy6KGtW1fSrf
-cv6yEGB9y8Osaa5Fl/rGpCPyhw2dO7e9n0PlogFmcvc44ioFsUMDOAeRJtD8RHMz
-l9aXq+M0zmYduvisFbm6GfU4p32fK0EGt22PfkSZqmpTohxhs6tD5nzVnHzIIr1Y
-18QOwIQxSufHC1JxsjEja3Icy480dyIY3gGAi5h4fyj1NlOIYWl9hyZimAzQoPWj
-x2VTO78iOMV0U9TOLb+kVdF8kEerySwUpCl6IcJLZnMGkUbJ/dDYGOJVhYU5lgHO
-p5xYcQKbK8SGuYj2j1ZLHQ/OHLPOsfKGMzOSRzmfiKoCebv+HEKZcWVCt837fIPZ
-sXCj99eTWr3Y3vFyX6mBhvE95OpVlJVgkWvHDZBJmWOf/oRGMFNuZTxuvscE0J3u
-eVKavhV6X9EXkCQ4iZFCb2yWAXxDpAdzz1UmXeMiu0Hx+CJ3k7NO66tW/wb3jZ3E
-tFHusCVNQOyx7/aqpS9yd6UvN9txCAxvwhMZooUHtdsoJaNmny+n5j0w6i0MuCH7
-RjxMVCuXU+NsEFntMA9PtyGgl2fDaa5yWEWJARACNBapE8aauEvS6fIaWefJyh8D
-9m28fJdehkM4ftFHfcfZzyukhn5OJhGSFBjC4SdnEl4gwNRE5kqIgvRgtPRMJPK4
-xUyStTB/e/JaDcz0MbtMGbrHT3J5uVjDSJQIbEctYDTWEtMNAUn1mV2V4yz2gwP1
-QBtJRvEKqyXctbLZ9Ac/QpYsiyY/3Y5IpxUz1K8F2ZFcwynWODKByH2BlhiNItsK
-2cizmXT5atL+7FIb2tF2J3iX+SKbOg7UOVB3idxYCJFVN/Go2R62g+Ty8pvILQ5m
-20mvSh4WwSFlTatKeoUWMyTef46YiUNgYvZp5Z1W3ehek6qD5VEZHNI/ziQYKrl/
-MGEedVxzi9YBxuIuR68zroOFj6eGsIFMAsJBoW/uaYDTVvsQYN3TAGRhnyJCn+tH
-+DPRYQQ9Oi7fTZY1S6mv1qSXOUiWeN0Jehqi7qG9zoyDMh9tpg6/2tP+fJGnwqtf
-t5urvEUjG+D/NdZh9GVmBvbPv32tY3onvjyLRcqnMrgMh0C+zEOD4qxMVkppX9xU
-qUqCXfE88kmRsuCsxTDOC0GBvKGBKau2OwtHjbFsX0F5oM+GjVJGYh/nDxGgTQas
-A/w5IRN9zI+/6qVKU377HlStPyQBpwMo3Rwv6T2+p0i+rKmCh09TNnvcbqs67K5C
-02eVSaac8Ks+zR0XfrUYR99SHUoOp3kM/nVEoElh5Dxsf3ScLrpLsmZpkSdnRLle
-r9KaMV74LCNjKbnJ5uLMSCWZoej7z7g5gkdnNaBKt5pTx0OYV5DfTlU0NqTYDTdo
-5TOrvrSGWnpTeVuI9wlTE4Q94FEBeGVpZsAB/esztdasBJDadgZ6rX7pVrf6nmBF
-n0xu+pUk1qzzWYOLLWzIoLNBVj58ylMYYluQwMMnmNi6T4LoUQpjesETEdMykSOw
-32B+bdJO6ZCRTuYBhdhzUzB1h9/ePvpIBAAYcNoK9zDbZ0nlHMd1fPKKaRsf1F0Z
-H9/z1wrZ7AkgMvThAiAD+Qt7aarjd/mYj1cVTMsPMnQ+kjGcNwy+ay/TkuJEBSIB
-H6Zfm0ioxVo7ITAAE5SAw3efKySA8MqvxxtlZf2ILI/V/f7VcfFRYGhimyYGHrFk
-7zAaejktaJeyol8m52opjoOiQv+BxOZa0N81TEOMQJS57nds10PWg2aOityk9R+n
-Mkf2+QPgbrifIPr/TuknC1+7EG29qOJgkAxt9Pu7GUcPSkzgSNpJWAJcHYREABOK
-wHCGCriuH0d6pDUcV1Ke7YZnWbyvP5mkfXz8IWuZsXhrYbX5iPct3USEaGQuSDiO
-f9J+vcjZdVr6nMdNmNZ6VT4YBGoGdY+/rBz54eGwAn/Rfwbh61e87g8Ke396935T
-CdSfH0aewGDiiLuInhltUpwkC3tLTmj3F+Fhvanmib8NSRCGxfhgW6LNQImAeRz3
-ZFk3+gDtxi0oOVZkmMoWwDAHgBanONgPYbEc09/TU69a+9OA4G5HNAyJB45HetZ9
-9qtyw0aXMPnTvnDbpCmW5r9RcaryDC6ghznD8vUGIHJQllqsG0TLmeRmnvbS/AeZ
-7ge6qRQsMdEZ5Tm4qUMBx/DJh7jrQIdF7/Keydb6qdQoTURxiFTnr73wLLtTAB4t
-MJCbYQSnfceNeX02Z3+qFiTyVUmaUk/edqaSTRqd8uCGNuv/6UjuRi/5wAtUzWVN
-2+ALrcZ37JZPXr6qdTj/SiibWAKDW9e8Mnhfj3eUW8nE45cMbh0Ghv1JdrfzbhFQ
-9+NHlqCfYgdEuJXI+aT+7uQ5hqxd+roFVR6BEDM7MeKchW337Jio2hGStROn8Frz
-tWZxTd0PixOjzKIP0WSUAJzYdyjaE0gi4SwuV9TiisqdkEYkKHMi+5FE1mdEnQ3v
-ZtO354FPUji45NekL0O11kIQEU/mRRgRaCjuIhVwLbX7Q4br47XKkvPXg1hJ4/1f
-JsCFVi0LWDEWX5dKTzM8n/74fKoEF0/ZQQIJOrc6WAHxFduvNaznJ/tdpxIj7+DL
-0kinLTsi4OxngEyMXAgjyrp8R3Q7HkCxhquUvjCTzF6u6sI99IIbieww7RvW+d/8
-SpGvELmRHIOPAlBCOzkon3IoW4uCp3P8uh+9Vh39aWCbQQM4yO/lntzo0mw1xJZm
-iJgZj/jJzI3sVQf7WE68QGTi+Tx8RTn8tuwGSW64B53tG+C5isjliqE8fT5pDSm8
-gG8PrLTpqPb4KkmQkeR8xd0VtdymW35JAii7iGhECA8ehOoXh0rkfVJp3HR1cBfq
-OqnkLX5w/TIYKd4b9VBLYTZb7VjvoINP4nbDa1CRk2zdpj8EI+5yPyPWCVL3OGHT
-HFa3awDTRPlKdYWlpQmV7XoW2UeD7xLScl0fLuH6NTfVgF9vrNJ6VObwrLbUJjeN
-ECMGEtOft49hXd7QQS52X1U25Vivg45uxfY/kb8i4Bqv/3GyDdd8oWsoWcYfMj1j
-Hq40LZE28JJ1CYgY17oFIRsmGK5+CyjPdRv1RrPB4rKzjz+T9yWgLk9YOtVQCik1
-x3RMSvu7tZ5U6aJ6VYFE1O01YbBvMYm8laZzO2t92mKTadBVBxBsiajZV31+DnPG
-Oq+m1LwEXJ/22V5pAZ+DpkSiJ5XrozpxiTr51AZlP8rLDsin5MZpU/EegetW8U9X
-d+WwMF1uFhM/fZpaS2rBp0E84BuRvogXaUlYG4HXgDzMm/azFXxhEohdpfz8PW7/
-zbCyP5986DwBl+cUAFe5WCnof8wTEiZ4Av7d9C1n8NWbrhBG5RRpIUbIltsyLI5f
-9vqe0pvZ+SDTQdkYwcfh/VFKQ6jsMMPULM28f6Z23JE4TrLMhPUnz6128E8ko+tN
-dREpSkssRyJYN4WtoXJ80P9SgE/L5mSNexa8y+aCyl3wl5Pjc08F7kFORqR1M5cP
-zFcNFQwnJsi4PtDB4gI2EzEn7ecVhfI05TZXm7lZLKCkmKJKmHMx2qc/t+mg1S1v
-mDpWkCL4Du0ZCALhI/yC40Y1kP7ROgd/BmimNWTrpbzhgAhBztDc00DTcR/H1MJz
-cyOp/5iYsHg1jsyDlYn925TjYCJPvRhgDEyeW5UVBz1gcxzH7VLN2UocpCPB7iYE
-zkvHXZFjku/4s8MTu0RQH7q6stCEPG6ywtUFL7kXCmjUWEbbxdur0xyWqZFj/IPC
-NxAB2M9Y8e9z7cMudy72GTo7/eFlYos676NIJyk8Ezgii27bxdjXV8CvELf+sNE8
-bOCRPnRgmzHe+nb1SjBMPeAahIS9Hb7NNYxuOj+kkE+rO/CRnizysgLdWqqGOyX8
-fF4pBi927rWI9bl3tfboaXdZB9pgj7qT/n1CNvyBMX94wvhGPnYZ9cYxMtz/GIt7
-GDgHSRQ0gB5RRaGN4Ewr+Ai6eamY33HvFGCk64pctWMhEv4AgwtPW38CWbB0E/3Q
-RpkFi2djKyzfSB0AIdinyt1MDwXl+xYWi3WoTEx+cUzwTKkx5gBsV6AeJP8pq7KI
-KOCqdcDl3Tf/oqJSNoIfKOfmVzo9MhveLw9pFUQhuJTvBk4i0tavByqIokO+OvC4
-vKT2ewgX47bmJhd4293UONJdvvgSNPtgLs8OJYKsbY+HXDOWMHxOgK+OZ1NUM2ca
-vF5+3hVm6Ij5UdlCNirZ1Oq5tzYHeE1emxaC9eyIcqpNgV9rKQEJkJlk7xkGoOPj
-U/V6ltsC0RRc2ahRIcL9kQgEEpf06b24TBWmTp1S9C3sOwvB4UjQ9QsyTnt1joKp
-HwmP2FjKjGSNvx6xGRqTKLGV9fePJohdhkbhUZb3TzwC8NCzkvuJUjru6OD7VgFk
-b5v/WYrT3JSgflU4Hy/QBVSHh9KkbZBfWbo85IXwDCAFb10eUBts14aSYQklmvCy
-PfRbEL28aaj5CMEUGyI2Fgrv3muebbBoGNk+HNPLkr3BooxWOwW1Nzd1ztcOuPjt
-cCHPyZ6atZ25xDBUbPn2zjwZ89Ozyq4Mrji/JCGVz+z0lnp3jLQ7S3qnltl4ilvZ
-cW4cvMYV5BqC9AQj8eJRJQiiPGhCaNHunFaZvUOARzSJgurVow+/6xj8tfSDTjz9
-IISj41DVZK7asvRm3SDvjIceUJyHVd5exXBXAdyMXYmU9lhoDKuWpRG18MZappEI
-jYhBLeWmiyRiBtPg/JdkU4XCUVYyZhP/vv36Xja9+MQBGqtHGMtcx9sWZg7nPqHe
-He5dxlVS1GcTKI3BaXq/DrB2SwkH6gUksNnfmnz5QsZaf8J6lT7pdeL2T9g5drCY
-f+pm7/UAQFKr5lCKv262i8z81W7Wa3S6WvUaSl0K6oCtA07Wv7gx3nFIRN+DOzib
-gXfnYkzNyuynG/6i44smuK8DIaAtYNEOG/MmmfehOU4t8vELG6ORbcArrr1EjG39
-xnxT8Xwt3QlAn1Jgo7APXVrJZpwXs7d22410tyc169uT19lPvt754JyAZlJOJvOR
-79Yuwow/uzP5wHh/4C2yKR5nGtI2cezBjWFwI3a7QHNkEhYx4H9nPi72gz+zxMyR
-4/ftQiWjYWcjBFBrKve0E0p3cnerzSznNI15dfyBGMFkGm8Q8Yy7kH1ax6KaCNA0
-KjUZVQxEsRNCOKRsjHUb8EFN1+jEeVKVMKJJOppvGZdwxJ7S3xHKbwOPMsf9iDzn
-SLihModxhXb7kpkIStsDl0CmbHWlpbCoSoiPFYWZUyMESqpBR1Ti5I4QeG9ZQonx
-xvfbTN2EjNlNKVrZIVulUJC28z52p1OkRCKJ3vAOoHdJMDP1WDYW2hxc/r3uXtpf
-ixc2oSdPD4VBxpmHuxQjTZhX0t+Db1kXZrV9jQ+HSwgsumx9hfJ8qksQrIsloaxr
-DgEaiZEMQH6TJAbT3lkMdYmfGocb/tax9Mo6jl1qYEU+GNF8iErxuCQMJcY8AUO5
-MLWPxjehNdA+3xuLPxMyF8b3aMegm3OeaXG/6sOFi8zBPCmFkeicCCPBAX8wSMBb
-hSHUUTAkl4MtABg4TiFFCB/qMG/oFL3/wUZBwUvq4U9cLDfWTC5N246SXnSJtB6S
-xHmw6BrozhheI2qoyKaL4HVodIKvPeX58x95tqr3CLCw/WZyXzZ+yOA75MyRW572
-7l0e/L61GYJwc+ILLAL6YNv5XF2lcxODZO1RMMGZFXPxikKUoyVZgUDyX65INvIS
-hJ38m8uBBK8Xbb8FjC2jz8Snv/FgTRBVAsC6uOzghn3E+1yU5x2dhSwAmcTj9mIi
-neXQ1o2OQ/Ghk3aZ2stIr3LugTi1STPaMy5DdYrBC+NMyB5kYxs+uw7cge37jxSm
-DDirlKU6FHqCv+n70/ey8fp+fqi/KyBByw1fc8kcVZkuiUA6ywvd4MNyNwbPekP5
-CIqE5txsfkNv9oRvw2Yo8a8bYdJwKQ6xRCb3CaCRSqO+OTB2zxLZoi+J8fkb3kJU
-W2UCkqKNSEnhTXo0v6fe9zBzvtPc9sCyIsk7qvGrYGINGcblb+8imxouTv2zBe1M
-DGfBFSdIfgADrFHvWQQ7oXhBm05zyFsTOMMIreQ3T1q52gKguLIHkacbrD6hFkCb
-6dDMzMRjKGqxQRTJzyjqeEuKpYumi0EEwM0eo4tD9hJJWPz2AVDa1BiFTpdd8b7m
-2cggn7UiQfbG0mel3PPM4xiWT34UVxZsLJaz2jeLXbGY669LF65AY4izyHtdICl2
-2S3RzOIBB53AluU2TdIwr9+bVjzlme1Joo1OKjDXoM1zHYAmG0hkYpakuHZazlpJ
-kz8mai3eiJ5zfZXLm6ps2PrtANbWeHaLqAhzb+OODHX+f9RyQMsPl1S1IGa2U+ph
-Tp7LVEAtLR9+tfsm65P6XEmZ/BXHcsWT/hIBZHeObUFK4qIO6R52OaDjxEqYiC4g
-tYb3DQbIC8SPA2NNPA63lBIt6UfhKdVQMKExEqA1CAtIO4+rizMWgM3Fp34k3lsK
-dfHyEJ7IEliiKEIP6fxphUvwCKgX6hkcET9jPUozC89HkCg0ITEYUVE3VQQx9pe8
-u0CoBwTl+PLj7V+jtmhYvzfDCHNc58ZJmo3cJURyFtvdTdlQryYG8gV1hJl3igaO
-FjWsQFtwp1tQHn0nOkGmfIdfJTMF1RL1qN58XG0wbGrSCbL227wIapgIQFutTbNx
-AdcULQpDJMx5aZPyBUMlAsXsvGwUbk5cCtN3Ff9E0dFUrzvzbNPwL9nsB5vI9YL6
-BnEGneCcLnM8BX3fCbDuqCWZPf+gLwIc+xijY4+fnAZpEPE51wphjm5GbVBVyGYk
-+QN6ARWPfo58iwa5ikH18BhLYen9TOVMXqsyk8O9phybU6UzLkZjP3bcoVBgABPP
-zXo8R5wplOJjxKmxFVZWNnbMK0Qdt5L/atz3W97WEIFNrfn6ThVepIvAHh4G3MuJ
-Wg2ASKIf1iCI3dg17O1ZgWxvN48UXZMRa2rIH1R+kApeLvxPPSOYbI07WeeFG5az
-IB9YD7HIgYGdc4AiAsa7dCzztsEhQGAA/2tJMqXCtrfUKJuzNbkyuPda4LNRkeo7
-AJqiTCTlvOKFRb9dL6IMQj7e+9j6Mc8WuPxicWMMs9ZzwDZ1Olu5BCZQ6RYgtZrg
-QgN586x4ePuj11p74TDI4gblkKJtptMJrBy5Qk5y9gEIW+ykRgjXZs0kA2DbZlmh
-wo3t5EhVSlj7YpcXrtbKwZn1uvuovF7zLHBUPKWsQcUTBzxGBB1SI52DGRvEYPd5
-bNoUglm88npbpNsAaXY/AMJA7d+M5duUNom2XibrJE9+kD58WwHJPGSiLsVwIZAt
-VgeI+yD4TkblSbCAoFmYoSe599LKFwbhwbFo27bCxNb46LqJiwHDS5MocDN+Li2y
-zFAiDT5rfMrIRnFJLrxw9Addp+lGVtAWVHEcJPSVQ+rRb1rvTD573LTDMPt83v1n
-fLslV6r5CMwCRgcGkgZlXb3JxXf6aa0qmHcZhf3POM3kZtQUn2H2wEEKg8XLi7er
-keBBviMr8Oo41fW5wbIQLqU+d+22ML7ETKKF7xcZcWEDUUE8yNOM1nZfKcP8OTyo
-gLhTf7OQZl9xjVhsFQOlcEF4KyTJcaWNVaBqq3tTHEfzacRlQzUitdVm3yEIRlHx
-6K6BBp2cXSDaOqYQ/lbPAhqu3k1ilPMe/g1qScSWJHZCJOo/BU/f8pIHLYKdozQT
-zpOQA1aEndECmBPyiMBxW3zXuysTMnY9T1n0EBmSzYw8nHdjxPbuKbG5oEGyy0AC
-7QfLW2Ad5a8Sv15U4YGpIPIAX5mefXUksz3jm4n4EqkWwD7mTFdqvT3X6wYBaQEH
-3XrRbFMmEwU+birra2up6bEoDvkb7SDbnbxBxztEIvE0tr8t69HTkBiTl4KAA23F
-+kMcKLuWxQcm6bD/HngFoGq2mboFgyUPaqtT0Yye619ohW509cuk6+zY28tnEedY
-S7iqnfztVzRZ1r/uJBJEedje5w3GeASoZlh6PXnbpUFPKwhisnd8Y6AZnlaMjFpR
-A+V5jtt9cJHZaFKj8MAUqXAOAD4K1wWxW4qZk3983hQKYS2ohYSawsG1hZQ4YaN5
-1nej87FGAGk3rNcUI4YZKugcvyDL+eXRMxb/IqFtJM4wHVZjcgc6VSREZ7ZR0I8O
-Zp8+ZGpMDPzzRSaHjKuuBl+Uasqz6yidZ2XH7eIv5h1+JNeQTL9/FOna9AYNjd4y
-uQu/lCtCgIkhKUVUjIZaCBH9L4bUgGXNpVlZydXajg+jTUkonAmgfAuLoZrhdB4b
-8sbOfqf9vGeL3GJJKHQoMF7H8GgGVgrt8PUkwbmbGtnHdggvFPuwarKrp4DnpHD6
-OPL+pTuayWqYd93MkWVrvbko57q8sXXfA03bQwU3sLCnhQupXmYY6AKmlnfB5KSZ
-bhqVaqf4D1LkqFKhuQGqY//uPzCQi4zonrVjTF432hV7r2kO6JXzExQUS6Fa/1Xb
-w2k5/dCV8Ei/kn1c3kHZyDe8DmohD9JncMuIRsBrylbCSAvZ+bOB/Ag9m+1M98S2
-/ZEp2Jy3aVVlIatiZHkQTeVxwch+ef03r6pwL30VgKql8u9JoTvmsFRuJzE5OA3J
-BSi5JIYOgQDu1JURRVMkkpnHOg/8BP9yrzeCBtHf559teqoZ14tAxdbf8o0msv72
-mmQlcYCcJal29TjC0pWaySXuWDzSs0PqpKrygXTPKTJ3IgUsJ6zFNQQJkDvR2rsI
-IwnYfRF9s3CPZ5SYZ78dZMdRtbDBqo6gESg0qmrzNJ/f8rPMXeh+Yo1UEdB+4v5o
-LRpNORorQ2ZbVgldjW+9i57wWvfTXtvvADLj41HlqwocVgf17zt9geOwUoOWFRi8
-ue92YS9GzkN6YRmhOSZRlbDDgEidp1Yn4apCCXj2xm4Az397NeNZ6FuJEsS4Eb9q
-qm6imMrO6tSXCjk4t2qcx7Am8H+Tw/Z43yyyrJlm3Hety3Wj9lILyRipZVuPj4fc
-JJUjnBJTMepYBHts73iUfY75OqtzOVJHs+eZl1s8RK/lxY6lgH6rl8TYFjGRYOEE
-o+oUqbHH1MM21dCl8dGXbFNojH4oCOyMIlUasdls5s5EPO4UkJ3Gg5SRXj4EE/LF
-6HyNaKwUY/hTe3dKUMhRP7A/uImXCzkcfL/HACHJ1iOn8p0MYHiICVsiy14ScC7y
-kz0bknXrVb6k2pu7ebD8+2aH2C1MDezFJ56mDoKJSSDNwzgM9cUkBA1r4jZjsk5H
-EXHfPWPBcmTjk/i3atjk0tMNtl5V9zW1f6+FK9LKO4EhbWTqYJxilRCZwDxpuDET
-NaiZg6qgYMnB1Tj/imbpsPoHR893qCsqRL3vY0hfo8dYfM8HLm9SLpOwR60no5uy
-2HKYPw/dYNCHkMnMfPLeU/nK4zj7CqKgklpPxef6zQNiBm5dCiT9gnPSEglAJNzS
-UI8Xsf0dQg32wM4UExTxI93Hu9YXvBEMop6icH5g8bg+Bb1y1EPDHMpPB4BGmCyU
-LdHqV1qWm3JO2zT479BnmgaUDmLmOW+9FhngrQEQr02+FtiiHJQDgSMGBgTkmmJ2
-KBjXrGmckcNOrzWokPZv2goS4VNo7g/RZnVlmNgP04w8s7XQK53vq/lCSimyHWAJ
-p+tZODyWK+/yyeQMtSxUTkO/+am57al5j4BzGQ3nJ+Juu2X8ZD/s+PE5+RcRqoEt
-6QjP5Gd7A23/d6xbLUJISanNuNGjn3D0Or7oFrPuTCTyOR/2BlNzQdzEP8AfZPKS
-cM/Ca6UD5pS7ow2uXrccIXmMdAtz53wCF1BOdHi9vW7T0SetnwgL7RKaODXF+l68
-VsipCoz2nSE+pjEvfE3z6/FOUeguF1itnsRYbHsNPbjizbZhW2De7ceyJV9/tCRp
-wlXVnt/WNYPbgKzbzkvgiYCukSj0vsrqst2J5coO3cIiaFvfxTrQTG/chQtodyOg
-5GeamcoIqMaxfw+ZKxifZEIav8HB/zUFHqNXDf0gAop/3631ox1a42L0yfMhQxbN
-EJrcINFt3HBkvQmNMBDNu4GT9rWuH6YWHDC98u2VtcWVFgBB42rqgUYrSdsggvyg
-ijHT/ikAlD/J+/dcAHGl6GNTPHso+Y/lYqo8YTyM0QvVzoDrjYyh4QC4cdp/n6pN
-HztZsTI4AUEphRr4ZmSFWtdFKvgYlz1LIPJS82M79i8dXn894x5twLdjIDcZcxy7
-IftFyNmfMCF9Ptb1ew8Ne32Jy7C4WoXv3HNqf4sORtvRTvjb7FZbwRNT/Z3uhWsz
-FJyhpL07B1TfJ/pyjMoS5kYUOKdZ+5DeffH5aNckzMOO2IZyV70kyoqLqXygCIKr
-iSiui/h5cIypqBPn23r19ptBVp+gkW4pab2EiaFqTfj+CgKBLXwDAJ2gkLv7EZ9y
-Okr5W/ud1EARKa0Mt/mVWIhjbks3D6Q02QRDtuuDCUSZrW2Y9nb8TIKzBynEMXFm
-bY4DxVMm0mzVNssecHIQku3ng/NJ+mktXTQfe+ocjn0W93Bt5SME7yoIFnnuv5i9
-TZETg8cwpvnrZYQgUzzRu/LopaScZ3Bs6S/KZqDn2jBlV+H9ZgOIG0S31BWwLoek
-POGoM9ag/Z8FsMaMGQ+n8VhaBMWfzxvldNk1s5oxXSO032TsfhhHrvTaj6bArfG5
-gQXFE+imCSNEbVecdkS4y+qwZ/fck2y8g+K7KECl6QGYs5OclzYlQeg9txG4A3uy
-EURUi3f2wLnlkkUf4SeYMO4KP/xto6BcadozXVo0+nIrGnubI6/6wRj7UNRwL7pO
-vL3KkUDhZtoZgsgtEKfubIgFOYhBJD41VMEH+7bcpi7nSYZtd/mOQPy6KfDehpgB
-21/a5Lvd8hXP9yFUVwY26BjU0iVmi4iFzqTJCgJShdW0j20Sd4rZmr0eJeEKOjNS
-+G8hBPhJ7PS8m6dvf52quKbenAVCWx9gDf1uKyQtubIY7aW6QjgLBYM3NIKsy69x
-aLwgJ+iUqJjU0buBqgOjS4WvEDvnKH31bmNoYuyP4hCJzBX6MjNbBVM3dCfEAFLn
-FUSe8HtQrE0DxqgGWqi0vJ83/21BekVD3+QuTuklg/FAzIiqTBdQhF3diHjobe1O
-SMLd7vIo/sNb8EK3yNr9O+A/8+JlAg9X3DoOgQALna/+oea/R/8VrYK124oHtY5E
-rStDraiMfSlZzGjt7rnt0Cq3a6/MNOXzaU2R11B6xbUhY55OOw6mocpnuPDKxzzg
-+sJi0NdwdMJoimTlUjt/z9yfvTSXddeFDl9dpn2BiR6GJ2GTw76PW2lcSZFYqihc
-tG/Mx97/7Us7pRPpYzhTs6+q9JIG8+GXeRtDJHJ2R8/MJzAKTtr+h5M9/UNVjAkI
-YymCMmB2wzRHY4QC73puQ3HPGdQ1s5fPI1HD43ycVA3/FiArnqE0i+U1t7PH+409
-aDWVpu4/IwvbsoRK4Uv+UX7dvjPmdnd6/MWMrWrCpl8cfYVKqO6xrUpKYMQRboga
-gnDhOvJe4i0rJxM3Ks1KZwWfpU10olcEnyPataaFS5dCQVd4+8tYVogKM5MPRroh
-2iFw3sDt2n+NDVpbrahCAVgCHV5FUCNqdqnGYGskf5ddIOkcSHbrmIryAbvJOZ2X
-zfrQlfuzLvJklHbuDm8NKta5ydSmypuvjK2vdP4PVi6PiSXQwlGqS04WA0edhmm4
-0xWV9re7IO90Rga4nGT5mOYE6MxBdKnVD3PqPIMTmCAIKsf6ERzUEWU7jhsrT8+o
-VCyh9hXSIHbFJZfMm0IrUZVhywK9+cnEq9Xhj2eYdJ0idHbhwXc8KAdHsKqKwTfM
-rZIMz5oI1M/YVOs+w3HIjSwNs3ViOom9NoZ0NmGe+Dh63yTbAQqko7e3DzmnCFzs
-pNau5qcbvkm3WGtpdPvvvLStT5P4wgrSehnTvmlCwkP6/0mI4TOZTmC3fYO3RdtT
-lZ1RFN3P5vD72wviR33t7xMOYGkNENkO0tzoF+Sf/2ELel2azz7v1Qj1zPr4Hn7U
-IRdqNvlDvmvwqM2CvLmukD8WZ5Nk4TlTvjxJlwUojB027EEdBJBApktv8rkUqTyP
-GykpEWL24jxM2qJqgLo9YIw0Vdchsla722unq/g+GloGZeUR5ZM3ihs0TnM1Vhjf
-yqDpW7RJxz1r7TaNY72PVCUCZy6UNjrm6yzJbRQt1Iw8NMglvSV9FPCQ1iBXzKC4
-uLcT/Ur9ISlEN5H1qHS/YMdKoOcuy75iOFOcbbs7UUWdxHDMIiv6zcfSndmnj1nn
-GbJ+UgSsK8MFwVd2C4OFYWY2adWEw980qy6rh8aLVxv0Siqs+dI9D2xS2XvemmTW
-UX75nrXRUz6sAqbesURz751CjzfcHWxLLBO8ayDgQC5MouR711t1haN9VjM5e3NJ
-w+FVK8bIJFKzE20y5j6j3KrE1a4GSApBCSdnZQK0DOGGF0Fv+5rY8pUnkDUTxLsw
-CBuRhc3/+vXvB/ZujN6N08j0/skwYYxDJC6Y2hUhyiAaMK5M1npp8vk9hEp7Z/a6
-3lvSDEMGLm+hFcss+7ks3D8N2YgkF9nvI9VsR/g8fcx15ZXxOO+/+1O7j/zkeKvg
-LEdxLYS+mfwZFF7Sv7Qz7m0QCHAOB8VO+E9DXSqS67xlSp6q1jBEWiihIU8+b45g
-D42I8eiAj6CZJmNJDIlFxDxOh6Nz9EmYwSO3iNnUfAhke8AWOxMZlmXlzt4k2wgo
-AwvaV+eJ76cih4HWY06SmJjyK+zfECReBF3uBWoh3ogFw595B8CTk3TmVPYKxK9v
-xERIDDzMFcbvICyWOSL4UMlJAg6sI07BVXkVcqd2Ky4VrW2DxL96SsWh3hwpSmlY
-SHTrKbl/UsjV4DhKMCBP4oTHSAYNGBiS1v/5YShLRIi/l3QeMD/Dmw0mIOdsSjlQ
-y4anPzPmtZZUOgrDr9Q2KrWdco6Ah0BSuBun1T5zhOHT567fmt4ljc0OIOcr0UaN
-fOnWA4tWcV+RO53b6PaKMdabFf/mY/5ExNmQQRB0wwU+P4xE3WAlo/rDcpyqv53B
-k7bavr7xDY9ZH6ynpUMXSY4djUxohIA/kL11yQqn5ym7t0Uu06p938IYk9VJTmdb
-eyWheELn11q+OY9M7+lx/ObvdTS8tV88ytd7mGQObFwR7PESr6K1TXMg9jWLQV6u
-Q6cld61ac7Z/ROTiywqJnfv0+COsQ5AyZoqJ+FIWOVhbK7AMKf0KmH8x7faWgiF3
-8SfUKQ+4j4Hpyo0QhWcFYpQA2eFTocKIEI8am+4uUk/yBy/D6gEu0WiaCwkMum3e
-h7HeRWDqrdTa9OTQT75Mn2ahUKMjWsGhrLyZvqW+QnRposjfWrm1L8hlgpCivGY3
-iWVJH17BKvsXSByohG9OaSh2ZC5VitDTxmJe2sGvMi7cjnAg0IHoOFraQf5gBvaS
-mdiM6E9E9GektCgj7uto8Kq045p6i9DUCh4N3zF7KwRzgO6RSfBYFe8XfsbUd920
-1JtpfM3RQ6I0QJnB+CC6qTePkbe686QoDs+rqVIR276i9Nu/CIGgTcBqjYGg6N5j
-OwwOm8tuk8XfQHn+QVdIh8qqCPqoDlv2Y6ZI8Tfu8RISll5+91thdZB3iR+iAHCu
-AsVc1+6dhBV5KrvM8MSV9j0SQmrTMBnYoPty4fsG5kyMoMQTFRmedDht7/IqYsbb
-Vft2bjndHPalr/PFxeHZgrY3/2LKICiY6Q+NZpFoSfpgDQ8mUON7ueu2Za4j3PNL
-U9tAP3X2gMiLFBQbVzJI7ZM2ZiYdSPIqflrE4xyhVI14mhrYNrDdcQRytzpORdl/
-fz7hjQavx8cu0RgpN4F+fPX6qp9rzUc9F9VIVG/ZaNclwtjibN16piGKgzHNO58M
-BhBv30+vyj8UxLTm3ZVti8viXmgH1GsaDyaK+RzIceL4VQfP6UmAHUqf7pv0eXau
-X1kWj2cFjptir1Vku3B4V7euRr8dHYrSFGYw/cMtx2Sd4ZEUFRewTiQG9KeN/VeX
-40zJwHcBL/n+H509UmMCxF57rKcz5N02rVMz0TalPCkFec22rqCW7Dx6BG/6Dgx6
-V45J7nOwakUI05fqRL2GwP94Hz5AWhW72aeYZMVxghVoFt2KMqdHVdfYZ7nYp4S3
-DETUD5Ovcm0yIO72vMBvn14NUAWMY0NKwjq6g+rl3cpP6q3ob8GyxuLC/P/u7hB2
-zchxJaCviPqMsp6ldi4qn4kIbmi4EPGTUZjGSWK6x50QW+dKyoVFgBw2TbcpNx3W
-i6wFdkCqUgHpS9fjxO7Amj9XyP6r2f7zXwYiejHkbVySHmVupBpyYI3MSh9TL+sg
-PI1SEzng1ovYWfepCoGRSv3oWOsjrMpMeA7Y0zoDktVsxxHWmIZCG3VuWaUbhrJp
-9wdq/GezkUuLRW/MKBZjsd3WfgzQH5rYeXEYfOQPkYKNsSKZECCrrAil7eqFl/I+
-BGIV8JYkXAFLh/nHk7h9O3joP/uO0bZIbH81Sh3cO4buST7ovfPNv7QuG2JnJ0rm
-7cTJ4ZorwvDvSdqAA4v9lJ+RDzyIfvi0QUuM7LmNBSB3CpfVfa3LMjmWL0vs0jaF
-nKCIV1SBDmEfe2iBdJbkEIklEf0BefDyDwYppj553HwboAWWeKNm6gJnM/+s96NS
-cBBsj3yiGKoDiqC4L0YK9RxZT2F2jcTmSlHDoaZ65PCfmSmnESR790R3/MUuvXou
-fnS+z6F3WAv7bFF3upST8JeGRixD5psR3XbYwlAoLcf4n2TjxV5i7ksvSwWqsCHu
-qqIALDNCwV72ihjWxRsCDcbFzsT6MIoxAGvcoPEJCNgGPAELk70RntCISJEXXUu3
-vfbsqFLAbyEW5JMBU11bL6KeXNaCd8wfftmJ5jA/Tcl0ae2U8cEeZz4LpZPTzSun
-GBbRVVI7W7m/eSGvFcVxoOtCt7nlEQfWnWziz7LYufzchAwuIHg9M5LiZCBvY+3F
-fZ2FjGc+mY+5qQn300n67rmG1HZGpC9z7u1U6Y4lzcEpKVqZvBW6hp/OTf7LPHR6
-fN49CbcGZ3JzhFxB5/p/np7PjGiGsstMNWNaiHAjyWoaeT8Lj/yF0J3lfzT/Z9Mv
-yeSrzn1KgQhk7zAUsDywedJq27uAPbQs3MOkZPA7kImSBIr4QRkeQ8ygEp2zQnxa
-Ehq5KBLnRCDOYc54qQixlqjgr9DoxtN2bdi7nOEnNNbWFu/mVQX2nHSV0nwSwF7U
-zPSrN1WIzgJERF+nWL99RQD1VEz/QXL7zRPhax2P4fQkJ30bUZyeZZEDoXzj0c/O
-+EySYCsgak3JMzjfd8Tq8Gi4y1Hrp2gp92R2Kn1awFvQqtntvTm8ulorllJT8c0J
-v0jUZx1fBbqwmakqboj77LNadNIwl/LE/TxxXo53bPXP7bKpn6YClTgtCDqq3jNr
-ZKdcbUm2aIGHQxUwbWStU03nrt1QKbN2rnfbrJjtWnXG3ledAziN7JtwgF4V6FT9
-gMw9AwbuTnKHwRrJKp/oUGM3pSOQOv+xnhSfpWXBW7VIoO8PK1SFDbJOdHpjq1zy
-Jr6ltUL+UBL8X7LhAvNcxQGiTaHFHQgaTFzxl7fNIveq19CPVXArtgfZCBhx/4dz
-hMGFBlN0kIHP+vM5VZFqNe+jmZGKohd4dbMNUlb8Rx3CskMcTWjP9vJbL06Pv0i1
-d0lpps9D8CblS6j5KA9bB9sQ4uTrpUrS2fhfsotWud96OKiRP8v8fkWSRCBgXNY8
-RQalhD3dDcj5erWGamTR3CS2kM9lho7IG0GdY8fsbNjUoSXrXKkCtzmqR2nluRjG
-qf9ov72FgMp7mPg8A9PaUYlxj13OLCZRYAKSKeh4NKKpcxUybPSF0inH5CEyZWsR
-ySmSHMTihUgR3tG7YqRPhtYMnm+imxqEmtMhHSFJbxKYqDG/qWQ69oRsjCRYn+jQ
-L3ahX4YKthqe2oFh8gzs8sMlLFGjHF34Yu/f3oYtO6bUNgcbUhI6xDVfYCMloJ+g
-iGcvcBTp8MC537Jcy0GoYo1p5XROJQBFXemB+YoZAN/VjOpHUcYbY37Sstmj1Uuo
-Kc8xBy8ezQ3as4soFn9OHRLhsU4T3P/fYDcFDIj3gIzDmrzRWn8wwW+I8aFBODOo
-DdeuvegCRbk1MzffYUJ+gyqXecM+STCBZmmlbd3eFuBgWEe9Wne4byFrLzUAjYFm
-BF8bUUZuB4NQr/zt9vofb+vAP6Ru9cx1UbEHUivwceZE3vllbW6oKS7OX12gLlEz
-btUXgfUfVWsZ0HJcfULyRT2aLC7X05QixZcXP8wXPl+Tgyb1Hu3PKO5QFP59gTNR
-JHIHBryp7wG3192UYih+LMLqvq9YIuM2BYdvvDK0OAVAYp2xYOnxdLtp1cblMQ25
-JEDiz63kMFRStOzQUg614AK4RGwtPhPPkjKqZDrp7RLzeRcSfoeGgvtD0s0wybg0
-x0I1fGmajyDCixXMFdOzWnO76xaSIIa+uZQu8S/SYQVGnOKAb0OhBO87AlcyKlIH
-mDCS7SpdBSxPJNaJsaioHovXVKDeyPzul0E4DuWm69Zz+KXuzxmQoCqCC2MfOM/0
-nPy3X5VonPfmhI6PjSZ756I5smcHTu/iBQp4+L3wivlRGGCbERYS+Uld6c0mD90M
-f8Pw4jeF9gBMwmjjlmeB6q6eLAHVNZur18SYgd7kqpbQt2KsfnL2RJsERuzs6nGr
-0BKG1nwvnNVR+n2COy3qyByoM0DufGctZTS+QSCUeWuryRe5mhdR5nugKJgHl0Ac
-naxQZ2aV27B2QroaPPj/Z2kb1+K67PFNB3DELE3WUY2I/Z2toLUox8NLv3DUxcjQ
-cOXlgQ+fmHZEFlTXxdcPlGbySpNI5M+5uXrJwTDnEe/IZa9n/1fWUUcEyKUH/mQj
-8kNr7omevtPxVGSTZQ4E5aTVRbIRgJpEI2zBvuCrUiXSlL6QiK3e3yDxAgFRZyc3
-ZN2QFhyGIMsMhkzZAhyMyUGrCu4DpCX7kQYRz+zLy6EWdX5FkWJht0gmQAiCcRva
-lLeQxYWw8LYvrdO9JpqJkZTNHg8i5f/zsi0nsemOjy/5ap1UFNSLeymB+zQ/U2vq
-Hx6lskKdzpCB27ClK9QEilfEshh1UUDV+NDdKEtCL/KDaCYY2oNDkhUsevhfvpvr
-YWFxJdpgsCBFEH2BQGkf5l8D1/3GRPOAK6mV6HjYmN5VcjPhIK5qOtjMTXZTjI8a
-qSeDw8Hmp3WSfDVxVlBAaLx0Bloh9zy6KCfnb8ragzW956MBVNlsU6tAjvK69+1v
-Z4s4aCNRch45hYByn0CzBVcVdQP90Po63Qk4sYDEhZo0poyGxGK4Xi1tKI5rNcQF
-BIMKhdiJ446Fm3zoBrpFyQpUT3ysSfu4ZF99lZDN9Vj9a3SJl6EEPFJxdgLsBpTl
-bHhIhmXVSVUzg3F+gRp+qx59EyyMdrVbEf6Its3mOYi3oXTt2dyPdfITXefStcKl
-PgEr0cSMP0aOg5TClhK1webHcaHgFFdYxen3EyFsQBZnESFxqVhGu86vaZTCI1BR
-IqDgmouiPN5CxfN62c0+INC7x2KzPpf6wNkzmHn4RlJpZPQFTuicnnn5uHfQIf+7
-RoKTRBJ247bJxNszfS8exTvTNnKhXGqmOTs+Q9OA9GVk0T7uY1SR/JT6TCZ0DjAg
-9P7uXO1PLha1G6kuNv4m3Xl/qrEG8E9gJv9fyA5Oy7PTq5+JBuo4qj7ubYyGapt5
-AHKFuvA1HoUph13dLoah2zJ8FFuyAdfrzv12LVzETihU8zo35SZKV5XlrTtyP0Rl
-l1GtTdT2KI4rOnujnzB2ljOb3lFZZMHeBqAbABxvyIPIWjggRf1qbA633BYHhmRQ
-s/Yk3mNHJn1mvDCIc1rNsd9mGW44ffZ0jXm2yw2pb9EyLkq+35QiWw5ZiGuDuhI/
-u3Cm8iHbBChpHC46qmJBmtgsvSpO9Io0IoJIVtDfDHNSk8fXMozbam3KV1gFr1n9
-sucqHfs+e1fvD4fVarYp1sdmEX+UHjdVYq9up2S+ByaHEoqaBNUjONIiVsqHljL1
-ObpuBOXGwGytHZmaPMKfmbSXxvDEge1A/v/89zDLE3gDLEouwNVtFiru/EAP4KBe
-sL8Hz2L4DaCKla8xRxilritfGnsaRDiYlHcsuW+BmCohlQ7T/LMj2R5+8wCxNqkO
-8y1+X6KSEkJ+od0PMfZKhGfaWkw5C3Q2n+gvw5BhNvlQc8GnFpZVj7tbk4MUcDag
-Xas9EP1F0Bda7H0iqlyYkvfrcEsb1hEHs6XbTvbpOTyU9E7pdfhJcctPF+cHp5Cl
-buWwfggEQXzbeUmmZ8ft37FsqxaWckY/biCRC0dtsFMNa8xXuIhkO3wwNZkndBc3
-jLzUroTJSGsmE4k3GZBP8x4IOlaZ1ZCcheNFVPcNiyD7IqxtmKK7qiUlYjNa70ah
-5gorOxLiqihmUf1yygBrKRbM1KuGBabL4rgQpfxGzmKy4EtY1A+Z+5/HoHpOHKqu
-h1sWzgbWTVFISOhl9ZNvRPPX3oRYMVZZeVxzXzQQ/ztA7pwiXEDaL0jxNLh1XHDV
-ifN+E80awjHZ9g907wSmbxTh3JiaRoOCFRYwDZbdRFi6ncDrdTb4lMnXcq12OLUE
-U4veQaRJiNq3UQh6mtBCUegZZ4qDeL+mvn1H5b5cplu70FK+GcC15gEKYHZGEBEE
-5k3c7Y0Q1o9UyuLb+rB9BWKdiZjUp60OdvVy2ifGPMYXtkTDEeYXvHCxVYGvF/sW
-8cX8VbnINyBfLaUnNZYE5FKlt4GG228PWUdYre1cecnskT28ovRIiZllS6QaZ7et
-PJDmydciBHO6XeJbdyR4VfcxAuCvGJ+Zg6dxlKAh0FRBW1WcSJUgl/3hjHlvJ0SK
-lGGryloIWk5QP858+eOscMKgOan4Y0tvRB032qNO4k8RqsoQ5Mp4YeXKV4eb9JUn
-GUUB6aqRsVg5EekEHMieRw291ZdvyI7Tgf+JXY68gYMO2K7GMUCW+dakOUYn9i43
-2RFVSo9ywM76AMH1pFQudFYxmOJNx+6y1oGDCfm9AWmL1UecNEj/Z7C4yXPg7+zG
-JmNeKYeSzENkrRhQUUjJbjukocyNZ+AlmlqqOWOrlNmudezQNhLs2WDGjBYv3c6i
-2+z9Kb0IWkzh15y0+jmqLqTHb8bXNUqeh5B4dL1uGh+4HeUQaJHKJX/l8SOdtg1F
-mxc5BS7jx+pKr6dxjKVYif1qSgAeQDefHxQh9KTJkK1jBtD2BK+fNRILz5k3ptou
-VPbu5AIUv1DquLJ8ymSlWYjpKCFTAL+AW2fqSv/Zc93lOTF+fHTH1Ff/QEQDX33e
-l9qZ9avJbQLa0ajCLLwHZvw3ZqoF6AV0iIS3NXIg77yXWoecJdGvW7/l5OR8ZCoe
-vV6ArWYatu2ruV6BoCpcDWIyMe2vLzEKez4ObvHRceHxdrXI4P78hr+J8Q+u7c4Q
-JqRgX/mWKK3iE9NdKNE15nibZHuGMA2YCF++pnxks5XkBkzYJ1ICns5iz5wq4FgS
-CFNOSNG4D2q4VAjItf7/CPW+anu0KRnmg9PPD87aC14gDahgiUhbXVqgBPUJbeVf
-Rcrt7zYok0ezcGAqPL1IVNrZP27GN0Ka3cCvapklIkMBMTU5wMOTeuH+F9SLLbbc
-UhLOLq1WkmQTcpZ8Rrwo78lFrVJswL1vd+ZOu/Re2wTzqPhZhSkxHS1IZ1mrwHSN
-FopFuTw/1tJN2F5oaoTG8f1Pdac2w1g1ZmrFA3v8tG+QskIdZTmAos0LyVwiqtn8
-npxYmsvWsQbo3ukvp043eDgDPNL6ANkRTovkEyBvnFQ7LrVmzZrIaw7rf+iG/caV
-1JgUgGKemnaxFATkGElhm37/fx7LRAHaKfofDy2DzLukOQ+7hKQEMWaHPZczAzbY
-mvDb97dFAPLltyikeoYKBwgNx8cKvoydpRospJtSmJeHr4xKX5O3OdAVoBdZDu+w
-5NL9I4zfyx7OQQEX9GZ3SfgDTCH7y8SOJUDGENIIMS2ukX2hwizpFy9YNVI/96nk
-HJzrRcb7Ke0xNOWti2c8DbXHkjsh8QXdlzmxcrnPpaAcwoA2T8K6l4G4nyyLRfCG
-O2awhlV0yaqVfmo9iQdj+qEujN/81DQ4ehZ9aONp8CxV0bQYn3OktuFtIkMLUnM0
-H49AkHa1IrPQd+Pd+X1O6X/TH5njAJ2LY2HOePpI7RPopSE17CW1gCluSI8FyBvG
-qIcLXwYQVDBAlPYXEqMaww7Z6n8Y6uN89kjjDkNK00jbkU1MXN83BXMSNWn70KZe
-/a8ppFpyrN6GBEKW3EdMojGoijcrN5t9T93ssQAiir8ehGXziiJj5xOuRHhnMoEj
-+o6cZDllxiD4zUJAUEl73SI/xIFCSBFHlY+QD3Aq4WPxriGRWQLiYRhY4e3M9CBG
-1YuuZFhehGfbUFCWf8eb3MnM5RXB0XsnW9CROrvFp5EFscde8q8T63Wv/d4O2S6Z
-aeXPzlIbNCMh2+no+gPBrbrXmCR5IY9WOwvq3GQNa+X1yflXSOjcXWC4sK11T5sw
-IJLozeqUeJsb5gxa7IL5VpKt0hxRLYGesD+BS5KhUpnVdHRbL8iAJGjHct9hDBjy
-nyjh4ai0mcStCCJ+GuJUvZadSTPhEBBYuWovZ9+ijMGf2CZYlC+KlPv4pDP1g1Pk
-Gxg3QY1qXNmrbonszBlTMYR7+mVK0/1CxE4WBKYaimdYxdha8rddgpNwSwwPX+BK
-fUVHfeZ9ntkwJ6lt7pidVoqDhg8KIa3b0tk/CG2G5qixxoVRgHl7GWpLjoWUHxcU
-JDei2IbxoRMlE1xxm8fA2LKSGOh84I5KqSMuDAqUQT5xoSnXOqC74c88kbkRPIAR
-kfU4Go8KPq50YDXIDDufnEwEVyCLrF8hudNtb0+jCOWp9woOEPe9yR9GjSwdGbYb
-IOBpgDi+nNK3HYiUB8ldVjNkSVlYY4qwoURkvVSNjTwvuw0Tg4G2sI4LB9aGK8CH
-XjQ+iRGKBhfG7z1Y74yekuEOa+VC496PUilLU2BcKYJHTQnsmybzABmKSuDc3gyc
-hH0=
-=wbbp
+hQIMA7ODiaEXBlRZARAAibMc8dMCIWOIKLWMsEoBrDvoc7JNr+nEMwwkZ38jtLmX
+nGmZIvsGSyoRySdf58vtGptFMCesI9mLWMduYdcG3xl/J37QchHsY6RqP+ENIlHs
+AbuBoAKknVbTOmirPJ0TDz770OJ146a8OwmCkhDfw33Yp82I4G9qD0cyDGpRamiO
+pm2e7yu+oib+hWaRhALKjaj1+JK04nQyLlQ1aYCpqLuavCsVdfUR6ZmA4UFmzEx+
+MUYB9V0cpJM/beaBIJ8T+70m576NiisTKJ1XKAbUx3QHPFkNCVBa+ks1Vz6QcW29
+tk014xdecKTkm7ACNZkRmBPOhg5dYXv0mEWwCaI3Hib8qLfzF4E3x5O8sX9SP+Da
+90Lngi+q3r7KaQx8HJx7sVkZe+Lnqs/VqekK2Q/PZZOadu9fwuz4p06n5ym9V5Qu
+JnIzXATRrUOS90rEKjOvvtAI454q7oihQhBpEQxH7Hq0D+kxKr+FKAz7yrct+XFg
+rMLkiz6rzDfe6Zwb7kQ2bD6TraYS6t5Y2K49QByw0IqOjaYWun3YdQlUNvHVErqW
+UICAT8fhOSj4FRvXPy6bt3JulPZRshcu0PGGpcidQ0gWGnrtomyOFyOg4MA1dTMZ
+14FG9vMIHA66vc6+9U5nnJdWFTid4Wi1Vu0pHbXH/6m9z30NxU1oIAROE0wD8OTS
+7QHBgxzmHKYRmZj4yMlEXNdGaZb5i++oVQCdBfHaAmZA6BhhqjL9TCast3LZNAfV
+nujlcF/6Uld1fI0dlqTyZ4uMmfCiV6kmsyq8h5/NI33AffOkN4MMUSLnsS6nTJhG
+3d0QJLgYm5MBvzpvHYmry+ji4g1WpxasboiGNqoTgKbEpuZdHEDWeUXh/3ZVQ90R
+a1+FKA+RM4x5koN4uvonzn5LR8QZEDAMP22ZluQY8/L9uy+TtQ7QcRagMl+2myNS
+zNL7xsW38z6A2KjavDYh6G1EYsujqFqDsRVUjjL38sYo+l3MpconFJ6SXxtRBQcd
+nM3X3w9xPiVIGbp1YvffMtwmpEUdpdos3OTon4MjXY2+7HfM4atU7my+qOwv8nSy
+GXCbwYby8qAEhZJQyE/lnfwdBicYD3wRYZ0s3syx4f0Nu9KKP/AoI6crZM1nNX9/
+UNwZYL0S53RE96wvSqPNnxwTPITNAxzPSyd+apbKpC/oirP9iA7xDwA1sQIjPHb6
+ALja6xnVFZAbpO0nd+BZTG8ik6b1BN7Qd+e4AePrfuX55fKOTtcmNKKAZyPTcYJe
+1bwC/IKLMSXo7jJHaqmwX4WjZabKx+s7Xkl+D8sW/H+CRfKhNV93KLCHrILxFQgV
+ozmLD/rH2CMy8iB/95n3u7Gp+lQJXCUDtzizpQxJ1YPkqrzYPbMz8i3OVq4/1Ggl
+2+M7upWgjWh0kZBQFWTtb1SwlX4p1LZfvaNRaRFO5sBJFklJuqfsAhU+lKtvdo0A
+carjRofbDLlEptFtH7XhFqAZPeCwnZGLjqG1kVreCYsp1d0XC4yBkXoAu2XQiGh/
+Eql2DlOIM35a6TotKyve4gWRAEIbn8yeP932vwqNLzhuQVU1/mpobAWUcKptiIuQ
+DDKwdZ8vaDtKOLPxoXqO6ST2VmM/DhVSWkk1HkKTInY5XfVCXKY8XEhFbNGPNXyq
+MJRRI4uARGPKBboMW2tFHDlVPCeNsFah3A+8F2RTwaz4nfLKpBHZqUiNDVVmYEYz
+ayHMqcZEcGwY5KxKw4lmx0trnE1vXlJPujhRrzOjzuVxYu0OGq+W6qmVRx9h/USi
+kPXlib/DYqWz4gm1rRCX70Qb4tbILuJmZAFXNo7kYJrb8+4VKhHH49r35rF9DAt6
+HzNa990g7/noZ760PDRFaf6OQh6HhW4dCRIMevmvNqLpgKi4f82NWgXfUel4jdea
++eHpOmg7g0xefQ2ff8T+6OoaEbFXmm1ODI7YMfWnbR9o4SM+SimA23MyCh3iACUV
+mh8g5udw2/VsqF2I6tA02UYAI+nfa7D8mskTvYUhISEcZ8hFhu/7JwNljUFwilN7
+1m72K7SBnpA8fbUkwoOhWgSymsmy4gILT1zeyMAPwmi9T1REesVip6peN6v3uf2L
+Ejx3ymdADY6kZFrQ2QWwxbXhjFz67DK8iA0LVvHjBa+PmDunFwiO+etBfhqkPMOx
+2bmGLV7XkZ2dPeEVKn8MGUcjuiYNfh4oo/eGyqx5KD5pG8EC+ZcP1+CSqrEzIdiE
+Dp9O0HzXPNQV4tUd2WhaSt4mbU8bW/v4wdpNxi+VtMURx7tneN94dRnvwuvsmLFG
+I07kvnTRI9MCa2OpJSqodAvQuLjRZq0eD7RMmWRNyZ7OhaI47tSJ0rv5D74SZo5e
+KQ+iqgGZfD25iHqgWQgf3rqxllCYp1T9lKwybfYgc4YGNGLbL48B0ddrVP3tEiwy
+h3vOzhzRwWLhqXUl4QivVcL4HdsGbMBQjJg+9HDlJ/8RzXAnR9fInj/gcaq1jykc
+QlusAgm1+nhHf/iq46u56yq7ndIo52Sj5AgDizOZ6AAlPJKY6DxbxIa7gt7leP05
+eY1KW/U8eVK5RPUIvVmwirILPCbj+ophM+AkzwS3ESWMxrBxQV0JN0ZBn1qKFWFZ
+XrFI9KZ1rzq/C2mU8yByMYXllzipnuCTjMXfa0J+UP5qIYXjkWI14KBoEt773vVS
+Ie5ObFOCNacd63n8mysStM34kIBEIZwpzWNe1uhyJ+gSLMVVQ0GQsjCn5wfMotaR
+bE10FATXyt3HBO2TKV7QCfFwtBGa35lxaX3OEns9Yjb2R71BfqIiX2otLW0qFMt6
+uQyTqslKV2Q/OPuit/eUOYbcWEeSVAx0SgHBxro9lWAsjFXy/jxn72ZDYzbd5Y+X
+8zCZ7opvkQYt5YynTtP5bOsp2wvqXUEcv3M6bK9SoC9kgHXljuSk/t2kIX4hdCIA
+wedCxmDlVmAgq/Q1pbGkmGefd7Cj2G4I7nGpx71tSIKxgTfNsBS1yQ5aABJ7WdX2
+BBsDPv5A488b4V/x2gU6WS1MNGg/GUcRt01HDd+UYRg8BMi1fC0sYn0fZbzu9nz4
+MYJ28G6gvvuEPGlv3I0yKhSJRlzM3Q3Cen9n6eduHjQkb/czDq6V3wU+7x/M8sHg
+iP5faqNoxBYqLxz4jdUzdn1w/1thVbchlYkt4djf+VpNWnWWQuUJUwykM44LnjPl
+rewc1qBIt0SmbM8GUYfE8JFYoegi/DxA5lOnzaUcPD38C8w6epkODYNjPdTDJSv5
+Tuq74kvXuYKst1Hmcejvs40hmX9dRiMG2ppdB7MNKomrP5wb5lRy+TTVLYQQcW2n
+YpeZqzSRD2/RBSDt1faeBQqocOZAWJVxVZTYGHbUqZs9cVGd8Be+hIatBFDDiheb
+qzoXEadmqKJILWZ8b5UFape0Utkax57YPP5J/ydTnhG/2xDDHJSmLzte+hfCblJE
+q4YCCITlYTZP14gWwUHpnUb4nX+Q5vYEqoDcpS85LP2sFCunYrEWSksLE+j2RfR2
+K96smkwsleNdcYVvEinZRgy3N/psePUGzMHQopJOkDWiJeNsbeOI2jvBDDgAfHNZ
+ycbdz3NKa0tGqqHI6U1VATkjaw/l0voFdgRiOYd5b3AMn+HY9skXBuS0XMlsUtYz
+4/pGGtFq74CF9ACtFO0dWNrVuVJHjZeKxpBQkyNTiHl2ZfphgvNZbCgUenQ0WlT0
+4awmC4ysNtpF51rMtooi1nIylarlgxvoVzCnSd4vnkiXPBgHMykUW+yVgt31KyrK
+/T6aFEuTqH/KlvnacwnjVVLe4xbHOJLa6BRycXvQuD9FW+BGIAmqNgliCEVl3wy1
+/R4PDgxz471+Gz478n/hZdM6uONVxCuzAWPVpwqlyJExrKkRf75tGy7FFYfujC3C
+NCNKBQaHDImQpjIvwOY2WhPmObT4Kzwn0AdWaBtPgMD0ijv+ux3umacJWev3aImN
+5Lt1k9xTN2alPtSwBPw9CHoxV6MKuVTxPfAo1dmCFUn1ZU2Xoyx0lNqBVsgzzOZt
+ounszDfVwIXL0cQbEhj8H9wzTOvfYFWdIYXH2IERfCU37GSpMDfBGy/7dqDUrJJh
+Jho9R2oORSxHbUEt0uGjhlLBjykzQIV0qVcTZEbqVJtJUcrchTT7N//zs9KMjVIn
+NMo3lWv2dn07w8/T9MDy+e9rFMfo5ehq+sTDWmlnEVpVuFuaOQvLr8rvghHuTDex
+YxNZAFQUzYXWJ7Uxa0JRJULO9IQzi0sUvMBymFSVwso4W/T7xKiQ+tQepDeb40hW
+ZQyHl+EeaUMsbj0YU4lEgHiehRMUjQ5es8teIufJ1EWeSDdrx8LOI8Cjh5PZoLX8
+Wv/5ExI0ii1sYn2OnPgd/DnnvJ9cDMNIkxrQXHgnZECGYaaMZgAXT9rvF/iONU4F
+eGvqBwe9nLEDxe1DaRX+KRHMqV8qCQiwVu7vmehe/4E4z8rrbsDEZz9bW9lfw7H7
+FJMT6NH9TTyOWybOUYfNjcyztguZN0VXeL5UsGizzRt0OAfu//sFCD14HHu9qd9G
+Y6Nzs8U+NYk+s9FMzqGur7usBDvQdjgJSVUrSz5ZZ5HQrc3jHHHWfVLnEOrhF2ZT
+1fP+fM/hxCaMAGkgJkdnGGhXsHmXdFuoWRRMrfz5Ta4NWeuZjg3PgsCzctg+1vrA
+Dl88WA6hE7x0zkcrQdJ4l4riYrCBdsh3HD+Cn6rXtXtJfyGSRDfhWVWZSwZhyK+1
+uRWtGvB0s0uGupJdbIuO7FwsdsdPPzwoaynsDWS+2ZeE6cVoHk30W2QJMj9ck0ir
+i9mKbwDLoUWodX6hqgDO4kEPRLv5mEOEbLDFH4Reaqokd8jLxGVftPpb/nTZzgMT
+hvhb5fqohTDhj9SHfBN6u0TcNDhXQolnLESsUZF2ux6QOf34ttuzOomjnZC7R17k
+cxzcR5Yy8I2D/UrTRKiHKMtu7QWpQ/lkYpNuQ31p3+tRMRWsfYdObngK8SqcT8pH
+rVencegbi/DxRe7ifpo4mDJ/9x3sRCk5CPY1Oy20LEK7yqtxu/ElTT+xsRIj9Alj
+JxgjhY1ECQcg5GNVqTsj3VmjjtSO7O2sO0TAorfaVqrLfmwnRqrY0aQQ6G6gF8zg
+Olzv3qudNatm2Co5ucIZbuo3/XppdrgoFMMLc3ym6t4cXKmB0GLM8Le+QulH2PJV
+imBYK0LBr1eaZrJ5XPyoUm60QD9jqDjAkTj5WWDvlXwv43tN+noO8Y7EN0wEE5yJ
+QHEvyxvmVMWfXqzv+MGA4lfMfqxNsBjM/KwU5/IlfrwxeFRu+wjdoj7RHLRPnE7E
+Cktg0wJ+lgPdsAgSPQITDsk1ebGsovaX1Xwn9f3ke/8aFB9evUtA+VD9i/c2PFlf
+AJ7UoXSBRPRlL0imAViK8Xz+S8rr+OO3kH4LFerC54EN5ylhOBIt9qnr7dtVk/0B
+nHpndh/PNOJeH2XTMc0LgApeWMcFzHVQo9OAFE6L/wKqjceSdXB5p//REabtNsW6
+8xUE0bY3h7nC6opMNB+mDweoO8ahXRn0Pm7K4LDNpH7tmX9OtPHynbD4Bj4kkOjM
+bri46nTaVU41+aJcKjCqUZYMeSmdlU6+H3pUyy4cI9vB/D+n2n8yBItfXiKHJMzq
+jL6NcD+asuyv61g+i4jU7OQa8Jh9rqwjOthA+3NBfLNSEPvCFIt1gYtPOpaqqeWh
+Y7NooHDPPFJ1xf9vb82v7p8vavUXa85+vng1uW83gA3L5iHpEqNm2lQRoHlGrRjU
+WdT93MNDjaHh+9xpgi+bPp1d/xEfOC7UlXXzRGLKnvS5ARjjyLDuUto18cVKEDCj
+MEtaV0mTW52+/DgDyXc8krRZtDj8uCBXdqrS41O5RyN2wnQc9LiULsk4wx3X+7Eu
+S1xNDMPIxBqZiE50qBB2dAswg57DJKYSY0F4s+842PGWMpd/cZv795A7rQIdT5bk
+Pcm3II4OtGxKX50TY//b7a2jCH3tyCxIen3dj2zFo3IWSIz/kGTUBKqVQcqHvou3
+UmBYdg5soItc0lb3dhOW/EFLoTyZWTlpt+f7NFIE2hAMjE+cnZlE54ET7VXZJM86
+KkNyBZEaZJWwPdYIfSVBusVB77vhthTz8hiiE/6SjqtSjvsHm/wBWBg4rX6m7hR6
+TDTBFvqVLxwYlbSU/KDFesMf+AoBrk9YJIGZvlt2EGpQflar26fhSisoxwG41vdo
+hkHbfCpdRyaXayJ+MCy9brAX+tHzStEoKoIrtqMe/bna12sL2ZBIzWhTNk68ylu5
+/iND7RNY5hk5WnfnYWPP0uG5L4EZzIKoxWEpRKfnTRAUed81QuXDqiCBg48gNZx9
+0O1k4LMKlp/RrbubK+ImIAijfvOGS+oqLTNWbuUBNOyNeMrnUATQEOZ8aXuaS2Cv
+b2isxXBeg08HPdAV4WHTSdt7K/FrVSw+bJDXfp191iiWH/ZPJU64ngTGKskH5CE3
+VUGhcOlDeHg2koDejJ5zgjsD0fvozGMhuRpZEH/WJnF4ZRh4wbWIedEU2abglg2o
+8uHvTAgooKJNbThL7HuCDO9QAlZ0lkIEUAH/kwCwRYvCInSGi7ClJpDig9o13hzZ
+W1CqGByKKreQ0YAEdMujzKESzjTO/hpxCrgCk9BF6Y8EMRnItDM8Kn5o7Hmqu5v8
+uMPOwFUW9gglR1qel1GGC7R06l+uISXpFE7mlPWjQqJCyA46TOeXUn2trWSFJHij
+9Nl7nUtDp3+hWGgFkLVUYWZD7S3jQPA2KwYSOLaf3X+Xe5XyGhvZPTgKneyoch6d
+qzS5B++yti/mZy5X4Swfct/6W5Xsrr7z0HKnuKkeq7Msb78l/gn+MvJX2M+JTTrC
+ehIyjyVEB143AzRhxIVHq48d6h9BIsKi0isUOP3ZP35lZy40O9KdgIkmrHLmw6MV
+iqwMSG1Di/4fSxnTV6ooMN5dP0Yxy59xcC23OaIE6oDyTi+zziFOZ47MJxP8YgPf
+i5yrG+qTW/T6KWzIXFqcuiMAwmUSNCJgpRD387KUYLu9y+Huh7JhJFARxiv8hM5o
+O+zQIJ7squ4P1lOcId1rue1loxfHhNGcKQ1kFKfer440Q0U6a0LQSQwxvCxJb2G+
+92PZsz8jkKdaisNVhKcI/NM2KCcmqvjg1bEFZD69Vt1mQmZx9YQvSC0mzWXnBEGw
+Sff9eocERRqH0o5LIILpTQjFDbZSR7oGDPmj2V3cfF2yMDGvjEQKIZ9VPQLeW8FL
+9jrSugzxmQzidZVk7fd7e6ZemQuRr2aMT5ZQBFSe0UEaY8onBJYXNRGep1E5mHqM
+ORZeguMW+UacpPF6l5ComwlujbjXFS8td7djavWcrncNumXwbavLYoJucKXUQvFa
+w/rWtBlOPbrv1j150RH38koqPjYKlhlFiIvX8PtBRjDD+pw7/8mA+Jl2IAwoYGXz
+M2WGGp/eOtMgrCuq+IMllNCaGmr63xttXe1nvWLabgUtN5OObNiJzM4tpLaZzXuK
+T98KflcwbUDo4jXNaa3Gav85aZpeRgn8o4UWsOXjIocxt8yqXdScXHXbkV2IKw2+
+TDTfHZYws7HvbBoNAaDXYlKX1bjHesZVEJOJv+UNKWItgv63x+nhUVj1OODImsKE
+mx1/JNpxTblKBxZTCcid3IQhywo7B7RSx6PXeyvQ+V4kSOUAHbvtI2gcHODLRJUR
+wHR/5t1YZFKDuNUwXxVFUeSy5BoGDlIFKBieTydfDV5OFXg3onqEbbKDWAwAjHok
+OF5g2h3K3Nfi2kr6ApyH0w3iAbhIpnyX7LjNwuwZ9w60i4oHeLKzzDb/cZI59ekK
+X9GI6ZzelJ3JH4MLQIqdmWLMGuMtiqnfCmuvrZcubEZWKXKBOIELzrhX1u55DIE1
+4wmhza4wI+7TjvvmsEj24XGfYmtucuI0+np3o5g8me+Qcc6yk+u0r0HBw8jQXrIJ
+FLNpu+iRfsBGZkVvpEeM6s6EQMm6ydGees3VA1Raf9hZAE9ZMF7zZYVRQp+VOOGF
+3V2xfPL+0exOIeZUFZ2i73gsNKDuz1zhW1Z9/Sl43jwzBRAx9tB2cK+Y3om8SUty
+Ta7HADf/Swr/gxUO7XjOe5nZglW6HfxhpILZj8s1RVEvcXQ3lEqXOOIkpcdGRmmu
+AdtiEPUiAgWgHIQOXfRCD+Lqn1a7VOiA5vCUdh/cJ/9ABzRnmem0r2QAWc6w0OD3
+8gCjOMeTgUnSiUMjOdZXw4WAyLGU6e41P719tXZLn8nk5q3VkwK1dOu7o9rbQ312
+HVM81d0ai8JF23+5v+crs5PVM9azHOEsuUm5VlPlqtAWXR9fUGipXDxVA8GbJUUm
+o09BZMTAg/d//jO+Sflq7eVWdjdVbagdVHqxvsIdQ/naMBCMNHySnFrpWzl41HqI
+gDrB86F3ZZV4Bps+zG1UkZgNagXgeNBt/hMw1jg1MoT0QahQ6m2nsp+h2manO+Td
+HsYLPveP70n+HODi0tp9FDbpUJw8DlMXfaxKAZjAfX2OfkVbwG64Q5mJR9ztEEQV
+zZs2+XUA3+IgoCOW5UYv+YskBPbXapKvYH+Jcvzi1M2QkYBHZOetLbJ/UArwpwVs
+N+Odua8r7E8Rmhuq3Zc0aolWR5Q91Vt898dT3+ZENFTNa10oqy1esi9EulwNIUig
+fRUvtFUWmxJww6eT5n8Gm/kgZKI7GNIZ73ZMFT37tdhFkQqcPHQmEWkJ7o0CrCJW
+jaizd8T08bXQZPM9LSjL+8y841CXAl1LTQneXylHWEnQkRuEVW8E1Jj6yGFCGcwc
+mzo2KXnSqZBJ1ZSJrFTx8EyETxtdL4z4KiNZbNmLgXHLZhK+HMS4O/yVPDTe0Aa+
+BnQcEgFN/FEWusetRG9zbwQG3MEnlThas3vIeDKBLrwCjmzNncUPYfbhbZvq/i93
+tCCUgzwUbQ9p9cZdH/SHJVJDMz9jQPNXOlzbOW+9frfKoVTStcv0ADXv1iqdn232
+Xx7APEIK6sJIDWm7AwO0IJ8mK1T2mXmGfG4pK8zfxoPUwvfSaIPY9MiEqO5nUR52
+79qcEFUHb8x+hXbmxxY79tLqFrXFuQJ81ar2NIqy2I1IJgwAwuVSx70CtATrSPkI
+VJh+f9ktFuUUnzJQ3Z7/0P24rFWnt18BKv0Ajm1kpsLieCGUsadNMjwzfLzmt0ro
+MNEmSJPCDtRwgqItw53d1yAln9TR5R4zopBaBLW/AX/nh40u7tKdUu5Jc4W3FA6A
+t4gVvdOOqHw6YPEPhGRN0LgBFhHN0vNJ0RHQYL7Y8pXP3Kz++Aq3JdeiTkqX9JH+
+T1NcH4spbjQdQhFREfQj740IvMv3EIctvTgrzW6v1sn7YkSGJnbbi2HcBXptdx+h
+Z4wCuUJg+FH60Hk8TitqMUarLghOhXCYAPb0DtsOK7715pJzeTDIgNkcoz+eidhF
+UKn6XX9G1mhPOvxGDiED7CYUogLyMrzxQfyi2taxoUEbjs6TNux87TDdo1wwumXI
+cxG15m4UGLCYf115eH4lQG/oC7zFplvVCVsO2llZeYKJVl6B96sFCp8lY7PGQHqc
+ZJnGRkel5No9jL+fldmK9d9NcPJMVzvooBLwsAl+H/tfe+TM6q4+1qfANAEhPnId
+qQexGWjJo+XIT7vHees1uSAxb9Hyw7FpcgdQHBmHX/Cjd4DmnvWo0/d1pZhJAInW
+tuHcHpUvALKvRLQN6ZMHxlcorucrWmi4MJMp3fxO7c3omjnyKqn3pdGnIxjgdVwI
+Y4ut0YlmvOKX/64c5vxaK8ODUmUfY6bk1nMJ2flfghMMgDYIvnljAvyUAivh0jvl
+DQe+frWsujWQjGxrr1E6eeYh7YYuV9w9jzkZjvLEXkTxLL/zcWyqRqgnpnHAaOMJ
+FmtFDyONUhkf/c9mcmraE4eESjc650RBOWwoxhlIAgCdIluOwvShJQi8KO2/SqF3
+NkGsNAoCzsNP3Ri6cq5DUYVLl94wsfQtGu9DufQzeOUeojGzHYMTqgxiJjkTP6bw
+2JkZNS1gBjpurALkJGTIheOC+HTxwYbwtrPPURlhPq4gMu4DMmfwYDegCCuSiezT
+85LefcoX8j6c9sSBMbB6sGmNvS/mIYp3QodTrtA2TSVz7H0QsmdMP5nrlook9SBY
+uEayFCDBIKqw+xds/8hQwmEI5FM3V6HjklVILUzRZHtcjUvZPA1cvk+Swyn9gsfa
+lrkAW8s1qZxv6/kfVY8RIKLi9tak5WMSCyqXHApI0WGM0sAbfk41a/kKLBj7pBYC
+qeY5HMEz/EuJe/TOjE2kKHjOtXxL/vnjTxMXM1Fpsglj4l6EGYmRf5AWxCM9He+E
++u1H3FVMfC1kX9Ipn14v5N3defy38oRxosN3lHqCgAL/s89vPNY+9nJLBHi7CiB+
+dJw2v0ncMUWKCOknz3uqjhACWJt+QxlUwlWmlgtZ0k3raYVKfwML6jfstIt84EyJ
+E9ydqVkG60VGHlLCTjq8V5dXGTZ6NcNsIgo7IeKa47UBt6n3+uN7lr78DiBCFRcv
+s+K5IyIV67c5y5KRLreTuKfgiM8DuiJtOVPXmIrYIq8KNSpwwlshxOW5Z5hap8Pw
+TDrQhL7MGaiNBjIhGuF2oLRMMZkqOyXIE9twkIeUVwK8FgkaFSQed8qOEh5cjfBF
+VCXyuT9S+lmrKozCa1UFwet9fn8PMkSNNAmUpnkURBahtB7egyszYh7fdX0d8Ofn
+eVWf2sCgJaptLPSYSzvAieha5Xc4uLB7MP0xWG3kHqmFpzP6ZYZyAl1my96fMKgL
+OYko8I+PLoTCFR4FMVGVeNUuc6kUROMHI/UmWssUEIw/e7m1gQ5va5K5tGu1baEB
+yxmMM6/K2S/uyuEMijZGOFsp7tJKTVqt9P9bkAP0ehA/HFcWoQOmvtK220832Ag/
+y6SWvUp5EKvKxF2PTI37WE844opfCcznZQ6MTXGa+M6FdYElPKr+EwMnORx4bkzl
+evCFbz1zDa53b/QBlynINYbYzcC93PjacUxnPXxpBgIz62VLlH+IcA+2nCLQWyDt
++LdsIhb/OXFf5TtFZOUfQaczXExb5jmhb30hfuChGjyhMtDjCvqj5v5h8R+Nm5pS
+bcGOJScyjvujYFbf532ydmNpsRCM0pi1PPlwXzhGnU9mNp5JmxS2wCx6tfZWIaac
+yOmQZy32BH1TMaRYJivRHFLGzVkxct9r/3CI4cnvv6oEnKo+GMNRlHRsOw5457jU
+2wFOgruZDSoDhD8/+ufOmat0AnMUV1btVzIRjGFZxiNUWZ+a25tOCALyuFUUa8Z0
+6YGgtBtXkFxZghEGPhOaBq9vUbRPyrOi/1qhAnYJDJp7yqY0eDTg/lW85UAUDxmq
+mmRpHsvBDJVHqWrwL3b13pwhtEiiiWpovbeL3gRcD+vbYYN09mpiygTC5vRXbUX7
+8xRONmqz8z5AQtU2DE7jXNIn+R02Jjt7NB+ODqMhB1gB9r0Jo0oPB9r9KYoR5s2R
+TO/uYn+iErbhWIxDnnEh7oJ6AFi9y2IerRLgeY1sPQQn7yCc8dPThNnh7fgp1JHj
+iXEZ752eLHuOq2skQsrpu58s/62aqHzbAAxldJKVwRa3KMyHQcVoH6hLQjX4Gjda
+04p/8clCAlN6LuacDjyYWVLBDWlwln41o39Leg+eYBIS7TBkqIADB7wCBkuAP3Rd
+fY+3jO61aJb2dnTWETQ30+BHY7rQU7HwPuDsZjhfm5brEX2MvV1W9arpn+TtQ6u2
+oXv1BtecTBt9Mxub4KCQO6i20+zGyuIBrpIwxQbauYul3Ow393G3pmhrZ1ePEfp3
+cQDLgFwakFV4gd6NlLnAkPPEokc3+NvK/gwqj2hJ5uvKEBwln/9zlja5PiLFTLc7
+sDNebwsxC8VNhK3MPhFHHVfP5d+xUBHjEMRPbHXZLubffeZx4TIbC+cUDREbjy6x
+565rAjt7LijAIfEgT3H0Tky+N9v2Zbf3RE+o/5ZmMnnwnFSPn+GGhqswzj1OqJ6d
+42575KG/504ybgdFV7ZJvnRQO/P0Fi803voFgDyKC4OQ3YBIR0MjfrfPZKgxGjpD
+WazGYo3JEVIU5S2MPZAfreFDASHl/yQ3E0liUpMmdNlULkB3M0KacUg3SRi0bEdo
+cgCuZZnFEPvCFLPh610WCIhgcQRNKhAdFuk4/947PtONLMpXcmMMgJ0s1neoQW8r
+sX4pwcq+c6Zy17WNhHmIbxUZ7YBmxRfNR9lsl4HDy8vnlaxsXXjNqj2znjcMcLIv
+GHlAmLZ2sKi2M+MD/8U4f0EwJUimJTwXwaN2nSL2MnFJB0+1b9JishCIotMSfi+1
+M5UgeshyZCNouVQ7Jp4c7EDkFc7/PPWij8xld6GiGrSI2o1R2PzWlGgrmmD4EOty
+wF+blFLd/t2QcehNZSQd3WsiLot5250NhPv0iZExNq06cBV/7z/mvix+i7z6XZMz
+t8p7xIACnCfhpFRWHobLwPs5NQFeadlCRozUF/dvUsnp95QUQD8ItDqK0ktjwuAv
+MCnIkEl84XIVtRcAjtbgajJgawOy11Ii1tUvZs+/ik0ma1qV+y3AG+UVsDOcFVwZ
+G5/P6y86evtL4oF8UsL8o65EeK50lmO7xpPJ1axQxMiksLHBfsy0Zpp531rRtE+o
+yoDm/sWiUrl2lbN0tsKp1xLqe+WRFlCML3EmixtCe9CAiOWgmfHlrdi6BEimqx5a
+6VcJ87Zy246/8/wgl3eQSkFzki7NcUJpJe49gKFhH2jgzz0Sxa9ogOkQ8hmzNkUO
+0JNBEtqUULqM9YaJ7YBCliP7aG/QiLEgVwcg4OEZ/t5FxPDdLMXquLWh6uiPpSkK
+JDgrLaJCBw98kAgFGxFOIKkv/ueqiIzsF1PSEuGgy1zS+ieiX7kZgT5J+zwK6YAl
+f21BaCiFYIl477nJNZYYAfT+sJeVIC50K7v3FqD+MAD9aAmBNKdOlzhK1zsEEg3O
+quF1YoSeGG/s+l16Qs8W4bEH7ByI8TOnTmc//lVcO+l7jlfnM5hcjeA0kgSJ4tiW
+XK91pWZp30VU8Bx1wva5rSuW/SYd2wD/wc1RsrXmilEjBXYzac1jW9KohXGkG4BL
+xbEitVXon9uJQbHwVe//QV+6eOuE3WPBpSBv4F933jwNlteJ75kYuf/sbOyrXGbu
+O4Pqu/mlXkV6OEGKXsVJPZvDgCK9m4nzWNGUdRNd3TLrHhjhnw7+F2uNsrxxbUv5
+UD2YfY4xDgBjq/49tDe/hcw4l8Z+IfEcz+er1ltdcFHM/lmtvlRMzN7pAbR59Pay
+GYuQ/B2e0JddUgneipLsBnbJixKka2iItYt1IdYO8pYEjNWXCioNcixqJ5WHYwx1
+CjKcoH+CpTForecWIIiWy5HX+ot+PFA01+KgAv0Sgr1ynHv1GuGuRvIOg+488Q/u
+FRdbFIUzUqSqI+BV/OhKvH2Oyj4tuhaHMs5YSTS23UK9Qzs+wCTY36/YbMIBu8e+
+5WCVmEDJo3olkaCXcSdSq9Fl+jD0cZHqJoIF0lr3VNMpaTEm/BI1iDbwbcFqweZr
+vDp1+PX4K4wTVVSLsK5HFF0QUgz6pEpwgAO3yZSy1aKYFnmMNJBsYwU0W1Jh3bgt
+hTBEtGq4N+16LOFCiN2mpkq3A2QhjjMrmWL4PwUN0LT6zqXydxa03pAmGlPmjCJb
+Tcp3/0Yu7PH9Vbpip7bujtVhnJyQ9u4gR/79iKn+tKVI3/CIyl73kq1Em+sZbJNm
+SaNs+7zjJPWb9UZETBxhcM2hsWSm4iMY1KnrLYZGWHOrr/P/Nm01Ds8BKSji0yRW
+KiY1sNXe/8SffJOGJNwv5x0S1hJo4l4mi/5TTos2faksVKNqKKARBF5dxt+hd1wQ
+GBamSGYpZUW39pjxW0uuDt6bQ7Js98VWoPWi/GrTPeF6GzBJ+SZUP6n1h2fBeZ1a
+ysts4qHv+8rKWLKY8sDtdARS0gnAVko3k36Xza5gSF846HnjrrBOkxxhsSbaU4Ng
+GV99KSk+M1ASB8ub7uUltjHK9PAXhWst30i/dX3f0x9GXNlKhrS/NI6ifDrtRN4r
+QRFDcGKk+bfpczzs4qLYANaV3aSdJWHaHGjdqbHj14sBPCTPdhFSBttEOA7EW1ij
+nGJp7aKp2Qr+97OTz1JhjQf2X/hXLzl6+e6AF3L1jya7+YOkfRI+TeF3rLwSvhSI
+plkXChG3jKzS3IV9TE2PMUywF7M+bVwIsAMO85zPp0V34f95vO2xB0dV/oTRWM5F
+7Kl9KKL5rviAf4tAvoDGWSAOH+pm0TBgIF7kaRFsl2IqFouc4k3ewKJNzVLXJYjp
+b9mh0TYukaBtv4ypJSithRJDKq6R9Q2k3GwMKAE2azFSJxazK9TXKq/l32GnPjeJ
+4yTsPKxIRub4iMPlaLFnxgxtOVwlQtKnzoY1VJiwrLncOPu+osnXKPBaGxv0LPBK
+B18e3sCywoC/1cSGN1mQGCDsAjrAOOpmurZIed1INeqeLuxoymJ8rAI4DXB/FEAs
+od8E+kPvwZR1TXST95MXpKJ/v/jLy07YT4cmt4y2iDJiWXSvxdh3LhsD7LFNItyg
+rBcuvMXmBEvQxnlrFPcBeK4YIvDUgzBNL/bRIlxDmfxjiJXq5r8ZowYaWWltXoLd
+W+ra/dVjG5S9IKD5wF0O6Y1bxaghKGuGOUP07ia59ghSKGzUl1qLDkrwRaoWNuWw
+OLSC1Uql+CkKJtKukAn8j9relF0lgtSOXk9ieQjmUshZNyeixYVQJrbDzqIzoC+F
+n36qARbLc5YtCSpCwyYK5VA/zaIvDv7X1sTUFnc/3x6kWXx4zMHicCcal0qccNe5
+/JBwyxAwykn61Bvgcbu112pkbHNblxV/BvoNjDHap8uCuqOhbF2aDSnMglcGPVIG
+rF3F64ZeiVNCx1HQpmMurIZ5nBXF9X4NmLr0sp9u2PaRQ1WKEGqZAHExSp+v2fSr
+8AtBS6oRQErVcrEzqM7e94DP+RcSiWeVvzi8NjAecbh85PCOeO2Lo0h6t/GDHeVR
+3Gfd0q+mhB6wneuXkSTU79zbEzCrJ0SGJNrtkZs9ciTX9fMj/OdhrscHan+LiLl4
+wKtwny4HUOkeyC/GfC6UOeJ6mK5d+a+3qu8hPUCVm38jHAVQJNqhT6hpwXOWk2lw
+Pv4inp1f5oEiVBsDAsb76ghEmoCY0eGqLGuUM4WyzEBIXnfEZciZ2h2QOZdWKvzA
+LaYIDDSuAGidSpmBKnakiU1ZJSThdONnPP6CVrxkQSFmQCQKMObv8c+eSyY3DreG
+yf1rEFiBrIJKMPKlAe7szQdKeY9+0gvMuONU+i5a7ETiwRkMO3TDgEyDuUnViMVC
+vTfvUsUHAEDY6ZYabauGlR/Em1MZzdHQWlLhYvOknauLLsSKwamfBvtlLR6Xqp8q
+cVFHS7GPjCgc6efYr9VeI36qryRDei3DMmXHwF3PXrn7yiuAbcs9s0x8NmtZa3lR
+tACm6eTBzyJi3PR5JEYODpn+WgPANWmkpB/qQCqJCu2uO6hQ/nuVfkUT0lwcArgh
+IOKZ+Pvmqz+I+dx+z2wORJHvz6GeZ0Krb9sgGQ0Yo1ZLmLp2mugiTjkrTfQK8eZ0
+en4LDKOBEsdrr2wPmUyZDW/EpdXCGDpeOfWwdG2OCMNgZpcu2RQOyiCatpe5yTM+
+oozYcnr1AjgufCgMpXkz4jKFUgpXWDZ9jWRBid4mb1UvLMwniUy+4+Qiq4pno8bC
+gBa5+1ZGTVvHdkzQMUaD7yDqk2r2hSEq40IMhWJqt0QTYvWf5d2VS3tJzCENM2SG
+tifBTFr4MjUKOfxjSJJHQ9OlbTYqUlMAgKyjRVAp0FUTAy/U2GZ7jXbco5IOvcZf
+K1wwRr72FpxCd+/+oOQ2qdi3+81+2skTkRGQc8rcssDFxHhamQTE0zIvnOgev89e
+1OqMWh9RHnfn1jIl1Eq6dIWemyfDEjuNvTFqpp6SRCz9lW+B7E9kmdvzHfUG+p3u
+D7/DqkVTzl/E+r3XU3WpRCMuS/S1vCqyebpwvbjFL0hxnVBIc+ikovl1rerIUsVs
+rZgm5hhSyoXZvcbmiPLOtdpK0JMHGiSlsN113IGrayxoVrFtEwwHeo4XLySvmoep
+UOwr04l4nTX2ZFDON9CXVv9k/ZIPJqRW5xTYsxehukrWzLwIFg+SS/Zq6wHDwL/9
+7yP+J4FbdSJBhi4iklN0dHtcNk/3jfDKmxOvmIx/NuE4a76d55/aB3Gh8P2Ka7RO
+r0dCO16X4vtUtdxGPRVRfj2E26Eg32cucwRhH7HyKoTDTkzK3JcOUEDBgcSSGFNB
+VZUIHELbxjJrYw0M5SsTi7uKl0XcPFmm9HAJ+tBuue8UkERGyCKQrm3/mmS24LI4
+7+rG6sjSHsNjzCF8GQHbFD4D9GpRdnpdrDvhLNtSHvEwDT8+QLKmrHDTCUxLvg6c
+DqVA0H1N1HkepT3Bp9Mpjy4HeD/t+kotA1S3izT+K/r78+RRSAggFchCTPS6CU7A
+DLTb5bVowargoQtGnGIS3X6wKw7T8OiSp9L8cWcfVpzk+QbPLCAy2xpxkFwLpgcg
+ZW9WBpj4EldH348QFXH4Be+H85OmD9rV+m6uh0kHjEff3J4qL3fza1zt2/PCpSe9
+zqZ9ZbGs4FbxRiRdjFwskIWBLp7SnL3RuANkeAkF/0ASHbDijB7Ct9TaVuyQq5cC
+Tk+BfZx4XpmU6Kmlp+2FI2nL0tvgYv44wb18yyvQ3iQXvqGxX9kR0AeN6sFAjgUC
+byoCJdVlYswGYhPDxkNTDJVf5gVmZKg7IkdmfjeM9u7zSi01QOfXW/E318O0xvLM
+5hTogFFw4aBDl5TMHHiJFce+z1bEric2T6kqkOXlocy6/Fl4duorCJdisemInd+1
+HyfC3n6e7dmYkGu7vw2X1v012LTdbsYaafKF7q3QIKZnjW9+fAo6elG6x79xEaBt
+/l02LEjwEAFc+bY5TxHeTz9ShPY96ysfqruD6j0kBWmrnUm+Ypv3jbdu/dlI4IMa
+wfO0uZNDN7PkQCNi24tf9ngU0ccx128H3keEtDtOVQj3VYa1LeRrrVpe4J51u5/2
+L9mCUVdB5WlPVawf2TQc9gzHsXjToAFSWo/kg0uXVlNTylf1cgAKsCc/xHwT7Dxr
+DLP7kD7VSdoCKTRDtn2yuYyOpgj6KYgzGqgnLlZYNRsLBUYBcNJxe81n6qN67SA6
+XBZ8UUrfAYlXt2M0Qp2oxIpKlVVgqZo+g5pLuZSJ3A8eAzDTQu3emBm/mzJ9nm+n
+5yGgSxo8VktVkyK7Jsn7fsVxmo2hSz4gx2nsIRB/Q4e0jt5JciLR5QmhVK8vBWr9
+kDMyjnASkxHFflN79aSDyNLxuYi0KjzXYpmuni3gEHaZeU/uu5haJsUdlXKJVyv6
+cGtccWswObrf1E6efii+hn+NzN85gT+Wkwi3QMY0UP8Qsix2QvvJUb/NT1jptiht
+uvLRl9ZNQ0NxB+IrVsD/V2hYyhVleDvSH/wyDk+5e+r2vKsBHAa1QN3QDodqIOA3
+VO7R9HVXzeJyFNXAWFwZPJuOEW8XjHpT2/1YrZBFc0VCRM4zUtStRTZ2T0a29OeI
+QgUv9ND0d+vHfxrfW3/t/fAysyrMMgrPdGdQWXGsAWNVjH1VhwuXLVKLQ8R8mMgz
+vElMSyaZPSM6Pgg4QVHlHCeTy1vfB2ZU7UAp5cq0Op15fqvNzS/z339mMeqeikvM
+Cz4/fC1iNSebZx1r3FtEZMzIPwJbCGkd2EpvxOE8R+1r2jUW3w0XctAjLvpacFe0
+ta0zhRO/CJay9Figs6FYmGSLPA06FpR1J18NC+fQOlwPfhERSndX02ZPKEHYY5KI
+rnAr13xC0Ad8lO/x8d8y4dHPdVc2SVd1gfMHfL5NzFosQpZDR14Vc5PDl+PM8v0b
+QhlPsyZxQ2yGdQs/iO+9GezihfigJUFLMqAb13FJ0ynmMc4MHVVaM1T5vhnAMmzZ
+iu08B1kvb0kSy9an2mn1MskxFP0qGySvcutAb6eLZYC1hqVECI3CYxUxWjuW9DuW
+b2GMBZxPS1Bu0YPpuB1Oq7Ms9TEfuf/5+XfSTKWrL5oHbUs5P3juYRVaR30d1lSr
+GDBWN7UW+9U6I475ist2rG/OhOlhPmsey5/1RHwkncTUGp18lI2t2zh5Jo3pJ5ao
+6nWNVcoQCEcSTthxOOlw/pwZnNoCx8hEmZGsXZ29zC4EE22ThUNRmFcyMR5dgl0a
+gFAYUAIFT+RyrIJt8IqRVTSy/08BKgag5wLzJgLfxDC1RO/XHOxdik4uQXoHkAK2
+8iiUMyPrKpZc+81TaRGAjvgHqkW6/UEGhjyz3PW4uxomd/LhRi3D57R0h87umzn+
+6gRXcC8FN2FfC5LjBaGwUwER3FSew02j0R7ksKBNsJbTJGdLKfj25N0Bw30kuzy9
+XpouaGXtuhfOl5v4B0E9JvWfhvzBB3++tr9L4hRX1PHsuNeSl+s27iv/DRQQFAK0
+eAQX4O7SY23xbZVu4nWaGSm7gTCS3jo+RtwTHJr/jbp08f7WHWyKiEU/Accu1KH1
+OTIGk5cib4vOzCxrV1G4mYDB8oliHGAQQbGP4aGX73Il7vAO5NXRkUvo0q0r3O6y
+yXEeFSvt3G8yLZxaN8fBXuQ/Y8niMYtD47aDLh2fNvhNb17ZgUyVGL6LlipOZsxF
+pz0VGCgpcBB72sJsZl5MpkRv8cs/2ezqTqU6Jp3Mv6QWk+qqvKKtz5+0b/iHgoAE
+O9Lbv/FZlOESNKr6/gSJjxnrmfWShslyX17RaD27tGcq0bTbV5F0W2KaiJkkDvUm
+gXxqb3Vw6u/QICOkf+009uUF9bIMGyxkM3RtbV6FN6VW/d44P46rcTafV6ta5njS
+PnkfqqbCvQsM3H8UeIS++9M2OYAsjKIMXmCeFfLTPSLmbxpVbeFb9K/9tR1blrOA
+6HwgXWUiHAAxRVlaBfiSbTg6lvIJX9xtZPd+FVEYkBJo53LVX+WEgyTIUjWU08GD
+RvM+D+xjD303WHWhBmeod+yoyrFJQ/yK3CSxJ8VJMbfwjSC4hzskti3W2MXPBHAF
+BOH2PXRmKbzRDjOqNG2s/yWAhghzDlobz2Mg6kxtd+ksbSDKZaCOhfO1JKPTEwmy
+5vjcIAt58RVV/hZMDtyWIjW9+rIKYbd89YQF6pVlbY8l/FqvDIWbzrVnWMDjwCGG
+z+xE2f6yaAHHpA1evTjktp3lIG9h/jX+oFh9c0fcfr2CFA8I9fciJEnM/xTvfjcR
+TItURG5wk754OKd5+70ai75pWO//W2p9H9oe8sU3pMZOhUrG2m0qEJuNrlW7Lzu7
+VUHjsRdPW6glMLR2XLl4f9rEo2wabCeB+MJOCIh7zpdfaUlscp2bBf4jjQ/D4JUJ
+2NJXrwRbb3AH8IUDPe936ezBNsuEzmXczrX1zfudNcu03Sww+gpVeO7jgne9NO8J
+idJoVAaOr5kg5d5ELXiXwrkn9p64N3G+GfkrIl0o+i8v9DjvOI8LB7Mgezp0N3Xw
+1PxlXr+OEGpMzL45wXiIIU5HwSFt2xjr5PgtrQdT/GCrczuuOVaqxZi7IvqcD8pm
+W+RPgbLp8M7MAwnk9xaRSGcAPN/rTIbHcUJLDxf1817UvaU+uTBSk1mjR3PJvnYC
+dJ+lmwbDdFc0wAMpYGAQok6UY1nNEmoO+ShJtPtpWS7i+JI95xXxWeGQt6nwx82Y
+hq4oehog/TOyaIwK8JMgHTsn7X0iaK//LzKTYJZann2pUDIWVjSJXfJcRk3d6xTj
+doJv31cFpL/Dq/H72YRSuxKOMuZKAlrRo8i748aUD3Ft2cNUrada7Q+Hbwug+AoE
+cidJSDidpllARdxkGda5useMKH4XTUd8QN1oEp05t0jOfzYREhHN542r38/ghEmv
+2APrc5VaTw5dPkxzqUS7RB3AdhhptVu5IX5N78lQ8H86y6BFYCNQrgs9PX4nODL6
+J4Rg5EBmWda2VZLLaToInSl5i1udVmZMoAnRAJZguT0UTrzPYOp1qs3GCDSRfjy0
+vR+5vCqHWQw60Hqs9EVJU+xbPojMOYGmSP4+Kb0H4crY6LJUlXwrZVt0l3M9liB/
+6H4uNh1K5gJIMgMiaqDJWLUew5MXr3p+roSfbOrHgI7OwbOzr1kcnQSU0lGWR/1a
+qWdtGa30BDc6MbBUdGj+faZuAOitkuNck+PfdF4OiCnsi5giSlx8UhIL/YzSSXER
+uuf1cnU9lGuS2XFz8+lrGK8YMw1Wz7rdosjWV5aCel2UfaifB18h5FmPtnUZxvbS
+lzmNBqMW1Cj8uQ7Bz+yGjZobNMXSaV14UK+bJFeOBpGEwxrnH0g9z6gwWY6X8iVD
+2MmeO4UAWJSGM2Q8cFZgez69h7C0SswUivc3OTHDQrMKjVWSIB+ynHc0KvbGv+TE
+hVdf814W8tIOGnonc45pADwu5x/deBE1V8kyDQ6UvEGfOfd1fYefU8Ml4vdKMG2w
+7PW6NE3//JfJCZDHzUAGd528Bb1PCOffvwUBmMQNOvhQpi7ZXG26R3XBToXssofh
+6ZVeqKlcZdsiMKfH9ixMWBALs0C52IIjvoS793xqfAScZs+ycAzVhEOzlqAGFI1J
+WBYvgpl8psmbqcpPapVwL/X+cz4MueftmkQKvuOSI6G9gEEKRZxnwfoHX4Zden2e
+9HydeIRxgd43AJaYpsZFY8hA4n5HGHkehs5zR35Mqaxr9XOfQeOZ5I7Y91RVc0WW
+VCVgtQ7LLBFa/LYt5WWUP0fBSvYge8jAbHVwgcypi9ii8UW471aDpSXvc4tGMMzJ
+KMvigizgGP+709SvAuD8AkTWa1kzgL77J/M77icSgztTvdIg82r8v1nqq+cc0khM
+hJYW0Na8+PLmfsSbNWdNvL4jekCjID4RS3iEstZ6sK3y/jHGsEUAkQ4gyLJb2PbU
+l3hwQDg45G3lQ+ULmK9FS90EqPBFNnPkFTyUd90aJVgShChQfwqcaDSBcVb+lU+1
+/G7amMAawn5Bd6vu1lxdfUiLgeu9xvCFF9qmPRMD3s1Y13N/n37gQPUWextSvtTu
+0PhuMpHrt4PRkEoFYzM9kQC3xqREgdHSKfrkx69tJ3b60RmPPVpQWnjXT2tGhmdz
+Vz/c8TvbNgwNmTuKMRg8dxeQbEch/D83hPLvQeuVCaLBdR1V0SpT/YlIiV17HDpe
+XAlO6nF79ZMtUXmufbwuGJovpN+EjUeIOVC639Iqx9a9coBFy4QP1/nNfrAWcRfu
+bVndIKDUFZ1RDDbD66WVOtxE6eLEw6sBFIf1NXOuzGSDJVXMl8FxZmbHL3Q0sKvt
+NvC16E3TPlXAIyVL8B1L+qyp2HQcPgJbc6U54ZB3tcEzyQj6vjouGGQPaauFeaK5
+zCLV0JGE13Pjg3YNQ9706sFK15LIbZRtM7GLpbx3UABQbc8s3qvLPPwnhWf5hmuV
+TNMBQLkU80da0QL0mWTTKMlgmuvS4nR8WDnMOC54ZWoJ5QUPg3n30h5CXOQnE5Fk
+E8qYel+kOocJHLJ7FV+JeBtuLqPDk3kfb/Rh2X/wbyMxXzqminVIcDMW2lN70sKI
+tAftsqSigTFpb0dNLNKb62SXWByi40cN5F2fi77J1y0hD0+upVRfBNsfN+FYDJ4b
+o+bolkAq4WdeZUlrfk/qBfPphxtbxDIZ7Xi2YLpbv101ZmVGBrh4mkrhF05taqZe
+n2TX7rmml/muEGUSXSmXOWn1PNe0qLkAh1kBoWpLDtCzdPicEe3WZIlFWJhAvVzt
+ehbl/kJsPI3tNvzXj/yHz71RSGbzACHU06uWDwYCS2ebCJ9HhwHgiToQGedC5A7o
+zVm6bmasjQIBvlVvkzWKZYWdNRBGlBFZKa4LPGJeWBED++zPxCUoYH4LVcSZenUF
+f0OuaDZB8x97bgJa/c4WubzhSyYLiF+h6/SSp3x6IbwicjNuI3fuBDffD41pU/lX
+MYVYsrWDec29SM1R0yy/cxZVcCaYmLG+XeAt7p3bWNaguhOGn+2jXWU8gquQXzN7
+/z0Pw/NeA9CevMAXprqy4PF45jJJq9NbWT5g5K0pbNu3eh3WudQY4MMx9iM1VHge
+JtN8FkIY7Du3uPMnE4Bfl2kfg7NNrY5q52ifZ3v/bfeTWycx+DlgaN1tpZoh+uMe
+nEAeBqEjyXvlcmRqClMCfSonPSkm6mANEvOdPwkN3eW0EFTjBy3WFQ3BJ7cCfWTy
+IZPw4YIMBuKdBLssjNun+LImfqVs/Gds9A7/W1065PCk0FZMQe7Nb8MsVWmVXT5I
+zMODdTcxVP1HUy439sw7iHa7ky4CUCGOWcFeReMZBszjRe21fMrWaGp9dbROsmZz
+lhs5zz27D0OTWoy8cyjuNmP4hrtfDEvp3YlljE4YjNBapxe3HwW72gjrMIHxbR4n
+L6yabWRcKEvF2FlbO1hLAQmu0a34n1It4VUkiCgF+KoY9MtHhtWXsYdOy8n+H4kt
+Dra/1J9P1oLIDHC6KknOkZsAaA2hdsnNt+GPSEk9wuLT89A05WS4d/kh9zDQpfXa
+qulxmJhQ5Wd9Z63flx7nLM/baUBiPfoXnuEx8pLu3N4zHPoMQvkwkQlJuYHE/WPN
+PTK0zU7TXPLTgRaSTe0cgzvO7XdQzOMJJtrS2192SaI8CLmsY0eB9/kk0xh4541j
+lgny/q6enPMKitl76VmtarX8EjdE513ivy3DzRU9Nvb3NpPiHPR2T4IK35OqNqXi
+cNnXclTLmMZu26OD1KtfF2WyqHUAhUEJtYDLo2YaW5VAAxheIX6KFI8fXn3mIjOU
+taU7XsHtUGx5pGNAKNBP9uu8AHnlX95jB3TUo5bOMCuvYOb7Wys6mnDcmu+fHT5/
+fXUb5rXvz5br1q1ELMvhI1nJ6fHRKKeqSo5Dsw0zz2L4stMF9vpQ5eFTq0PoAT5a
+9EXBQqJ5fn9/c4ZWhp8RDl6gkwxwTy6pOQcdySg8JJ3zMQHhHcD6KAhjALq3+SgM
+j8o2mUBQxH2pv0Qcb18ng90VcTO0eFpWvMYqbuqFVWaxhRFrbG40Us+TgB9MX2tt
+78CcAMlgjpXtIv7XldxJMwX5s2bjhJ5k9/OZdVmAPaNnMv5Zt/EDtxtFGFuThPpt
+F4gIDdjr/R/eqch6+oflQv3Vyfom9fL2M2xMIAoy2q/9cLtsLIeSMxpkee1q5cm3
+6QPwubR0bZ+BB26OzQm2SzdTm+gVbodgJuH6nyWVPcqQfPNHu2vpt4QJ+ObTmHUJ
+GQN+4+D1zYIl5pzysWpOMU4wwFQFwueqw/LCmcL9kWb6DiU/zijB+UjnwYwKE4y3
+CjlI9g0g4EuNjgShnm3f55IvJOAL12p5HO4eF+CPeHk76KXzm6hdHYGoW62UXEaC
+jf0XpEOHnSMXjRhtczkQ+sBiosQk/hKL6dQFCL/jKC7ciuxeBYhrBDq04izoFLPm
+a0gj84TnmudWJp3xrdQFMU9Za+NuoW3I2q5m/IJ6hGTRHciR1xF+7nlrXWdZLovX
+mKIiqLeMWIl6zl4zK+yuRtaMGclWHd2VPMeHMexSAKcJvXA0G4wrbU5Xfe1WecZX
+I12v56MAyqLZEjpz/jXs5oEqEwdw5f+fdgdp1hub4bSkN30gPiGQz85FIEKj2KbM
+Vzjx49umhv1nPX1GRPPl26W9XSXTBmjTJBGrWMHGL10/ovViaEeHNZ5Avfcdz59c
+DzENV/Dp6vEM+B9oyXB/RQh9xF3BhNrdMRES4HJexR4Xu0L270ww5BgIIZ3jkh/l
+gwKUjuh9vWr0w8uGqeGOgVswXRi9OB8qkDJJRDtjm1+AKaw6EmIS0OSuQbhnohFE
+dGNWyGYq8ZHfiwXwsN8SEBUybRvevY/UcVyPkr+rsgcMlHhYi7rXQmRkAAvm3uPE
+81kwHnyib/WRqbdz+6edbbIFOY7O+FjPDOViX7E/8k2CVo5gJwYnbxFabGL6xB8O
+BjI41CFlMiahaj9FV/id9S99vkxhezwfNDp1qasxJUH2usdF0bnF4BPR+9ZeJePi
+bLeuUM94dXiZ/BXg9jIoZIsGRJYu4BsgNjyoIFqwkf7z47aW4zcSaxEHP66mrTgo
+xwGUmkGgZjTCvpZPJw5NNygZhM0mypde0bb4ymZBTq3TMxEq6a43inj0mj5IJZtU
+9VXVmN6i92b5LuqnCFlE0/j7MsHE1qmrjMShgJs5RLPWTL+Ub93Pahku8JJ9OEQI
+IQDVjrlNnegR2AXfitUTJGvU93T+9jJo0x9AqKVkSUYWT7zIV9WdLVED3oh62iZA
+RB9V7Gkki/2ncgtniFTz6UZ8EU27n/E1P7sZFRNa9AfjF2jINQGdh4nA+8ouwbak
++pAy3LR1F7osyO4k3OxkKzV5f5k8iB/Q43CwUOWplO4MSU7DQWSjySDk6xAFE6hQ
+fdK01LL9HCfAWhLLOtBrPczI5eCAi70+p5ApC6rxizp7QkvQX0cJW5YkfVjywpvu
+0nsPUcfwvfmIcbHEqN/h9nThLF2sgorX8nbmqxCW9rbcu+7ph0qR0AsiwVckhjfH
+7X6IZXMXDBbrYXaqOtsYfBZKqk65il9vM0L1eKgTOvg36CQ6uxS9BT/f6iViyyzH
+7yKTG1So2qS6xYdpxxe57zYZyCCRbzVN+HqCpvTek1IAt1Bjm+d8wQvOPuTIyuHT
+540BLV4N2USgyDJHn7/BrxEalVXm3fnAeJ6CYAzyKYlnXe3vHueYjA/U6uN1pyps
+YPrqLprPAPw9TT9OVqGef3ptpyP1rDRK1kkesFF69KQUvA5yWaWdn0oysFf49j8x
+HhHO20jUE4otqwbLhEdJYoH/eOOyIeDaN9ctO6cnPM3tX9WxnThq3038BWCnN11D
+h4aEMcz5V/hPwp4Hb6q4pYXlJAud4XtsJUIMrpkJ5oY6UYSSzyFzYAwkPHnxeWeJ
++FCe4cT6zEdiOpG5AGM0VLbQyYujl+brdoK+qFAih8DAJWIh4c/ceZ7ffOrZN41U
+qBZtDAAbhCo9RSuqlLkxbL0skhV3//cNS50WfxZ4Jj4MQzoAq2aedS+V6wiQ2/QJ
+sb4nNu4ri9WMm3Htv6c+foMrFYgiXodpb/K6OjyaFXYEgoSRK+QYAUHWgPW80dWS
+vCTY5kCcRy0bocDAWwQwKXH+NEAMBfbBdcrmdQ/m7ixQl3HNtFpV19RgDQBYeULP
+ALGMLrzXz0vTAbwGGmHd7boIGqRqb6Q3G6pstbfbjOxRbbcCYnc+YWtUX2iTmv7G
+B+lbeglufbPchDrgEbDBcokl9UuUSpRtbVOPAsqXiQX9gq63D+iDjcD20z5u74U0
+QfXIW8qKT6OVJbjl4OcvvPm8jjAWUOuE7XGnkFcwW2WGzPE0mEDf/7DNAbfDSjN4
+WQiQXLO02FAK1w8Afn53cb8NHsdxZqQf9meNUh/wtoJ53wBZjoCqfziMzNedhw1a
+KMKYTdTuHn2NfZqMA38s/f6g5gjRukMYEQFQC0U9v1uxNxj6Tfk90/Pa5SOD/wGi
+0dmDLp7WSIfOEASwCrqbukMfXKYCmbMyXPFIYD7XBzfy4BqZUIrJT4DjBw7fDhmQ
+OmJo88AELpViHiOb8cRa02ft/D5R3/Dy6r8e17HZk5ex1fnqHTFx8OP9ZeTAyY5g
+lVam95UVJmxUN+ew0IhF/ZcxFhiSPfN3dN1AFsOqBAI3YEoVaTzL7dv1fgEdlS03
+9XEOyq1n+cmZUMVt88rzlB4s91sHm4SsomF8dQn5l2K5xwJQaxcGRrAY+LM+5JVi
+CSsXWxp/5Ihwp4cYF5xTAxg8oRTzppvb+zNpfuPStbkk3Vg9UFux6Ft9J4DA7LGA
+Zymna9ubSckS3lJwDUIhKIwJXBfjQOzbUMRfgxAeadD5VKWmYb8D9ci4H8H4WOYI
+kC/PuaYvxxknzxODHu4XSUEHNoz+6iqwG3FHE1ZtUBziZUiigq5dVcO3XLtYbtIh
+AqRe8+Gskv/oY1X39/qSuP2FruTtY+WCuPf0LMTU1/Zf5/U0SDZU8cndKOn6DaeS
+J2m1H8Z8q7vC47e8Rx4X+cwlcicWaTleHjdLOhbco0vVWlrx/BuUa+1p0ZvW7n/T
+O6qG8pytK+8gzZR1KGMU7HWEpGZ0d0TRU2ZV5TzKvmDterbXBQOE2RMCq8FFvpoQ
+jallTotlVnKyFX0E1iWXzFE9Nr9wIu0HKDr72KmPdTF98Vz17H7HzFWNEWJKof4y
+WxJhrXtln148f2tTOBrqpt6Qxlv4ZwxpatuTjKo8zCfg/jeTTljU+aytDmjYQE25
+lZoA9fayZOPp63JAfxewqtXh6uT+lyzIIyewNF0EGfo2scHGd01KFwIvUaL/h3yd
+jdZshrglua8XNOnJo/nbTdWJbfmmHOyLo4sEECro3X9jaxWbNXQm7US4vX4u3TGf
+i+qnli7sxyFx1s08KByziukdN1ePCQhxmHMFRoYem53uYH36xU8okyCFDfXgqGhX
+nesLCWtTGsLozSKibRa7z3rbXbrLnDw0c8dAVQDD10PHOUidT+aIoEv1bL752EgL
+xP3H9abC67R8SReJtHCKbgBSKiLXNoWo3j13VAXQwQh1zyS4W4nclhfu+xUB7FyX
+ENH9Nvpp2udhwXdeKQRzUjSrkoN/076mpT67Ur3vkX6/m3sSCWzaQn44rw3yoOEL
+0mGURJ+cAZAdiN/UFDzxGRUumw8zIquKzEsW8LiiGGtmQQ6anWUsZZPL2pftO2t9
+nWD661kPiP6GguySOIMVP30PcdAcRjIMqvHTYMw/c1tZZ6aEk0/82QCI/CL4CbeD
+mfqlueuQC8h86JzocLD8JE++a1pLEgXEYlaQS9N7aReNetrckUVz/NuaMgmQmJ4+
+eqxjo1fgqfpemnbN0/ytxTYzGrKHSkj9FlvB7hBhzHxe5fJzZxCN0Vu1B4w3JMx3
+r9D5q6MAOMneF8OMlpRo/TO6obVSJgtMrVQ6vIyh0ICDUNu3c5n/2bKvDlOfO4Ty
+CJkHjXI1tymRtoONDL6i009zID7cXKhdh7avjeCOO8/AEsvbDF5RKedIe5s5P8sD
+g7HDFsJ6XO9QTb/yVIfDxAewWOHHJpA5egAujVkRoEWXJ4lvUPdiONKw06lO2OD6
+6q0akLuIayWmwEt77YTLB32iDDcqNc32q5mJOay4zdFaN9o1XcNC4biQDYdOnMgk
+bTHYvy9fQ/Th8I50DYwBT7Ln5wDM9qSnOTOY2H8PC9kA2YrEMzCMCwqigJtbiC8o
+r4imA+g9DVoFXjzbftSZETYXheP2Z4fVgTie120OazD0rNS/gsh0EngTYmyzHKWT
+7uLMT4uYa0AQj68j7Y/k3ZMMMgPNuXkGpK4WKabEEAUyWCYS4dbJX2FDMNFg+Ak1
+QuKpNOIarpIEgzMY/ukObal7im+tqYGsT587Bi2jUDv0WzpKWqYE+NVlQL3LDWgv
+he/yUaRO8XsLS5eKnDBs0WRtEaZUaY8P9IcuumV46/wc3so7e44HvCpliWGymUrn
+jvpJzDfF15OfHuCW26onGWNoz9n8g9ltbZcF8fsfI3BBjB67wnFr8JHvmpljRB4s
+Fsa1yy0alaMXQOm54PLN0SGE3+eiPNlc6g1QgwpqkhAjkAdArRCB9fTtdmhgeEXf
+GKh95DyyNoMCVqjfMWyfVCVts/qSpC0yTsJ6fsl4xJiUrXsW0i15nfskkGeLtX7A
+ViDI1Wb8j3jkIaHqHX5zJPiQXyZ0KGPjJ8vmzkgNxm51kaqtWW6vOTFPTWsJeH4N
+8H2w/+Gj7dKmlcOnutBew8lmHvF1kH7fH9gvZ19E8EoRgkazW68iXkkc2Fkdym7S
+qbKB1U3zMG9em+YJcTci5v34Vw3QjivRoaZAraijCvyWyP5nPFrQHjxz2wQx/Ykw
+Bts/ZR/hDEcaZEDi/wd0/D/Rd5bdgmelNXQfgil8ZZHchwX/97rz4etVs9orYEZ0
+RIrXHpyCDd8pFb+I1ySaMFHkyxfc80mtRYYwBEJLclSFFoGVXtwXCf8JYR6odWHH
+3Mn6sTNdWPOIVT3XhoYhlwR2PdNoMSOj0DuPT8INEuniJUBX73/h1Bg+lhoNaewI
+7tO4751SPhkhnx9xR493aSHXHMzwUIXGODXZ9TKvDYxfBmzCxjXojm5QBedtHENP
+K2D2MrsJpRGq05x+7YKw5gSptuMvHrtOOCaCk8WMiAw6g97QMWLqKDyrBa5qQW+M
+t1GfPMt2IUKcBFQguBORKZin4lUqrjFSlV97QhaMJCDuL17dzmjDk8NuYy+c79yR
+mk9G+/871lmqhVvNFi7Ic17O9lFZcCBaw/0T7DwKrtKBpw4e9VpmXmVBYZnEuESu
+y3EkCyVafBu+t6RV3f3tz1i+6k17U23pCHqCqC9b7abpk2/Z5FWiG7Oeg95Y8zgg
+BkKCJyPczQLpacPRr4VhfapdXYczUBn6Fcl9Tg4ZAuPwFwjGGuwCRJxnfan2M1D8
+rR5NpsWbLYo2EZGchIMVxqmLz/JeMyF/41fRQZ8Ta/Wwr0FgTsCqPNwGb4fr/2bJ
+xV94nXTGLW3TwtbnsrjleRGsT/PbRK448KWpyhauXh0zEPhfQhM//f1u1DWaKGmx
+k5NkyQI3ypnsuBHCxNwUfUH7fjyR0SuG/ARsv0/D5j9ehLFi80N7fHFTRGwrQ4p7
+Dwd+hEn3WngoOYmiJzWxbNMIljvTTzkj8FwB4Oi9GEt2eEEK+qdJCQR/pSAwUGey
+xDP01Pl9bqberzswOrVh3V8cHWPjvrz/l+3RhyVdN+t5IGyQKewuWItGoUpV2kF5
+CKMvSzWgsxrmZHmug7jUTpEj2K+HOP3fLkSrI9FalECfesWctZt0JnNhAGxlMY8u
+Itj1J4rMnhnY2/B2nJj/XpodEpm9qC39AltEQXlQvmZ/VhAKWvgckjmQ0oLLlO3u
+h1jSGcHkyNzWpK1vSidi/EGttDgyDYkcx1S4hUwVKJqVL/k8A6UWr6B9SHSpPuYV
+RFMHy0lLt/3xaT1rx6b3q1Yw5eV16KHdKs9bsm2qFouymoHvMFJRbRbzdgBu1TPk
+WyLaPd+wchTGcaoehszRaNABmLhmvHYYnfEjmExcjGX4NJAxgfJdZ36/FBkCS0Tb
+CilxJcAt0Y/c8iOY99xmLUk5LapBWCSanipNC0bQfIdCWfrI+Bd9Q1TD0x2VA+FI
+WFYHw6tB0U0O5eq9Tnts2wTGyV2IYxbcRBYG+I1A19UY4NIybebmuy9O23oOkRZ2
+XhVi2KCibhIePgWdIoN86NjxEJcmpsvxZYFDdw9TWh5oKSDYS94hXdTMP6gByFKh
+jqLwT9x3hhq7ydU7cfIzCOWSFn9yvphCSoA/9FU0h8PKfULvEMK0T5erbdaE0pSD
+3OGwyFZnsIobYAT9a6CB0X71LStftg/puwU2CuuillgygzBz8nriRPooMYGnvkv6
+8Zu92JgwryJui3XmpKMhLs3GNGzYrxNzq0m9Y1dtOt2aO+zMUHtUnz3xXwSgboGh
+vkiMluaE+RKahVy2T8bbtkyp/4EPx2dyGOwBcrlwcgASrXuzE4obu6MrriF0CKwO
++jVZRiDLfdjT4224p4T76jY4yHT///W8vbZdYL7tr/t3rJpWBo3IPSMN3f/WG2jD
+cmGrUUrQZX7G5VaxT9rvxV6BFqD3G2Id8VqWKPzs+YtGq8hRa/Bz/3JCCY83w/ao
+a6U5lAc2Tf9Ph4GkXY76MahLX2DqeIyUWVpu6nGj5Sr8I1VdEHvP82fy7cOmtTyj
++fVO23En1CUX6fAA8nbLWZafVl8XXLKUkVEnAqj4tgWaf/AGR9AUpqJp1baLnbsR
+n6iESrl8bGun6p9pwUvJrJmMo+kMFEbr+9jsN5veEPmaACVptww/Sh6Wtob+HYQt
+R7jpIy4iIYLWoD3LtZGKjKLL3MUH7kAN1JvYgrpmGPgBhZ8CwUnPp3+qybTYFs4P
+SbAAo1HmVx08AQbwUP21caljUCKGzrzgRwaSwMRdzL7swr52zNXIdjBIRGa4oQX+
+ja6AmOc4LmYXrToAo7YV3gH8akNUA8P0i5OjcSrL+nOTAkGtRs1rzTJU6GeADq4A
+GFsRM7nGkmSsc4P2N4vwRYXtcWEE4DNNN2P8tP8CA92bdkpA9rMpmON9mXabVRsg
+Tscggpmtfv84485nMQ7B5iVgITVSyeoscSQc0lDtCpRaV0/kjepsT4+QCr3lkYCY
+L2DtR7Z+JsVKhMGqjFyOz7Vk0Ksw9/B6vczNxSPg7s7s5UFDtMTEj/iqOjnc35Yk
+EugBvonQA1sHpAxN8rngVtFSB/QMTeo1PGIZT9jN6/ATJdPU8MaXk63fci2kQho/
+yW9pTCp7gOFp8PAbjx7AIVDBQ6BnFywPtk12RArtbfHvqC//Qt3/hwDrpJ/zM0mk
+0JymxS090teCmkYtAmJH1fv1MuapztpaUuOI9dLO3eh/BLrYxFRWqHf07CTwAVZz
+SNjNG0P/RsIPMR2kjSVwYFC0NLaUYKA5PVU8wIBwb4YkTvBrD8OvGrU5AyHggP9v
+rze+eHA8gm0WiB0OTP62BmyPRYFpwmvPvfwKfkbZwTHWv7O0cQiKudQCo2+Xl8G8
+QVXhWlUy+L0v9GJ8Paub4sCZs3C4H2pDjHYAt9GNRLIgvLhiPJTP42xAWvtAMEoC
+knKxR0pmwmeKGg//pSeDAnjfkIUXBDealZSPyXm/HVKNoi+tAWZTWtcxDpNDYycF
+TERtgDWaNA36QQDt0W5ixOMwG455rYy4cBFKCb9u3Dle2/Y3w9BuPHmR95TsHTTe
+RRMn6Lge+TJmUd6UWbWPhlQ/rPEm0kVzcZDe8C6WnoxcbhVZJVCHVi8SJ+W0MZIG
+lE9y+9IgbyQl8X7aPxz2Wz3vhUdLP7H20CIgQ6gjLSH4GjfFIO97qqmRzLoKaRUD
+ZZxRWc+3a7cXeQXpLETDbKjLks0OGChSjYxBFBPcIsYqsbZxPugerNpyazvxcd6V
+dByb12M12lZcs7zXY/kJfDSk32qrlMH82R2qG+GxOql5gTuKCUpOJ+MJT6EpQF24
+Kx3KRwYoApaCLwiKWxRUSjUtONIoKu/i9sAA9wPLPvloXvospuYHyw8RBBETDlon
+G7Pf32NlaFbCqfFMvBBeVgqrLpKha8rljgZN0PTEfi/SYHcO4X1AisavDN6VwPLg
+P5EGe1frzRIz4ywgTiKU+go3GLZ0ABa2dNL2qr3zjkJzr7jKsir4v5c5wZJCXG47
+7aaZo2EHf/2P6+ahtSmjO+tPScrKM7uheJ+qD7lLwdWXfKeuyUwfUK2MCyWzKLsV
+PMGVBNRc0qgJGxxEKOtri8TH2xrR2CtA9OucsqEivx0Msld1UT+NApNY2SxkySCC
+GTgHgSen5Yi5jjMOl0WFAZbuORWTYx7pnL71g4HLTvYV9fh9Wxjod997lYlo65R1
+vxmZY2VnWLVCXeCEDhJDF5UwqAGinOvHYwQyClGuGa5lrl6aWxoevM1wXYMJtUsD
+sNqukM5qO1WRsyZn9w7Xg1UbvAIZu2ksEl+C5ZpNuBkqhKj/9X6ZRfqFNiMy1d4K
++pFhA2qQEWkhv3ATcmR5ysuACglql7tXmj07C+Ew1AKgsxMUgsPL33SnOemMr3Y9
+CzM4zeXi9BxPkNMw4Dy57ZmmG3MKiuA8tlRdboBHlsDSDw01PKjae0V1NPZ/kml+
+VZkLu1SvXjUif3+X6JzbJu7Hp1Dpw17wBa0HWCUpIiy4xY+/oahMCy3u97g+ZZTj
+Q4EGFsWp2pGq3gSlz93os6jkCsopMP0BhvX26sk0OBX3NUIBpDjzkNmV+9magwze
+WPs+TpDO6RlXzgXstMbWTFvOjN2nkilr+IM+Bj5CcctcJY4oCb2NlUnEIQdnDxnW
+Uh5gcgVwGDiUTnlwhPrUIVOs1S0f15uGBc1vrE0vKRC9c5XsHxM+Wmv822HLDE0A
+Qq/ghWka/FcxCtg2BBRouWxPcVkWbGvBb0aHE6KS8aFk/rNng/17yvKje587ZiNF
+DC9GxTZSoADFtCUAFBCcnFJP60G9Odm1GR3npfvwLJqt/uAz5TRlP7+UV1ahTw1q
+amiNAbg7ERLxNECMKpNcMf+1FR3gfG8pVHO1XdQKiye1iNM3bKeoxiVMbGrUrJ8j
+iCRS9tQ4Ua27Dv2yisqKfVGpqeDIUwx+OkxagL7aUysQhhrZqjIlVQQUs1hu/fVi
+z7SaySLI0t/7hEYW9yicv4atJTVZ+taTKtlD6Gk3hb2GJEEycv1TzEI+CWpohrnU
+rLjzSygcBihlG1Hg3VhWkJHTyc8K05EarjRZoT1nI8lUIkiX91rMCVFXOUXSV6vv
++Z21d/69uNXMw8QLGfTC/RmOiH7z5ogI3DlOfdThgTt9Kylrd9rViCRiyLCnU1uz
+RCmAZL9gSNpakqiDf9lOTvHeeQEwV90j4MS0fVQxe5q13OZ7Ma3ujP8hiIcd9uM+
+oePB0UhcWAio6QOnYmh6wn8QEIrSpVhirJzrQju0xcjZs5/oQ55ZhnUZiZQtYuGD
+5mPhXmMQFrGSijvnTfmJ+Ol7dm4A1L03BJFfJLuVcBpo8iNALK+0bnQynTU6FFoy
+dN3c6WVaSmuQQm7o6/FQuKLoVgZU91SwqiWn7yHw61eQfvKxTLdk2eFsvYrbkXf0
+JDNNuGSDlmb7W8Pv3fbyZSfjuzrcZX47aLXKUTYrTrOz5AOGYMKxt7OOl9yFbaoW
+HnkkFoqJ/XkwpteUQcovt4vfHQ8fMGceDL3rh8QGelNK8K4p6qYzKpAnan2IXRAJ
+APg77ywp/BryuYdvPvcTrfgQ6io0U6IykQ1Rb25GSozvdTZoQmab5k/GBPqG427Y
+cO0qPNq0vmC7kuDLNZBiWNyO74V7VX7dxYm0gX0qtDZxPoHfgcaJeVmPPpiYaHBC
+9Nt7+JL6gYcq2FGGeTtY/JyhBX49wie2hr5zPgM2bi0EgkoXWUxK4hHMhiDvlpBz
+ZbKp5obvfyTA6CZCkyYYL5l3zeF9eHEtMixA6WrTUNKhT4cvla+52dtA01vFeGSI
+6EKm9gFfM+QMzfYW6+u79QDWcr05lgdpj0i/7cWeOL0lOcgmzXUu0OtRTfsFgPYb
+sE91mE7uwaJLxNDVfKF1wPDVxKciSAFnf6S+EeGj1wYTz/OkIrvSiAl0r58XZHB6
+f7qcZP2yM7dZlkKtV79DIIYMOsbE0AWMKGeNvGpm1/zz8VyhOhV1KMNycfsKDrYI
+bojw7jfFDJquyT34mtLQitPHXzXmSb5EI1Jf4ytQHHBBFs5XILgIVq0yuHZWIjqg
+Y2ITHokfoVkXVTrROSLKBRmdgjpG2C1xFutDJtyUoReCHsvqBGVpClCAol1Qf82Z
+5LnV7BmYjFv+Judd2k4pRM9IDoFjVCuMtWN5259zECK/v3BySkXsBcvn5rLbK3HE
+WM3r/i32BUhwzONDMirELj3gC66f3ibp9zWSEQ/Ofd1TAuMcuOMn7hfypab4I3FQ
+8veBh7IeXTFHzH2hWMG1StIw79oZoKeDXQJUWaNh1/QDFMRrPoxZg4ofeCeJlxRT
+BW5Bhr5Gh0McvQRM2Yze4LnzrzJl0Tqnqotxofe1VtabHTQFxdNAXma6kz2sJDe3
+kMpW7UoVOGkzHx9ubXLiH8F1exIzuZxdv4m1hJ9Aj6D5FxannNiQ7fHvgWRGMBmw
+PViS3q+U5I52/HkDJuBpvbVMSaF5/1ssN9hmFUYEvqJkHqkFawSiHzIAMAoRBxCH
+v00jdQ45Oged3Rtj1bwSmLvIF4KABL98gUd6YCNLrhsi7AlLZLswiaXihOUyfUI8
+X6jHA+HT+mvQACGDa2nHXlEKeFV1ba74Tkz23tcck8+5lS8XXsaEoWIwOelYeoKf
++uxXmnugeJ4PaM06W5Sas4sxX7EqbTFl9k4NcpY889gC1qMbcwqnSkDpj2dlN7k/
+byVviuLyqtt4okSjEfCI7gVC78sX6mVMCBeoiUXz4kweuF9zmLuHiMR8trPPVaIl
+JTvXyzpyZ4zJixXulT2nKmez8TazLHvTYpB9JjfT3ShZTWxPcAg5Nv5hmV3GnTG/
+C3msIr50pwcp8s6ET95MMoJisHsvqh6dCHvF3vKmIv6ZyfBdBY0Npx7xUUejm4d/
+i0+uuMTlDkJY2yoMCeVvpuhuOAzvlRt1cv8I2DJpRn7rALo5wdZZQy4zJiZJQUKT
+ya+ylBy5gSuSwnFAzhMY7oLNS3u/OhiAkaZFiUvzqbt0OAkrvPX1Tq2AAEbWoMis
+N+oOnBjPmg1AHusqhvEvkTrNrUnow+YMnDjE4IEAZQ1bFEN8Q1zPOetdYP6/OgCN
+8o5FQKXtfzir5vX227mXn7Oaaw8QOxoJkzaw4x8WewHceXZHwe/9b/xiAKkMprH0
+ew8ysNR4qBIK1N3ZCnYRh3tq8ohOXk8myVWEPwyrVY7PRePe5WBm6DUBVWbfgKIx
+wGi1XDbejWrixbJerBtP1i+Fal5nPOGZfbb+PZQyrCG8NOCybTqyuaXYj7JmMsjN
+WOA3NSjoOo8lHwsdgz1RZlZqxP14YYH17WU9QWo/9fbaUIck+En2xh0LPUM146cw
+6BSzH9GHISO/dDBBfODdCh19UTOopZoVASvqYer5mvg4oHLAs7wDGKIZ6+qOV0Zm
+NNMiTMt6HzIRO3mVrHWF2NcPp2sgPjOSk/BZ7LTLr072mY4O4U6mHZaWW0MnEuO5
+MTA+DBtAYkHdhkrgMHqHUv+ixKtQVpyDCopuLV70MedbDh/NuW2NWyam8n2I2TDn
+gJwb81UcKzU2ANtUdL/WhLT/mIefSVv1+Qh00DLipbLvel7JF+cGMP0vdO6TAQoi
+e1a8A6B9xVuEsKG7+ujOzh+HJAUq/ktlKql7dRqQUZaBwqS75eJ5ZGHU2KOXnNud
+N8E7SOgZQJqDy2oCR/dsZNyKI2UoxxKW6baucXpIyNG6LXCw3fg/JgQYaDgyDFWz
+FJqNT6UWr/Qc62nRfbq6e9j4BlF23X/LQAA+gAhyAoVI/jFkFv4d1SXIP1e7A3Ov
+SjFbUHIRkdCzpj2CmSrcmfNezEXs2KmNh3wSOKuuzSJhxhIwRVUGm8CJPsdJIGFs
+grSkhkyDeDkv6XBxPqjRH2GPNsV9tm6KabcHDww8Iv+Aaf5aEirPkll9fkcVhJmP
+fcD+9JBZu8Mt/k8qafiqfgs346IqW67h5VEHLQPz0vkIPfTwyJx7X0GieQzSebSw
+6k2ZLrxKN9XlYHeIjdno/7zSvVvW7HYsA7PLrA4N8rxke2Qcjg2a//Rc7DGYoQ6R
+zG2PWXOuLX7HGxdIhZcVk4/nZvdB5sfQefk6fnGKpl0o4lWVkqvGzWLh3b8X3elR
+xOJMQHV0wDCfanCJEM0L0+3WzZzeRCtnN1IKV4oqtN3uBOdmvDD8VLDuaFcsSad3
+8UccgF5+EkAeZF2U3zHyFynMJJgoa1AnA+QX+CoumE/QtMVNXZm/tpBE8jdb+XUd
+iQYfgqz6dZ0D+d+YRH142my698lv/ynl4NeS4V/fbi6LF8IsRvM9HYhE198+1jsn
+3LEvsovInNBW5n5gKBtAQu+/D0CT0TO9n/PNUPm+/71M0TUoLYjWPyOSGW4GK/Fj
+5FqmUD89FQOne8fOBCi/34vShZ300n4MUbT3qLKTEUSyyKSNbswj0i60Xp/+Oxro
+h8byGTauLkAo6WBm3fK/6HMH9bcIlqb6jdZ+yu1WVwQHPdpHspLD7E2tqKggmfiJ
+DiDz1EcxwHvMsFRP1Zm3AQcSfVOIQm77liTqTunyOK+Cp9ko2d9UEkNSJ/1pNnfL
+K5pjwghaIxgRXi4WhQXqVNQcV0A+KbNMcmmD5heqLc+yXHTk2Pz5s+eU57XZQ4hf
+6p3vOLFZ307O3X85wF833bj3G7wp5ySlkIMAm26yE4+pcGpDukYzDH0FC/pV2ND2
+AcDd1Q9etg+wDT6euBQ28fouSlHrv1McyaCVRtw3V4ybNQXbT9miyb3h9RAEhmXJ
+1rO4rAIv4NLZFtCwWl0G5MJV82Voe788me/roA7nHb6/F+WCov4e4JsKfYW/2DIt
+RMsI6idqnc3aa53Wv92kC8FQHvzFloBX8bpfS8Cx549ShI31KErfOEbv+tISEkp1
++GpQtSu5OmlCbtxMjeg9OCSBA8/kfrHTjXUvO79FszjJBh3ijBOXT+zqNE362ORg
+w3Hi7kOpMu/PSfnW5czC6mmB0V06koPplZvPPacye9mVXwdubi6L2g6ELJhIJRh8
+wijWNu0QOMa0f5aSzFwqMC6artb0kkxZ1FzJ+y7DAAc766NcqkMS3MO1wkIcohXj
+bcKGloIUKpIp5xrKTWw04gELyANRpNHX7OobKa7F8syRrJlGbpfJJXfGa0SWl7hB
+LPKmHkZu4v3O2kzIfKuiYy/NGJcdm6PHB7VLyZ8sHdzymW4d1LVrCe0AUKa6b2CY
+vfVLDRYp7xkfjsUwRyEBjxbjS0ABXz+K1Obg3MFXvsKHstovez50VXY9behdPkXV
+RSlGaQT5XVyfCnnbTiUSgqcOE5qvkMgMJcf+B+u1E6GpUzOJDXpTRuejW5DYhFXs
+KOTvnLwtXMm0aS94Jpnsr8qtxmIeHIbk+2hNK1h6gS5ximEtDMLubT4G7K9UR2Zz
+BLwnsU7MUS2dN3uxstx1A1tEkVcSd8GiDbFQ7KD4hiWEWSEFIlniutQozJQPCamB
+2C2Y7dEXWWy2SWbztul692TxP2ZkojrSp3bEzUVuJwZoWC36FNQn1sS05Hb7Tsei
+B6Mh/t+Mf5/Iz/a2E3ixCXpgsJVVGZqBHFbFtWP+xZQMRjhFm2GAvpUclv6RpLTW
+Hjm2LuIP9wh0Z9Ka7pXLECBnZ7PhoeKb0PRjJ4wGUfYHLb3nooM/v4x+gmwytwWw
+TDGNXvthMNJhvYg0VvIeZzEYaKCmkW21e964Bx/0lZCEaxywK6/ZdcF0JlBwvTwE
+wudTTTrbrGM8oWCCYiGC7wxWNQgFT+Pj34D6U8GebWS3Ikv71gEjJKVv/LB/JoZF
+oeKnlPtX3MwwVnndBMJzefNe6xjQ+6o8oTcvRXOxuqL+vitvp88vvFCJZRf8yh3u
+RpwftUkxBPnca4AsTHbGdcy8ajbviVdecnbeZI3ZWnu10b+jWi9mJPAWbLKbXz7n
+saepMDEFWaWKg1Lfs7AN7jNcvXhPqFIeJu35nOWwPuxnfgN0UrYI8ZwdwC52nx7u
+01ZeUmOY1DIRPtSC+xIBdfngBN7+xrvzSYn3xOrBEaFGoorkdsZpcOrJ+8cmX4SG
+6JqmNGxuxZJb+j2Zz9RyORT6J0Lcaes0ETVebXoEU+yQA6gikPySUHv4DBMVv0V4
+UGrIn/53terz4Pez+DYNXXPU8LPiuYh9x5uCM5K6aXgXUmGuPk0ElP0jHrhQukK3
+r/Z/BXHiSHt/7mOexIDLp7uhiIE2MNeoJy0WUTWMwH7n7Kk0UzXJifJPQ2VwCYiw
+zBmpMykucF1zr0kBSQAJywpJb7IzGHpBhDiYUx/eJ9PC82xibnlBcbKy7pgr9caj
+hS7P9v2KZsa4nPrLDFIFjyO2lGL0XA6UOBHkW3g2em/XMzkUijPLU8tZwp9J5VKN
+TVK1D88ANndSfUoPFaIAemqnlUxNuYMkWNG8j+iJ5lVD5TlEe7WcsNqk+7yRIog/
+YlBktuyh69Uvv1P4iwaMYtrVqJ+FMVX22S0rTbnpLeTQWcsa8yBGQmelGJRlznNr
+UgICyDkhiiAwuU+G7IQiQPk12UF27kBmZkIp5qv8DiaXniBvTt4C+cBdXH9qZ5K/
+7/ywf50RLPpYPHCZhWR8FwOkTVOpu0xyereNH63a4oPoY5YMaIvU/HGe4PBH40BB
+1LL13y+PHAuICdOyvUrbGJFQBPlVn2brC8HHeYtazt0JFu56Cx5GE6mM3LABubG5
+hwCinhgXkB9NSSgN3N3pGX9DMklD0Lv/PSbLijZ+VMpK9Aa4CUkM8JVbRvPg/Fk7
+aicjF5HNiJwNZfAe2bWNNXxsp9Npvz4ZaH6QyWCNbHSTgMdcKDGNDyLQnjRYuz1b
+xvkKdVhwHWr/JHZdViy9cVqhoxNQPftg/LKGkb++1jIMDoAxh42IogNPfIkwOG0t
+JsC7+WhJLRxaIUESB7CY6FslskkmqLtjqD/DHCzWYNJ80WOro4soNxiPuIidW6iT
+o+KrXkMZelOowcBxj8fa1Mw+cx9ro53I8OK7A4RbYupd0++MkLQaT/5RTomAg2QK
+xCofc3IOgx7Rl8dAFfnZ30+D8ZY5rM5Q329Ky7sD812OZceEXTwibiTEuT42/DhX
+wkxkh6w19rvufdnJs2NcrVXw2uWkYQwVl/kho4JDdMUbdBI7YJoLOhfhpLLbPYok
+06Yb5HkdioJgGRVEbpnaTkZPD9YP64pX249HazmSdZsknSFgU9kyp/yy4G6n5UEh
+IGrPYh/9MCc+k741r04oaVGbE82NgorEJjwT0KelKseOzI5qltNQrdFu6QoGMDbg
+08g1PqeUISa699tYVPhegvxRFYzpudlc5dEApZ8YSb40b36XaivCBGBXHfIWrwLX
+HdaxAnmjO+yP2Law65N97l56JmLYfzqkU97+WX2Dy4qc/1eFrqrW6zBtInofTVuF
+/7PcadBnvMxc2IMHMMNf16NNlaVJ+pm+bNVHSFfJCOyObA2Tcpv3luDKlKjlJ3K0
+85hQmU1JIfdQzrBfAcCK1FqPYy4h1LgDR/IRfY2Eobf0t/VXNbGdkvS5jen1i66x
+Cd2caEEZ0Kq6WhzTpj6K0tyd3Tav1UBQbXOi2Cq/fvh/SuO4IqCBkXjIrDTLVBXC
+AHoDJHIsWHkhYqVC18Dnactaw7aYOj9QhMjDidQOTnrV7M42VCsYSOcEUERh1OZA
+aPqrgFP6h7fhydXMKO+Qr/dub+hY3J4mRgBWkWRHIOw2Pqn0OoJoZ+1Bz7kwMYMI
+mXwpvV1u2Fijvu0Z5SqmrKGanDwFsdHyq1yJfjBQaxw21jG72+D5ErwzdgDdbAlT
+0HrzejopzT2rIgpua9V32wTjphamrhVEjNbpqnkUxoHJRIfNF9Ip6IV5DaPZdahp
+Ad6/2TnQdduDKWWnEMZzU7UkWCHZwPmKU3zHrD+98eBs417Evm/ZHuNZ4HzPV9c4
+ZyYEEGUKpENfqSfDOUbpbJK5QL4ZLmuSDjPDpBxqLDveqTZP0EQUdGLEx0M4Jc9L
+uDY48WblD2rn7QRAvj+Be0Zed7nY9FgY0qrc8Fz0g+WWnUAwTMgz5pe7jUiicIBo
+12Pu59s1x7vCXzc8JAQSc+WGcm1rttokAoApeJehO/Yjk58T3jJuVGMvjG8o8XtM
+KGdWKuc4GgiLFdq/x8Q3ncmYwLGa4KXVYrA24D+th/4nmUAS6lTakzfNRg862Dti
+sfO37lAUo1aWJyfDFpW8nvUcZly+zlJu8KC7nucXXanpVjOhEMJiaXcohF6zHRPP
+qpP+xD+HPBIYskdVCdsjAl8BkkXSwOTaeyCuR77eFqDvhKhnaMtSqhDxNlph/zkg
+gS+620tv9LubE9vvYSXZVT6XFowKhd4cgco7/HewlpMPsAstLXS19d5UDnya0lKV
+VARZmHv3FLPPF9TDj3zuobR8sCdjGTWmYn9S35GuGFf0mV8qkwsM3AnNeJX/tO9b
+ZqTgK8FOdvc62AI4KvNnZ0La53piYkINSe+xKQYURMj9GRyLe9Okdku4WcQVdoVc
+AAYTG6HlFxfZ+ZnxdIyMdk7vEE76rK3hYxiPkoCSQzHOwD+cx0tfgiaB7sh6ftY8
+tr0aCe2yE5BWWtEzI75ioLT6vLqwbAr71tTQy1g0wgP5x7EdIkMn47cdPoOkUf03
+4a1dTuSJ57lJjPPsf0RXv1tE/iO03Gkv0VpeAvEPLMn/ObfzJuPav4yL5sMMgCpd
+ZujMa1r11N4Rfnf5XePEPoD5pLt6OjCFMuy56q8UJZYAb96p1VG+dkmHkCwm9/+P
+mD/NvM2MAJmCnXxtoOkZjN8aifhY4/TLev0ZOLxxXVPP4rqCYjxr2ybCV/dbcYTf
+jA4TsNvEgEuKJHzHFoO2gxWwyjjik4x+zVWAmb/qIGepbwGYOA53UVWPvlzgVNjW
+Of2CGHYbiiQUxQIAgeAawDYre73tQGbT6vzcjEWXpMOfpMguUNiYa11zNCMxjseJ
+YeQsdK5d5ab66BIEu31Bc+vPwr2kg5FIH1r6b+H0lM1x5xRGpXORZcKKDsUlaEoF
+XYWKU1bA9/stcZZ6Xx6jLoRkODemb1d4lynts9tSiEBNTJIWv9Pt4vxCgnjjMV+5
+EG52CxQKmii3C3D7H1JEtwhkgFhVWVFC+qhWWRgp+fwYX5+LhYC1Trq3XaOGpwnZ
+0q3eIXTViisIrPbe+HtFHgJau7YQ5aWQbZnitBVzijp2yAqUfMSZJNltJXQIp6tx
+YsVXXOxS+d1yOIKjoSkm8vcfsIT7dVph3prtmfXVKl9RJo8EAwMygh9KBI9flqS5
+5KmDD06zPz7vxtbZyo53evxqvRjycgyNR4Tz2119Z2W9bqrtpuvokBcOu3MIIsv7
+nhbL7FlzlqfyHG88Pd30qKBIqd5sOqJvxEoRyxCd5QHyxlv3+sE/kBd8iO7P0wVi
+bqnqtFrQUpNK5QC+V1/jFm2KpOrR6IXN/b3sz/SZI3oo2+2ake1Nc56IOrbnAKih
+haIy3TWEdnYrCY4LgeG+GpqoJ2hff0091fW9oVXf8zTgq5S2chlqqVkt195z7Z7l
+bDB3pjsbmbs07KPFHi0p/lALKDfqWuZSJOPQBNGNrYXNqa5yZ4bVqUfptnayQxbB
+uyEEsn1tN6oibcVFFJTBnjI/6J2+H3eABtnJexpRScOEgejBRj4pX+6shW4hDMCQ
+Ny7wy4Uc1IjE/POvAMZ7MhMwWTQfgZLqi8ywF659GOB8sxYF7I4IfzTfjYXQfFXw
+mkaodS3K05RXVlKyvdAtTFSA6C8WnwaEemJeKt8G7GEDOqy3hsuU1cQkudO1ga8l
+9Z+Do8n2swEzWL1oQUaauPGdtPn1Q5mu1Zv90RIILKs4Xy8jf+FGlVWXCuWBPphQ
+CF9+ViGAz4RxH+PqowFcSYzDyrJO+eMe3B4fzpme/CxxS6G0rjAdWP8r5xrP417+
+z/G0Jm4tL4stFeOlut/PFM95XQ6e45bJtm9VNxKVXh8loivI0AH8LdQ+VcDE/GlF
+DZ8yqWV6qP6dZ4XFfNbblvFeGbH6YBLAqlV/ymX/eat+35jFuSUO+9VyQfxukqL3
+vlm2wl2FCvS9qubtEPMBcNtvc2robA4OFWHQrBYn5OZhE/g0Sn0e5CFzzAUYON3s
+N4jWrLBoRTsOTaz26Mb8CiTtId23FjGrU8jZeBMB+Tqsidq231r1aOpAAsa/brcp
+VvkJPTu1rco2cFY61Fe/Euig6ZFr/FdJ7CKxwTx8Y7i1aSZ2CeuDUp3PYajBN2GB
+w/YnUKzoVjO3mCxpMfjIOiInjJ+O5BA7ra97xuX/c6g68WYxTCcPPlusJ4mo7su8
+opV70s/VEgCfqP+0cn1AdeYkt79Xcbcvn7Q8IjiBwOdsUA3Lw6RLNdPAE6rgJMcd
+qqS6+zWwljRCkgxyxJjWmrOIVCK7EI/Z3r77kcX5vrEsOXTVhZxrmSPaiwSf3gKq
+zcaA4Xqq5s+tEsxZWANdqFLJzrohnWxUXkLdV2pAH8+jVk/hdY3XrBP+rrfpgB19
+0EYe8yFw16Z0Tg6IyQrf782Dj63sIdT24zNDCM5ks6thkPslPQbJP/JjgKgsOWur
+keZEhLumEe4hSEYsU+/VfVaCy10AepXtrHTHxM5jlxfCDtcg9936KSawUYfb72x9
+dIKUO3jwxuYtlVZZLP+loX55BWi8BdE5A3NYSVFLwrWTaZAinQp0iD76+AB9bkgk
+rZ2BOHJ4e2vvLAk5wwNdTuKJ2Hb83oXY9kl3uVOp9gxvosGu3jcR7vU2cEeV8kKk
++wSJ6SAPf4nvCb2mvF66ya4M12z5Dy0sbFTzZh8/ABa8+EQh8esnOewXnGk53mVF
+kp1ObP7eC8EpMK/YqpNgf0/625OhaH1phptvQEJU0KBfzoaBlMJN0b6QNqrzbdiO
+3ZivoOPyUoxHyWTnle14PqfgS1aIkDyYO/tnrBZ87NmY6rNOCaKYe09U+VsJk5b8
+R91b3ojWQmuCh1c8rD/oNFE+gsWh2lDeqnjLSQ/Hlyc8EhbWcr7yGl8k8eai4Qrl
+HXO15NkntgukO4ahPNbWaPJ6JvTRsx/RFRgk7eXRTTnc1l/+bCgMmp5UYMz4UVEL
+GGxH17QJ19snUeqCX24eKFfgTG51sabxlk3qnCrS2ugnQ/BwkG0fmDI51YJbzFq0
+p9r7GQvOne6licjnpdN1b6i3LYfnLdehV7ENSqUGHHVZxrE0SbvtHQAA2sfUBofl
+zOuETXIywYlikGm5eTZDQreOxyZUFwpZQNLs8sNw1THAk9WSgx/Jb+8eAXQlelWE
+ySiuM2dNa7aQkRjTCbJzDC3vMpsUwdPBI096ArAGHzHhETIHEUYvarXXqMwiasPY
+1kNjxiq3IeTp+EYMAdQPMlnySmuHQKwh3Ua8T3Ai0vfQyTBEaIf/xrymxihiLrKs
+cslVGsJLSIYq0PkfVoYUTAHFmWV+jRFpCICUjl09WZLZk5JjP/pAufD/kCUCYLBl
+rrIHvNF24r8JHhhCLstW6Fc85qvK6teDO1QrleHxTNyKdVOLffMNEEqwgY6azjhw
+G5UNY4JeLZ54AWE7+TEFhhwm5P+cAumD/CTpFuxahvROmQzQtQ+OBpoHrbSC6uSx
+7s4wNr8rtqar0D/NOBDWDarM9s02PrSuxR8CGNsXwNeqV1J35xuCVX6Ku4SoRdC+
+nFqwZbxtlvTiEaovdEpcN9HyQWtU53rtGH0ZtOvtvdY+RY/p5YGwqhiX0Y10/F6z
+XKbPMFeiOSrVwfqQaZZKx8uQFdA5ZwnCWacg3oaw/Se6lvzOK9Hox54fnOyiETOo
+exnpX3iegdOZ609756hk+RNOuv46EtFPzGqQoDcDx8X/euM8FbacXPj+uyBKHuUg
+My74UeSNPC49F0hbPHMSTZY7gWx2IxqFZnfPhRVv6FHXw0EDgjtHiMKa1I9eLtfY
+u6SnkLaAg3pcyw7CcgutRi2KuGdNLuwataXWtrg8WVeHYtDbxGahIPEUjEh9XpYb
+wL6+ESHkHmoD0kwbHGNIjSxYLFHes40nHJ6+tnnNQxxCG3Xxr32Dps5IrZ8GiYlD
+ZLlg6bBGwMjscWZO76Xv8kslNOsh5Oknw6fNvvsh/rW2HZrUd/G9V6KW+DgDxhBG
+IIJayDwHG6dAYMeXozppZMTiggUYAJKTijIecEyXAz+a5W6g26/o0lC7D7TA90Rc
+gjfnHqDz9qdQRjhoCUrhCRSvv09wmcRFTj7pYMs1W9zRZFMhusNW31VB8HaS6/0b
++pHeIBdj7yuFccrEk86b0w/5JJpMQJdzPskk1Wlnm2Bubz89BKFPgCYrprta3x8H
+pLt/8e9At0592aphyC/2mEQ9jN1wjrx7hXOp3nznBe3qgZXU2kpPNlixTEu+nHiu
+DGwA5nHD3RbCnUM1SUSox7Ns3pp2VXqu/7C15P53C0QNc4EQMNEFgF1Ga17mQbKD
+3SEgtUlsNGXjP6o2fmF/bcXbVROB3NWd3ODewns3llSSynYe/hmRSFuuicqL837p
+JnwRCQ/hlyvFyBZY2aN6H1cVFvdqYP+79vU4vXj0tSIDRrkrtlhTXiUzyvkaomk7
+PeZjjInWMjZkPHZDEAbT2iPPX8x66acFWQKlqNzB/du8wn0iaGbAcsyKHZtVU+1z
+n57XrUTqANmwzIkLsBH1pHWAqlYFVxlBgh8tszve9WTG247/8un7OrS16Z0MR+Re
+1P1J+UfqphJOGwZ5nh5SzX0NtmgFx9RGIjyKIbXKeKN6/p4vX4URC+8x9hBPPvMC
+2j+gmZssoK3/sa1CKmfLcsu8l+Nk4dCg+0OjfOUJFa/HHwCKJLYCiOVm+cQ0tgPt
+oY9u6yyoBL20PAM/+G2amHR5bA13egs+c9vgkCNqKRShR+UFBKAe6UCrvSvX5d2l
+LL+1tYwjdtpJWoM2dtwwV8NbtxAy2cMarMou5HMPhxWtFmbGcSZv3WaXS/7qsmzN
+Z9wuZa4mSJfIX2m+sDQ0q7zkLfCHwAtoubS4aUfkW+9Zd8c0MMwMgSGUvVzF7nMM
+htZtmhPkVsGnI+HpgfzMjdoPqESx4IPYL7UP3IbZJjmX+fj2O3Qcul1LEYglxyvk
+FcWQZUqKzGkE2O1rFVud0k9TdbNUcJ0lv38nvhxw7w0KFYpliIfTmPJVNIfZ+i/E
+9HCsbaKg+J9BwfgsN+g8tS1yRMNfkIkhEKUxr74dFQBtKebBX4EEq8SQNRY5O61P
+ucROFZKeNUGVUDHw0lf0ECwQgxNMgvd1vVpwQaCOVuBW1rJZiuU3q/YHq1JnhsgZ
+xNGiOshvVCbwTNj1sjkynXJuV+SryAShRCq6C2AAzotp1M5MC1Fd3soAOv/UPK+U
+0dTowQ5nS7gCSrgMCOIA9LK/rcf7unz70aU0gO8NYe0qEYSA7dlDrs6LCABbaF8R
+nc+8extSWOCZYKFC64/0fiFpMc5z8g8asSNNfzvaoXHn0FMb2zAF+zsc0PqFTR6/
+LUqfOBQc9nx8zNXldrCaAppmgSdKFfMnMZxIXGV+OLKJlKhCMUX/6dkOWoE3Jtc9
+frFSMjtRSCNhNe2MAJUGpNk2J9Pv9lJ2+redR1mpBw4J9HcUTgRT9Lrhzx1DJoFD
+yyaWWL/f43YFgXNGpZ0IftNCFAXMlduEC11za8baXrh2cmCdz0Vt398HT27bg7Gi
+bQ1ZLa58yGRMgfzfD2ihB9yBsCeMBnnKhIRLqaD8hpxF0JW9o9yIUd0cv2bSdQZT
+UG3yxg3Cj1AiiiyjPOYVaXLLp/Fri937CqEVbYT8kabD4h0pYrz+qCRRRxEOAtb1
+M3GqNsnugm6PopTPgmdkRH4SKLdFQHFnhm2FnqVT1THaL2jDwD71SqfFhsPma2g8
+Wf4NYyWPFf8V2qDb/J0GgdeMKYtNgVJQlv3fMopByGplj+1WmWMsT6RIjTjl60/R
+hFhHvKz248crp/YvYmJtO18Poi7Jr4v+VeDBSdlSpR5cr1SbtULR5xGk5xmhiLxg
+hFFSIqxvhW3G7uPNAaNTHKCW+4xpCny505/R37Svztn0MFT846QDxQPj8ha1R/HD
+xP/ac9vBAprMBXuqrc0gWDFIDHME8KqKyKf+/LfQ5dTKEefk+zz5cPbxmgY4WWBt
+/99gpLQ0n9dO5veH23IuSoHH7ta0GTkBUFeusBqTBFQWbS/xr4AJQzmN+5E02JFj
+SfJ9WfX+YhARGEDNwq9w0oOHaI0Ju9feaYw8FIsBpqVP6RaJClkDCnthBkTuaAVb
+4D14h0Ym7YEYtnDn1iwY3z9slrvKKwD4gBalJruxLdNkMoeM8u9nzjt8xQ1HEr9o
+WZAQpCbWAfZNdK0XIbGBj5lAm/h1B2fcU8ukCrcl+N+Wpk/r+9jfCbtY0eIPIuib
+cIiYhIRD6K2zzpxWgV8dYF6BWxqlBbzBI0q2oBu1TkAQl3DoN+NPKLWhvaiK+ejR
+Le9GJ53YqdKoGNOL7L5+wU4uWce+GO/GdZMLoXawR8ygTIM68y6Yw+3+lls/sI1O
+YcAFrRBlJtRDXmzjxuZCZY02PfXRBR6/KBFSHfYoODMs/DrlbYrOSKuxDreSjieQ
+ogXG59ADMcARQYhFbPoVsyysYvs+3rJP4lBC7uFVCGvmPdYMnLjdiEU1QdGhl6/5
+FBsaZSYZZTGT/wge9KlKgE+lv6WuUgh1Hew+yv1ndUpGLGHdsAs/lqHevJLAU9MJ
+JpfZrESAzXvguLgauZYqYipzwQ7mcFRVVbUBE+7Bnb65De5GpWR3DfUPnI9MY16X
+4f5vxnNP/0OW70D93HEcKC4mq7uJ15KTZTYoA44yXf9aBmXV3wNsgiLhuHc5woSD
+GlCTdfCwnjHJd+IP3EfHurnRC/U3IBG1EXd8eZ3YiIVlgNPF2RE4IKEfQaYrJtSX
+8UCYbwa0s7K3tMaKOyCYSOevfZmFb0ghs/By6DyH5r9j1rLZlyFG7AJCCk2nOxKk
+ONR4NfiCgTEueVRuEDl7TgSY2SHfp8BwNB20htOw/u3Qy6Y5JdQT7u9u/gF/iR95
+GiZ7HjSZ196igQYXrstRcidsIJWUF0x6XcKfALFZudG6pisMQVafs4zeirQ/Gldo
+1cu0FdG9Fd9X0dgV4Pmy7FaEOvfFVlAqEPQcy/sYhpj5ygeqEebK2wjmTQNxQNEb
+qyGIVHaJIrKxstByPMiAiDWj0atLgLWtEF3UIIjBaFCZHoHqrXMWZa5VmsVsEBia
+HsfXunTHJgojJGL4XiCvkU9rmjLhKVHbxe4tsAYbWktCa8v4EfHv3NeXkpcyUgcA
+6h0j2WJjUEAEzX2IqOQTbz5UMzAqARB33HvacatY4U4lk98vyuIxVqkLDaIMS4Ns
+icind6OVfdmElyArq3c99PaKbYxy6Bdftw+M7IJk0fim3ANRsHKV23cHqkSf57lB
+F6BZzqaAOu/t8bNNFj1uQnIaq4yVXGk86VnaZ0Y/v1aDVvlYUUe80C2Gd179etCb
+nBhr+6XXksUTjIVSRIS18l5rbgcHYrWfxX2PSEEVz2agzePwA86XfJK8PxvBbMY5
+M5kNOTWgl+Ypdx4Ys0niJ2kv/KON6xZPA9v+bxjrJd5Lazk/ufB1wvi8A3NbosH6
+Yb7+KUUeaBPVVfz4UURl7q7xS9eLZjHNpAkNNZOSFWnGEDX3Pgfgc8kU05zlfIPY
+Sa9QVT7sD8wBtYFOThgFsExvBnP1e51H3bc4G8K/h2IetjFCB8tJQGTRNGV+gfe5
+KWNR9GgBgLkvK0kBROKu6Y2p+H5u3tmLH0g0rAjEUCrh1z7FkREelHFj2yMDG4+/
+oLEKfhzVhQPssHcLrCIexVwjlHGpvSTdOXfxEijl9uGMqWtTMQ9Ytu/X25QFfRPx
+s5j3+Hb2torwiTXm6D/O1xMfFl2vwLp1mM0p9h0LWyDF4IcRxobAa/6RItTOIcdT
+30fYRYY9DDh3elFlPqG41T96CbfpBjez6TPJStUOzWfValB2TEf5gM25W9Z5wLhj
+Q200wGeKPQaTZ75JlzCNNexr0v+4CbV3MpwRXKUqfiJQXfOGlVFhWbf6D2GFChOO
+fPWnWG3ZDvRRzX6aXsKHo2ycVrTAMdElOSDIKorJ0Af3amGq15dDt/NwUsjdzQY+
+pQ5e+Eg8uXQny2UB6sv9LYlYBtnFWzhFtjWaIEVb29oM+xQX7tXsoKJe4Wetq15L
+cWvG5euAftzBMgwiHzIwl3+XhsL2tREVTsEGHdSXCVynO1ZWoJi3dV8dkIZH9i6Z
+VSwcj3kf1NelH0o3GCM2judj6nRCC5infgyUDDe2CzeTwymqTnTqOx9AgXXDv872
+UAU0AKEXYYGHCVy3wdMGNPgt1AveC/YYZXOtyBF4pj+6QDxNyu1bWjP98MOHnl14
+avV1h0iBlqxnZP6uhQPsC1YdB9x8f9AYr9Yb4KcUnq5TXd4mANIsWF38uhKce5Vt
+2oeAZk06y9XTsrDrHsoU+/n7+0lTZ3xcbWPA3POM+l9nJRU+3nSCJBn+Txvid15S
+wYmSfmfj1gUEqskB8GzjvWD/Oeqwrl43DknSp0n80jS5Insz8JjMwaWqyPoaEWHz
+IbLIFnrHOw+S48DZJIPBQuew1ONejc5nq3wdCM16sW84g93CocZLZILWhfzxibPg
+mTjdhbGQ9atRDIs0fyEvSrD9V6yK3OL5bJfAdR5R3yuP6yV6G/dHpGQ0RvDt3ab1
+I1XM/Ls5RP+sanoaEPY6KP53Ps1GFOt9mGY2LWyvR7z+7nZte5CoAxfCoY/542Kf
+um+uhohdtvnbSipqxa/6CD5ywBwm3ZEtnhXG2sP9hnsZbYF/NnlLhENwA8wMGPZY
+PnXnQyjuRKzsAD5Jzy/l5JwbgmrYlxMGdQRPGiA39cBDqq6845FpOJSysmN+tA0i
+8CoyXHVUV6mejLViMcjMmOzVltwgmysoBt11okwTY01hEPpfA/4YdUmLC59S4u8C
+Vm3OviyfdVR0f0WnE/lhPDTeWQewaAsLWatYy0hEjBaPdX9OUG+jaOfxEK/mktLL
+Pwf4wckWO0BZ3lAroYLm9AavlwMWjrF2OTrpuhk15AVbFYA3OBBzq3kBGke+qdxe
+MxZi7wMeDleYS2E1tHAXzcETNy3HX5QEutHTMch80XVNmLU3dzLzrW5xxdbNSU3o
+Zcb4EAQHj9N3FBkIlWnbGK8PcW64ISmgA0boHdnduONXBkueZQYXSqwvGHMTH1Vp
+XElstVUy7wqJx6tPoXln95EFYjCiWfVi9pu0QTSKxCTwNGM3xR7kPOgjQCT3OJBK
+G2BTWdRb9FdQUyecTdbw7eV+Ap9OhvLHau7EMXyvpTt5J/lCiRAfrH7JkMYY4Hkp
+QRjB3097GwTLfSkyVzL9n1ElrI/bDIGp4+purKJf8JliQZU+zn0nXjeBsyVKOG+e
+r8UL6BzBjw0O7mVlLd3mvZcjncIAALDMQi66pQb2Jhp7VMttePABWStXWbJdX/Gr
+c1a0nVQTZqibM3aYssnD9T8DhgUBVUSDfZIETysxQ0/W5njv/qrzhokWi3y+LVod
+NgEd7NMS7TkoO1/BQQCci2i4wSBZfzK4PZES58hgdAW3A8SSd/rgNrBks9ybFlYn
+vBMAg0SUJqYaPyaOT4UW2D7mgViX7ZZLqFV7mPswlMRWaed4zQTCeuK4LGfmXx/3
+urW9l454zTHZyx8RQ9foQR4Git463ABVqEdVkqXnC4s5f4jN2VUkBP0CB7kSLwEF
+trj+fxT7YlCrqKi4tVi9/h1dnllFr9dRB4EeGDTz/u+CIkCxOTiWpL3XyolJ1Btj
+tNl9/0TSnk1z+QDvEu2UORU7DdM8iIFqHILzZ7tVl5q3Pc25eiEsWa9IshvJVczx
+rlgURaEcRs0AjooO9IQnEvAKo4r1083QcP+WFMz6UVs6NC2S/jubXk20jSy1TW6k
+rkL3/yD2NfutS/TETi1iNPaVrpsyaNar0yYzDKhSBK2IEFleJ82TA/Ua/tAUhiGi
+0M9eLFwYPrWp+ZgNYwj3ccwlbTuancdbWvrxnKCZaUkcEVOFPPy+ip56Nx1IDkX6
+rFg/Hb7L/tYz96nrgllGtSscmstAhuGyMtcdo5b7oYxXRZA9jU0x9O59LRhsIp5w
+BFyx8pf9HGK4Sczn0yT1v2/OLvxW177YcmCbRGaIY5borersZRHL9OtQCTl2gdAv
+NujOokWL7UmMhFd3XkoKrM8VcA8B59+0HCxSmEukrGJWMdf1RkmyPmjyfgMlcEBi
+zBoOYVDwfKpWSkijP/2Rh3NclJSJA8DVsr2iE5qfmUaEP7pAi80d9S9FamQqSFhK
+UYp3FhKrtlB6RJkmFyzw+WrgZRbyL7WXjdRoBLKrsrEW1hf2zF/hSAFEVIboYj2N
+MhgHuN25MwEA9oEGerE7s9DYyoFKHSsKUk2R2/BFyqnWyRMdkguXiVVzDiLdxLjJ
+2WlNblX/HOsDSmbKzIM+Ezi+yrY/5zDy+ZJrRXReqP8ELjmKaeloPQV3C7020UeD
+QGG+f41IXNpuCSyehc5owiEkgJsigSOFogQgKP4I63/xRcpDsjltz9KJEvdO9F/4
+FFv1d5TdC2CA5iCZY9/RH8B7YyYBKzBd8TDJZZDrhXaPn/8fNGFByOoadlfCoX8g
+2+HRo9dipCj5XOLK7qvAP8Vz77LMoV9078X/Q66+FljyM9szjZ0yhuRcdZjpc1Y1
+ZqT5/ee0cBvMaKrwKAiFWpNQhEV+GXRd2djiNcp3CHfEIeGmTpqJCJQi8jdpeoWc
+gqcT9JYuzhVoGLT4UB/igjA47BZDChRz+Ga8pBlCxzpquuUQp/xVxv2wPR7HPrSQ
+TYuy5GXGeIpglwUaFX+Xw1l0l76hOSNAVY2/gWGCC5naJhuMcD8Vq/9lF32fikhL
+VwFwQAwPFQ2tj4tDCAd7hlQCnQ+A1NBj75whWCPmhoax5UMTFH/LmKbCSdlUsJ0L
+d4GAS7bPVmlKdndZEr1dSfiOjgDRmhbdCZ2Z7Ml95MS+EGdLctsNkeOhyqdzOguP
+R8camPVAL7+NKKWQChqA04bLZCXFC+Pk5vuDlYx4CbKjjkymGopOO9P57OklPtCH
+J0bwmCQJquvONlPbp53/2qrU7xMBo/iEuH2nkix2XYb6Ui6SgZKEja0kgOcQ0/8v
+LIyyTebfoeKZH5hS9TYlz0Ez+Vvx2NPB1yTDwZ7aRLgiHCr5DPN/e+vHWvM/bgWv
+51kXy/Q7BSSCFL6Or1GYYfdK62uCXDSHDU6TADLFomM5Ic4TvmD3bBB0bpmwsmLd
+0mSIi8OVQlbNXipFdbXI8avMw+LfNNQlo+W182CmKrMBEx6HLkBQCqqznCWZl9z9
+wfGY9nwARJqO/3gtmLs7aOZ/Px33TKDZjYQT34cKrE7TbdDrgdJj9eHly3M6rvEZ
+RruCtgQnT1g80RJpqOxMrGEFHhbLvvh0zf6X7ZPTf9pJIKqNprJ+DnkkyL+ywhb9
+jEygqB+tMPOK7GbsLz0Bip1D0Dt86a3/wPNI7unZwYtWF7q/xOUc7U/7F51IllGd
+5HN1bppL6JA8jMatlM56OBIkNU+aBnPbpmNye1F5suvDIKrwjFNs5CSdwrX0B0Dw
+fpVALNbbLrZNzKbckMCCoXkJPjmAfXB+NrZp/Mshw6Qv9WUk7QqM/3LHE+4lat5J
+o5bjnnVhz5Ot2tGaWIwaoo6n5Z54rZ/C9w4GWdo6ND//qv3uUcrFFHAeKcsYOXYh
+NNzF9RzPoO5eqgELM4C7zLgveREA6Omm2r5ScwsP8HSYgOki/S1m+ztW10/E98dy
+fCcIJES7jIB998U5JK5FZ30WQe9kDE8ug6OCV0tonbaPt6M/QHUP6/mnB6rLUFof
+d0eDpWivkVdVgSskM/FRiBBQcZZ0OOQ59BSwg0ZAgQy0Fej4T0dgAZOQOApomYPk
+3GcSHroDKnLih7FiOGeuXhxo8e5rf4oaPUTVhgbaRyRVKKI4ofFFJp29QsXLfrrK
+DoM917D4DtdJpb6fJazHk8UyzR/5ZBo2FS1YdYNAQo2we3Woc7IcDefNtRkaWt1h
+M9CbM1O3tD/yvwA91nfPabCNnSmrl6FhWOsKplwYAyo5+pMEtBMj5oWBlqm16fcE
+IZNKlBovr3euGBMYyZGIqzDmRaBHsfxxDgpMy6EqOIHza6fuwlr+WwBQGM49BRkN
+OQqQdWYUVK47BqZxKq6SI2C47/kGj/YZ5ZOpNDiuMJduJBXD+igKHIiTKXfJxI6H
+x55I6feJMWLK4kjh4M+gciDNXk2wqje6pr7ricruwsOZ+aoRBI51qO/gPxXYoZ7w
+4/YeCYifrSCiaK5uGvTpDtMCzty224Udwf6bgXFMRODIZD9JkLoMBlREEaLqPD0M
+Oy7GkdrQ/f8YK6fpA7Z6y2dbyHju2F4UsC92cToY3Pb//nIaqOk6bmZTE7ZQbKww
+CEzs34YVYQYnLzAtDmayeYUyIAfpSCQopHLYmhsQ1NJgizTtIHw7G0UbbI+K0aVT
+qRdTtYkCWFtgzR2fxWiXk0UyBkXtq5vI2gxYNPO5GFMChrMz0rS1rfi8f39hku8w
+To5wHZjl6D/ah5EjvwK/4dn+ijlt5B4VhYOGqay3XODFpwjzmFoy3zFqI0ZPyuWL
+XAtB6qEixamOvF6Yu2nv3CSyn/Y1dmijYq73So0vIpq+SfRc2MIUrKkECGi5IRki
+D4TV7csC+pcYzeKrVQFCn4X3It2UA5GyDA9B09JmKBesy51HzHwVO7gctvuMa3j5
+ckTEYsRreDNOGDB+yHDPAV7LTn2Y1Nmm8i17dC/WcAWK7BMhM1QSeNCbNzVRrxJt
+ByRzmx/pQRIuHqwT1ki5kKStrVrIFYQWkIZJzCbgcOxd5FwhRzRNXF8RKCVwiaKu
+JgOzv6Hk3kiJ9RBd/AcnnHakxE+JF2YsV9qn+B/sWgq7EpQNUMtluhDYk5S61ITr
+9rAl9LFlH6XXK3BKtBrR2aKDhHAMEZH4LkyNbitM5ALHWY1vPf9+pTsF+PwYsd7F
+q8SyaJMZqGCUQEF1hGzRyGiTI+BXVUZNTWl/ON62YHU2H1fYXKvwsIyaEUEn4ArZ
+ZosEGybijcIE3PhRg2aooNK6w/ltjL7M/ls0VUASTFqwmpHrvnGsY576b+rOiJic
+8G9troDfE7tdVzBAxvO9xHA5IwyWLp3SWfcYjyulI4Zzlf0bpkASc/aZo1zwNbeW
+RYYehO1PlMwLsdID/E2kvpCBHgC3Pln+2xtBsg56poG2aBePPmGQ3xKs4AzT3jAq
+3fA2hFBYtewyZj8Ay1Mf1P6hMzciB+pnCREQynVtcNIDR2BwinRF0Lq0FKyKhgPJ
+x93n31kbuDsqa15zynKmwCxqe2Cobg2u1zxNEiWPgMrmkXRpKh9nnKB5aILCyVcu
+ZvO7e1mRFl5ZjacGhSkwVzLSshQ9Agh2lkfNpWzsTpldh7lZygll/AuGkwxY9zHC
+FbtEAaYij62CbaW3eh9OPEH3nirECpFvkgtnp6NgPTcTSnMTKhVcbgQbc33iTOiZ
+Its8PxsUh/o2F/+wmmniFbRtSD11eG6zEuGbqJ5W8YbEgnZlcsnSHNnDpYLD/CZ0
+J/oVV/GCXXESPFzGYH1a2x4MzYKs0gwSB5nm3PfVZgebmDjVs2TtnhzNetyYmXeM
+51zy43V84kgu70ygL1EmKrm+bZL2AEFU746j539G1xwQkR75BRTd03guchiWLBdt
+TGaW2cS5ba4yGcKZOhopvGO95yZcgsVrQb1ZlCfZIsAGp4RjwskyusTG19KBHavr
+K2HasXXTLw963NoaIHPGnQqqeVsu04rKJsO51A5JFwJNZu+wtpeawv0W2xvD7USA
+5UT6OZTWMlfy0QEifiqG7E59md1zWdBFqFUA8LwVnqiIJn0LcrX6cy1//ES0QgWs
+3u/7Q6ssuPrMw27/bmea5Hs2+VJP1uvQ9+utuNXxaX/MHHBRdXlPVcwjjyhOSuV4
+Zcz21u08V65XXQdY/wh3reLNPpRd/12tDf1TbktxNVWnlV+my7/r0wD1cWpLFYr/
+sSntQ4gmwz7W98IU+0s/cq+tLkKuGZTZKHb7Cld60NZggrMo+jp237iQmoincOuF
+8TCM7Nd0hw9Nw9wB5N8rdA5DNqJDstJH1bhYWtOaa6L1ObAzORKCzHMuQ8ZqeUoz
+EO/KdRe2HKnauvo4Q01xAkQW6EwxL1Jq5nWZ+jRpcYmgA4cjYTzjdIRVtVLq/YEI
+BfpJIzM6fm8ORzWMZtbelVouyCbt7kxKBR7qU5Oh5Bx3QWLi4cwBQ5qDmELzIc8C
+VCHgQDHsyG9v8a/Tykqvy5HQXD+bfajiZtnYR108KfRAK7uzJfngnA954C0dRGap
+tQmTKwn9G2zZjOQXui7w03JmNiNHnlR1T4ElXnEO2K8q7JqQi5QwvYX18ro7dSTB
+esJnum3DJVWQlP8p/ihxBKsA2OATaepVCO4cu+kRh8KRjsFEv780fUTZtj5jY2vf
+KaR+rr7EjdS4EiwqKYe9l8Z5bqT+FrBoY3S/uzRj/Tm5XLH7d/UmqX7VKGm1mPzB
+LtV5JfZvdUCB/0OT690twFN9/iuVjuk4sioQ6y6FXrSR/PUccEZ4tJSMNOJzgwIc
+r4xi6eze4DSd2DkxcviaTZ4hz2ciHCsp38r2OUYO0tECorMCfc7pzDhpgEz0s24E
+RVok7Kdpo6yYKNzTjads6EkAWc8ZDT39Ww60Op5DyEytwOrrkBhGvee4JmtNZ4LU
+/D4yhaMUUjfS5epU5owg0+YaUfLnRl+DEah/oWhRkRgUjILx+BJw6j0zNwWiCKjr
+6GBfg3+P+6GpYAz5gnq5hcOlFYa1T6FouNf2lSf/9C8+OM1ViX6pBJB2SsGyd4H0
+EP5RpsQBj/qaGQ8KyzdAN3EFQ1pb2cFUUAtLGFLAPaWB7o+QlcTQ3vnGZ1PWAP9v
+LEfwQWwQtq+G/nwkyDqAqdtakoE2KfvyJmLM+yfpuUGtc/Hp2jxPsnAgANWrqJBk
++m/NQFoxrG9iFoUGxP/oRmOZPvnz0/EdpabwQAO8ywPcLd+DqYPmJMxOc4BHnrwL
+/xdeDdxsL+7jNqmJxilsJhtzbshRiKEky2U+JeDcReHVnfiygZxLhlzdgX9kEpKF
+Rj5Rgx7t7w9FLV/Y2BHvHCLSZGaMi9dOve8Fu1DvHbZH8J4IQVMg345XUL9wdBcK
+v2dHzWFt6P4jV2axQN+JMNKdGlj50oDgFUx0k1px7JadHt24XACbhfXXP6bAqOJz
+7zwmxxcrmBqQujKQcBJpM6V5cSjhx7YC/DJwM9t02Muc++0P0KskmwOku4yjbR5s
+cLfOtFISh5zOVsYpEszX+4VqMJZjBqP0Ed/8FhRJmHumsqtFKKj705oL49FSpW9V
+bW0uQWOHfHNx8j157zlf3Y2hO6c3xqKJkzzIuyWK3mgqSI3knAd31spR/3pewATI
+CEaVWKpkhUZzyvaqMKMMLIBaPaamrYhH1CswAeJAx+3X9UkFdVswaCa/SSpL6lWt
+9mJHkMHNRmizFol6wW92BdPrTnb3xEea3iDTe/sRsQJ96v3I0+vgEyZlaCxAh8rw
+D22Yw+BstZY0/7tVdV++q0WsOHkBpQ4mImtUCQLiybfeN+hk5Aat+XLoT0R7IDWD
+llFWloEoOFPtx6BykyeUXHLdZ6vF9zs+q0N+g8+kViuSaSulmq+yCZdvhYQdxYKs
+sW1AYxiu3kFEVBND3ZVc4WiLsk7akwerGTuJrGgf8PLPycETvkoLz1SyR2bjnDPI
+dsGRQ75pE5atiXLXD3R7vdD7MjpidP9KntUItXTtf92D9Rk1Wud1Ro8g1Qk8gJ7J
+B6dvh6QWFhnOdVRkKvRkK4SGREpFub8fxtlvge9ov8ggcFs65Q8Yb+2gYc24CVAq
+jVOiveYTuKuclAPfisY6PDqx21VZBYWdjjaHjfiXpr2K8r1diQa/dIcSIZrDklEi
+H0pVgXgG0Xt0HjCu+vUrhabXo3u/IgeDTFbnOgLQI+8FU11d2NZ3DoH0r+aM5T3J
+Xa87IBNTD2J8KNI2O9EqT3hZ6bp6P1rnyM3KZX+iOZRtdXh1a59yddRFNQSPkUpD
+FaGTrNzd3nGr70a8EW/HIuvYJP3+S7lD4hKpBX28m9nNevXbxgtapQ9EznpdAL+D
+OxEJpJWUObcgas4GY/TmDQx2ZAW+sGOhKg2coD1SW0m1VGAxYO5Js1ziqyVwkEH3
+N2/QQVU1Crk/pn5AibVlA30y3vn2SK+OKq7xVHTXkpDjX+sIVj0h+iBIQQeoHPJs
+pyJSxmpT5b74w7GbMi4GOETQpgnzRcnDdtZiVFyLiOQQdMOojZildHpBpvbG1uZg
+FmY/75kU2vHB45G65PZ2wi30HqBz7W//ErnsaY1MsZ8wvix58oudA6HJ1eqHJ04o
+NUYef/6ALjYi36shQoLJKMG+rwc03R5im8mIXX/cCJEnC1/Rp/Wb7VwvCzBP6BGT
+QzP63q8YFPpogt2orte8kTRGUztCMGJbSR+102THw7ol2eg2hW1kvRsc2KWJxbPu
+bvR1zHdspMHxyugDaMXZ8SMDE0ucXxjm1hqtRo5OuOpm8fDdXXkHh5hR5YusaEqa
+1qWK7QC7XV0uoQyZElTKiG5uCtu4TOK/lYtlSitPNvDDbSKaAO27AUyUnZrHTZWZ
+7sgha3s3Hvtlm5dmSPFgwwznaDHgjckNsbwTmkzN6S72PM+aj5WbIgzfUDtuYEgP
+SC17GPegzsz6eYsjiaKgjdXyc3+M4ApyJmmkimO1mV4U55c7dp2Iq1P8wqlHC0YX
+41mQB67n3fiE72qkwe82ycb43aS/lPcf5Ytt8qhWkurGuWmLzOH4yVdp+NpQY+Wb
+v8++ESVQJdyiORY68SfD52EmoaCbKfz2By6H/NeJPUj2b+AiOBjIIcx6X38JGUTv
+H9O7e4R2VN9iUcYRDniB5UykeiLiIq2PH18PAp3WJ4JwrIwdi1fvcKCxY6lqRKGW
+g4fwfuYhn6/+fkT/3PgVrYsy06HZigDtlaW9w2ByrvA/L4gcYt+ulk6zY0TnR8JT
+s3pqBTMU36wcoVxs+hVZr6ByjJxvXHT7PQKAaugmiJsuCsUnz4lapQWE/XhlvKBQ
+zkPJnk1+BxtQ+wuQvxCF2ZYciuY58JzP82JwuHf9KP6d7AAn9awh14tCua4xwRrX
+mVN5BgX70qhyWKn6x8PXpeuh0+gONyiiHEx/JkM5lRyx2swuPAlYNYosWdXBMQHm
+HHRbL5rwVngAIzRp6zefukyEQFnSL1O8BVwlTpqIl9U8BiTM3kNlMTiruXEeiNKF
+GBuj0dB7q7TxQ9NAEG0MwuKoYbUFr+rYYA6F8IqS+63kOSPrsnOBGinASfXD6AP8
+VQRclIH93TY6lfRX1hXisbFljUFHIz/N42L2t2qLiVymNxf/PuBHfDzPhi9nbagG
+5KFbmXqoDXBdTr4RT3T0r8Nwcoc4BJFHgB2HwAHKnMmJ40xmD+qp98HoWReuLX+O
+cAQenCVBfc8DJPgCWRVfBiEsnAcQ2ZKdKzs6m7chJghYikmaWjxD+OsRpye1zkCA
+51IbTYjs7rVwi3LHY2NQ3NW5CJMx+Bg1o3oFcs8DhPLDCK6yGYNJoNYboAB1I3sv
+UWRU/EYItF5+PJ6bZR7aQIODB2Lz43S8VDKlE18NEJukYk5OXjZ9Q9dJCsMw91Ij
+Bok8eygKQ/kjpdbJxmt0PIsLLVXC5nNUaK1p3dHihd3H6sB1dx1ed0TouSyitvrt
+q/AJEEW25OHx5RGUc8WmUKHUBYeEH3cDPRwU7mtMvZvVluYh+KV5fe2C1OqChRAe
+P7LMP/o0QkzeDjZEo/+xkP3Lb7GSJ3MJHaRovzkpcEM/lCXuuX5OnPQfrKARaBIr
+exwwR0f/wBr+gaAgPglBBm2Tfi5o514xCwrFfQE3DtRRQqOphuwki4JohXl5nmB4
+grTXkqUf/I1wlA1/Al5+2VzU6/IiaS+olJ/PQgiCZRrVP6Ei/GTxaeOmLnjJuMXy
+roZbdnJppgDDBmcnmRJJvmmGVvvMdKa3+AGT2On06zrPZpTDDFTXtMlH+DDKf554
+mwdScazB2i5TYfoOwK9vV3dz34MNw/MmfvoqpBcFA7/EZNDewOnqcnYJzpfuqo/0
+zPxONOpanaNOF3yd5tcRymR005VvkKxzYzJ2YjAMf4UE7FJiR9cNhl94IZldOAHA
+kVIZMXptwLTwUUUiEYx5mSqKrHq0zPSc6VTcaIyJ3AEGcweto0gCof8EAlC58dkx
+suQYYhC8QwgUNre8qiczyadHkXQpxAr7Mv1ECIVFnYNdxHixyHr86sms1An6l5Ot
+v3auXak/47B0vNHcJUp0ZVSjchXrL2LOV3WD0mD62GVvBbwIkskl9V3owy2xVBWG
+cg2d6dTgmXH1lCx1hfwaWB9R4MeTaVbiV8uyv75mc0y6GH25qByKEYT4M2vlvRq1
+5mQvW+Vr+/oeOiDPklmWNdnAKrlvI/+TiMYCVTbCYtwsWe0E38PJ+hbzakCYg6k1
+IrgI+RqMNb071Vya4WZq87/qyOvfb5O2vxFtiDK69AHR1JIZcYubzhw7dbFaGAw3
+cV771skzzdQqX6R0iaVHYgtx+M93UQgcswafMZHTkVn0eRqwGm24Nq0ErTv2Mkyn
+RiDfpCj6VPHH/nc3MSA17Jb6/mVVsjgMOau8Zg+pqR8wECybDPomhuQHvi0jUyFN
+1BfB0KPgVC41RCRz/IeuWl8mr/ESDELW36INkEpDdMZEt1yKiPAT5sSC4fa/VIJS
+hjaPpeMN/59RJ/BeubG8uxKSc1B6yenssTQ7y2X2JW0OzDq8jaHcWIzRg/Wevgl4
+cavP+KCZFU9b2SPFnllJrcoYN3Mdfv0VcCfE8rX0C1WytuDfmVF6Kpjc+KRlJFDT
+dSCj7/SR1d4xDxhx2T2BlmpnidR1WdTNx4Bb4q3uhZ/GXmoSnAqPSEn4CI1fhhgZ
+YPdYGEy3fx86IZjgGGtv2fxFHcK1vTcBiGDoUIrLeZZfXdN2xHoVtklUfAkVPsJu
+inVznqaX9FbzngzYEsRxDCRHJcu9c5wehmNSGILGGjqLvhVeJPvBFErjFQA/tU0+
+7+WuSWpyTG8gkXBB50c61aNy28sdcsBBsoG2kbIZrGHUcKmWY902UXlCQbsDW0WW
+SDE3+IolntzEE7vKaiDhD0wq21ktRZU07eglbiaxm7ryzwjVm8ctKzugXW2U/Ih8
+um/Z+uHVN2HVPFjRLDJrh68Rgpz8XcJMgY6BAPHRjzNNREH7yVfYYaxSsV7cLFQ1
+wmsQC1zVAPiq1WORG2seLbrpM18hZmjKXXoGTfg4T3VubPgwrdu5hNDPaY8UetIi
+KS0PS+XWxOeTpY+4aZK9Y2fbjOUV4ZE1cZAnc1HVH940FpfyJ3BXYz9+DCcwCDMs
+DovYXcTPZ/FC/BflXZVTAp2p1nzGKU3K1z0jD3jvrt37uGAsKczXpd5C7JYlJYEG
+Vborp33rRPK8KXExpcdj4bkn1DJ2KAkMHaCFv+Qih18yEOj11U6xIOK0UZPcgc7I
+pAelk/QXldmKEP4s81pnW7WmipcZfpPU5hcgQ3JE/Eqf6UYGcqsSgpkd2Au7AQDR
+7r//zkYwZe2OwGdUmBHNOrTrt7915RrshoZuoOF34vABUSRLfJ2AK+NrVnjpziql
+QYrdMxM+8H7p+2oQh3xOwNLYByR65CQmQO2rFSkU9SDoCEAxgPjVSEunagjYpGHr
+J7cdG50oTMbh3vMqd7+Mi5HwWH1tHUBVO/E9goguBP7WxKB5cjtoAM6qW1dFo54Q
+CYuaG1fugOoXstfsHdYe/8ABimfJWWXWvV1WYc0dViA+45f8KnqWec8VPheY6pVi
+wWWvuHINcslJjluUI1NrXQK6sZaNz7nfF0qXcrbSDljkbrj9v4oq61vUHeVmPATE
+nN0Zu5iy+kZ2+98iZYRV8crWziQxUZ1zczYPx3KbwC2z16OtxEiMHgaJ+5QtizE5
+uJFgr+6LVPWg2MZkuzu3sQ7m9GiHXWsU3oJu0QiUoSkKH3YZciSPijnpwTBh7sm7
+uFJ83zmakjohApqzVhwHFWbiDaN7nzxp063V3vcalh13MBScmzePvf0m6zYLxr+x
+fNqbYaojLz7BC9uQzuCbbS6ztOp1aN3RG2/c4Xfhl4cgdmcoC1CDYnZFrZD9IE9k
+u3oC8aYtER2K1mXASCP9p2OTRb274nV9YV9SAVKzppwT2kXfQMVY6j8mqMFIkcTY
+mIul21w+pIPJpY16n6nYl0u85PczlZ4zXWWUOI83SYiCa9MG1f5y+s/7anaS7U4v
+ByilYWww7xYDoG7IjbPwIRb4vvL4bMJ81prZWX5gFS1q17Nrkq4b2Phx1sgB70u5
+by+Uopa7mZeqnHvYJVvjLSCKQGljtDa18Yq8hPHO93mtwCn8gT8ufaOBQW0HY6OY
+98hifwCOKaM1pHfeP0VMzCdDFd0bn6fNHE26zt0/IPQRZfnLK88zU7DqWWXHTXEk
+4eBmAYaTWYoe2R84U7HNU1lJmsWy4OxH67fy5IyGrcJ7WkGXr/5a8BlrfWq1z8B7
+k4cAVmp5PI+3vCP2Qg5Z+aDARA5NZZeqmOX2is2aNyQcmRUmOkTBzGuOqTiYmX9/
+Q9BATR1tPG8RFOyRiFP8qTJe07qGyAIvkFb0uXKZtPZBiToC3b39Krd2PR6DLI9k
+ga2nvLNsIWeRH0eRaBEdxGq04/RjZlgO15deH5rglM1A/gVXszB+FsuvXdzAeou8
+9Ok5yDfkSpfdgt2iVnGjv/L0owKeYjipkbcQFmNDh+AA9H1EWCEgwziSsEd8dBiP
+VMOlI/8BHPWT1X7lyqjN7TcCAUJuwrcrUsJIX5D3hWpN8eZp+3pXqbGcqhVFOOVa
+NEYZSAjqNqhg0Uto6uubVn5X6BNCeMtqkE1Ig4A1pgn9SzcU6gFs26s5gG8VYf7V
+fzRw3dzmjBV1+GfcxZIcJjOYjOUjbieKOynSH5QHONf9FHtePV0K9gDNYOwSJldO
+EIYfBAmWn6U0Dsb+Cmze2zdaD92G6csnO+wiBSXMM/zXgkTM85qc/niRWi8VuavR
+WhjbxKqzj3NmEErj+GH9Z5cGSBLSVl528ss7TzLekTCZjdV70ZP93DS3fFV2rdeR
+bMFgAmKZS9m0ooMn6e1JSdss/tOoJP5qzdfaseXHqnq+UvsQ1j/oyvfkzfxwxw0l
+N497NiRTI+azWa4BAH2BGv387xTK5XsCGHRnNPaFXugIhQqDx8xrpjdVoH+3hLrt
+ibDEQJdV9Zu/5XhYKUML5tCwsGUC1DXLXd7nmynN58FA43JirX6tU+DIn6LWdsb0
+HWgALsD933DBte/+cOAbd5g1jfuXEn6DG6SkdGXnHjpXg4SRuAqdMrnS8PfpQYRo
+7HFzdjcylGohxGX2a3Mmn9z69SG1kJK52vYPbdpjOs42xrukIwcMerxoiO+zx46+
+61BIHjMfkLdCZCueuyctUNp4JMXaoda1bgiKE6H58+PkI6yjs82Aim1OlzzMqALC
+qEGsnaidy+wzDHKVc7Lt0mIkz5NAV96Eb/Kjp7LyHkbL8F27zhYy/GtzAiSgTGUW
+GrZM0G/9QgSJf3jpsQQ9HYq8TDU7SZUoRXOLSnhUR7LKNs46tR+Moro1zEXINtiM
+81rnI8tLMw02LYzMUweJQLMHOsKfHcv/lz56knkboRQgQYt+ziln2D0+uEifV34X
+nwnFL8NZ6fm+0VpEOLY8skJuTSNIsavK74c9EbFUxwqhivJop6GGMcGxHDun3ir9
+i5G8Yqnk4pFtqqy8zKgh9e/P96mieW8Tiat9PGwg3LpSj62YRdNibQp8/7Tgaqy8
+fuvMnEG2u6lv+ooeSiMlg6o6HoJ4B0k9nSTfcWdqTT11zxSzSPrnx6ZF9dQwWieU
+7jwO/SRg684J+tDXHcbLPl6uLX3Z8o2gKhajoxbghBoK8/L4VEYNfmEVjQCTmRo1
+bqDUiUjSmoU0QIos8X3ih8I+KXxlGrsyNCmT2Eb3km6f8LroeO+R98d2gqsFnb9X
+cq534IkFBX6x3Exw2pNGPMgXdqWWItBZ0nZhbnxNIwJhijBjHXj4mi7kxbC6VF58
+IgkTN1nS5+7EZcrpQvAxVR22U1MFrM+2/PBN6NtnGhfxL0gPI0U3kerBuVdYibrY
+p4d67y6xUTArs3pgnuDG/TuGx9pUVwZECD7+q4yckjuItbQDnMVP1REatKLznf33
+pLD6hYTVqAN3wyBDCThKPu3gVtb6KccbofDv4+MC0UHmMBTyRh6Rsh9pfBn5Uf46
+1Cs2hDjAD3ZrCNRh+c6Ut6x2gPm/HOD8bCKptNWR9g+HbiOM2ioa3OehQObSpSRM
+PDp/tGA0gW2/gk92oHCUrd6EXLPnLillAB7lvI4ylyDCCou2q67edpby0GyNEbmf
+boMDUulipqwCFqLBJfr2j6IKTnbXHlS5k2COV45Q31jcrs6QFJSXWYT0jNvjhCTz
+/YpLDSKyMGjtD5MFTXooKQyMcHkmALkVvV+ktMGAcZXK+0FCoBtH7hr9s1g/2B3I
+PJlrL8dX8pi0A8xSZ01ZkTyJF6De0uOkyOLfZ8dt7rGzEdyeaauPtRJVAFfSLLMM
+g7JP8nc9kPGXJisCUmDEUY4rtU9bi2goloNk9VjAVcxhDPaC4C8dRDsTVqYk+ndN
+KbAgr4TgEfha0qnycYwcvZtCFCnUptO87JWERauuOompXETiNfEHNhNTHv3jgMwY
+svzOl2HFqN3I6v7pOPNyjtyaUaegEfG74k8re2rljsc+zVWzA5ClfJ1zEOTVUCzg
+XqgfA75eExxsaud7eBZFXYMDFd+ubD5LCOTJzJXbDkRjqP/re3qDxWtg0gj3yxUy
++FtyX4f1/Rr1ZrQN1mAQJ/tyFlqWci+mAk5Y2xDAVdcKg1xQYYhh/lbeGJtVdIE5
+C9J4jsi9RdNLZKMZY5h8gwgatcwakwd2XwHU8ITcp2xraYQyj0w3uzBx/7px8eD8
+QWGWsUUTNycs5kVC0bVaHaXRYiQLAOwJEPKo+Bc+PuZ+F8LGPXh+GhOdDoSyXPAe
+WxZa0b+KuEHy05Jyq9FPdx8taCF0DEOvoOB45KK4xM3FezyvLKZuxVOPu9nmMmDd
+iFrv1+ZKUnxzmZB94laq4Gal06grXCG9DoQOrgH+5wHTkMJB6BBluTyCYpQFvIRM
+HureZxQavU/smWQQPhnAzqqUbHNMj/aZOqbcl1kHHMYvHdHBiPgcaeR+y8svf/uY
+c3+uMBLLjEvnpXtqt68ugt1B/T+TVhSplFkq+jep+ht1Rj6Rv8kJPc6wrvpHJl4V
+L5cSwFCY9EYjVRDbaJ7UWxRxVfiAH1J9A8Igs4gM1ho2DP8eEbcZX9nb01CYV463
+S52nlbOpg791GPpsjwtwvnR55g83OwDBiLLtWTKLrp9cAM3NdqKlQdhny0FbvURM
+AP7P9Bi6YI1H0dtwodsdCtlAwSrvrDcYD2noU7BEwdvJ81YrzVToWLTOHXDqADDG
+77NWLhJfhG3vGzzGCUrFIganVmMtHl5WpxDYUyRqEYjS4Vt2CpUzL6cSTq3tCxE+
+ZegDhc/m9UU0t5OAL1c+69cUVSywC4KOeLLDW8XKcJ1gT4vxHH2jT4rH+aZQJcnt
+hzUfOxdU+tJPMYEhcQulxuIxQAMXNX0Z+AQC2czv8DxjYEMuNxBCmfQW4PnIkD5g
+1IaFzFntXhv+k7i6SjvrfQfSI0QE8pB0phVnxgtAnUVx8lkvz7xdc6JXDLXV7yJk
+QqhqjGEyViln2/StEmESCz1XTNbH/cGkhliROkwWWfxy8kkeU4JmUW96JTooBDG6
+c+0zxxJCMRYNf8yN7UcEmMkKlyrO0A02KMFduk39usgMXaeiBiNsBChVJXPCElCI
+4Y38m9dT/pQPGIisR6Ux+tIcJftcjwhlrszhAacxaF2uw39Y7YUhf/yguODHh9hK
+98jP4fcv5afyEZiNs9WAYD18Z5hoO4qEMiRrtXqQnre/2+51l6/8tedB5XVpesjY
+m4Vb8q8/uz68sR1fhW8XYDqIq8d/zHECow80/TtOZC99jvXLsAHbdkGEPWMJ7lNs
+nloEG/XtqxfqzJZwbVDQ++YvwMaYvMeo3TETrp2dK7bZxtc/0EANxvZOQOa1PS1T
+598hnl7M1q7DOourJmOLKQy9PoBPzKOSug57jM+ghBBehuqyg4uVyYJ0lx/cRqUo
+CIjoDFiHK7WXGClK+n6hQx85NHfTaHZ+TTjXk/D6M3Cz/7DFwbA7h3J9UdErXWTu
+Zj77Ce3p0b8Ftf2g4hJdYjOm3xAhaRN1rGpx2XXiBsYIK+kkhRgIioOLg/qzVqUw
+abLi0Ihu7bvIE7wMTUfpY9+sNQ/vsBGjQvGbpVNMnnl61wAvTAzXfWN9/OyE/Gy2
+JivO4lwC5W8FuM7tr//uM5T+WpqJVaDHEsWeeqeED6ZhrsCCkNqzwlBLNTKl3Eg6
+UADteNlJLGTPKEvvl62TAK80jCwAbqNEoQDsbyDD/hyQt/PxHZ3efd/8PSUN6tcI
+kK5qbFCAPCyBZvdMWXfSSb5Cm3pamh0xLyN4/Ea+GykjUxGejBmVCaFXr4LCQBbL
+X2mjig56BQL9WIP6ajpmJceUPlju8medEWD24bjyWEg3ay7wMHpGlD16Ecp843rq
+WQPAfwYs5qEo6EuKbx6BN2D7r57DFR66Mpg3fBSM6ETbKhhzYxc9UXL5mQ8rls+e
+kc2Hy5E7ybFTeqT71don7tTg5ovcPg+f1/U0QPcSj/bmxoO+bzpvUe6HsXr4NCxx
+PgIj6MRgaItHIM3pjwxMdDCNxotnWC7ZsmhwLrfA1SLSwkFXjruc/F+f0GO1zoHL
+7ArDhNccok1TfHTdiEkVxLYtrrx7mpUPw/6Op/2DQok0hXhPmpv31sa5WTA2tWOS
+q91SWbsqoMHteU3N4e85uJZ4ZVp2yjEt8EKsxh6anJseeHQZ+Yl7YZCPv0C8wEBG
+4P8Bz2RfKDTC7M33yp/97w4FcuKp+1QxpY0NwmEh/jNiE6JQo91XHiJ3jWl0wAMb
+jWbQl4rn/sJzawdlju8Ynt45t5GyHAH52cuWAY8dGtbf4cJqoqQKL026auR1y22x
+jjL7dQKd/Q4m7FVh+TwbBgH2jo3fTA7nFRfi8MgChznHKFKZjQRKN3PPezDBEVU/
+4wLAjueFnSKjMUDOVMndkgL9zAZue500Z/SeZpls0XW8imMG6PLyALZjax/WCTrl
+DfO/yy1zzQdtSLf/S5VoxmEOL5oXPrWqv+wfr1UovffhK9lqT4YN72gouRcUDk/4
+j8hdLtUfdKop1KnXHUYDOqJhG/GSlhz8slAdcLJnQNJU+EdUG1i/g3wEzQ7Hp2et
+OsIeOFxNffek5MoOt1Sj69xT0UODsfZm5ah81ZFgAZWkeoRXqaFYl/1weu6rY7pk
+cpCxNsfUS1oC4eSuQeLlzEnx8ZAPqKTUitdy9piSQ5dU0/ZdKXqU8qF2Eel71nPh
+BEoS1l/Z3dR1B/Gw6RAidsruxHqBrE8a7mAAHDNrjFKpCJivsYYyE3krbv/wKWfQ
+/7AAaaDnG7qVdaKFAP4PzQe90VIwsvaP55sl+kk095XZ39BYqa4Wp3LfkAFlAN7m
+wX7N4TJGUgMFnsiM8oqcnslmzB68HNrVFyNyjG168L9jYXPaEeWZdVCzvBfehfDd
+er8VRf/fneMnFeA+YgabMyKHW7LNpcEXhZBBjO2LeWU1ka3k5KvBi7rfOhuM+/ni
+ZsSvzqLdRglY/Se6G3tN4IT9poBi/h5Pf4eiOs+jwX+Us5fPxmcU+Rw2P4CLK5Oq
+USQTQgOat6zf7x6wz7c5SVnuR5mJsxs8xOv2Y7iXB62dM+fhvhNHwkW73e3KMuY8
+7s1XfFNUrx0S42/gzcWx6w6kba6I21vlCbHzTRztsvNf6X+GIkJWayzscsLYrVkV
+HIvSRINqCKy7iXuWdAEwhynvhx9oN7me0YCDk8e5DuG9bX0bsvHOMpRvp68DwbyP
+SYRhk4YAfMuFk4eTWzeD0yQffS9uch79oxVA7RsKMqY9sDSav+lp/VKkUyMg8tB2
+CJnRGVm7BioVfbsHMt8BNixuBu+aKm0CoBCci2liODHt/XQ/BX3erjBqqmTFbQdm
+UhJJ39ZTKRdMYb9SqoLUpjaMoft0xzBswf+KmoYw2iVShJcplUbi/yv3aLiPrNcl
+naU0R7iqIFFTdWsPmr5X85Ze7l5p+ehBQq9Fvc00Od3uDmL9J9A7olFzmv/8qZeM
+XqJAs24k6mGon+BRFMEL1mbNiSBKQ58RkfmCo9OemgZJYY/7gf+bziCCK5YGKl5C
+O94ChB3LbYY8XKII92n+tyOhyJQiATGutOF/GTMaM5vXszy/SpjacOV8nF/+CrqR
+VSOQYkWbYP3V9/YfoOnuJSWmc5vInA0arSufyVvcjK4S08DqvzkdB4vF2g7dZhh/
+V/cziUjW7qxu+UJ79U5Rj8ipu4oiAyEeFys+UuQlHce4Ps3aEytb6PqB/gVHJ1O5
+r829K0udQ6mjClLDrnXh7gFw57kHeSX9rMvJI4LsOeruioOUcNiIBjFWMjaO60q0
+Ipjd9wE2k9KlUD54XOVtGJMIyWMx2dw0l8eZJXFfnRyAy7MCWhb8qJ7mBpadmUn8
+OA+6LW2bdpMNsj41HCPvrV7eV0nAJ9+cSaf2d1UZfTWjO1ziw6cVi/JIg/GzfDCe
+ww8Srx35hYeoR0vT2dbA7FoAk3/lMl9e0u/5AWA6I1K10NlJmL0eVBK8aqjNB3T/
+s1LaSdT8fpTIzKd1/Wo5TiQi1US1QQmTiGs5ZCzwjQ4ux1lrpFzwhCPvqVUBGbub
+vt00xVt7kya/ETYZ7uZPOezXPTbIvPcFW4tGGRs3XnW61jrTdn61+oRDRmCG3vAL
+Yu7AV/uu89DlkOrxfbuypAjVZTBm1u1ioca2+AX7wGzQhz+rSbdoqXsLR2bmj8Hb
+VDQEtrnzbuUWUQ3S7TACvSf6ylDG99r2wfbonhjU7thS6R62JGmrNGdw08qN5PTJ
+X2ybg1o9crw8PrKjk5SYgD3pMgQaS7ANSocsy3V4HNX9cSmBvWk9LFKSPulrvErl
+DR6qI/PimoPVPhcGy4xanvBtXN8QzPpcMQWowF6ps6fLGceLl7lJtzUb4rjCq0Cv
+fI3fJyh3etIH8chQOwTrQWW3svJVZdYXzg9WA5EJkVFAeoZEXyFfrxg3lf6wLEdl
+ZuOqxvcuGRkqSL5QYFqyfVdt4HvqNfOxyeGsYm+h328rTjbvGrgVlsHuxPpQZwo8
+87YUId5F7fkZaRrmBgaL2K5r5Ruj5pVfuKSMaQc1BxRg9lQcpHDLqmR1txdVpA0m
+7U/8u2qrdswBmLGWIEbzS0zfG50Pvf/wxm3kz/JnJeBzj43KhqhgDxFDJePuIT6b
+9mG9NvelWArkJsHscTl1B8DB328aZYNXBPTNQx9c9pwjyXdyP7CVgdo+F6kprk1Y
+qkmQn+4TDLnZC9SBlywM+ulxykpzu8wnAPloMjx5++KUf82+sys0WGuBB5FZKW+S
+prCREWx1FX6ETAQdHJBpTEGM4l9z1qt/FhLyAPAbIvEC4DaFEI4/DBj4vJDZS6ke
+B5X9u1oJoS7+WforMZenLcxt9O7NAIIS5eIUXxiFLkCR3K8a/ZZj4tLnhPBpTV/B
+taszoTfGfbnAbezwaJilbiPbdln2++qsqt7SzBHmUJSAsNDMQCDq3GjYE4l/6015
+vD+AX9eKwiZpB5+M+MLcROuL0l5TS/nVv0CJVz1PqB81gy4Vjl8WSXFoQ6a5ncNN
+FbzNfFc5PL59b+jpS1jUCEMqqe/aDA6rCKSTwdSVH4iQcv+LSlQeq1XJWNpLnKz3
+d5670re28WWJXNtnHvWlI2BSUvvIQcW5dQ9f5Hx86jbY3hXm7nKciLyfDjluDZaB
+o9Nkvd+KL457+jFdnYf2eCeIU6W6jYlZpiom4IKsAhsUKhfzjlU/mfcvROcfE8Wd
+e5Rh7LjPhe0dHZPKrc9OEHJEPTqypOAeKH79ixWvL1EgoQ/HDcuS/yWXkOQ7iAmq
+3ty0OeWHFdkOkhdaoz93ZYbWkBf1Y4WcaZSuu8b4qWZBh1YnIeb9wUg9BSF6pcxk
+VwbK16rPo+rteYetmMUZl/lVQHnzoMuLDxjlDiE2j7T1ZZk/Q6iQBvoV91kLrCbb
+DLOv3MFbhuF2padWe287pGHkyXw1Eg34gjUMkMKO2zYqx0w7mT2S9fp9wX7q1nqa
+ps298+3WUkVqtTz6xcEXd7ZrYEGMjeQZF4hJ71cnIpzDvr3ozfDyVzsHIpPyr7mt
+8LzXfaeNIq5fOyT25FbEFto/jYDoUsFZoVpq58k6Z7NySac1SnuPUBxvr5DkGwOn
+Gi60oGFSGnt7LHOffsUsysaawoQfT10XjyiEqCXI73f2dVaxLNCuo/28FbooqTcF
+dKqWQ7gK3tVrq0BX322Lc4Y1/dFEQ2v7HZFdVXltWPPFWHVUnMkr0dA6hsuKIVYN
+BZ294SA752022uscA+PWUj04pT3T7OvR/WU7IMZOhk8UjqpXlmI4QXfdVhRthC2l
+fvMa0W6+e/twTtPCNgGD9t69kjYbd7HXIHCzDPX/v7eNVlhW/eOlIxwI2JvyXZXM
+QrppMuqwUTxGVjOfoex+JftUP+Y6GT/KXdd9AxQRjXwUGgtbtXb78ABgN8OkdGB9
+mEybXWJYw7S1BJGVFnhqbxTeJ3e25FICnPXLHWME7jetrh9mcxRVyRy448rlcOOP
+HL5RhPAL77C179+l7aT227Tdov1ATifDDCWsak4bRdHfD1gcX+RH6cryCoRENwTi
+kjMNbedLZpLSoymmNBsDYkh/LoqZaPlzzUYW8uv2CxR4dOYibLRiXLBpA1GSnCNA
+psENL9bR3do2SmyTJp1FREQ/0tlZukDZZIKENDp8PsKqUqdquj8NNmh5OmJGQI4R
+wIF+C1dh7ZAAwfLPYbnNO2kgH+lNdSx9cKVRV40Jj7GFb4oUNOV6wfHXPVbW9txw
+VBCkKYX5aXbHERq0kmLJk9Kq8AWHtiWg4q1QOt2p7KTthUAPhzcLW9X8D8yVKxe/
+uWs+eyFcrDYk/Uvstn9xunARuAdpgVIqSRlx+KKrUxeP3VESPIowQisI0Qnn8V/I
+ubOkOhz16QwK6genWgucQA69F2pmTuu4FWUGqClGsrL2cjP1Ht3xQYfvz1m9tlJ+
+BXXo2bDjke9sbvccURqBD4m2odjsSNyZ7wWqp59OXCJ6Yl6oxbQz1j0FR4iY7/8W
+GyCf/FF8LyRqgQPJwd1joqz7zYiKxEPieiwJPudaaP1CMzDxlNo/Vs1rfT4xqRbw
+ZwETjSaZYhlNqQMrXHYpP9lFCHsFA6EwwZo63G9ENyYbo+bNzIvPmPG4Vavm+C4O
+XKYtGQcQevq4iYniAxEIYUi/HHDyrUW7pjJDJr39gmGqbLP/wDYDycDEAeCi/nqX
+JBwH3lveS3n4MGOUCqRtT5oyepSquDBUWlGGgWtQbX7npv/Qyh+9/rsLUXLfd5A4
+n7JQTtpnV7kE7xNe88lzZN0BZ5AlIBtUEZeye0CmN7Omj56jN4L4HKoDPaZrYWTa
+1fPgMcVvWSEi674eGMOQYeeMN3Y8sQPT6xfHX+5uUg7A8UgF1mUNjwCakoW4J3xk
+dLwE9+eOmo0NpJhWQ+0ug47L/Sqk/lVvec4+72wYnS4EZWrnhHcU7TcCGEyJFWDL
+ejqsOH88o3w2tinDBlVmNHb96KO6sFBXZUyiIGcq60jZdN8uirufIeW6t7jvl6su
+3L7+LgP0r2Y6JedIpvdMNNM6ZEMK28mg09US643ZYpO9iMl3dUTKKrKHs7+fJrOQ
+NxEKJtxRbIwjeK68RkmjktPmNAxYKX2H5MOuzFx3+Z5TZKcNd4eCNrp2vj49xEL3
+WR+ZzwjsvM47aOFeb3glK5D/k8fcvhZIzEunAiGUvZtUIrI2VEpf2EuIF+bkK9UD
+LJO0x7nU48PEzwrlZ4p4IkvIeEYz6u83cTx891QO+XaZ/ZimDiOlKkV7r1o32CF7
+aV9Ywm1ln/+8x74DKc58+GsL3KMIe/ncQ4g6tg3DDbxulEpVupVS6C70yzwW4lHb
+EvN/5PZkGyvIFYR3w2aqxs6enbPTfAm6q+VL/Szp9u613n8DSIH8Wj5HcDGp94PQ
+703ME4O5CZQu4q6x1vveDIvJacB5SIf/4ZuRLjEnQ7NSnrAk03jixiwSvngy0IB2
+HGp7bRZ3vFmr/Qesyc1TbxQ1u3kqwYjP5LiCuFz7xvrUEVEmHhhtnJjrK6pDu4XL
+/VXTX7jLXE4Lp9HoEF7FI/xxefUs/qBC2vBjuUioitJdphUj+NMC9Z63mOCqGLCn
+CJnR8CdLPB3Gc15WO8wFtFrVDrwDH+1jDughj/BvTMbj8Huq6zQCHAVE9B+aaLxT
+TpYcNNecSlLUhA010/M+ZdkEffvyJUSETRxNMzX4reinCcqgLUzD1QnAXHUK9HE5
+rgOCnO0XvZyUp99L48sMlQcfzqNDOb3sCx+VxoOUNpshshh+Pk9UlGZ8evubYs4u
+hkSGcw09JTes/lL4mC5DQYcQxGQypBSG2zFBna6wL7qkUZttDCXxWimQkg5QYOcY
+t3NAsnPX8cDniLdnGdyUAk6kQBSq0G7rpUUAVJXVve3K+FTsp3BnKBV2WqCXIrj7
+icGxpbLYX5dcXRoCQtMCGuhjlZO4+l7AIf6IajInZKhT6WCVHBbYTs/VkhryPMNF
+IEGzqiZCWzuX/yQQdTkyIGcK5nnEfZXGUdQB/aFCCXMlZrncfk5HghVQXWbYqqTY
+rv0WzxyIQl8+9dtOELaMiqMyAHCDoq4e8oJZeHMItxaXn4c1KS5ENvm0naCv/NNR
+Np3Y0l0mPVCcMjspWVnGiVrP6bMqPEl2E6x0C012M/uxldih/P/qlnXgmNselFC+
+U1uQYIEdOEDAj4wG5IVYF6Nl2JMxiDyGrLvFH8uUs436LIK3e7FSoXuljYZAfieM
+v15ngEbSSeyWwfnYM54G72eqIC33Z/s7SgTQTCGEECrwXOzwT03ciacPDtovF4bb
+4gKfOKOCThvKLdja0LqLIzehcgJfslnuQ9qVBeljUBBAusxlHRbd0WykqhcJ39nw
+aZ4ItTYKm+JfKSNg8e0SxyrHORmBs9FMFLQ5YdIx7wTmx5sfG9dI7ZpuJB2YKQ8W
+DUojlKX3sHfe+8Ax/67VzRfrniz2JVqqbPwIyYbiJgQ7RxURYFPmg196721NfQ+z
+OqOsZfbZwNSNxQP95dq7K0UfGvBz05BzwqdufPS9+39vNO9NFdB24oxd14a7Yrgh
+LMXIfuy8f9vyB8s5tmKFNJhkCWkUBkM8XH86+3qbR/oQSJ5/SYah427a1NuoDf8F
+bqoBD5REjeisTqZ7DA6eTyie6K+qGeHNuZZjlojlUWpeRdWPQUIZuGQrsNJf8mzr
+F70FT8RmBiTM2uqkT84qQObcWQ1GDUBm7s2ZbBaH8vt3bvNqyX8MYN5pv4aDtnoJ
+iU9teS9EKt2Eg8xHwYSPR63lRuOh13PRTWoZCCvX9a9KXU4iGummIZn9FeDSwDqD
+JFrZB0GUsybe7NkvxgFbC8pS2CnH55zCtawBa+Xb8FKaQq4R2Y67lxPKBqobndnU
+18AXVHiJiZm0cPa86gJL1mkJElf3OBwNbRgLT5bxTUdZIZ1cT1BF0zlkHL6qXAl9
+RRIsS0MWpcMvhPeXnBOKZLk8uo5TWodaRzX56XWW8nbByFRAepgx3C17i0hTh/t7
+296mXPBNTAgxTTgQrXTGcgsRckI+ksMoFJ57h8Ig5eRKQgOPcyaF8gjgfn6U9GTA
+d6qqqKmciJkQrkVo5S8Cg6UjxNTpGvi40crgDcaEbdMa4D7AZRJUp/pBXgS6WUky
+gX1R72GbzeXErAmILwwFmx+66r++0q79I4WaT8QzsmdozzmiF0WTG6W35Uo6kFZh
+6zysjOcHqzeCtdnWF7w+FtuaaJQc6wYsYrG9GwoxQsgDGXKNRh7AeI1cBA6Z59A4
+CjdfV1wz2cdF2viigwND6hHR3EJKPTnspppleAHehcj0AChf7UfYq3Mlt3keKukw
+m0ZvFLCuFZgAe0soFOuZ28KzN9AuVNGllz26HXlbYqY15WZVOljFB8u8KxSVkTIa
+EXa9C7sNAId/taeXVxoV/+2erai3X9u7gc3QZeprR8fUNpniZquw2DdBwQYTEOLd
+i5p6+078V58SQOa319QpZf9ngCiN74knCuNzXUwID0ao1+TdMYyBCVGAtUx7xfEr
+NXf7eMPl2td6bV1hcteEw2Nn4keuPLHIfbyXrIClxPy6J2bJMduPP6ExNn7JGXjA
+J2j8jxjvVSyaL8E2Fi3cC5UwbFhMqm6ajPwc5fro3q0Pt2bFI28ewwKZekrIvonh
+JX04J0C8IHVo6Srpc/GR7eUzV+Ct3KXPToT7QvWISk1h+y1w3jbefoJDx2uQ4bon
+cIz7xz4c5GfIxWA5uCVsFrKozDnWhy04BvxAoeDN9vCzAEd8F2Y9W/5IZuilGcEp
+zlVuK7NJCQ8WqdFZqERib1f+z39pV8VkX3UtscWJqk+By8ljUeHpN02af8UHEUCD
+VDtceRdzP+3IxJii6lPlcjUUMMXCFJdAy9L7Ar/7IOTI18wF73xuOe+Jk+qFNIKz
+0Gc2eoELb+i78Xs7qZnH2EmUS4J08omDbqymcRAr+pLH4ps8p8O/dfNw22qjjCWR
+6hHc3XwJZ107Kz6azVHgnTgNKEdm0F6MoDXNMd3fhjyXUto4vHYQ0kC7wPwDKxcX
+0YIDSK5qt/rd6gh5q2em4qUL1v76jUXMtcaOvVLVLwAFL0FUF7Lfe1EhYad/KIUU
+ksJlPs8rP1bHUuAXT5qRUY+kTPtD5E9yZYjUdEUbQkovXnJ7ppAa9hY5H6wM7qi2
+UoedHYtfyNaj5tot1GJY60Ji37zYdzDAYx0+EfHN8tRe3JU8szklQ865laxtcmfB
+FNybkQKhrOq+bCMDQXaNvwS65TkiBDp5+Po/nho3P9A0b4TmEfa5fNm2hjDF2B3Q
+doerLA9PzxqAuypymRRghM3t/NelyQ9T8oPrOk02K/98TO8b//l9e24HGym2fm5P
+au/JItc/mwbcefdiZPFYRm5MS4qre6t5Wjdymef9cZezj6RW6hZzxtd++Aj7im7Y
+iFrIcRnwUJCUAKHfi2ncWf+ax4qV5urk/YugZcCerP+eUK9XQow0vgHrr04AlWt4
+khVR4OeOhSEXv2DUWdylXjybhn8Aoxu3dOtMYXoXJZlRM5W9bfpR+7XKjMGzW+T3
+RW5MQxLz5Bqeo+Evvge6d96QT24uvdksS2yrD+frC+EW63bXM10qCGD1dLbJhMGy
+hR/yfpqLdcrRbJrUUKJdz/33qZMdkR35vBVEfAZGiTgMPj3VWSxt2CqIKBp61GDo
+gYfLdkZWP2qRk4/o05vbpyCTtIE6RYrKtofO7m0gFqx1gFadO3FZ2iToqQdIZqkw
+5jWWWgRHzzFDl9mZwSqRkYAIWmaoDkVqiwhLiblfyBwt2BBGhYuSydwNu4u752Ii
+JFhh1wOQd7xHp7uJdteoZpKKVtUb2AhhkXJNrbBgcQ3Y+/JQPiv9DXpwOFte1Wb2
+8jYQP4eUDG1X4iRh4vzPcFAWkd585IRC3VTzRGCgdq8sUJNqIdNP9SNgNe89Rr/t
+l/Z7Ngadz944df7BObcsfX59FxSHTYODPjcUixlrkAtFXF6KdHslQOZUI/a4vlF+
+4JoFHNTG+BAjkA8b5XXs0aqQg7zzv5OJrAPCdtwC3y/SF0kh0iLxQMkaXyelwOBz
+5H1K1/3VZj+IvhxofC0F+84eDnJeIVDueQzPzaS9Z3quJKZcLaeD4ZGf4caBLJtc
+AMuoW9t9JFqvBRsXMXlHpNnXycw8JgGpreV6slnFmXcrT7LJRUQMdKwlqj/QeUx6
+suBJzsxlGbQ9aUS3pKsnJHZg0rBEpysuV5vzHT5BrtuZdrf5bUIMl6fEeXI4xwpo
+PLsJsA9GgOKJ/p3K+fdadOSKUNxiOcqZWeFGrHjleZDtA4/7zi9VWyCTC0uiwH5v
+67BrWNz6Wp6Nk2vDfWTtiRkYbaewu/sk5i9Tp1iRA4gqTH3RLxOGatJmA4VdI1tH
+2aI29WyFD7lxW+JFI06fq6gYj//G2VN4euZx0kqR/eH0GlBpx/SjRKiFNoAXS6sK
+ZYS2vzj/yiLKOSc770k8GHhsJWEnB+ux63+HokUSbr6EDk1i+P0jTOo88QcWUYYA
+kNeFcCsVgptyiGDYrcViJvLe85gRDqc0ONOgGYGNKRW4cOlBcWWddUypaAiQ4f39
+bC6IGRlkL0MAgDle8Ag64JqGSlMPZysQp0HRhue9/yg5juepO+a546x0cH5usour
+k1B8PF+yj1Ve9XO1aESL06ao9hLjChPN4DD75wXPgcfzc+7wFvv4G22SJ6GUJVdc
+2hdEMJQPIHU45Qre+m7q2lXEvsuTD5jtrvI/ZQFwRc/VIEBU6G+oNb6UlrvQoMKf
+uiKoo/eRXOWDVoXbEhWLzhWNEJ0jmqlTcunl7T9roo0rIpnCFwiFrAjcD4Dsc9WG
+xJHI94Y4/EITz/LDOO1TrK4AQOmxU7/E/d+xV9J6uZuhpY0ingyRE/Jip652od2q
+eCVQBpeyUDuad+GKoDsMLztYD7W6ixEm9j8xkmU1aQG7LkCkrFXwfrdc277TjWCB
+18vL6I9AM3JT+jZTHnsoLbMGYr7DG3/0QuCbBOEVdkDErVXm8f4fEE+aOwT59zD2
+HKDd5CvLvA2LNNADZLFAKooDdQkXk+Otpssh2KY6Oq3FHoXLNPAw5Tzl5xqD7UG2
+R8B1GhGN6uZpF3QdpKdylGHAYVNRF9RnfAoT8TpzlDcVGSfngrR/gtDsqMU0/FIr
+Wj3zgP6BWMmqKTBEiGPU8GkJJE5cE8yW35jlyvJSQPpSCvao8WiG9LErxlbx8qWf
+hDMtuiJHpDwcVXT9jv8kkmiIvT7H37EtMLrCZj9xERpPpwZfO9C8FlXK5/0olBW1
+TWUB+AjttCrwGHJ42L6GKiw8iWHVxioHQ6gaXXT1dX93r6KfRlu6H5dkxr3c8yKi
+CD7S7kQPfqPZ4kuaK2BzRSfVSzUBJuUKz5VZOKkAVsCOxDZPX2uqYFWF309XoFMd
+kVh790gJbqrKhuieQGVbFXtrQLDLeQz6NL/QQyDEk9fOq4+dIHGRCK0Qk88zLO16
+yR/uf9LXsCn7eQZ0RX2BIfPLk4g4PiGvboUfcQjDG8ONdXKw7F+4O3nfMFugDTh8
+SuNi5Ndoz3dMCQja4frLooniwSFvKFNHPS/GB8ehagFFG7iskFljf5IWn+UkIm4u
+OUeZJY5lHS7oFQ63X3NGEUHj6949RRxq3dSK03A2zuoJqTalhXgeeoWZGiOlTujS
+JHngExI8hZLdvtPHt78SUavbURcuuk6BAPXEY62SkwyGZ81vnY0rmPtEVTsM7krK
+utFeU5zb3XSOilxa30akXAQJamQzlcoeS3651sZ7oKAlniaaai01IYOlWI3slvI9
+iPAda1Z30/obDPYp+FjIq5Gxao67/ZxGrWSpTXoWPJ2+M6lszlpvq5m9JlvFhFeb
+QBrZ/lyqCR0+bKkU70HBSLq+FQAZNFMPnVfdXklbZk9guN8dTZIKbHtzDrB113BB
+/ghplNhEuPNREv2ezQoumrRy7CRJ4RfYAOXkgzki+1TxV/dZJI5m15ckUVFMuuSi
+XTKPtm6obl/wTeabiusrvc3OAn4ZKQIoZ41h7A3CdE4mEcpKuhEm8zSnPaYQjv2y
+sNP6mIgIVfUuhukmCikaO6/85mlo+DX1gFknhsc46uvKx7tSwRGmBSTkDIhxE6/5
+gTQQ2d+oUXj4ENRCZYETB/R+HeurH4+4CEvLXbYNEP7fWanexYeJfl2o6iUEQ5HY
+NdISlRwUvA4aTC4kwAVKOKLM6PBjQ2Ot7QymLKhuu3znyxVQL4i1Nm1KHoDtYfLY
+8jAnV/jU0cb2wg0+JE7Lof8R8RH3zej6jDKYmxRlsjq0BYBalqHEoKdfWxbmCUWW
+JhXcn4S4/QsbW44k1Y0HI00mzEikoykjn3oOkXApPa3KEjQFK12QJT9efYGwgjqL
+e1mEMQvT10OWBPWAy9oRkPr2LTL/2gzz240MvmBVee+ZfVnyIPy8Dqxral7GeGcR
+aYM2fUndOUdnr1175KWu39bJw8e+3ryU34UREvxV3ODTentLePIgsEoe/jdXFAHA
+JxlzK66FngD2r18m69BTyH3xGm6gXnj51gKNNq/OwjXo1HSEP0rbfsee7CGqivU5
+9gimkdrrja1TyOlS7ke5lpjxJj0/VRiusmR5TTYuYy0ROMgRtwatf15n9f4cj8SV
+72dySH+Rtp/rDnjCNsCR5Y2wqAZpNUz6oDrSIMK43lrV1I92zFdU8HQo5d7RFBSZ
+Kumwe3OImNQtG+nLSiiFc/aX0hiWv4rlUuXbWhHPD0DKiiA7v8Ex8iP7GxW9Yfs0
+6DYZq26/EbQ9iHYUnI3jaWQSdpwpce0bcQV8zvFOi/b/Wb8J9Dj99D18qdLVHgu5
+Gkur5xFlftUf6B+3qb+LpBOvEj26o/bg+Cv+U71RKQTk8E5P6YqYGzU6rtW4QvEE
+0ZGsvez/+Tpg2dU+yXwFBVjH9zYI8hlc3UThgqlEJ22b6Hbq3bH6eEeaEL4g5m0A
+QQqEZxP7FdF5iixGd388QjC9t1Bud327655EmBi5TX+GNSynmGNZBCcXandWNUk5
+/U2f2S+9kvPHaIRfFD8vA7AV9Z+mYccMuGqA/jhXzgkjgn17ltwDG9GeuNoqSsT1
+x9nr10hHCPxodkauuuUiBcXxE99ZPJ1jMMndAkeysUADldnnvCwuqwrY0cq4JK0J
+ENwkQ5JUQMzpMQnScN1ZDzosMyQq11GP+CMOtW4tzS0UCN2ayk03SP0l6+3DlWOx
+J/+eXdkvn0EjSQWR/rKbSP6KMYzPw5GFA94z1xPopuMWpLq8dZQZ8d5fZTT+8RLB
+k0h0HeiC8Uky87vqHH+S2k+jrCNMi0/gaHwUXmg65rgFo7gRMjX3qlwAOJ3eRsIm
+5f3AfCEVvp2CaFh4v3PidiY/lr6iPAUbDMJXhkN9yIoNJ+QzA5d79LaaCmFCG9Mm
+IfqGrZg1pqeO/vVcnH8RCyBpVY4byA5Nuw0ma1bq91WoY4Ulqc55o57w6x3QUfEH
+rbPtseTc5ItPB3dxUZpjlrJ4+aoXEzhqIiT2zGDvfz1OxhwZ6OVRUN8RkCk/9JCP
+7oIXuxe26+JC0quLuahTn0oS3/qPTJ/S9KDdP2rJWZuRr/J77MUZY0eAqfV6wszo
+W262FEVSjLGSQsJEzPNMz0Ou/MFOYOmE+QwOTRTOqW68v7j+c0876Rlz6npKzCuB
+xpdXcaJvUhq8ns+GAattlFyl5lES7yvmZxWqy071BuUTMSx4NFQezBT8lU/KCCWS
+fT5+hd67hvA87EvIejb68G2Mi5wd8tjeNVvd03y1mfXbwsfZHlv0NxzGb9g911LX
+2f360Ky5FoL30OPaIynaRDYF2r5vs0IWbTxURXRlg/NcKveNWzknaKIqhFaDjn7i
+MSuyDx4ekbij0awuZTjWcgXK9wDTLVQWCzEXpj7jYmmp66xpu9S6X+vgGlqEGSn1
+hTxb1r4kH5rlL3A6HwlxICRXV4c5OH0wEMFQA/7WkNiPLHmx2jIfzxPmdmvJDy+o
+vDPcIEXhEujjvjoSLYgjWLno7075zXFN06AlcaDvWwIZlzZmzOYpOROw7h6TQXC1
+ttHXe/a7aXUd2H8u3KjncNupX/A+r7vZsY9dfw3FhrFWqlw4uMxbxoKm8P+tCh24
+iW585tnvDVRc2L0LEIz+6KhYcdcEMM0D+rEe+CyUfN4bKP4933KzwvB5i6w0Ghjm
+cLlaDgoC3vzoMydAHgMrACyBnEMnUN4ZvgE7fx3LGftka/L0VirvRLzKE/j+7S4D
+ieriGRM+FI1gu67ZgdCiM+vmYaZTXK5MAoYtT+u8Z+GM2cTto1VdkOfB5uDjdu3P
+wA7Y/jysmltOzougFYa29aHiQiaNX2XxqEB1ucJqR468ZGeXwdBc4oLGjx6zPaeS
+0g0kSCTUzjD3xSHcQ3n8qvtCemf0rDI+Roebl+QRZvYF0sHAePvkmJgeBBx7Ogi7
+e2Bfw1LvN8sDaUOQqwKF5EjC35QEnOsReTnjg0iT5q2LJyU3/lw47I6xvtErPerk
+dPn6I5h/X5ug+Oy0hJVNpO1DMSy/W0Mlp8aML3ahU9HDcJKd2IcDJ1qDrHqxsXUd
+JMXxhLyFDH3hFQm+gwDOH4azM3a7SoEoqKfxbNA3QSc5yeuyLfbBkUbNvX79lo9G
+w+xaqX6geoBJijtElkeeSmjQEJeDxzZtlH/8YzEi5k4ktcTRb4tn1EPpf/P9HqBN
+gKEB9f85tAhkySqg5RV+ZmVrjlFFya/IK7qCTSxMWsZwu2rgorRTK1FXB27gg62j
+qB6ed8cVf4OADqoaTeMQ2zhhqXguhko2RVoDKrqIBrDD5sZW6S6hJplo9psz2XJS
++c1UZ+6t9bHqgZmrwIzjNrVFXXs1QIg4MScE7cUUsJJtsf7L266Y0rao9XPwCRV5
+FUvK8l6sLVrg3YBRUNrC89cSmY6G00bc3DkPIm+HmFJoTMzAwIM8NatT3j/4M8qF
+NpoFcQByjCUXiJDJuWaLDKmbQNwjukQ6RZrlPdPf1ffo7zp5B3o91fuilPPqDjck
+h2+utKqBUGjG9h6qYt6ArcoQ9PCdPYsjduuGPqyGQgBIG1HsiJu28Dhc4nibAwrL
+LN8UuIeKCQ66m1qGqbLpfCDcqScDD7im1CNr8DQX0nMtck4vX2XVKBCreJJFxGoO
+liQJT7iIqt9nHFrFmESKPg2Li+s/Vj9V/OpQl1KpfvHuSVdRuKVPVu5k6vFqUHS+
+AZQxHnu8BD8v0/IbPcOJcDH3tP3T29K9yKgwJOstiJffZ0Mu0HqfD+QTFKixv3mm
+uDVXri3UCYGDDJPQEeQCLSf5I4f9m/L4fv7AQVljOjGN+8o2F68VqhQ43h12bw6y
+CjuPQ5F9FaAFvjhH2a6KEQfHGV7JBNsXXznxu7vb3xXI+gehedwYROsgEiHMU9xj
+0vRwCoGnhUMoVCSdh1h7q+8Ju/3VGDJR6PzkF9ajgJyFjEZy5/7bDIojY7Z2RXvh
+TKBqzfTmAZE8NrAIOixUb/5PuRrH0JTILAiThuZ7n1XMKcm9rz2Zbm7xsarzOv2h
+OfR0EcYnW/tBTGO5MTHmKWl/lmsQTrPQJp7eQPntsi0biM/wS/lWFpzpl8W3aEsA
+w29/IAbLQaROfJdi9WdbNq4pzKj4AOVFaEMFOvp0BKOxabiPVrAyW9YyyDLn3+PK
+SzthO+qNkG2h3/q0zmyJyVQaMvny+DsUkB3Z9EK+bM2QLKmrD/oSgpDFiI4oDY6m
+4143q+vW6YVCCV6XJmGo41wwoY32uP0PnqLCWUe/qUEckJiH4ZayryF/TpOB+VDr
+anzo/PMYvUOko3qNuBSzBYle1oeARTizD/sA3c4Q+WPM30BcH7NxvPW2NVSvyc1H
+s4gvXigBQDxqENA/MPvtgFdrQNBHNjHcVRhnG+ziBRUzNOCZ5IjI9R6sjR/4lyOr
+h3/4Bm0bTvVVnLIaiYZWA8UBSef/2RLUjKMMl0IK2BYDyBwXSchPqULXud/OPtTL
+MtcUNNgTGHGexEwnbBu8TacFrSFQMnTrOP2djyOmzniNHLYOXOLJt5rYR0qjd6+r
+ey61eTNAlg4O2MJITT7f1yAwHc4Oyr0KmUeMKdhrU93i23Qx/JdqhUvaIKeDldT9
+2r/KH5OPEelX3hwSWoC8jeyhhFM2MwWvRtwc0ojwnmo4M0gU8C5KtJd9DqaGmyUu
+walDEXVlQdlviB/oOPB2Tn4mYmV/1fYWJ5S6V2nIBst7UbDcjZCc119F2wgr9m2B
+eqAGDR3WdmvfvOyKK06BCKhVSVlSrtya6w3xbn9VJVN7SGVuI4P+Pbbozya0kvuc
+IVSum44tEcOWL/Dl0MrPWtHEgBDAr51upNvHXwiIzG22MkVY2ss3kOwWMpEe2HMj
+PLgHgsyx92DCJNyvDMszjyOk0uD2UEGPxmkY4BMcaeisFlnRajyBcfjLwEGuhKq/
+g/dBnn+9x7cWk/p6iM5V5XnWFWRsOUKRqTNbuXf8AUNF1orwWQTgvuBaetkgJ1UY
+5sBreSD6sfutOGd9iLMmU9BtBtWmM9y/wP8sVfYKKmM87is9LkGm8ZBgHX5nu8gQ
+gS6N5Yi3ZMFcwBqgBCRI43ocpjI4+mjGsa0/5jVAqrxzea6KaZBRm3ZxCe7vpmCM
+x5+V6f1bhOqBRFqPANN6sQlzrJ08FkHvovClJMI9UZTc0vVl+6fjq96zMDII8lyQ
+t5fnp+gySYErq8IvNWrOUK8aaF0umVg7vCguGN1TzAaOLUNA5efJxeSBDuKyq1j4
+lHCKpH9m567xcLH7/cwxTYHtvN1QgfqNcvcJOS27G9JUvBqczx24vyuEI39rZGeG
+1QSn+MmjMg9cZ99OGyz/XLsVrzJn/80YYOpQsOx7krmxVqAosjKGJ7cWjFHF9piH
+WQkrhGgzf2eDkhVoY+epzlt38LnhyhBGxyZUvwJXmeIDDqV+d+LCBaVAGCDUKVee
+H6dSSR3vmOTt/aYVVpsYLZcFTZ/km/9dmDNduOrFroeumgAqNm0CRnTjR9nTKEd8
+3hjhZhzRZpB4UibImK+8ln7fPnDbjZOFYI1S59kyT4gAnNRMWSEv6dHYqTludfcE
+NJ2jYCc8JDwadOSvxL6YeaQ+1O5U/MZhxF1eG9crUa0D2eAxI3QivxCdl+dWExgO
+VQj7H28NYV8wW9LBRnFvhb+5vOf9nWPGonRbg/2H5liMi8U1owR/koIA87dX+0tL
+nfR0lcucoT0+6ju65OCVAO5busv9A5sMpVUw9psghQN07nIETosPxzNmycdcsOK8
+sag5oaYzBUqLMA2WoapOiAijFV9Szca3o9WJoPnhUc96fDYMBgPbIuwJPuCgtnL5
+ssZQ1ettUd7Tp5dVCyGi6TfzoubOFogVGirz+7j6IRereAbqwOvgEaKRZ33on/gA
+FFfDtQZx/9cO7z+kyZuKZyR5mCfyQYJ8CNzdYPRdGPLbcGriOZGPCGetwtqjlFjt
+oLpS7vusbyfQuFR8pi5Ign9yHDZ1r5vwz/xAHbsCZFwQEpA8nojvx5R/047EMfQJ
+v3fKfNK6BkUVqSBe9vsTsSecibt+R1/XmI6R1pdGax5YmP0Gciy1Ukmv7NtGUPza
+MvYJ6rje4PjQJ9QNbpIkLA/8kvOh2fgdz7ny24nVhh6xlr2QNelOpGbcRBaGccLO
+772G1gMmxiUtW7lukO8qM98zPluuVpePbBevQOzRUFavJ+vJxXtJKkMPEv++cyo8
+7wMvaugbUBw7ZZ1fvZkyzWc2PyQTLmgwX2+M/H7631sxCaZVxtEMYAqEvdYJ++2v
+cf0Mdu0M0qwtwPcfYCi2PhKhKWnZIf6kJjsg8iq6Bf5SMQ8JxJwRJESegSkKNm59
+htpzJafVvye1l3+ilgXJoasy7AJ028Aa5wKdlC/AeWeL787XTKy/dUxnaFI2D4Os
+Ahk4FB64aHBPr2qVsZRMWNU8pRxikwnTzTX0MXW8Ge4tgiQucytwbWZWxZP53Srd
+2sLHxe6LgY+kVqeCOwh2GtGzItNtjsB8hjW9lN8zCvldpZnYor/6DoedJ6SMMwT1
+rQxB8tagq1dOiMXdlwnVPpstKSJofTLgiXKNZaCLHoConGNCO0cz4vefuhdtzuPU
+v/Rf+7cJmXFWru5YxfQFI1vbG9vqrDPoAC58gCC9BzAvzuO5PDoTU2pcTB/9zqJ9
+t4yetdLLpFyxd4MTiXoUEjzlNsmyMZ4HIpAaGluloUPyz9fx1wJpPTFuX05KS8FR
+BaxtLkdVdndBBE+CGqfRrr2Z4BXTPBXyrt5bDkbvMh5AZw89uYOu9pmI6dh+jzGw
+o3B3qC0QNhR94uaay8v0oeXhvKji11KgoYRuBLTAwKpcxiFue3ePxIbq6F68tL6Z
+rSvoQXGcDhjgDiYa6haqzxo1y4RgxybwuUP4UOWD3nWklNzkxnz9RiLnwUHRt36j
+oMCB1C3JFjY6pNPUFuNmHDiV060jjZmk/A0R92/JNiUv87dZ/7K46r88H81nv4Se
+Za/Td5p1DtKRpc3mT6R/3XRvrIy3g5L09BUGCPuW1IpKu6zOAt07QrwX/WAvgf40
+zsWQUgZ0gaMkZkMr2QgIcgzQOiMhCIcylxu1ky7jgnhhCq7Xny24jQ4ZFj/VtwUW
+P5TopAUtSdmzNgnEbG2JNsCumcAIpNAggEeDpVvRq1e+yYIkYvHrv4qwhl6UJmLA
+cyh6BQ0kaQ16v++Rt2PYz7D4VZzXfXULHUhTgbm5Jwx5v1GEWohfQ2IjvSs043DV
+SRi094WAR9NCN23suwQ22yoYNP0z83Wkej43c8OfapreA8Ndiy2QSQXD90n05hI5
+PWMQ1zZz+wVWSGLIoTj2qEZtnpSUUw6sLqVsDx2vv+g86ubbhzHhfC5yIJs5HFxB
+u6/rPtqdHm8Nvuu1Lb7AQsS2v9E2GBR9akzm8L8KsBcvIqbeKZi22zbix8A1gA8e
+iNNmh0c0jBNJin9GiFMy1ij8+P4CJKFHHlcOJuzpW0RZY+f9wG3tKc1zwao8G2vV
+e8CU9Umvccoya/HAMHvlDPhQ69hS0m4aA7GwOwpnX0uss7e7rGeohLYxdvQ8CuO+
+vdxpnIY65HncnX1tBWiovlAs/3KAR1J/pHKqU62v9DLIvWjKeBHWjOHlKqHFQ7k/
+7cFcs4kF7bxqP1SVf3Tcp8NN+uvYdtkEEOfi3AaoVsZcaSCspHzgTlO4FFCH3mGM
+Hq7BPsfYxjg5VVaIkYGz4ghfc9v9n+G+NSw0uxmZBzbmzGSgKHAebflHHh6aLnSJ
+0h5JhY4WVQFRDtasn3j0yaFQWGGEzIknIYzaz5mN4ArTvpkXMpRlsAJYxAZeXEh/
+H4rjPdNIEzKUeNbdRMJfLwh2awQ/3R7rYLwQjP9oxP3XQxXBhxEz0drYj/BN9M+o
+QsD1ilS3ijiiOFiVdZyAQBlhLOCmHToiILvMBh8JOCXI1sSm1kYhnwTe4R3D8jwK
+BjhhabQ/agpfheNsfFZ09BrB4j8B6OV8cwD7NjTJilYD+4WqJquvjaluEtmJ4cMi
+9JFpTgZAFpOQcglwdl+zSaJ/A+ZSRbmkN0DfpoExE1GIrR/hIsOf46xwB1WHxrO6
+tyIF85ehBqOuBdFtyzQp/lQ9t0xuy2ScijfxliwWGyuiYBrJGi3ptoDJ+SZ6mZKw
+umV1tL/3sOXO4p5sIzW/S19UMQHfrXHUAofDFoZQqizv+9vR1hRKyWWggLD6C62r
+5ZQ5IKfgMI9Pq5LzMc40cwl9GFCviJyZVTxp5aIQbIt8G2DiMKflhHtDM4NWS9f4
+VrS58h9bJi7cgWOcnST39t3ZaXCR7XMD1PGgX20ouw9QQ1ffWDzjCK3dHWWXxGei
+VURLV+IPDsG3p70eJjJjegHtTrGD0OyavZ/F5lv6tKEDoZmHJpMXdP7hUeiJeW2v
+zL6+1Z2brk1S+Qhtmqrct94lHV5tKCAUo/T5tOBef105MTFaEbp7f2I5Mqb4l9nd
+N1hNqby2X7nrfVf3wjq56hExTwkNuSMxza56KLsZrjA9nOMszblza0pV9uvzZEL/
+wM9mY49Eu8ZyTHSxXss8lJCRrm5Fl1TZFy4blB0klHOKjnqx33RJooWFgU16sP3W
+7uMf50qgxqGFBoqZOh/HQ4yB6dGjPzDTLQjesbxGZXMOYoSwbcVI/sZUHBcIcjDr
+002nDJmivTZtrqXz6kKHo5Z9fCmZ/U74CyjzFoR5PSO4E2wsWDPWqs2MPb6JZMM9
+kDRgE+MAeQ+QVwvij1N9bI4OqsnRW/JIqBicY3A54chbkV7YllcLWBExgL0iLtco
+muDLZNSwSubE+mnVEyB95GJ+XwNfL8ULsl3hlsN4vcbYNbWecXnqE7cm4RRb+M31
+mmx1+ZHqGsLOf1iYgSWp6Twbu3WlhOpZ3+qHCzOpwh2kvNZyMm7LDNhX5u/jOets
+oNTFL5zt63g4e180B69vRlSBDHQe5BDX5UYGOUGvLsZ7v/CXN1TUY8jMiOfoffMS
+QJivsUMIy4zidcBwmxjqlyLJmlNw/vv2eL8JIeDC2yEaSHEN9ch4Rhyhg/F7ni3s
+zTgOVSFmgRUKhz8zaypDtNd4BdUacYibCN6g3haC7+LoxB4j227+9dK56uZbFgeg
+hlL/hzhF8wGXxpjeAKALx7pmSPjzhEWtPCztHGVtIWdy5D8SxzPsV+pdk4KCRTnw
+oouHOpYoKS0FE7uHBSQs6xgzT9njwxlhm7eyx+Dc6WOXRpfnHqhnL6C6t3wGJZWO
+U6Imba5bZ1P9HQ2mgoAMLpSbq3FT4kr3iFfr6hloxFFteZp+Uja5kuz8kPeTDhkV
+3w9ZLDYx4UHLF5zc46vMuz+tfXEI8OYBiT+V9tz4MT9+E72wbAKCB1XxdXQ2O0MT
+gHjF4s3OAzN8ycv3g6SSHgjB0dx2cjWt9mJpSwqaIX9c5KuNoohD62iSh/FeND2Q
+rNhxCTaO2tyoL8y6yKDFcdXDpkYuIYjAfnfnk0ZA2ak2B8BVL/6ukC9rGaf2bKfR
+xofxzmH7vuBL/wgcbisGbsKev+iF8kMryiBiWiv8shRHpU4UMyI9JpHli5rPABcG
+4Ri5VGuWU8ivgIJaQpCCri0WMM2CxdAzTiYTdV5rKPybD8m7iBwvtzENHSh1YXpj
+Bs5kuiP9zUo8ItDi4lcSWF9gkOdmlHahOI9C0ojYC9G/3ehmrNJE6dnuEoYsoiGS
+WA5n3AMIX9vO99P5nug1juNttMq9GAmx4eBCMagGhVsPNJVFwThCHsnv7Nr8nIJP
+OqPpUqiZEPwLl/2y50rDubiOfFyoDMKGnTY726dnXvtiwmdONeU47A2IC1r6tbO5
+QDkzyfF7XIeVgV6frZ9MvcN5x4n0ib/Ls3LFGoW8AtmdHzrs/sIqKFsBANKfZEP9
++X4kDaHSAwsvIJVxV8sYMMG68pMXrgzPWGbxgsy8kqg9WuI5Jf+f4wvUYT9wfbJ4
+dE+K4+jIMUsVoFH0In9Fih11Hq/IjYSn8FuVkGCWJ8Y++mTIV595pjcgLZ998SGF
+OfGxcVeXuts1ucFhINBms9jDE/JiDaRWEZ8sg2ry9fMQz+QPEUWCwnunJin4NckZ
+wo7dcZYjgZdSYdTIpG60noHfJ6d6cdzwn+aANy2lcfbHGw2YpQCNEOmbWpdLG+O2
+3Rj3Y1olunSnQACK0zp6AtQVQk7jty/vx22fJDy0UPQgzWvWgAWpw0uSDc2ehWRJ
+i+kWqZq/J1fdKcdwxbF+jRaMxHUsuaMtVSGqRU7H4uhdM3EN4KU0djuvMOo6xzDY
+ShgBfkLsNwSgN9Ld5RiC4ATcROeoBP6lTqoX4HMXp1OORul+xyWA117u6ElRewkO
+hxiMVcmM+Kqvhddv0IjUd37BFIrfOE3ryRVh2UK7ucOkFYlods/wFOPjirlnDK5y
+ZyVWvBiEf42QjHfX+Bk+RIDdTnldz7ZttVUNCrTSM36nNeF/bs5rq+IzVrgIV4SN
+RkcQd9DbW0mxG1Mvk+ebkDnrplAR8hlxtuVYqz1Bd+7ZpoKkh6NPRvmuQr7DW66I
+5VbaIrFxLHpkAg+Y9Y7ZAxREbYGl1Fn/9qcNA24/TThyhemKTkl7XDDJdEtJu9Lj
+KChmMzvd9zoPMxjudNDeN2PxqI3HKVtZ1Cr6oJPM5+rO8SgB/p8RGHo45Kd1JHhG
++TeLtyAd9+pi7QrrF7yQDvgIvmzdCmRWp1QHGSpMmvymqF+JB9hZ8HN0JYZqxAyP
+AxnDF8Au+jVrX5fCBqTRKB5r6JoVmobmRgL+Z07Jm8t8YiHV2MxadG8Fx7mhGGL9
+MPC3AQ8oaNzyqHkT8v9YkNLaROmZB7mjcnDlF+C2BanEjQvFAj8PWocWpN1CuYzK
+ASa/6X3B/Gc9PootCmKROD0JKpSkfgHNFZu/VXffqt0SrGMaqscVJ2qY7btWLKt7
+NpwxvFXtU+WnlVD3EfiquUQWSWvv4fEaJiTlKVmUyHKxhtq6SgL5B3DqCvMva+qm
+0zCc8my5w3Y1SDhHrbDp618v3u0Yb8fnWMI44sz1+RRo1Pi2T2DnGG8NESfO7/yj
+ftudvnUZmPlIk4p0hTGu1KFnmVG8UC/6DOMohDgci8EIe4uaE47EgOBKyG+QfEoX
+iX7CGOaKU0+A1I9WFTWLTVEh/iVQD+iqWEcoc5QXOdkwCsLn1EVIY3a48LHhMg9y
+bmBKeZqgEE2ywPH/aLOTTXeMvsmSUfeI85+06xN1sPt0Bh4VAqMqomWvKuE5UE2u
+cXyNvdVftp8qmiJ/PDrHjiLIK5usIRxnXbi28HAPTfj0mqCcsRE5i6G3cI62JSD6
+askrqezv7y63Qlx+5nl7T7Z4ukryphrxFS7L18OlwlaZqVxPIuMtezedob34QoWK
+n35rv2uwSe/5PUNOF0KTVxfIDkkVICjKnaTyFk1Stm6n/LB/r/iHnQ/QmQbXtqpU
+NYznbDF8Vjod4+ux9h+bDKQ4JhZr+ZirQg==
+=XxLG
 -----END PGP MESSAGE-----
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index d2bd70fe..a6cb3794 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -558,7 +558,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 
 	& "/etc/aliases" `File.hasPrivContentExposed` ctx
 		`onChange` Postfix.newaliases
-	& hasStartSslCAChain
+	& hasJoeyCAChain
 	& hasPostfixCert ctx
 
 	& "/etc/postfix/mydomain" `File.containsLines`
@@ -622,7 +622,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 		, "milter_default_action = accept"
 
 		, "# TLS setup -- server"
-		, "smtpd_tls_CAfile = /etc/ssl/certs/startssl.pem"
+		, "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"
 		, "smtpd_tls_cert_file = /etc/ssl/certs/postfix.pem"
 		, "smtpd_tls_key_file = /etc/ssl/private/postfix.pem"
 		, "smtpd_tls_loglevel = 1"
@@ -632,7 +632,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 		, "smtpd_tls_session_cache_database = sdbm:/etc/postfix/smtpd_scache"
 
 		, "# TLS setup -- client"
-		, "smtp_tls_CAfile = /etc/ssl/certs/startssl.pem"
+		, "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"
 		, "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"
 		, "smtp_tls_key_file = /etc/ssl/private/postfix.pem"
 		, "smtp_tls_loglevel = 1"
@@ -751,10 +751,6 @@ hasJoeyCAChain :: Property (HasInfo + UnixLike)
 hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
 	Context "joeyca.pem"
 
-hasStartSslCAChain :: Property (HasInfo + UnixLike)
-hasStartSslCAChain = "/etc/ssl/certs/startssl.pem" `File.hasPrivContentExposed`
-	Context "startssl.pem"
-
 hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
 hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props
 	& "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
-- 
cgit v1.2.3

-- 
cgit v1.2.3


From 351c06951753e38ddb238d9dca01f29ddef33eeb Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Wed, 30 Mar 2016 22:41:03 -0400
Subject: upgrade guide

---
 doc/forum/upgrading_to_propellor_3.0.mdwn | 72 +++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)
 create mode 100644 doc/forum/upgrading_to_propellor_3.0.mdwn

diff --git a/doc/forum/upgrading_to_propellor_3.0.mdwn b/doc/forum/upgrading_to_propellor_3.0.mdwn
new file mode 100644
index 00000000..af54e938
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0.mdwn
@@ -0,0 +1,72 @@
+Propellor 3.0 is a major new version with large changes to the API.
+
+Property types have been improved to indicate what systems they target.
+This prevents using eg, Property FreeBSD on a Debian system.
+
+This forum topic is to help users with the upgrade. Post comments
+if you're having trouble and [[Joey]] will get back to you. ;)
+
+First things first: In order to upgrade to propellor 3.0, you **must first
+upgrade to propellor 2.17.2**, and deploy that to all your hosts. If you
+skip this step, propellor --spin will fail when you upgrade to propellor
+3.0.0.  
+(Workaround: ssh to host, cd /usr/local/propellor && make clean,
+then you can re-run propellor --spin.)  
+[[details_of_why_this_two_step_upgrade_is_needed|todo/problem_with_spin_after_new_dependencies_added]]
+
+Now, the transition guide as far as your config.hs goes:
+
+* Change "host name & foo & bar"  
+  to     "host name $ props & foo & bar"
+* Similarly, `propertyList` and `combineProperties` need `props`
+  to be used to combine together properties; they no longer accept
+  lists of properties. (If you have such a list, use `toProps`.)
+* And similarly, Chroot, Docker, and Systemd container need `props`
+  to be used to combine together the properies used inside them.
+* The `os` property is removed. Instead use `osDebian`, `osBuntish`,
+  or `osFreeBSD`. These tell the type checker the target OS of a host.
+* GHC needs `{-# LANGUAGE TypeOperators #-}` to use these fancy types.
+  This is enabled by default for all modules in propellor.cabal. But
+  if you are using propellor as a library, you may need to enable it
+  manually.
+
+Additional things you need to do if you've written your own properties:
+
+* Change "Property NoInfo" to "Property UnixLike"
+* Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
+* Change "RevertableProperty NoInfo" to  
+  "RevertableProperty UnixLike UnixLike"
+* Change "RevertableProperty HasInfo" to  
+  "RevertableProperty (HasInfo + UnixLike) UnixLike"
+* If you know a property only works on a particular OS, like Debian
+  or FreeBSD, use that instead of "UnixLike". For example:
+  "Property Debian"
+* It's also possible make a property support a set of OS's, for example:
+  "Property (Debian + FreeBSD)"
+* Removed `infoProperty` and `simpleProperty` constructors, instead use
+  `property` to construct a Property.
+* Due to the polymorphic type returned by `property`, additional type
+  signatures tend to be needed when using it. For example, this will
+  fail to type check, because the type checker cannot guess what type
+  you intend the intermediate property "go" to have:
+	foo :: Property UnixLike
+	foo = go `requires` bar
+	  where
+		go = property "foo" (return NoChange)
+  To fix, specify the type of go:
+		go :: Property UnixLike
+* `ensureProperty` now needs to be passed a witness to the type of the 
+  property it's used in.
+  change this:  foo = property desc $ ... ensureProperty bar
+  to this:      foo = property' desc $ \w -> ... ensureProperty w bar
+* General purpose properties like cmdProperty have type "Property UnixLike".
+  When using that to run a command only available on Debian, you can
+  tighten the type to only the OS that your more specific property works on.
+  For example:
+	upgraded :: Property Debian
+	upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
+* Several utility functions have been renamed:  
+  getInfo to fromInfo  
+  propertyInfo to getInfo  
+  propertyDesc to getDesc  
+  propertyChildren to getChildren
-- 
cgit v1.2.3


From 503437b676f5c4d41ef41c6de3e3b25045bcc5d7 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Fri, 1 Apr 2016 18:33:17 -0400
Subject: Improved propellor's first run experience; the wrapper program will
 now walk the user through setting up ~/.propellor with a choice between a
 clone of propellor's git repository, or a minimal config.

---
 debian/changelog |   3 +
 src/wrapper.hs   | 254 +++++++++++++++++++++++++++++++++++++++++--------------
 2 files changed, 193 insertions(+), 64 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index ee3311e4..14d3f1a9 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -64,6 +64,9 @@ propellor (3.0.0) UNRELEASED; urgency=medium
     these complex new types.
   * Added dependency on concurrent-output; removed embedded copy.
   * Apt.PPA: New module, contributed by Evan Cofsky.
+  * Improved propellor's first run experience; the wrapper program will
+    now walk the user through setting up ~/.propellor with a choice between
+    a clone of propellor's git repository, or a minimal config.
 
  -- Joey Hess   Wed, 30 Mar 2016 15:45:08 -0400
 
diff --git a/src/wrapper.hs b/src/wrapper.hs
index 289b12b5..f079eb32 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -5,12 +5,8 @@
 --
 -- This is not the propellor main program (that's config.hs)
 --
--- This installs propellor's source into ~/.propellor,
--- uses it to build the real propellor program (if not already built),
--- and runs it.
--- 
--- The source is cloned from /usr/src/propellor when available,
--- or is cloned from git over the network.
+-- This bootstraps ~/.propellor/config.hs, builds it if
+-- it's not already built, and runs it.
 
 module Main where
 
@@ -22,6 +18,7 @@ import Utility.Process
 import Utility.SafeCommand
 import Utility.Exception
 
+import Data.Char
 import Control.Monad
 import Control.Monad.IfElse
 import System.Directory
@@ -36,9 +33,12 @@ import Prelude
 distdir :: FilePath
 distdir = "/usr/src/propellor"
 
+-- A distribution may include a bundle of propellor's git repository here.
+-- If not, it will be pulled from the network when needed.
 distrepo :: FilePath
 distrepo = distdir  "propellor.git"
 
+-- File containing the head rev of the distrepo.
 disthead :: FilePath
 disthead = distdir  "head"
 
@@ -54,60 +54,186 @@ main :: IO ()
 main = withConcurrentOutput $ do
 	args <- getArgs
 	home <- myHomeDir
-	let propellordir = home  ".propellor"
-	let propellorbin = propellordir  "propellor"
-	wrapper args propellordir propellorbin
-
-wrapper :: [String] -> FilePath -> FilePath -> IO ()
-wrapper args propellordir propellorbin = do
-	ifM (doesDirectoryExist propellordir)
-		( checkRepo 
-		, makeRepo
+	let dotpropellor = home  ".propellor"
+	ifM (doesDirectoryExist dotpropellor)
+		( do
+			checkRepoUpToDate dotpropellor
+			buildRunConfig dotpropellor args
+		, do
+			welcomeBanner
+			setup dotpropellor
 		)
-	buildruncfg
+
+buildRunConfig :: FilePath -> [String] -> IO ()
+buildRunConfig dotpropellor args = do
+	changeWorkingDirectory dotpropellor
+	buildPropellor Nothing
+	putStrLn ""
+	putStrLn ""
+	chain
   where
-	makeRepo = do
-		putStrLn $ "Setting up your propellor repo in " ++ propellordir
-		putStrLn ""
-		ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
-			( do			
-				void $ boolSystem "git" [Param "clone", File distrepo, File propellordir]
-				fetchUpstreamBranch propellordir distrepo
-				changeWorkingDirectory propellordir
-				void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
-			, do
-				void $ boolSystem "git" [Param "clone", Param netrepo, File propellordir]
-				changeWorkingDirectory propellordir
-				-- Rename origin to upstream and avoid
-				-- git push to that read-only repo.
-				void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
-				void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
-			)
-
-	checkRepo = whenM (doesFileExist disthead <&&> doesFileExist (propellordir  "propellor.cabal")) $ do
-		headrev <- takeWhile (/= '\n') <$> readFile disthead
-		changeWorkingDirectory propellordir
-		headknown <- catchMaybeIO $ 
-			withQuietOutput createProcessSuccess $
-				proc "git" ["log", headrev]
-		if (headknown == Nothing)
-			then setupupstreammaster headrev propellordir
-			else do
-				merged <- not . null <$>
-					readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
-				unless merged $
-					warnoutofdate propellordir True
-	buildruncfg = do
-		changeWorkingDirectory propellordir
-		buildPropellor Nothing
-		putStrLn ""
-		putStrLn ""
-		chain
+	propellorbin = dotpropellor  "propellor"
 	chain = do
 		(_, _, _, pid) <- createProcess (proc propellorbin args) 
 		exitWith =<< waitForProcess pid
 
--- Passed the user's propellordir repository, makes upstream/master
+welcomeBanner :: IO ()
+welcomeBanner = putStr $ unlines $ map prettify
+	[ ""
+	, ""
+	, "                                 _         ______`|                       ,-.__"
+	, " .---------------------------  /   ~___-=O`/|O`/__|                      (____.'"
+	, "  - Welcome to              -- ~          / | /    )          _.-'-._"
+	, "  -            Propellor!   --  `/-==__ _/__|/__=-|          (       ~_"
+	, " `---------------------------   *             ~ | |           '--------'"
+	, "                                           (o)  `"
+	, ""
+	, ""
+	]
+  where
+	prettify = map (replace '~' '\\')
+	replace x y c
+		| c == x = y
+		| otherwise = c
+
+prompt :: String -> [(Char, IO ())] -> IO ()
+prompt p cs = do
+	putStr (p ++ " [" ++ map fst cs ++ "] ")
+	hFlush stdout
+	r <- map toLower <$> getLine
+	if r == "\n"
+		then snd (head cs) -- default to first choice on return
+		else case filter (\(c, a) -> [toLower c] == r) cs of
+			[(_, a)] -> a
+			_ -> do
+				putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
+				prompt p cs
+
+section :: IO ()
+section = do
+	putStrLn ""
+	putStrLn "---------------------------------------------------------------------------------"
+	putStrLn ""
+
+setup :: FilePath -> IO ()
+setup dotpropellor = do
+	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
+	putStrLn ""
+	putStrLn "Lets get you started with a simple config that you can adapt"
+	putStrLn "to your needs. You can start with:"
+	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
+	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
+	prompt "Which would you prefer?"
+		[ ('A', fullClone dotpropellor),
+		 ('B', minimalConfig dotpropellor)
+		]
+	putStrLn "Ok, ~/.propellor/config.hs is set up!"
+	
+	section
+	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
+	buildPropellor Nothing
+	putStrLn "Great! Propellor is set up and ready to use."
+
+	section
+	putStrLn "Your next step is to edit ~/.propellor/config.hs,"
+	putStrLn "and run propellor again to try it out."
+	putStrLn ""
+	putStrLn "For docs, see https://propellor.branchable.com/"
+	putStrLn "Enjoy propellor!"
+
+minimalConfig :: FilePath -> IO ()
+minimalConfig dotpropellor = do
+	createDirectoryIfMissing True dotpropellor
+	writeFile cabalfile (unlines cabalcontent)
+	writeFile configfile (unlines configcontent)
+	changeWorkingDirectory dotpropellor
+	void $ boolSystem "git" [Param "init"]
+	void $ boolSystem "git" [Param "add" , File cabalfile, File configfile]
+  where
+	cabalfile = dotpropellor  "config.cabal"
+	configfile = dotpropellor  "config.hs"
+	cabalcontent =
+		[ "-- This is a cabal file to use to build your propellor configuration."
+		, ""
+		, "Name: config"
+		, "Cabal-Version: >= 1.6"
+		, "Build-Type: Simple"
+		, "Version: 0"
+		, ""
+		, "Executable propellor-config"
+		, "  Main-Is: config.hs"
+		, "  GHC-Options: -threaded -Wall -fno-warn-tabs -O0"
+		, "  Extensions: TypeOperators"
+		, "  Build-Depends: propellor >= 3.0, base >= 3"
+		]
+	configcontent = 
+		[ "-- This is the main configuration file for Propellor, and is used to build"
+		, "-- the propellor program."
+		, ""
+		, "import Propellor"
+		, "import qualified Propellor.Property.File as File"
+		, "import qualified Propellor.Property.Apt as Apt"
+		, "import qualified Propellor.Property.Cron as Cron"
+		, "import qualified Propellor.Property.User as User"
+		, ""
+		, "main :: IO ()"
+		, "main = defaultMain hosts"
+		, ""
+		, "-- The hosts propellor knows about."
+		, "hosts :: [Host]"
+		, "hosts ="
+		, "        [ mybox"
+		, "        ]"
+		, ""
+		, "-- An example host."
+		, "mybox :: Host"
+		, "mybox = host \"mybox.example.com\" $ props"
+		, "        & osDebian Unstable \"amd64\""
+		, "        & Apt.stdSourcesList"
+		, "        & Apt.unattendedUpgrades"
+		, "        & Apt.installed [\"etckeeper\"]"
+		, "        & Apt.installed [\"ssh\"]"
+		, "        & User.hasSomePassword (User \"root\")"
+		, "        & File.dirExists \"/var/www\""
+		, "        & Cron.runPropellor (Cron.Times \"30 * * * *\")"
+		, ""
+		]
+
+fullClone :: FilePath -> IO ()
+fullClone dotpropellor = ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
+	( do			
+		void $ boolSystem "git" [Param "clone", File distrepo, File dotpropellor]
+		fetchUpstreamBranch dotpropellor distrepo
+		changeWorkingDirectory dotpropellor
+		void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
+	, do
+		void $ boolSystem "git" [Param "clone", Param netrepo, File dotpropellor]
+		changeWorkingDirectory dotpropellor
+		-- Rename origin to upstream and avoid
+		-- git push to that read-only repo.
+		void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
+		void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
+	)
+
+checkRepoUpToDate :: FilePath -> IO ()
+checkRepoUpToDate dotpropellor = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
+	headrev <- takeWhile (/= '\n') <$> readFile disthead
+	changeWorkingDirectory dotpropellor
+	headknown <- catchMaybeIO $ 
+		withQuietOutput createProcessSuccess $
+			proc "git" ["log", headrev]
+	if (headknown == Nothing)
+		then setupUpstreamMaster headrev dotpropellor
+		else do
+			merged <- not . null <$>
+				readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
+			unless merged $
+				warnoutofdate dotpropellor True
+  where
+	gitbundleavail = doesFileExist disthead
+	dotpropellorpopulated = doesFileExist (dotpropellor  "propellor.cabal")
+
+-- Passed the user's dotpropellor repository, makes upstream/master
 -- be a usefully mergeable branch.
 --
 -- We cannot just use origin/master, because in the case of a distrepo,
@@ -122,12 +248,12 @@ wrapper args propellordir propellorbin = do
 -- repository, giving it a new master branch. That new branch is fetched
 -- into the user's repository, as if fetching from a upstream remote,
 -- yielding a new upstream/master branch.
-setupupstreammaster :: String -> FilePath -> IO ()
-setupupstreammaster newref propellordir = do
-	changeWorkingDirectory propellordir
+setupUpstreamMaster :: String -> FilePath -> IO ()
+setupUpstreamMaster newref dotpropellor = do
+	changeWorkingDirectory dotpropellor
 	go =<< catchMaybeIO getoldrev
   where
-	go Nothing = warnoutofdate propellordir False
+	go Nothing = warnoutofdate dotpropellor False
 	go (Just oldref) = do
 		let tmprepo = ".git/propellordisttmp"
 		let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
@@ -139,9 +265,9 @@ setupupstreammaster newref propellordir = do
 		git ["reset", "--hard", oldref, "--quiet"]
 		git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
 	
-		fetchUpstreamBranch propellordir tmprepo
+		fetchUpstreamBranch dotpropellor tmprepo
 		cleantmprepo
-		warnoutofdate propellordir True
+		warnoutofdate dotpropellor True
 
 	getoldrev = takeWhile (/= '\n')
 		<$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
@@ -151,8 +277,8 @@ setupupstreammaster newref propellordir = do
 		error $ "Failed to run " ++ cmd ++ " " ++ show ps
 
 warnoutofdate :: FilePath -> Bool -> IO ()
-warnoutofdate propellordir havebranch = do
-	warningMessage ("** Your " ++ propellordir ++ " is out of date..")
+warnoutofdate dotpropellor havebranch = do
+	warningMessage ("** Your " ++ dotpropellor ++ " is out of date..")
 	let also s = hPutStrLn stderr ("   " ++ s)
 	also ("A newer upstream version is available in " ++ distrepo)
 	if havebranch
@@ -161,8 +287,8 @@ warnoutofdate propellordir havebranch = do
 	also ""
 
 fetchUpstreamBranch :: FilePath -> FilePath -> IO ()
-fetchUpstreamBranch propellordir repo = do
-	changeWorkingDirectory propellordir
+fetchUpstreamBranch dotpropellor repo = do
+	changeWorkingDirectory dotpropellor
 	void $ boolSystem "git"
 		[ Param "fetch"
 		, File repo
-- 
cgit v1.2.3


From ccfdfcab60753eb6eb6ab1c6a6ad6203b8adfdcf Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Fri, 1 Apr 2016 18:36:38 -0400
Subject: fix false positive for out of date message after initial clone from
 git bundle

---
 src/wrapper.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/src/wrapper.hs b/src/wrapper.hs
index f079eb32..82251dc9 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -12,6 +12,7 @@ module Main where
 
 import Propellor.Message
 import Propellor.Bootstrap
+import Propellor.Git
 import Utility.UserInfo
 import Utility.Monad
 import Utility.Process
@@ -225,10 +226,12 @@ checkRepoUpToDate dotpropellor = whenM (gitbundleavail <&&> dotpropellorpopulate
 	if (headknown == Nothing)
 		then setupUpstreamMaster headrev dotpropellor
 		else do
-			merged <- not . null <$>
-				readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
-			unless merged $
-				warnoutofdate dotpropellor True
+			theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef
+			when (theirhead /= headrev) $ do
+				merged <- not . null <$>
+					readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
+				unless merged $
+					warnoutofdate dotpropellor True
   where
 	gitbundleavail = doesFileExist disthead
 	dotpropellorpopulated = doesFileExist (dotpropellor  "propellor.cabal")
-- 
cgit v1.2.3


From 93b083f3a1204a7cf4452b5ebd589dd77d25dbac Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Fri, 1 Apr 2016 19:34:27 -0400
Subject: setup gpg key in initial setup process

---
 debian/changelog                                |  5 +-
 doc/README.mdwn                                 | 19 ++----
 doc/components.mdwn                             |  8 +--
 doc/todo/commandline_to_setup_minimal_repo.mdwn |  2 +
 src/Propellor/Gpg.hs                            | 17 +++--
 src/wrapper.hs                                  | 88 ++++++++++++++++++++++---
 6 files changed, 104 insertions(+), 35 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 14d3f1a9..21c53bf8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -65,8 +65,9 @@ propellor (3.0.0) UNRELEASED; urgency=medium
   * Added dependency on concurrent-output; removed embedded copy.
   * Apt.PPA: New module, contributed by Evan Cofsky.
   * Improved propellor's first run experience; the wrapper program will
-    now walk the user through setting up ~/.propellor with a choice between
-    a clone of propellor's git repository, or a minimal config.
+    now walk the user through setting up ~/.propellor, with a choice between
+    a clone of propellor's git repository, or a minimal config, and will
+    configure propellor to use a gpg key.
 
  -- Joey Hess   Wed, 30 Mar 2016 15:45:08 -0400
 
diff --git a/doc/README.mdwn b/doc/README.mdwn
index b17f8575..fc3c3fd1 100644
--- a/doc/README.mdwn
+++ b/doc/README.mdwn
@@ -44,18 +44,13 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask
      `apt-get install propellor`
 2. Run `propellor` for the first time. It will set up a `~/.propellor/` git
    repository for you.
-3. If you don't have a gpg private key already, generate one: `gpg --gen-key`
-4. Run: `propellor --add-key $KEYID`, which will make propellor trust
-   your gpg key, and will sign your `~/.propellor` repository using it.
-5. Edit `~/.propellor/config.hs`, and add a host you want to manage.
+3. Edit `~/.propellor/config.hs`, and add a host you want to manage.
    You can start by not adding any properties, or only a few.
-6. Run: `propellor --spin $HOST`
-7. Now you have a simple propellor deployment, but it doesn't do
-   much to the host yet, besides installing propellor.  
-   So, edit `~/.propellor/config.hs` to configure the host, add some
-   properties to it, and re-run step 6.  
-   Repeat until happy and move on to the next host. :)
-8. Once you have a lot of hosts, and running `propellor --spin HOST` for
+4. Run: `propellor --spin $HOST`
+5. Now you have a simple propellor deployment to a host. Continue editing
+   `~/.propellor/config.hs` to further configure the host, add more hosts
+   etc, and re-run `propellor --spin $HOST` after each change.  
+6. Once you have a lot of hosts, and running `propellor --spin HOST` for
    each host becomes tiresome, you can
    [automate that](http://propellor.branchable.com/automated_spins/).
-9. Write some neat new properties and send patches!
+7. Write some neat new properties and send patches!
diff --git a/doc/components.mdwn b/doc/components.mdwn
index 801bb6bf..5b47e106 100644
--- a/doc/components.mdwn
+++ b/doc/components.mdwn
@@ -28,12 +28,8 @@ then copy in `~/.propellor/src/Propellor/` and it will be used. See
 ## minimal .propellor repository
 
 All that really needs to be in `~/.propellor/` though, is a `config.hs`
-file, and a cabal file. To use propellor this way, you can first
-install propellor, and then copy the two files from the
-[mininalconfig branch](http://source.propellor.branchable.com/?p=source.git;a=tree;h=refs/heads/minimalconfig;hb=refs/heads/minimalconfig),
-or clone it:
-
-	git clone git://propellor.branchable.com/ .propellor --branch minimalconfig --single-branch
+file, and a cabal file. Running propellor when `~/.propellor/` doesn't exist
+will ask you if you want a minimal config, and create those files.
 
 In this configuration, when propellor is deploying itself to a new host,
 it will automatically install the version of the propellor library
diff --git a/doc/todo/commandline_to_setup_minimal_repo.mdwn b/doc/todo/commandline_to_setup_minimal_repo.mdwn
index 5e82ed0f..2b41d370 100644
--- a/doc/todo/commandline_to_setup_minimal_repo.mdwn
+++ b/doc/todo/commandline_to_setup_minimal_repo.mdwn
@@ -3,3 +3,5 @@ parameters, like --minimal to clone the minimal config repo instead of the
 full one, or --stack to set up ~/.propellor to use stack.  --[[Joey]]
 
 > Or, it could be an interactive setup process. --[[Joey]]
+
+>> Made it interactive. [[done]] --[[Joey]]
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
index 55d89d29..4e6ceb79 100644
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -32,14 +32,21 @@ getGpgBin = do
 -- Lists the keys in propellor's keyring.
 listPubKeys :: IO [KeyId]
 listPubKeys = do
-	gpgbin <- getGpgBin
 	keyring <- privDataKeyring
-	parse . lines <$> readProcess gpgbin (listopts keyring)
+	map fst <$> listKeys ("--list-public-keys" : useKeyringOpts keyring)
+
+listSecretKeys :: IO [(KeyId, String)]
+listSecretKeys = listKeys ["--list-secret-keys"]
+
+listKeys :: [String] -> IO [(KeyId, String)]
+listKeys ps = do
+	gpgbin <- getGpgBin
+	parse . lines <$> readProcess gpgbin listopts
   where
-	listopts keyring = useKeyringOpts keyring ++
-		["--with-colons", "--list-public-keys"]
+	listopts = ps ++ ["--with-colons"]
 	parse = mapMaybe (keyIdField . split ":")
-	keyIdField ("pub":_:_:_:f:_) = Just f
+	keyIdField (t:_:_:_:f:_:_:_:_:n:_)
+		| t == "pub" || t == "sec" = Just (f, n)
 	keyIdField _ = Nothing
 
 useKeyringOpts :: FilePath -> [String]
diff --git a/src/wrapper.hs b/src/wrapper.hs
index 82251dc9..32e036da 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -3,8 +3,7 @@
 -- Distributions should install this program into PATH.
 -- (Cabal builds it as dist/build/propellor/propellor).
 --
--- This is not the propellor main program (that's config.hs)
---
+-- This is not the propellor main program (that's config.hs).
 -- This bootstraps ~/.propellor/config.hs, builds it if
 -- it's not already built, and runs it.
 
@@ -13,13 +12,16 @@ module Main where
 import Propellor.Message
 import Propellor.Bootstrap
 import Propellor.Git
+import Propellor.Gpg
 import Utility.UserInfo
 import Utility.Monad
 import Utility.Process
 import Utility.SafeCommand
 import Utility.Exception
+import Utility.Path
 
 import Data.Char
+import Data.List
 import Control.Monad
 import Control.Monad.IfElse
 import System.Directory
@@ -97,14 +99,14 @@ welcomeBanner = putStr $ unlines $ map prettify
 		| c == x = y
 		| otherwise = c
 
-prompt :: String -> [(Char, IO ())] -> IO ()
+prompt :: String -> [(String, IO ())] -> IO ()
 prompt p cs = do
-	putStr (p ++ " [" ++ map fst cs ++ "] ")
+	putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
 	hFlush stdout
 	r <- map toLower <$> getLine
-	if r == "\n"
+	if null r
 		then snd (head cs) -- default to first choice on return
-		else case filter (\(c, a) -> [toLower c] == r) cs of
+		else case filter (\(s, _) -> map toLower s == r) cs of
 			[(_, a)] -> a
 			_ -> do
 				putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
@@ -125,23 +127,89 @@ setup dotpropellor = do
 	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
 	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
 	prompt "Which would you prefer?"
-		[ ('A', fullClone dotpropellor),
-		 ('B', minimalConfig dotpropellor)
+		[ ("A", fullClone dotpropellor)
+		, ("B", minimalConfig dotpropellor)
 		]
 	putStrLn "Ok, ~/.propellor/config.hs is set up!"
-	
+	changeWorkingDirectory dotpropellor
+
 	section
 	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
 	buildPropellor Nothing
-	putStrLn "Great! Propellor is set up and ready to use."
+	putStrLn "Great! Propellor is bootstrapped."
+	
+	section
+	putStrLn "Propellor uses gpg to encrypt private data about the systems it manages,"
+	putStrLn "and to sign git commits."
+	gpg <- getGpgBin
+	ifM (inPath gpg)
+		( setupGpgKey dotpropellor
+		, do
+			putStrLn "You don't seem to have gpg installed, so skipping setting it up."
+			explainManualSetupGpgKey
+		)
 
 	section
+	putStrLn "Everything is set up ..."
 	putStrLn "Your next step is to edit ~/.propellor/config.hs,"
 	putStrLn "and run propellor again to try it out."
 	putStrLn ""
 	putStrLn "For docs, see https://propellor.branchable.com/"
 	putStrLn "Enjoy propellor!"
 
+explainManualSetupGpgKey :: IO ()
+explainManualSetupGpgKey = do
+	putStrLn "Propellor can still be used without gpg, but it won't be able to"
+	putStrLn "manage private data. You can set this up later:"
+	putStrLn " 1. gpg --gen-key"
+	putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)"
+
+setupGpgKey :: FilePath -> IO ()
+setupGpgKey dotpropellor = do
+	ks <- listSecretKeys
+	putStrLn ""
+	case ks of
+		[] -> makeGpgKey dotpropellor
+		[(k, _)] -> propellorAddKey dotpropellor k
+		_ -> do
+			let nks = zip ks (map show ([1..] :: [Integer]))
+			putStrLn "I see you have several gpg keys:"
+			forM_ nks $ \((k, d), n) ->
+				putStrLn $ "   " ++ n ++ "   " ++ d ++ "  (keyid " ++ k ++ ")"
+			prompt "Which of your gpg keys should propellor use?"
+				(map (\((k, _), n) -> (n, propellorAddKey dotpropellor k)) nks)
+
+makeGpgKey :: FilePath -> IO ()
+makeGpgKey dotpropellor = do
+	putStrLn "You seem to not have any gpg secret keys."
+	prompt "Would you like to create one now?"
+		[("Y", rungpg), ("N", nope)]
+  where
+	nope = do
+		putStrLn "No problem."
+		explainManualSetupGpgKey
+	rungpg = do
+		putStrLn "Running gpg --gen-key ..."
+		gpg <- getGpgBin
+		void $ boolSystem gpg [Param "--gen-key"]
+		ks <- listSecretKeys
+		case ks of
+			[] -> do
+				putStrLn "Hmm, gpg seemed to not set up a secret key."
+				prompt "Want to try running gpg again?"
+					[("Y", rungpg), ("N", nope)]
+			((k, _):_) -> propellorAddKey dotpropellor k
+
+propellorAddKey :: FilePath -> String -> IO ()
+propellorAddKey dotpropellor keyid = do
+	putStrLn ""
+	putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid
+	unlessM (boolSystem propellorbin [Param "--add-key", Param keyid]) $ do
+		putStrLn "Oops, that didn't work! You can retry the same command later."
+		putStrLn "Continuing onward ..."
+  where
+	propellorbin = dotpropellor  "propellor"
+
 minimalConfig :: FilePath -> IO ()
 minimalConfig dotpropellor = do
 	createDirectoryIfMissing True dotpropellor
-- 
cgit v1.2.3


From 1dc914a71c94e0395641565e5891a2dc33ba1b35 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Fri, 1 Apr 2016 21:20:13 -0400
Subject: separate propellor --init

---
 debian/changelog               |   4 +-
 doc/README.mdwn                |   2 +-
 propellor.cabal                |   1 +
 src/Propellor/CmdLine.hs       |   4 +
 src/Propellor/DotDir.hs        | 348 ++++++++++++++++++++++++++++++++++++++++
 src/Propellor/Types/CmdLine.hs |   1 +
 src/wrapper.hs                 | 353 ++---------------------------------------
 7 files changed, 370 insertions(+), 343 deletions(-)
 create mode 100644 src/Propellor/DotDir.hs

diff --git a/debian/changelog b/debian/changelog
index 21c53bf8..ae593902 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -64,8 +64,8 @@ propellor (3.0.0) UNRELEASED; urgency=medium
     these complex new types.
   * Added dependency on concurrent-output; removed embedded copy.
   * Apt.PPA: New module, contributed by Evan Cofsky.
-  * Improved propellor's first run experience; the wrapper program will
-    now walk the user through setting up ~/.propellor, with a choice between
+  * Improved propellor's first run experience; propellor --init will
+    walk the user through setting up ~/.propellor, with a choice between
     a clone of propellor's git repository, or a minimal config, and will
     configure propellor to use a gpg key.
 
diff --git a/doc/README.mdwn b/doc/README.mdwn
index fc3c3fd1..31d222c1 100644
--- a/doc/README.mdwn
+++ b/doc/README.mdwn
@@ -42,7 +42,7 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask
      `cabal install propellor`
           or
      `apt-get install propellor`
-2. Run `propellor` for the first time. It will set up a `~/.propellor/` git
+2. Run `propellor --init` ; this will set up a `~/.propellor/` git
    repository for you.
 3. Edit `~/.propellor/config.hs`, and add a host you want to manage.
    You can start by not adding any properties, or only a few.
diff --git a/propellor.cabal b/propellor.cabal
index 9f74d264..d97d4096 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -151,6 +151,7 @@ Library
     Propellor.Info
     Propellor.Message
     Propellor.Debug
+    Propellor.DotDir
     Propellor.PrivData
     Propellor.Engine
     Propellor.EnsureProperty
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index d93a8e3a..19e49f5a 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -16,6 +16,7 @@ import Propellor.Git.VerifiedBranch
 import Propellor.Bootstrap
 import Propellor.Spin
 import Propellor.Types.CmdLine
+import Propellor.DotDir (interactiveInit)
 import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Shim as Shim
@@ -23,6 +24,7 @@ import qualified Propellor.Shim as Shim
 usage :: Handle -> IO ()
 usage h = hPutStrLn h $ unlines
 	[ "Usage:"
+	, "  propellor --init"
 	, "  propellor"
 	, "  propellor hostname"
 	, "  propellor --spin targethost [--via relayhost]"
@@ -69,6 +71,7 @@ processCmdLine = go =<< getArgs
 	go ("--serialized":s:[]) = serialized Serialized s
 	go ("--continue":s:[]) = serialized Continue s
 	go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout)
+	go ("--init":_) = return Init
 	go ("--run":h:[]) = go [h]
 	go (h:[])
 		| "--" `isPrefixOf` h = usageError [h]
@@ -130,6 +133,7 @@ defaultMain hostlist = withConcurrentOutput $ do
 		fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn))
 	-- When continuing after a rebuild, don't want to rebuild again.
 	go _ (Continue cmdline) = go NoRebuild cmdline
+	go _ Init = interactiveInit
 
 	withhost :: HostName -> (Host -> IO ()) -> IO ()
 	withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
new file mode 100644
index 00000000..92c20654
--- /dev/null
+++ b/src/Propellor/DotDir.hs
@@ -0,0 +1,348 @@
+module Propellor.DotDir where
+
+import Propellor.Message
+import Propellor.Bootstrap
+import Propellor.Git
+import Propellor.Gpg
+import Utility.UserInfo
+import Utility.Monad
+import Utility.Process
+import Utility.SafeCommand
+import Utility.Exception
+import Utility.Path
+
+import Data.Char
+import Data.List
+import Control.Monad
+import Control.Monad.IfElse
+import System.Directory
+import System.FilePath
+import System.Posix.Directory
+import System.IO
+import Control.Applicative
+import Prelude
+
+distdir :: FilePath
+distdir = "/usr/src/propellor"
+
+-- A distribution may include a bundle of propellor's git repository here.
+-- If not, it will be pulled from the network when needed.
+distrepo :: FilePath
+distrepo = distdir  "propellor.git"
+
+-- File containing the head rev of the distrepo.
+disthead :: FilePath
+disthead = distdir  "head"
+
+upstreambranch :: String
+upstreambranch = "upstream/master"
+
+-- Using the github mirror of the main propellor repo because
+-- it is accessible over https for better security.
+netrepo :: String
+netrepo = "https://github.com/joeyh/propellor.git"
+
+dotPropellor :: IO FilePath
+dotPropellor = do
+	home <- myHomeDir
+	return (home  ".propellor")
+
+interactiveInit :: IO ()
+interactiveInit = ifM (doesDirectoryExist =<< dotPropellor)
+	( error "~/.propellor/ already exists, not doing anything"
+	, do
+		welcomeBanner
+		setup
+	)
+
+welcomeBanner :: IO ()
+welcomeBanner = putStr $ unlines $ map prettify
+	[ ""
+	, ""
+	, "                                 _         ______`|                       ,-.__"
+	, " .---------------------------  /   ~___-=O`/|O`/__|                      (____.'"
+	, "  - Welcome to              -- ~          / | /    )          _.-'-._"
+	, "  -            Propellor!   --  `/-==__ _/__|/__=-|          (       ~_"
+	, " `---------------------------   *             ~ | |           '--------'"
+	, "                                           (o)  `"
+	, ""
+	, ""
+	]
+  where
+	prettify = map (replace '~' '\\')
+	replace x y c
+		| c == x = y
+		| otherwise = c
+
+prompt :: String -> [(String, IO ())] -> IO ()
+prompt p cs = do
+	putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
+	hFlush stdout
+	r <- map toLower <$> getLine
+	if null r
+		then snd (head cs) -- default to first choice on return
+		else case filter (\(s, _) -> map toLower s == r) cs of
+			[(_, a)] -> a
+			_ -> do
+				putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
+				prompt p cs
+
+section :: IO ()
+section = do
+	putStrLn ""
+	putStrLn "---------------------------------------------------------------------------------"
+	putStrLn ""
+
+setup :: IO ()
+setup = do
+	dotpropellor <- dotPropellor
+	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
+	putStrLn ""
+	putStrLn "Lets get you started with a simple config that you can adapt"
+	putStrLn "to your needs. You can start with:"
+	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
+	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
+	prompt "Which would you prefer?"
+		[ ("A", fullClone)
+		, ("B", minimalConfig)
+		]
+	putStrLn "Ok, ~/.propellor/config.hs is set up!"
+	changeWorkingDirectory dotpropellor
+
+	section
+	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
+	buildPropellor Nothing
+	putStrLn "Great! Propellor is bootstrapped."
+	
+	section
+	putStrLn "Propellor uses gpg to encrypt private data about the systems it manages,"
+	putStrLn "and to sign git commits."
+	gpg <- getGpgBin
+	ifM (inPath gpg)
+		( setupGpgKey
+		, do
+			putStrLn "You don't seem to have gpg installed, so skipping setting it up."
+			explainManualSetupGpgKey
+		)
+
+	section
+	putStrLn "Everything is set up ..."
+	putStrLn "Your next step is to edit ~/.propellor/config.hs,"
+	putStrLn "and run propellor again to try it out."
+	putStrLn ""
+	putStrLn "For docs, see https://propellor.branchable.com/"
+	putStrLn "Enjoy propellor!"
+
+explainManualSetupGpgKey :: IO ()
+explainManualSetupGpgKey = do
+	putStrLn "Propellor can still be used without gpg, but it won't be able to"
+	putStrLn "manage private data. You can set this up later:"
+	putStrLn " 1. gpg --gen-key"
+	putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)"
+
+setupGpgKey :: IO ()
+setupGpgKey = do
+	ks <- listSecretKeys
+	putStrLn ""
+	case ks of
+		[] -> makeGpgKey
+		[(k, _)] -> propellorAddKey k
+		_ -> do
+			let nks = zip ks (map show ([1..] :: [Integer]))
+			putStrLn "I see you have several gpg keys:"
+			forM_ nks $ \((k, d), n) ->
+				putStrLn $ "   " ++ n ++ "   " ++ d ++ "  (keyid " ++ k ++ ")"
+			prompt "Which of your gpg keys should propellor use?"
+				(map (\((k, _), n) -> (n, propellorAddKey k)) nks)
+
+makeGpgKey :: IO ()
+makeGpgKey = do
+	putStrLn "You seem to not have any gpg secret keys."
+	prompt "Would you like to create one now?"
+		[("Y", rungpg), ("N", nope)]
+  where
+	nope = do
+		putStrLn "No problem."
+		explainManualSetupGpgKey
+	rungpg = do
+		putStrLn "Running gpg --gen-key ..."
+		gpg <- getGpgBin
+		void $ boolSystem gpg [Param "--gen-key"]
+		ks <- listSecretKeys
+		case ks of
+			[] -> do
+				putStrLn "Hmm, gpg seemed to not set up a secret key."
+				prompt "Want to try running gpg again?"
+					[("Y", rungpg), ("N", nope)]
+			((k, _):_) -> propellorAddKey k
+
+propellorAddKey :: String -> IO ()
+propellorAddKey keyid = do
+	putStrLn ""
+	putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid
+	d <- dotPropellor
+	unlessM (boolSystem (d  "propellor") [Param "--add-key", Param keyid]) $ do
+		putStrLn "Oops, that didn't work! You can retry the same command later."
+		putStrLn "Continuing onward ..."
+
+minimalConfig :: IO ()
+minimalConfig = do
+	d <- dotPropellor
+	createDirectoryIfMissing True d
+	let cabalfile = d  "config.cabal"
+	let configfile = d  "config.hs"
+	writeFile cabalfile (unlines cabalcontent)
+	writeFile configfile (unlines configcontent)
+	changeWorkingDirectory d
+	void $ boolSystem "git" [Param "init"]
+	void $ boolSystem "git" [Param "add" , File cabalfile, File configfile]
+  where
+	cabalcontent =
+		[ "-- This is a cabal file to use to build your propellor configuration."
+		, ""
+		, "Name: config"
+		, "Cabal-Version: >= 1.6"
+		, "Build-Type: Simple"
+		, "Version: 0"
+		, ""
+		, "Executable propellor-config"
+		, "  Main-Is: config.hs"
+		, "  GHC-Options: -threaded -Wall -fno-warn-tabs -O0"
+		, "  Extensions: TypeOperators"
+		, "  Build-Depends: propellor >= 3.0, base >= 3"
+		]
+	configcontent = 
+		[ "-- This is the main configuration file for Propellor, and is used to build"
+		, "-- the propellor program."
+		, ""
+		, "import Propellor"
+		, "import qualified Propellor.Property.File as File"
+		, "import qualified Propellor.Property.Apt as Apt"
+		, "import qualified Propellor.Property.Cron as Cron"
+		, "import qualified Propellor.Property.User as User"
+		, ""
+		, "main :: IO ()"
+		, "main = defaultMain hosts"
+		, ""
+		, "-- The hosts propellor knows about."
+		, "hosts :: [Host]"
+		, "hosts ="
+		, "        [ mybox"
+		, "        ]"
+		, ""
+		, "-- An example host."
+		, "mybox :: Host"
+		, "mybox = host \"mybox.example.com\" $ props"
+		, "        & osDebian Unstable \"amd64\""
+		, "        & Apt.stdSourcesList"
+		, "        & Apt.unattendedUpgrades"
+		, "        & Apt.installed [\"etckeeper\"]"
+		, "        & Apt.installed [\"ssh\"]"
+		, "        & User.hasSomePassword (User \"root\")"
+		, "        & File.dirExists \"/var/www\""
+		, "        & Cron.runPropellor (Cron.Times \"30 * * * *\")"
+		, ""
+		]
+
+fullClone :: IO ()
+fullClone = do
+	d <- dotPropellor
+	ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
+		( do			
+			void $ boolSystem "git" [Param "clone", File distrepo, File d]
+			fetchUpstreamBranch distrepo
+			changeWorkingDirectory d
+			void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
+		, do
+			void $ boolSystem "git" [Param "clone", Param netrepo, File d]
+			changeWorkingDirectory d
+			-- Rename origin to upstream and avoid
+			-- git push to that read-only repo.
+			void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
+			void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
+		)
+
+fetchUpstreamBranch :: FilePath -> IO ()
+fetchUpstreamBranch repo = do
+	changeWorkingDirectory =<< dotPropellor
+	void $ boolSystem "git"
+		[ Param "fetch"
+		, File repo
+		, Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch)
+		, Param "--quiet"
+		]
+
+checkRepoUpToDate :: IO ()
+checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
+	headrev <- takeWhile (/= '\n') <$> readFile disthead
+	changeWorkingDirectory =<< dotPropellor
+	headknown <- catchMaybeIO $ 
+		withQuietOutput createProcessSuccess $
+			proc "git" ["log", headrev]
+	if (headknown == Nothing)
+		then setupUpstreamMaster headrev
+		else do
+			theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef
+			when (theirhead /= headrev) $ do
+				merged <- not . null <$>
+					readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
+				unless merged $
+					warnoutofdate True
+  where
+	gitbundleavail = doesFileExist disthead
+	dotpropellorpopulated = do
+		d <- dotPropellor
+		doesFileExist (d  "propellor.cabal")
+
+-- Passed the user's dotpropellor repository, makes upstream/master
+-- be a usefully mergeable branch.
+--
+-- We cannot just use origin/master, because in the case of a distrepo,
+-- it only contains 1 commit. So, trying to merge with it will result
+-- in lots of merge conflicts, since git cannot find a common parent
+-- commit.
+--
+-- Instead, the upstream/master branch is created by taking the
+-- upstream/master branch (which must be an old version of propellor,
+-- as distributed), and diffing from it to the current origin/master,
+-- and committing the result. This is done in a temporary clone of the
+-- repository, giving it a new master branch. That new branch is fetched
+-- into the user's repository, as if fetching from a upstream remote,
+-- yielding a new upstream/master branch.
+setupUpstreamMaster :: String -> IO ()
+setupUpstreamMaster newref = do
+	changeWorkingDirectory =<< dotPropellor
+	go =<< catchMaybeIO getoldrev
+  where
+	go Nothing = warnoutofdate False
+	go (Just oldref) = do
+		let tmprepo = ".git/propellordisttmp"
+		let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
+		cleantmprepo
+		git ["clone", "--quiet", ".", tmprepo]
+	
+		changeWorkingDirectory tmprepo
+		git ["fetch", distrepo, "--quiet"]
+		git ["reset", "--hard", oldref, "--quiet"]
+		git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
+	
+		fetchUpstreamBranch tmprepo
+		cleantmprepo
+		warnoutofdate True
+
+	getoldrev = takeWhile (/= '\n')
+		<$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
+	
+	git = run "git"
+	run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
+		error $ "Failed to run " ++ cmd ++ " " ++ show ps
+
+warnoutofdate :: Bool -> IO ()
+warnoutofdate havebranch = do
+	warningMessage ("** Your ~/.propellor/ is out of date..")
+	let also s = hPutStrLn stderr ("   " ++ s)
+	also ("A newer upstream version is available in " ++ distrepo)
+	if havebranch
+		then also ("To merge it, run: git merge " ++ upstreambranch)
+		else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.")
+	also ""
diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs
index 558c6e8b..0773d9d9 100644
--- a/src/Propellor/Types/CmdLine.hs
+++ b/src/Propellor/Types/CmdLine.hs
@@ -28,4 +28,5 @@ data CmdLine
 	| ChrootChain HostName FilePath Bool Bool
 	| GitPush Fd Fd
 	| Check
+	| Init
 	deriving (Read, Show, Eq)
diff --git a/src/wrapper.hs b/src/wrapper.hs
index 32e036da..1a90fcb0 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -9,360 +9,33 @@
 
 module Main where
 
+import Propellor.DotDir
 import Propellor.Message
 import Propellor.Bootstrap
-import Propellor.Git
-import Propellor.Gpg
-import Utility.UserInfo
 import Utility.Monad
 import Utility.Process
-import Utility.SafeCommand
-import Utility.Exception
-import Utility.Path
 
-import Data.Char
-import Data.List
-import Control.Monad
-import Control.Monad.IfElse
 import System.Directory
-import System.FilePath
 import System.Environment (getArgs)
 import System.Exit
 import System.Posix.Directory
-import System.IO
-import Control.Applicative
-import Prelude
-
-distdir :: FilePath
-distdir = "/usr/src/propellor"
-
--- A distribution may include a bundle of propellor's git repository here.
--- If not, it will be pulled from the network when needed.
-distrepo :: FilePath
-distrepo = distdir  "propellor.git"
-
--- File containing the head rev of the distrepo.
-disthead :: FilePath
-disthead = distdir  "head"
-
-upstreambranch :: String
-upstreambranch = "upstream/master"
-
--- Using the github mirror of the main propellor repo because
--- it is accessible over https for better security.
-netrepo :: String
-netrepo = "https://github.com/joeyh/propellor.git"
 
 main :: IO ()
-main = withConcurrentOutput $ do
-	args <- getArgs
-	home <- myHomeDir
-	let dotpropellor = home  ".propellor"
-	ifM (doesDirectoryExist dotpropellor)
+main = withConcurrentOutput $ go =<< getArgs
+  where
+	go ["--init"] = interactiveInit
+	go args = ifM (doesDirectoryExist =<< dotPropellor)
 		( do
-			checkRepoUpToDate dotpropellor
-			buildRunConfig dotpropellor args
-		, do
-			welcomeBanner
-			setup dotpropellor
+			checkRepoUpToDate
+			buildRunConfig args
+		, error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
 		)
 
-buildRunConfig :: FilePath -> [String] -> IO ()
-buildRunConfig dotpropellor args = do
-	changeWorkingDirectory dotpropellor
-	buildPropellor Nothing
-	putStrLn ""
-	putStrLn ""
-	chain
-  where
-	propellorbin = dotpropellor  "propellor"
-	chain = do
-		(_, _, _, pid) <- createProcess (proc propellorbin args) 
-		exitWith =<< waitForProcess pid
-
-welcomeBanner :: IO ()
-welcomeBanner = putStr $ unlines $ map prettify
-	[ ""
-	, ""
-	, "                                 _         ______`|                       ,-.__"
-	, " .---------------------------  /   ~___-=O`/|O`/__|                      (____.'"
-	, "  - Welcome to              -- ~          / | /    )          _.-'-._"
-	, "  -            Propellor!   --  `/-==__ _/__|/__=-|          (       ~_"
-	, " `---------------------------   *             ~ | |           '--------'"
-	, "                                           (o)  `"
-	, ""
-	, ""
-	]
-  where
-	prettify = map (replace '~' '\\')
-	replace x y c
-		| c == x = y
-		| otherwise = c
-
-prompt :: String -> [(String, IO ())] -> IO ()
-prompt p cs = do
-	putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
-	hFlush stdout
-	r <- map toLower <$> getLine
-	if null r
-		then snd (head cs) -- default to first choice on return
-		else case filter (\(s, _) -> map toLower s == r) cs of
-			[(_, a)] -> a
-			_ -> do
-				putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
-				prompt p cs
-
-section :: IO ()
-section = do
-	putStrLn ""
-	putStrLn "---------------------------------------------------------------------------------"
-	putStrLn ""
-
-setup :: FilePath -> IO ()
-setup dotpropellor = do
-	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
-	putStrLn ""
-	putStrLn "Lets get you started with a simple config that you can adapt"
-	putStrLn "to your needs. You can start with:"
-	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
-	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
-	prompt "Which would you prefer?"
-		[ ("A", fullClone dotpropellor)
-		, ("B", minimalConfig dotpropellor)
-		]
-	putStrLn "Ok, ~/.propellor/config.hs is set up!"
-	changeWorkingDirectory dotpropellor
-
-	section
-	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
+buildRunConfig :: [String] -> IO ()
+buildRunConfig args = do
+	changeWorkingDirectory =<< dotPropellor
 	buildPropellor Nothing
-	putStrLn "Great! Propellor is bootstrapped."
-	
-	section
-	putStrLn "Propellor uses gpg to encrypt private data about the systems it manages,"
-	putStrLn "and to sign git commits."
-	gpg <- getGpgBin
-	ifM (inPath gpg)
-		( setupGpgKey dotpropellor
-		, do
-			putStrLn "You don't seem to have gpg installed, so skipping setting it up."
-			explainManualSetupGpgKey
-		)
-
-	section
-	putStrLn "Everything is set up ..."
-	putStrLn "Your next step is to edit ~/.propellor/config.hs,"
-	putStrLn "and run propellor again to try it out."
 	putStrLn ""
-	putStrLn "For docs, see https://propellor.branchable.com/"
-	putStrLn "Enjoy propellor!"
-
-explainManualSetupGpgKey :: IO ()
-explainManualSetupGpgKey = do
-	putStrLn "Propellor can still be used without gpg, but it won't be able to"
-	putStrLn "manage private data. You can set this up later:"
-	putStrLn " 1. gpg --gen-key"
-	putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)"
-
-setupGpgKey :: FilePath -> IO ()
-setupGpgKey dotpropellor = do
-	ks <- listSecretKeys
-	putStrLn ""
-	case ks of
-		[] -> makeGpgKey dotpropellor
-		[(k, _)] -> propellorAddKey dotpropellor k
-		_ -> do
-			let nks = zip ks (map show ([1..] :: [Integer]))
-			putStrLn "I see you have several gpg keys:"
-			forM_ nks $ \((k, d), n) ->
-				putStrLn $ "   " ++ n ++ "   " ++ d ++ "  (keyid " ++ k ++ ")"
-			prompt "Which of your gpg keys should propellor use?"
-				(map (\((k, _), n) -> (n, propellorAddKey dotpropellor k)) nks)
-
-makeGpgKey :: FilePath -> IO ()
-makeGpgKey dotpropellor = do
-	putStrLn "You seem to not have any gpg secret keys."
-	prompt "Would you like to create one now?"
-		[("Y", rungpg), ("N", nope)]
-  where
-	nope = do
-		putStrLn "No problem."
-		explainManualSetupGpgKey
-	rungpg = do
-		putStrLn "Running gpg --gen-key ..."
-		gpg <- getGpgBin
-		void $ boolSystem gpg [Param "--gen-key"]
-		ks <- listSecretKeys
-		case ks of
-			[] -> do
-				putStrLn "Hmm, gpg seemed to not set up a secret key."
-				prompt "Want to try running gpg again?"
-					[("Y", rungpg), ("N", nope)]
-			((k, _):_) -> propellorAddKey dotpropellor k
-
-propellorAddKey :: FilePath -> String -> IO ()
-propellorAddKey dotpropellor keyid = do
 	putStrLn ""
-	putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid
-	unlessM (boolSystem propellorbin [Param "--add-key", Param keyid]) $ do
-		putStrLn "Oops, that didn't work! You can retry the same command later."
-		putStrLn "Continuing onward ..."
-  where
-	propellorbin = dotpropellor  "propellor"
-
-minimalConfig :: FilePath -> IO ()
-minimalConfig dotpropellor = do
-	createDirectoryIfMissing True dotpropellor
-	writeFile cabalfile (unlines cabalcontent)
-	writeFile configfile (unlines configcontent)
-	changeWorkingDirectory dotpropellor
-	void $ boolSystem "git" [Param "init"]
-	void $ boolSystem "git" [Param "add" , File cabalfile, File configfile]
-  where
-	cabalfile = dotpropellor  "config.cabal"
-	configfile = dotpropellor  "config.hs"
-	cabalcontent =
-		[ "-- This is a cabal file to use to build your propellor configuration."
-		, ""
-		, "Name: config"
-		, "Cabal-Version: >= 1.6"
-		, "Build-Type: Simple"
-		, "Version: 0"
-		, ""
-		, "Executable propellor-config"
-		, "  Main-Is: config.hs"
-		, "  GHC-Options: -threaded -Wall -fno-warn-tabs -O0"
-		, "  Extensions: TypeOperators"
-		, "  Build-Depends: propellor >= 3.0, base >= 3"
-		]
-	configcontent = 
-		[ "-- This is the main configuration file for Propellor, and is used to build"
-		, "-- the propellor program."
-		, ""
-		, "import Propellor"
-		, "import qualified Propellor.Property.File as File"
-		, "import qualified Propellor.Property.Apt as Apt"
-		, "import qualified Propellor.Property.Cron as Cron"
-		, "import qualified Propellor.Property.User as User"
-		, ""
-		, "main :: IO ()"
-		, "main = defaultMain hosts"
-		, ""
-		, "-- The hosts propellor knows about."
-		, "hosts :: [Host]"
-		, "hosts ="
-		, "        [ mybox"
-		, "        ]"
-		, ""
-		, "-- An example host."
-		, "mybox :: Host"
-		, "mybox = host \"mybox.example.com\" $ props"
-		, "        & osDebian Unstable \"amd64\""
-		, "        & Apt.stdSourcesList"
-		, "        & Apt.unattendedUpgrades"
-		, "        & Apt.installed [\"etckeeper\"]"
-		, "        & Apt.installed [\"ssh\"]"
-		, "        & User.hasSomePassword (User \"root\")"
-		, "        & File.dirExists \"/var/www\""
-		, "        & Cron.runPropellor (Cron.Times \"30 * * * *\")"
-		, ""
-		]
-
-fullClone :: FilePath -> IO ()
-fullClone dotpropellor = ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
-	( do			
-		void $ boolSystem "git" [Param "clone", File distrepo, File dotpropellor]
-		fetchUpstreamBranch dotpropellor distrepo
-		changeWorkingDirectory dotpropellor
-		void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
-	, do
-		void $ boolSystem "git" [Param "clone", Param netrepo, File dotpropellor]
-		changeWorkingDirectory dotpropellor
-		-- Rename origin to upstream and avoid
-		-- git push to that read-only repo.
-		void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
-		void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
-	)
-
-checkRepoUpToDate :: FilePath -> IO ()
-checkRepoUpToDate dotpropellor = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
-	headrev <- takeWhile (/= '\n') <$> readFile disthead
-	changeWorkingDirectory dotpropellor
-	headknown <- catchMaybeIO $ 
-		withQuietOutput createProcessSuccess $
-			proc "git" ["log", headrev]
-	if (headknown == Nothing)
-		then setupUpstreamMaster headrev dotpropellor
-		else do
-			theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef
-			when (theirhead /= headrev) $ do
-				merged <- not . null <$>
-					readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
-				unless merged $
-					warnoutofdate dotpropellor True
-  where
-	gitbundleavail = doesFileExist disthead
-	dotpropellorpopulated = doesFileExist (dotpropellor  "propellor.cabal")
-
--- Passed the user's dotpropellor repository, makes upstream/master
--- be a usefully mergeable branch.
---
--- We cannot just use origin/master, because in the case of a distrepo,
--- it only contains 1 commit. So, trying to merge with it will result
--- in lots of merge conflicts, since git cannot find a common parent
--- commit.
---
--- Instead, the upstream/master branch is created by taking the
--- upstream/master branch (which must be an old version of propellor,
--- as distributed), and diffing from it to the current origin/master,
--- and committing the result. This is done in a temporary clone of the
--- repository, giving it a new master branch. That new branch is fetched
--- into the user's repository, as if fetching from a upstream remote,
--- yielding a new upstream/master branch.
-setupUpstreamMaster :: String -> FilePath -> IO ()
-setupUpstreamMaster newref dotpropellor = do
-	changeWorkingDirectory dotpropellor
-	go =<< catchMaybeIO getoldrev
-  where
-	go Nothing = warnoutofdate dotpropellor False
-	go (Just oldref) = do
-		let tmprepo = ".git/propellordisttmp"
-		let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
-		cleantmprepo
-		git ["clone", "--quiet", ".", tmprepo]
-	
-		changeWorkingDirectory tmprepo
-		git ["fetch", distrepo, "--quiet"]
-		git ["reset", "--hard", oldref, "--quiet"]
-		git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
-	
-		fetchUpstreamBranch dotpropellor tmprepo
-		cleantmprepo
-		warnoutofdate dotpropellor True
-
-	getoldrev = takeWhile (/= '\n')
-		<$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
-	
-	git = run "git"
-	run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
-		error $ "Failed to run " ++ cmd ++ " " ++ show ps
-
-warnoutofdate :: FilePath -> Bool -> IO ()
-warnoutofdate dotpropellor havebranch = do
-	warningMessage ("** Your " ++ dotpropellor ++ " is out of date..")
-	let also s = hPutStrLn stderr ("   " ++ s)
-	also ("A newer upstream version is available in " ++ distrepo)
-	if havebranch
-		then also ("To merge it, run: git merge " ++ upstreambranch)
-		else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.")
-	also ""
-
-fetchUpstreamBranch :: FilePath -> FilePath -> IO ()
-fetchUpstreamBranch dotpropellor repo = do
-	changeWorkingDirectory dotpropellor
-	void $ boolSystem "git"
-		[ Param "fetch"
-		, File repo
-		, Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch)
-		, Param "--quiet"
-		]
+	(_, _, _, pid) <- createProcess (proc "./propellor" args) 
+	exitWith =<< waitForProcess pid
-- 
cgit v1.2.3


From 71bc7071094ef56bca518f1eb4660718a0c9d0b0 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Fri, 1 Apr 2016 23:40:39 -0400
Subject: verify use of gpg key

having a prompt here makes it clearer to the user why gpg is prompting for
a passphrase.
---
 joeyconfig.hs           |  2 +-
 src/Propellor/DotDir.hs | 20 +++++++++++++++-----
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/joeyconfig.hs b/joeyconfig.hs
index 489a0f58..20103e61 100644
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -43,7 +43,7 @@ main = defaultMain hosts --  /   \___-=O`/|O`/__|                      (____.'
   {- Propellor            -- \          / | /    )          _.-"-._
      Deployed -}          --  `/-==__ _/__|/__=-|          (       \_
 hosts :: [Host]          --   *             \ | |           '--------'
-hosts =                --                  (o)  `
+hosts =                 --                  (o)  `
 	[ darkstar
 	, gnu 
 	, clam
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 92c20654..bf7550d5 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -64,7 +64,7 @@ welcomeBanner = putStr $ unlines $ map prettify
 	, "  - Welcome to              -- ~          / | /    )          _.-'-._"
 	, "  -            Propellor!   --  `/-==__ _/__|/__=-|          (       ~_"
 	, " `---------------------------   *             ~ | |           '--------'"
-	, "                                           (o)  `"
+	, "                                            (o)  `"
 	, ""
 	, ""
 	]
@@ -90,7 +90,7 @@ prompt p cs = do
 section :: IO ()
 section = do
 	putStrLn ""
-	putStrLn "---------------------------------------------------------------------------------"
+	putStrLn "------------------------------------------------------------------------------"
 	putStrLn ""
 
 setup :: IO ()
@@ -111,11 +111,13 @@ setup = do
 
 	section
 	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
+	putStrLn ""
 	buildPropellor Nothing
+	putStrLn ""
 	putStrLn "Great! Propellor is bootstrapped."
 	
 	section
-	putStrLn "Propellor uses gpg to encrypt private data about the systems it manages,"
+	putStrLn "Propellor can use gpg to encrypt private data about the systems it manages,"
 	putStrLn "and to sign git commits."
 	gpg <- getGpgBin
 	ifM (inPath gpg)
@@ -146,14 +148,21 @@ setupGpgKey = do
 	putStrLn ""
 	case ks of
 		[] -> makeGpgKey
-		[(k, _)] -> propellorAddKey k
+		[(k, d)] -> do
+			putStrLn $ "You have one gpg key: " ++ desckey k d
+			prompt "Should propellor use that key?" 
+				[ ("Y", propellorAddKey k)
+				, ("N", putStrLn $ "Skipping gpg setup. If you change your mind, run: propellor --add-key " ++ k)
+				]
 		_ -> do
 			let nks = zip ks (map show ([1..] :: [Integer]))
 			putStrLn "I see you have several gpg keys:"
 			forM_ nks $ \((k, d), n) ->
-				putStrLn $ "   " ++ n ++ "   " ++ d ++ "  (keyid " ++ k ++ ")"
+				putStrLn $ "   " ++ n ++ "   " ++ desckey k d
 			prompt "Which of your gpg keys should propellor use?"
 				(map (\((k, _), n) -> (n, propellorAddKey k)) nks)
+  where
+	desckey k d = d ++ "  (keyid " ++ k ++ ")"
 
 makeGpgKey :: IO ()
 makeGpgKey = do
@@ -199,6 +208,7 @@ minimalConfig = do
   where
 	cabalcontent =
 		[ "-- This is a cabal file to use to build your propellor configuration."
+		, "-- https://propellor.branchable.com/"
 		, ""
 		, "Name: config"
 		, "Cabal-Version: >= 1.6"
-- 
cgit v1.2.3


From e8d767448a64b0ad529015c7125d97811f9cbbd7 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Fri, 1 Apr 2016 23:57:25 -0400
Subject: cosmetics

---
 src/Propellor/DotDir.hs | 56 +++++++++++++++++++++++++------------------------
 1 file changed, 29 insertions(+), 27 deletions(-)

diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index bf7550d5..f0dace2f 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -4,6 +4,7 @@ import Propellor.Message
 import Propellor.Bootstrap
 import Propellor.Git
 import Propellor.Gpg
+import Propellor.Types.Result
 import Utility.UserInfo
 import Utility.Monad
 import Utility.Process
@@ -95,7 +96,6 @@ section = do
 
 setup :: IO ()
 setup = do
-	dotpropellor <- dotPropellor
 	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
 	putStrLn ""
 	putStrLn "Lets get you started with a simple config that you can adapt"
@@ -103,11 +103,10 @@ setup = do
 	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
 	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
 	prompt "Which would you prefer?"
-		[ ("A", fullClone)
-		, ("B", minimalConfig)
+		[ ("A", actionMessage "Cloning propellor's git repository" fullClone >> return ())
+		, ("B", actionMessage "Creating minimal config" minimalConfig >> return ())
 		]
-	putStrLn "Ok, ~/.propellor/config.hs is set up!"
-	changeWorkingDirectory dotpropellor
+	changeWorkingDirectory =<< dotPropellor
 
 	section
 	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
@@ -129,7 +128,7 @@ setup = do
 
 	section
 	putStrLn "Everything is set up ..."
-	putStrLn "Your next step is to edit ~/.propellor/config.hs,"
+	putStrLn "Your next step is to edit ~/.propellor/config.hs"
 	putStrLn "and run propellor again to try it out."
 	putStrLn ""
 	putStrLn "For docs, see https://propellor.branchable.com/"
@@ -150,7 +149,7 @@ setupGpgKey = do
 		[] -> makeGpgKey
 		[(k, d)] -> do
 			putStrLn $ "You have one gpg key: " ++ desckey k d
-			prompt "Should propellor use that key?" 
+			prompt "Should propellor use that key?"
 				[ ("Y", propellorAddKey k)
 				, ("N", putStrLn $ "Skipping gpg setup. If you change your mind, run: propellor --add-key " ++ k)
 				]
@@ -194,7 +193,7 @@ propellorAddKey keyid = do
 		putStrLn "Oops, that didn't work! You can retry the same command later."
 		putStrLn "Continuing onward ..."
 
-minimalConfig :: IO ()
+minimalConfig :: IO Result
 minimalConfig = do
 	d <- dotPropellor
 	createDirectoryIfMissing True d
@@ -205,10 +204,10 @@ minimalConfig = do
 	changeWorkingDirectory d
 	void $ boolSystem "git" [Param "init"]
 	void $ boolSystem "git" [Param "add" , File cabalfile, File configfile]
+	return MadeChange
   where
 	cabalcontent =
 		[ "-- This is a cabal file to use to build your propellor configuration."
-		, "-- https://propellor.branchable.com/"
 		, ""
 		, "Name: config"
 		, "Cabal-Version: >= 1.6"
@@ -223,7 +222,7 @@ minimalConfig = do
 		]
 	configcontent = 
 		[ "-- This is the main configuration file for Propellor, and is used to build"
-		, "-- the propellor program."
+		, "-- the propellor program.    https://propellor.branchable.com/"
 		, ""
 		, "import Propellor"
 		, "import qualified Propellor.Property.File as File"
@@ -254,28 +253,32 @@ minimalConfig = do
 		, ""
 		]
 
-fullClone :: IO ()
+fullClone :: IO Result
 fullClone = do
 	d <- dotPropellor
-	ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
-		( do			
-			void $ boolSystem "git" [Param "clone", File distrepo, File d]
-			fetchUpstreamBranch distrepo
-			changeWorkingDirectory d
-			void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
-		, do
-			void $ boolSystem "git" [Param "clone", Param netrepo, File d]
-			changeWorkingDirectory d
+	let enterdotpropellor = changeWorkingDirectory d >> return True
+	ok <- ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
+		( allM id
+			[ boolSystem "git" [Param "clone", File distrepo, File d]
+			, fetchUpstreamBranch distrepo
+			, enterdotpropellor
+			, boolSystem "git" [Param "remote", Param "rm", Param "origin"]
+			]
+		, allM id
+			[ boolSystem "git" [Param "clone", Param netrepo, File d]
+			, enterdotpropellor
 			-- Rename origin to upstream and avoid
 			-- git push to that read-only repo.
-			void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
-			void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
+			, boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
+			, boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
+			]
 		)
+	return (toResult ok)
 
-fetchUpstreamBranch :: FilePath -> IO ()
+fetchUpstreamBranch :: FilePath -> IO Bool
 fetchUpstreamBranch repo = do
 	changeWorkingDirectory =<< dotPropellor
-	void $ boolSystem "git"
+	boolSystem "git"
 		[ Param "fetch"
 		, File repo
 		, Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch)
@@ -304,8 +307,7 @@ checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
 		d <- dotPropellor
 		doesFileExist (d  "propellor.cabal")
 
--- Passed the user's dotpropellor repository, makes upstream/master
--- be a usefully mergeable branch.
+-- Makes upstream/master in dotPropellor be a usefully mergeable branch.
 --
 -- We cannot just use origin/master, because in the case of a distrepo,
 -- it only contains 1 commit. So, trying to merge with it will result
@@ -336,7 +338,7 @@ setupUpstreamMaster newref = do
 		git ["reset", "--hard", oldref, "--quiet"]
 		git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
 	
-		fetchUpstreamBranch tmprepo
+		void $ fetchUpstreamBranch tmprepo
 		cleantmprepo
 		warnoutofdate True
 
-- 
cgit v1.2.3


From e3920861ee444945e54fd42ce0f599d585155652 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 01:29:23 -0400
Subject: Stack support.

* Stack support. "git config propellor.buildsystem stack" will make
  propellor build its config using stack.
* When propellor is installed using stack, propellor --init will
  automatically set propellor.buildsystem=stack.
---
 Makefile                                           |  1 +
 debian/changelog                                   |  4 ++
 ...use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn |  6 +++
 propellor.cabal                                    |  6 +++
 src/Propellor/Bootstrap.hs                         | 54 ++++++++++++++++++----
 src/Propellor/DotDir.hs                            | 47 +++++++++++++++----
 stack.yaml                                         |  6 +++
 7 files changed, 107 insertions(+), 17 deletions(-)
 create mode 100644 stack.yaml

diff --git a/Makefile b/Makefile
index a9ad2b84..5322d6c5 100644
--- a/Makefile
+++ b/Makefile
@@ -16,6 +16,7 @@ install:
 	mkdir -p dist/gittmp
 	$(CABAL) sdist
 	cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1)
+	cp stack.yaml dist/gittmp # also include in bundle
 	# cabal sdist does not preserve symlinks, so copy over file
 	cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done
 	# reset mtime on files in git bundle so bundle is reproducible
diff --git a/debian/changelog b/debian/changelog
index ae593902..aab077b0 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -68,6 +68,10 @@ propellor (3.0.0) UNRELEASED; urgency=medium
     walk the user through setting up ~/.propellor, with a choice between
     a clone of propellor's git repository, or a minimal config, and will
     configure propellor to use a gpg key.
+  * Stack support. "git config propellor.buildsystem stack" will make
+    propellor build its config using stack.
+  * When propellor is installed using stack, propellor --init will
+    automatically set propellor.buildsystem=stack.
 
  -- Joey Hess   Wed, 30 Mar 2016 15:45:08 -0400
 
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn
index 2973e662..55c3ef7e 100644
--- a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn
@@ -7,3 +7,9 @@ and run with
     stack exec -- propellor ...
 
 see [[https://github.com/yesodweb/yesod/issues/1018]] and [[https://github.com/yesodweb/yesod/commit/a7cccf2a7c5df8b26da9ea4fdcb6bac5ab3a3b75]]
+
+> I don't think `stack exec propellor` makes sense to use.
+> Instead, `stack install propellor` and then put that in PATH.
+> I've now made `propellor --init` know when it was built using stack,
+> and it will set up propellor to continue to build itself using stack.
+> [[done]] --[[Joey]]
diff --git a/propellor.cabal b/propellor.cabal
index d97d4096..3431d410 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -34,6 +34,10 @@ Description:
  .
  It is configured using haskell.
 
+Flag UseStack
+  Description: Have propellor rebuild itself using Stack (default is Cabal)
+  Default: False
+
 Executable propellor
   Main-Is: wrapper.hs
   GHC-Options: -threaded -Wall -fno-warn-tabs -O0
@@ -46,6 +50,8 @@ Executable propellor
     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
     time, mtl, transformers, exceptions (>= 0.6), stm, text,
     concurrent-output
+  if flag(UseStack)
+    CPP-Options: -DUSE_STACK
 
 Executable propellor-config
   Main-Is: config.hs
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 969e1a42..300be156 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -7,6 +7,7 @@ module Propellor.Bootstrap (
 
 import Propellor.Base
 import Propellor.Types.Info
+import Propellor.Git.Config
 
 import System.Posix.Files
 import Data.List
@@ -139,16 +140,22 @@ buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
 		Just (InfoVal sys) -> Just sys
 		_ -> Nothing
 
--- Build propellor using cabal, and symlink propellor to where cabal
--- leaves the built binary.
---
+-- Build propellor using cabal or stack, and symlink propellor to the
+-- built binary.
+build :: Maybe System -> IO Bool
+build msys = catchBoolIO $ do
+	bs <- getGitConfigValue "propellor.buildsystem"
+	case bs of
+		Just "stack" -> stackBuild msys
+		_ -> cabalBuild msys
+
 -- For speed, only runs cabal configure when it's not been run before.
 -- If the build fails cabal may need to have configure re-run.
 --
 -- If the cabal configure fails, and a System is provided, installs
 -- dependencies and retries.
-build :: Maybe System -> IO Bool
-build msys = catchBoolIO $ do
+cabalBuild :: Maybe System -> IO Bool
+cabalBuild msys = do
 	make "dist/setup-config" ["propellor.cabal"] cabal_configure
 	unlessM cabal_build $
 		unlessM (cabal_configure <&&> cabal_build) $
@@ -163,14 +170,11 @@ build msys = catchBoolIO $ do
 	unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
 		error "cp of binary failed"
 	rename (tmpfor safetycopy) safetycopy
-	createSymbolicLink safetycopy (tmpfor dest)
-	rename (tmpfor dest) dest
+	symlinkPropellorBin safetycopy
 	return True
   where
-	dest = "propellor"
 	cabalbuiltbin = "dist/build/propellor-config/propellor-config"
 	safetycopy = cabalbuiltbin ++ ".built"
-	tmpfor f = f ++ ".propellortmp"
 	cabal_configure = ifM (cabal ["configure"])
 		( return True
 		, case msys of
@@ -181,6 +185,35 @@ build msys = catchBoolIO $ do
 		)
 	cabal_build = cabal ["build", "propellor-config"]
 
+stackBuild :: Maybe System -> IO Bool
+stackBuild _msys = do
+	createDirectoryIfMissing True builddest
+	ifM (stack buildparams)
+		( do
+			symlinkPropellorBin (builddest  "propellor-config")
+			return True
+		, return False
+		)
+  where
+ 	builddest = ".built"
+	buildparams =
+		[ "--local-bin-path", builddest
+		, "build"
+		, ":propellor-config" -- only build config program
+		, "--copy-bins"
+		]
+
+-- Atomic symlink creation/update.
+symlinkPropellorBin :: FilePath -> IO ()
+symlinkPropellorBin bin = do
+	createSymbolicLink bin (tmpfor dest)
+	rename (tmpfor dest) dest
+  where
+	dest = "propellor"
+
+tmpfor :: FilePath -> FilePath
+tmpfor f = f ++ ".propellortmp"
+
 make :: FilePath -> [FilePath] -> IO Bool -> IO ()
 make dest srcs builder = do
 	dt <- getmtime dest
@@ -193,3 +226,6 @@ make dest srcs builder = do
 
 cabal :: [String] -> IO Bool
 cabal = boolSystem "cabal" . map Param
+
+stack :: [String] -> IO Bool
+stack = boolSystem "stack" . map Param
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index f0dace2f..90147abe 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Propellor.DotDir where
 
 import Propellor.Message
@@ -11,9 +13,12 @@ import Utility.Process
 import Utility.SafeCommand
 import Utility.Exception
 import Utility.Path
+-- This module is autogenerated by the build system.
+import qualified Paths_propellor as Package
 
 import Data.Char
 import Data.List
+import Data.Version
 import Control.Monad
 import Control.Monad.IfElse
 import System.Directory
@@ -48,6 +53,15 @@ dotPropellor = do
 	home <- myHomeDir
 	return (home  ".propellor")
 
+data InitCfg = UseCabal | UseStack
+
+initCfg :: InitCfg
+#ifdef USE_STACK
+initCfg = UseStack
+#else
+initCfg = UseCabal
+#endif
+
 interactiveInit :: IO ()
 interactiveInit = ifM (doesDirectoryExist =<< dotPropellor)
 	( error "~/.propellor/ already exists, not doing anything"
@@ -95,7 +109,7 @@ section = do
 	putStrLn ""
 
 setup :: IO ()
-setup = do
+setup initcfg = do
 	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
 	putStrLn ""
 	putStrLn "Lets get you started with a simple config that you can adapt"
@@ -103,14 +117,21 @@ setup = do
 	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
 	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
 	prompt "Which would you prefer?"
-		[ ("A", actionMessage "Cloning propellor's git repository" fullClone >> return ())
-		, ("B", actionMessage "Creating minimal config" minimalConfig >> return ())
+		[ ("A", void $ actionMessage "Cloning propellor's git repository" fullClone)
+		, ("B", void $ actionMessage "Creating minimal config" minimalConfig)
 		]
 	changeWorkingDirectory =<< dotPropellor
 
 	section
 	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
 	putStrLn ""
+	void $ boolSystem "git"
+		[ Param "config"
+		, Param "propellor.buildsystem"
+		, Param $ case initCfg of
+			UseCabal -> "cabal"
+			UseStack -> "stack"
+		]
 	buildPropellor Nothing
 	putStrLn ""
 	putStrLn "Great! Propellor is bootstrapped."
@@ -197,15 +218,16 @@ minimalConfig :: IO Result
 minimalConfig = do
 	d <- dotPropellor
 	createDirectoryIfMissing True d
-	let cabalfile = d  "config.cabal"
-	let configfile = d  "config.hs"
-	writeFile cabalfile (unlines cabalcontent)
-	writeFile configfile (unlines configcontent)
 	changeWorkingDirectory d
 	void $ boolSystem "git" [Param "init"]
-	void $ boolSystem "git" [Param "add" , File cabalfile, File configfile]
+	addfile "config.cabal" cabalcontent
+	addfile "config.hs" configcontent
+	addfile "stack.yaml" stackcontent
 	return MadeChange
   where
+	addfile f content = do
+		writeFile f (unlines content)
+		void $ boolSystem "git" [Param "add" , File f]
 	cabalcontent =
 		[ "-- This is a cabal file to use to build your propellor configuration."
 		, ""
@@ -252,6 +274,15 @@ minimalConfig = do
 		, "        & Cron.runPropellor (Cron.Times \"30 * * * *\")"
 		, ""
 		]
+	stackcontent =
+		-- This should be the same resolver version in propellor's
+		-- own stack.yaml
+		[ "resolver: lts-5.10"
+		, "packages:"
+		, "- '.'"
+		, "extra-deps:"
+		, "- propellor-" ++ showVersion Package.version
+		]
 
 fullClone :: IO Result
 fullClone = do
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 00000000..6b5e859c
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,6 @@
+resolver: lts-5.10
+packages:
+- '.'
+flags:
+  propellor:
+    usestack: true
-- 
cgit v1.2.3


From 1c70d2e18917973723bf836fdc1f789532d96811 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 01:49:01 -0400
Subject: avoid wrapper building propellor unnessessarily

---
 src/wrapper.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/wrapper.hs b/src/wrapper.hs
index 1a90fcb0..c65d60d3 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -34,8 +34,9 @@ main = withConcurrentOutput $ go =<< getArgs
 buildRunConfig :: [String] -> IO ()
 buildRunConfig args = do
 	changeWorkingDirectory =<< dotPropellor
-	buildPropellor Nothing
-	putStrLn ""
-	putStrLn ""
+	unlessM (doesFileExist "propellor") $ do
+		buildPropellor Nothing
+		putStrLn ""
+		putStrLn ""
 	(_, _, _, pid) <- createProcess (proc "./propellor" args) 
 	exitWith =<< waitForProcess pid
-- 
cgit v1.2.3


From bdffac1bfae1ec20ac20453b559addca2b98e1ff Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 01:50:06 -0400
Subject: typo

---
 src/Propellor/DotDir.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 90147abe..43067417 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -109,7 +109,7 @@ section = do
 	putStrLn ""
 
 setup :: IO ()
-setup initcfg = do
+setup = do
 	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
 	putStrLn ""
 	putStrLn "Lets get you started with a simple config that you can adapt"
-- 
cgit v1.2.3


From 828830eace62dba7d75b656142d83f8396fd2968 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 01:51:01 -0400
Subject: typo

---
 src/wrapper.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/wrapper.hs b/src/wrapper.hs
index c65d60d3..212f737d 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -19,6 +19,7 @@ import System.Directory
 import System.Environment (getArgs)
 import System.Exit
 import System.Posix.Directory
+import Control.Monad.IfElse
 
 main :: IO ()
 main = withConcurrentOutput $ go =<< getArgs
-- 
cgit v1.2.3


From db2d46246c5772c12aa8cf64ea604b65d164a7b0 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 01:59:38 -0400
Subject: make sure that the wrapper runs propellor in the foreground

---
 src/wrapper.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/wrapper.hs b/src/wrapper.hs
index 212f737d..90f14379 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -14,6 +14,7 @@ import Propellor.Message
 import Propellor.Bootstrap
 import Utility.Monad
 import Utility.Process
+import Utility.Process.NonConcurrent
 
 import System.Directory
 import System.Environment (getArgs)
@@ -39,5 +40,5 @@ buildRunConfig args = do
 		buildPropellor Nothing
 		putStrLn ""
 		putStrLn ""
-	(_, _, _, pid) <- createProcess (proc "./propellor" args) 
-	exitWith =<< waitForProcess pid
+	(_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args) 
+	exitWith =<< waitForProcessNonConcurrent pid
-- 
cgit v1.2.3


From ecf786ddab0161a4f5fa84e07cced60efb1595cd Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 12:05:07 -0400
Subject: got rid of build flag to detect stack

---
 propellor.cabal         |  6 ------
 src/Propellor/DotDir.hs | 20 +++++++-------------
 stack.yaml              |  3 ---
 3 files changed, 7 insertions(+), 22 deletions(-)

diff --git a/propellor.cabal b/propellor.cabal
index 3431d410..d97d4096 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -34,10 +34,6 @@ Description:
  .
  It is configured using haskell.
 
-Flag UseStack
-  Description: Have propellor rebuild itself using Stack (default is Cabal)
-  Default: False
-
 Executable propellor
   Main-Is: wrapper.hs
   GHC-Options: -threaded -Wall -fno-warn-tabs -O0
@@ -50,8 +46,6 @@ Executable propellor
     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
     time, mtl, transformers, exceptions (>= 0.6), stm, text,
     concurrent-output
-  if flag(UseStack)
-    CPP-Options: -DUSE_STACK
 
 Executable propellor-config
   Main-Is: config.hs
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 43067417..21479cb1 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 module Propellor.DotDir where
 
 import Propellor.Message
@@ -53,14 +51,11 @@ dotPropellor = do
 	home <- myHomeDir
 	return (home  ".propellor")
 
-data InitCfg = UseCabal | UseStack
-
-initCfg :: InitCfg
-#ifdef USE_STACK
-initCfg = UseStack
-#else
-initCfg = UseCabal
-#endif
+-- Detect if propellor was built using stack. This is somewhat of a hack.
+buildSystem :: IO String
+buildSystem = do
+	d <- Package.getLibDir
+	return $ if "stack-work" `isInfixOf` d then "stack" else "cabal"
 
 interactiveInit :: IO ()
 interactiveInit = ifM (doesDirectoryExist =<< dotPropellor)
@@ -125,12 +120,11 @@ setup = do
 	section
 	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
 	putStrLn ""
+	b <- buildSystem
 	void $ boolSystem "git"
 		[ Param "config"
 		, Param "propellor.buildsystem"
-		, Param $ case initCfg of
-			UseCabal -> "cabal"
-			UseStack -> "stack"
+		, Param b
 		]
 	buildPropellor Nothing
 	putStrLn ""
diff --git a/stack.yaml b/stack.yaml
index 6b5e859c..7b6bcef8 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,6 +1,3 @@
 resolver: lts-5.10
 packages:
 - '.'
-flags:
-  propellor:
-    usestack: true
-- 
cgit v1.2.3


From 1c5da932e9e356c2fbad22dcb97e1ea8943407cd Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 12:07:40 -0400
Subject: include stack.yaml in sdist

---
 Makefile        | 1 -
 propellor.cabal | 1 +
 2 files changed, 1 insertion(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index 5322d6c5..a9ad2b84 100644
--- a/Makefile
+++ b/Makefile
@@ -16,7 +16,6 @@ install:
 	mkdir -p dist/gittmp
 	$(CABAL) sdist
 	cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1)
-	cp stack.yaml dist/gittmp # also include in bundle
 	# cabal sdist does not preserve symlinks, so copy over file
 	cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done
 	# reset mtime on files in git bundle so bundle is reproducible
diff --git a/propellor.cabal b/propellor.cabal
index d97d4096..4017df87 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -20,6 +20,7 @@ Extra-Source-Files:
   joeyconfig.hs
   config.hs
   contrib/post-merge-hook
+  stack.yaml
   debian/changelog
   debian/README.Debian
   debian/compat
-- 
cgit v1.2.3


From d9e7191bb54d27c5680a98da448725e5314a3e23 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 12:16:43 -0400
Subject: use concurrent-output consistently

---
 src/Propellor/DotDir.hs | 91 ++++++++++++++++++++++++++-----------------------
 1 file changed, 49 insertions(+), 42 deletions(-)

diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 21479cb1..d8be3af9 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -23,6 +23,7 @@ import System.Directory
 import System.FilePath
 import System.Posix.Directory
 import System.IO
+import System.Console.Concurrent
 import Control.Applicative
 import Prelude
 
@@ -65,8 +66,14 @@ interactiveInit = ifM (doesDirectoryExist =<< dotPropellor)
 		setup
 	)
 
+say :: String -> IO ()
+say = outputConcurrent
+
+sayLn :: String -> IO ()
+sayLn s = say (s ++ "\n")
+
 welcomeBanner :: IO ()
-welcomeBanner = putStr $ unlines $ map prettify
+welcomeBanner = say $ unlines $ map prettify
 	[ ""
 	, ""
 	, "                                 _         ______`|                       ,-.__"
@@ -86,7 +93,7 @@ welcomeBanner = putStr $ unlines $ map prettify
 
 prompt :: String -> [(String, IO ())] -> IO ()
 prompt p cs = do
-	putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
+	say (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
 	hFlush stdout
 	r <- map toLower <$> getLine
 	if null r
@@ -94,23 +101,23 @@ prompt p cs = do
 		else case filter (\(s, _) -> map toLower s == r) cs of
 			[(_, a)] -> a
 			_ -> do
-				putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
+				sayLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
 				prompt p cs
 
 section :: IO ()
 section = do
-	putStrLn ""
-	putStrLn "------------------------------------------------------------------------------"
-	putStrLn ""
+	sayLn ""
+	sayLn "------------------------------------------------------------------------------"
+	sayLn ""
 
 setup :: IO ()
 setup = do
-	putStrLn "Propellor's configuration file is ~/.propellor/config.hs"
-	putStrLn ""
-	putStrLn "Lets get you started with a simple config that you can adapt"
-	putStrLn "to your needs. You can start with:"
-	putStrLn "   A: A clone of propellor's git repository    (most flexible)"
-	putStrLn "   B: The bare minimum files to use propellor  (most simple)"
+	sayLn "Propellor's configuration file is ~/.propellor/config.hs"
+	sayLn ""
+	sayLn "Lets get you started with a simple config that you can adapt"
+	sayLn "to your needs. You can start with:"
+	sayLn "   A: A clone of propellor's git repository    (most flexible)"
+	sayLn "   B: The bare minimum files to use propellor  (most simple)"
 	prompt "Which would you prefer?"
 		[ ("A", void $ actionMessage "Cloning propellor's git repository" fullClone)
 		, ("B", void $ actionMessage "Creating minimal config" minimalConfig)
@@ -118,8 +125,8 @@ setup = do
 	changeWorkingDirectory =<< dotPropellor
 
 	section
-	putStrLn "Let's try building the propellor configuration, to make sure it will work..."
-	putStrLn ""
+	sayLn "Let's try building the propellor configuration, to make sure it will work..."
+	sayLn ""
 	b <- buildSystem
 	void $ boolSystem "git"
 		[ Param "config"
@@ -127,52 +134,52 @@ setup = do
 		, Param b
 		]
 	buildPropellor Nothing
-	putStrLn ""
-	putStrLn "Great! Propellor is bootstrapped."
+	sayLn ""
+	sayLn "Great! Propellor is bootstrapped."
 	
 	section
-	putStrLn "Propellor can use gpg to encrypt private data about the systems it manages,"
-	putStrLn "and to sign git commits."
+	sayLn "Propellor can use gpg to encrypt private data about the systems it manages,"
+	sayLn "and to sign git commits."
 	gpg <- getGpgBin
 	ifM (inPath gpg)
 		( setupGpgKey
 		, do
-			putStrLn "You don't seem to have gpg installed, so skipping setting it up."
+			sayLn "You don't seem to have gpg installed, so skipping setting it up."
 			explainManualSetupGpgKey
 		)
 
 	section
-	putStrLn "Everything is set up ..."
-	putStrLn "Your next step is to edit ~/.propellor/config.hs"
-	putStrLn "and run propellor again to try it out."
-	putStrLn ""
-	putStrLn "For docs, see https://propellor.branchable.com/"
-	putStrLn "Enjoy propellor!"
+	sayLn "Everything is set up ..."
+	sayLn "Your next step is to edit ~/.propellor/config.hs"
+	sayLn "and run propellor again to try it out."
+	sayLn ""
+	sayLn "For docs, see https://propellor.branchable.com/"
+	sayLn "Enjoy propellor!"
 
 explainManualSetupGpgKey :: IO ()
 explainManualSetupGpgKey = do
-	putStrLn "Propellor can still be used without gpg, but it won't be able to"
-	putStrLn "manage private data. You can set this up later:"
-	putStrLn " 1. gpg --gen-key"
-	putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)"
+	sayLn "Propellor can still be used without gpg, but it won't be able to"
+	sayLn "manage private data. You can set this up later:"
+	sayLn " 1. gpg --gen-key"
+	sayLn " 2. propellor --add-key (pass it the key ID generated in step 1)"
 
 setupGpgKey :: IO ()
 setupGpgKey = do
 	ks <- listSecretKeys
-	putStrLn ""
+	sayLn ""
 	case ks of
 		[] -> makeGpgKey
 		[(k, d)] -> do
-			putStrLn $ "You have one gpg key: " ++ desckey k d
+			sayLn $ "You have one gpg key: " ++ desckey k d
 			prompt "Should propellor use that key?"
 				[ ("Y", propellorAddKey k)
-				, ("N", putStrLn $ "Skipping gpg setup. If you change your mind, run: propellor --add-key " ++ k)
+				, ("N", sayLn $ "Skipping gpg setup. If you change your mind, run: propellor --add-key " ++ k)
 				]
 		_ -> do
 			let nks = zip ks (map show ([1..] :: [Integer]))
-			putStrLn "I see you have several gpg keys:"
+			sayLn "I see you have several gpg keys:"
 			forM_ nks $ \((k, d), n) ->
-				putStrLn $ "   " ++ n ++ "   " ++ desckey k d
+				sayLn $ "   " ++ n ++ "   " ++ desckey k d
 			prompt "Which of your gpg keys should propellor use?"
 				(map (\((k, _), n) -> (n, propellorAddKey k)) nks)
   where
@@ -180,33 +187,33 @@ setupGpgKey = do
 
 makeGpgKey :: IO ()
 makeGpgKey = do
-	putStrLn "You seem to not have any gpg secret keys."
+	sayLn "You seem to not have any gpg secret keys."
 	prompt "Would you like to create one now?"
 		[("Y", rungpg), ("N", nope)]
   where
 	nope = do
-		putStrLn "No problem."
+		sayLn "No problem."
 		explainManualSetupGpgKey
 	rungpg = do
-		putStrLn "Running gpg --gen-key ..."
+		sayLn "Running gpg --gen-key ..."
 		gpg <- getGpgBin
 		void $ boolSystem gpg [Param "--gen-key"]
 		ks <- listSecretKeys
 		case ks of
 			[] -> do
-				putStrLn "Hmm, gpg seemed to not set up a secret key."
+				sayLn "Hmm, gpg seemed to not set up a secret key."
 				prompt "Want to try running gpg again?"
 					[("Y", rungpg), ("N", nope)]
 			((k, _):_) -> propellorAddKey k
 
 propellorAddKey :: String -> IO ()
 propellorAddKey keyid = do
-	putStrLn ""
-	putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid
+	sayLn ""
+	sayLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid
 	d <- dotPropellor
 	unlessM (boolSystem (d  "propellor") [Param "--add-key", Param keyid]) $ do
-		putStrLn "Oops, that didn't work! You can retry the same command later."
-		putStrLn "Continuing onward ..."
+		sayLn "Oops, that didn't work! You can retry the same command later."
+		sayLn "Continuing onward ..."
 
 minimalConfig :: IO Result
 minimalConfig = do
-- 
cgit v1.2.3


From 2d046cad32f5950472b87bc8eb97686fbf2cdcb3 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 12:21:49 -0400
Subject: force flush on prompt

---
 src/Propellor/DotDir.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index d8be3af9..4de7b9c8 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -94,6 +94,7 @@ welcomeBanner = say $ unlines $ map prettify
 prompt :: String -> [(String, IO ())] -> IO ()
 prompt p cs = do
 	say (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
+	flushConcurrentOutput
 	hFlush stdout
 	r <- map toLower <$> getLine
 	if null r
-- 
cgit v1.2.3


From 149bb5e170e81d818564a5c35bc3e59c8e074687 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 12:22:35 -0400
Subject: move clouds

---
 src/Propellor/DotDir.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 4de7b9c8..4f27788d 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -76,11 +76,11 @@ welcomeBanner :: IO ()
 welcomeBanner = say $ unlines $ map prettify
 	[ ""
 	, ""
-	, "                                 _         ______`|                       ,-.__"
-	, " .---------------------------  /   ~___-=O`/|O`/__|                      (____.'"
-	, "  - Welcome to              -- ~          / | /    )          _.-'-._"
-	, "  -            Propellor!   --  `/-==__ _/__|/__=-|          (       ~_"
-	, " `---------------------------   *             ~ | |           '--------'"
+	, "                                 _         ______`|                     ,-.__"
+	, " .---------------------------  /   ~___-=O`/|O`/__|                    (____.'"
+	, "  - Welcome to              -- ~          / | /    )        _.-'-._"
+	, "  -            Propellor!   --  `/-==__ _/__|/__=-|        (       ~_"
+	, " `---------------------------   *             ~ | |         '--------'"
 	, "                                            (o)  `"
 	, ""
 	, ""
-- 
cgit v1.2.3


From 48608a48bd91743776cf3d4abb2172b806d4b917 Mon Sep 17 00:00:00 2001
From: Joey Hess
Date: Sat, 2 Apr 2016 15:33:37 -0400
Subject: prep release

---
 debian/changelog | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index aab077b0..4c432a73 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-propellor (3.0.0) UNRELEASED; urgency=medium
+propellor (3.0.0) unstable; urgency=medium
 
   * Property types have been improved to indicate what systems they target.
     This prevents using eg, Property FreeBSD on a Debian system.
@@ -73,7 +73,7 @@ propellor (3.0.0) UNRELEASED; urgency=medium
   * When propellor is installed using stack, propellor --init will
     automatically set propellor.buildsystem=stack.
 
- -- Joey Hess   Wed, 30 Mar 2016 15:45:08 -0400
+ -- Joey Hess   Sat, 02 Apr 2016 15:33:26 -0400
 
 propellor (2.17.2) unstable; urgency=medium
 
-- 
cgit v1.2.3