propellor 2.13.0 → 2.14.0

raw patch · 17 files changed

+307/−142 lines, 17 filesdep −QuickCheckdep ~exceptionsPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck

Dependency ranges changed: exceptions

API changes (from Hackage documentation)

Files

• CHANGELOG +17/−0
• config-joey.hs +2/−0
• debian/changelog +17/−0
• debian/control +0/−2
• propellor.cabal +11/−20
• src/Propellor.hs +0/−1
• src/Propellor/Bootstrap.hs +0/−1
• src/Propellor/Property/Chroot.hs +20/−0
• src/Propellor/Property/DebianMirror.hs +109/−15
• src/Propellor/Property/DiskImage.hs +25/−12
• src/Propellor/Property/Git.hs +20/−0
• src/Propellor/Property/PropellorRepo.hs +19/−0
• src/Propellor/Property/SiteSpecific/JoeySites.hs +41/−0
• src/Propellor/Property/User.hs +23/−0
• src/Propellor/Types.hs +2/−1
• src/Utility/QuickCheck.hs +0/−53
• src/Utility/Scheduled.hs +1/−37

@@ -1,3 +1,20 @@+propellor (2.14.0) unstable; urgency=medium++  * Add Propellor.Property.PropellorRepo.hasOriginUrl, an explicit way to+    set the git repository url normally implicitly set when using --spin.+  * Added Chroot.noServices property.+  * DiskImage creation automatically uses Chroot.noServices.+  * Removed the (unused) dependency on quickcheck.+  * DebianMirror: Added a DebianMirror type for configuration (API change)+    Thanks, Félix Sipma.+  * DebianMirror: Add RsyncExtra to configuration.+    Thanks, Félix Sipma.+  * Added Git.repoConfigured and Git.repoAcceptsNonFFs properties.+    Thanks, Sean Whitton+  * Added User.hasDesktopGroups property.++ -- Joey Hess <id@joeyh.name>  Tue, 24 Nov 2015 16:03:55 -0400+ propellor (2.13.0) unstable; urgency=medium    * RevertableProperty used to be assumed to contain info, but this is

@@ -80,6 +80,8 @@  	& JoeySites.postfixClientRelay (Context "darkstar.kitenet.net") 	& JoeySites.dkimMilter+	& JoeySites.alarmClock "*-*-* 7:30" (User "joey")+		"/usr/bin/timeout 45m /home/joey/bin/goodmorning"  	& imageBuilt "/tmp/img" c MSDOS (grubBooted PC) 		[ partition EXT2 `mountedAt` "/boot"

@@ -1,3 +1,20 @@+propellor (2.14.0) unstable; urgency=medium++  * Add Propellor.Property.PropellorRepo.hasOriginUrl, an explicit way to+    set the git repository url normally implicitly set when using --spin.+  * Added Chroot.noServices property.+  * DiskImage creation automatically uses Chroot.noServices.+  * Removed the (unused) dependency on quickcheck.+  * DebianMirror: Added a DebianMirror type for configuration (API change)+    Thanks, Félix Sipma.+  * DebianMirror: Add RsyncExtra to configuration.+    Thanks, Félix Sipma.+  * Added Git.repoConfigured and Git.repoAcceptsNonFFs properties.+    Thanks, Sean Whitton+  * Added User.hasDesktopGroups property.++ -- Joey Hess <id@joeyh.name>  Tue, 24 Nov 2015 16:03:55 -0400+ propellor (2.13.0) unstable; urgency=medium    * RevertableProperty used to be assumed to contain info, but this is

@@ -13,7 +13,6 @@ 	libghc-ansi-terminal-dev, 	libghc-ifelse-dev, 	libghc-network-dev,-	libghc-quickcheck2-dev, 	libghc-mtl-dev, 	libghc-transformers-dev, 	libghc-exceptions-dev (>= 0.6),@@ -37,7 +36,6 @@ 	libghc-ansi-terminal-dev, 	libghc-ifelse-dev, 	libghc-network-dev,-	libghc-quickcheck2-dev, 	libghc-mtl-dev, 	libghc-transformers-dev, 	libghc-exceptions-dev (>= 0.6),

@@ -1,5 +1,5 @@ Name: propellor-Version: 2.13.0+Version: 2.14.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -35,37 +35,28 @@ Executable propellor   Main-Is: wrapper.hs   GHC-Options: -threaded -Wall -fno-warn-tabs-  Hs-Source-Dirs:  src+  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, QuickCheck, mtl, transformers,-   exceptions (>= 0.6), stm, text--  if (! os(windows))-    Build-Depends: unix+   containers (>= 0.5), network, async, time, mtl, transformers,+   exceptions (>= 0.6), stm, text, unix  Executable propellor-config   Main-Is: config.hs   GHC-Options: -threaded -Wall -fno-warn-tabs-  Hs-Source-Dirs:  src+  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, QuickCheck, mtl, transformers,-   exceptions, stm, text--  if (! os(windows))-    Build-Depends: unix+   containers (>= 0.5), network, async, time, mtl, transformers,+   exceptions (>= 0.6), stm, text, unix  Library   GHC-Options: -Wall -fno-warn-tabs-  Hs-Source-Dirs:  src+  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, QuickCheck, mtl, transformers,-   exceptions, stm, text--  if (! os(windows))-    Build-Depends: unix+   containers (>= 0.5), network, async, time, mtl, transformers,+   exceptions (>= 0.6), stm, text, unix    Exposed-Modules:     Propellor@@ -109,6 +100,7 @@     Propellor.Property.Parted     Propellor.Property.Partition     Propellor.Property.Postfix+    Propellor.Property.PropellorRepo     Propellor.Property.Prosody     Propellor.Property.Reboot     Propellor.Property.Rsync@@ -183,7 +175,6 @@     Utility.ThreadScheduler     Utility.Tmp     Utility.UserInfo-    Utility.QuickCheck     System.Console.Concurrent     System.Console.Concurrent.Internal     System.Process.Concurrent

@@ -31,7 +31,6 @@ 	  Host(..) 	, Property 	, RevertableProperty-	, (<!>) 	, module Propellor.Types 	-- * Config file 	, defaultMain

@@ -77,7 +77,6 @@ 		, "libghc-ansi-terminal-dev" 		, "libghc-ifelse-dev" 		, "libghc-network-dev"-		, "libghc-quickcheck2-dev" 		, "libghc-mtl-dev" 		, "libghc-transformers-dev" 		, "libghc-exceptions-dev"

@@ -8,6 +8,7 @@ 	ChrootBootstrapper(..), 	Debootstrapped(..), 	ChrootTarball(..),+	noServices, 	inChroot, 	-- * Internal use 	provisioned',@@ -27,6 +28,7 @@ import qualified Propellor.Property.File as File import qualified Propellor.Shim as Shim import Propellor.Property.Mount+import Utility.FileMode  import qualified Data.Map as M import Data.List.Utils@@ -246,6 +248,24 @@  chrootDesc :: Chroot -> String -> String chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc++-- | Adding this property to a chroot prevents daemons and other services+-- from being started, which is often something you want to prevent when+-- building a chroot.+--+-- This is accomplished by installing a </usr/sbin/policy-rc.d> 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 = setup <!> teardown+  where+	f = "/usr/sbin/policy-rc.d"+	script = [ "#!/bin/sh", "exit 101" ]+	setup = combineProperties "no services started"+		[ File.hasContent f script+		, File.mode f (combineModes (readModes ++ executeModes))+		]+	teardown = File.notPresent f  -- | Check if propellor is currently running within a chroot. --

@@ -1,10 +1,22 @@ -- | Maintainer: Félix Sipma <felix+propellor@gueux.org>  module Propellor.Property.DebianMirror-	( DebianPriority(..)+	( DebianPriority (..) 	, showPriority 	, mirror-	, mirrorCdn+	, RsyncExtra (..)+	, Method (..)+	, DebianMirror+	, debianMirrorHostName+	, debianMirrorSuites+	, debianMirrorArchitectures+	, debianMirrorSections+	, debianMirrorSourceBool+	, debianMirrorPriorities+	, debianMirrorMethod+	, debianMirrorKeyring+	, debianMirrorRsyncExtra+	, mkDebianMirror 	) where  import Propellor.Base@@ -27,8 +39,88 @@ showPriority Optional  = "optional" showPriority Extra     = "extra" -mirror :: Apt.Url -> FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo-mirror url dir suites archs sections source priorities crontimes = propertyList+data RsyncExtra = Doc | Indices | Tools | Trace+	deriving (Show, Eq)++showRsyncExtra :: RsyncExtra -> String+showRsyncExtra Doc = "doc"+showRsyncExtra Indices = "indices"+showRsyncExtra Tools = "tools"+showRsyncExtra Trace = "trace"++data Method = Ftp | Http | Https | Rsync | MirrorFile++showMethod :: Method -> String+showMethod Ftp = "ftp"+showMethod Http = "http"+showMethod Https = "https"+showMethod Rsync = "rsync"+showMethod MirrorFile = "file"++-- | To get a new DebianMirror and set options, use:+--+-- > mkDebianMirror mymirrordir mycrontimes+-- > 	. debianMirrorHostName "otherhostname"+-- > 	. debianMirrorSourceBool True++data DebianMirror = DebianMirror+	{ _debianMirrorHostName :: HostName+	, _debianMirrorDir :: FilePath+	, _debianMirrorSuites :: [DebianSuite]+	, _debianMirrorArchitectures :: [Architecture]+	, _debianMirrorSections :: [Apt.Section]+	, _debianMirrorSourceBool :: Bool+	, _debianMirrorPriorities :: [DebianPriority]+	, _debianMirrorMethod :: Method+	, _debianMirrorKeyring :: FilePath+	, _debianMirrorRsyncExtra :: [RsyncExtra]+	, _debianMirrorCronTimes :: Cron.Times+	}++mkDebianMirror :: FilePath -> Cron.Times -> DebianMirror+mkDebianMirror dir crontimes = DebianMirror+	{ _debianMirrorHostName = "httpredir.debian.org"+	, _debianMirrorDir = dir+	, _debianMirrorSuites = []+	, _debianMirrorArchitectures = []+	, _debianMirrorSections = []+	, _debianMirrorSourceBool = False+	, _debianMirrorPriorities = []+	, _debianMirrorMethod = Http+	, _debianMirrorKeyring = "/usr/share/keyrings/debian-archive-keyring.gpg"+	, _debianMirrorRsyncExtra = [Trace]+	, _debianMirrorCronTimes = crontimes+	}++debianMirrorHostName :: HostName -> DebianMirror -> DebianMirror+debianMirrorHostName hn m = m { _debianMirrorHostName = hn }++debianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror+debianMirrorSuites s m = m { _debianMirrorSuites = s }++debianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror+debianMirrorArchitectures a m = m { _debianMirrorArchitectures = a }++debianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror+debianMirrorSections s m = m { _debianMirrorSections = s }++debianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror+debianMirrorSourceBool s m = m { _debianMirrorSourceBool = s }++debianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror+debianMirrorPriorities p m = m { _debianMirrorPriorities = p }++debianMirrorMethod :: Method -> DebianMirror -> DebianMirror+debianMirrorMethod me m = m { _debianMirrorMethod = me }++debianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror+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")@@ -36,28 +128,30 @@ 	, File.ownerGroup dir (User "debmirror") (Group "debmirror") 	, check (not . and <$> mapM suitemirrored suites) $ cmdProperty "debmirror" args 		`describe` "debmirror setup"-	, Cron.niceJob ("debmirror_" ++ dir) crontimes (User "debmirror") "/" $+	, Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/" $ 		unwords ("/usr/bin/debmirror" : args) 	]   where+	dir = _debianMirrorDir mirror'+	suites = _debianMirrorSuites mirror' 	suitemirrored suite = doesDirectoryExist $ dir </> "dists" </> Apt.showSuite suite 	architecturearg = intercalate "," 	suitearg = intercalate "," $ map Apt.showSuite suites 	priorityRegex pp = "(" ++ intercalate "|" (map showPriority pp) ++ ")"+	rsyncextraarg [] = "none"+	rsyncextraarg res = intercalate "," $ map showRsyncExtra res 	args = 		[ "--dist" , suitearg-		, "--arch", architecturearg archs-		, "--section", intercalate "," sections-		, "--limit-priority", "\"" ++ priorityRegex priorities ++ "\""+		, "--arch", architecturearg $ _debianMirrorArchitectures mirror'+		, "--section", intercalate "," $ _debianMirrorSections mirror'+		, "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\"" 		] 		++-		(if source then [] else ["--nosource"])+		(if _debianMirrorSourceBool mirror' then [] else ["--nosource"]) 		++-		[ "--host", url-		, "--method", "http"-		, "--keyring", "/usr/share/keyrings/debian-archive-keyring.gpg"+		[ "--host", _debianMirrorHostName mirror'+		, "--method", showMethod $ _debianMirrorMethod mirror'+		, "--rsync-extra", rsyncextraarg $ _debianMirrorRsyncExtra mirror'+		, "--keyring", _debianMirrorKeyring mirror' 		, dir 		]--mirrorCdn :: FilePath -> [DebianSuite] -> [Architecture] -> [Apt.Section] -> Bool -> [DebianPriority] -> Cron.Times -> Property NoInfo-mirrorCdn = mirror "http://httpredir.debian.org/debian"

@@ -1,8 +1,6 @@ -- | Disk image generation.  -- -- This module is designed to be imported unqualified.------ TODO avoid starting services while populating chroot and running final  module Propellor.Property.DiskImage ( 	-- * Partition specification@@ -54,21 +52,30 @@ -- > import Propellor.Property.DiskImage -- -- > let chroot d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d--- > 		& Apt.installed ["linux-image-amd64"]--- >		& ...+-- >	& Apt.installed ["linux-image-amd64"]+-- >	& User.hasPassword (User "root")+-- >	& User.accountFor (User "demo")+-- > 	& User.hasPassword (User "demo")+-- >	& User.hasDesktopGroups (User "demo")+-- > 	& ... -- > in imageBuilt "/srv/images/foo.img" chroot--- >		MSDOS (grubBooted PC)--- >		[ partition EXT2 `mountedAt` "/boot"--- >			`setFlag` BootFlag--- >		, partition EXT4 `mountedAt` "/"--- >			`addFreeSpace` MegaBytes 100--- >			`mountOpt` errorReadonly--- >		, swapPartition (MegaBytes 256)--- >		]+-- >	MSDOS (grubBooted PC)+-- >	[ partition EXT2 `mountedAt` "/boot"+-- >		`setFlag` BootFlag+-- >	, partition EXT4 `mountedAt` "/"+-- >		`addFreeSpace` MegaBytes 100+-- >		`mountOpt` errorReadonly+-- >	, swapPartition (MegaBytes 256)+-- >	] -- -- Note that the disk image file is reused if it already exists, -- to avoid expensive IO to generate a new one. And, it's updated in-place, -- so its contents are undefined during the build process.+--+-- Note that the `Chroot.noServices` property is automatically added to the+-- 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 = imageBuilt' False @@ -93,6 +100,9 @@ 		| 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@@ -227,6 +237,7 @@ 	go top = do 		liftIO $ mountall top 		liftIO $ writefstab top+		liftIO $ allowservices top 		ensureProperty $ final top devs 	 	-- Ordered lexographically by mount point, so / comes before /usr@@ -259,6 +270,8 @@ 		writeFile fstab $ unlines $ new ++ old 	-- Eg "UNCONFIGURED FSTAB FOR BASE SYSTEM" 	unconfigured s = "UNCONFIGURED" `isInfixOf` s++	allowservices top = nukeFile (top ++ "/usr/sbin/policy-rc.d")  noFinalization :: Finalization noFinalization = (doNothing, \_ _ -> doNothing)

@@ -114,3 +114,23 @@ 			]   where 	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+repo `repoConfigured` (key, value) =+	trivial $ userScriptProperty (User "root")+		[ "cd " ++ repo+		, "git config " ++ key ++ " " ++ value+		]+	`describe` ("git repo at " ++ repo+		 ++ " config setting " ++ key ++ " set to " ++ value)++-- | Whether a repo accepts non-fast-forward pushes.+repoAcceptsNonFFs :: FilePath -> RevertableProperty NoInfo+repoAcceptsNonFFs repo = accepts <!> refuses+  where+	accepts = repoConfigured repo ("receive.denyNonFastForwards", "false")+		`describe` desc "accepts"+	refuses = repoConfigured repo ("receive.denyNonFastForwards", "true")+		`describe` desc "rejects"+	desc s = "git repo " ++ repo ++ " " ++ s ++ " non-fast-forward pushes"

@@ -0,0 +1,19 @@+module Propellor.Property.PropellorRepo where++import Propellor.Base+import Propellor.Git++-- | Sets the url to use as the origin of propellor's git repository.+--+-- When propellor --spin is used to update a host, the url is taken from+-- the repository that --spin is run in, and passed to the host. So, you+-- don't need to specifiy this property then. +--+-- 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 u = property ("propellor repo url " ++ u) $ do+	curru <- liftIO getRepoUrl+	if curru == Just u+		then return NoChange+		else makeChange $ setRepoUrl u

@@ -6,6 +6,7 @@ import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File+import qualified Propellor.Property.ConfFile as ConfFile import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.Git as Git@@ -929,3 +930,43 @@ 	munge = replace "public_html" "html" 	conf = "/etc/apache2/mods-available/userdir.conf" +-- Alarm clock: see+-- <http://joeyh.name/blog/entry/a_programmable_alarm_clock_using_systemd/>+--+-- 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`+		[ "[Unit]"+		, "Description=good morning"+		, ""+		, "[Timer]"+		, "Unit=goodmorning.service"+		, "OnCalendar=" ++ oncalendar+		, "WakeSystem=true"+		, "Persistent=false"+		, ""+		, "[Install]"+		, "WantedBy=multi-user.target"+		]+		`onChange` (Systemd.daemonReloaded+			`before` Systemd.restarted "goodmorning.timer")+	, "/etc/systemd/system/goodmorning.service" `File.hasContent`+		[ "[Unit]"+		, "Description=good morning"+		, "RefuseManualStart=true"+		, "RefuseManualStop=true"+		, "ConditionACPower=true"+		, "StopWhenUnneeded=yes"+		, ""+		, "[Service]"+		, "Type=oneshot"+		, "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`+		("Login", "LidSwitchIgnoreInhibited", "no")+	]

@@ -107,6 +107,29 @@   where 	test = not . elem group' . words <$> readProcess "groups" [user] +-- | Gives a user access to the secondary groups, including audio and+-- video, that the OS installer normally gives a desktop user access to.+hasDesktopGroups :: User -> Property NoInfo+hasDesktopGroups user@(User u) = combineProperties desc $ +	map (hasGroup user . Group) desktopgroups+  where+	desc = "user " ++ u ++ " is in standard desktop groups"+	-- This list comes from user-setup's debconf+	-- template named "passwd/user-default-groups"+	desktopgroups = +		[ "audio"+		, "cdrom"+		, "dip"+		, "floppy"+		, "video"+		, "plugdev"+		, "netdev"+		, "scanner"+		, "bluetooth"+		, "debian-tor"+		, "lpadmin"+		]+ -- | Controls whether shadow passwords are enabled or not. shadowConfig :: Bool -> Property NoInfo shadowConfig True = check (not <$> shadowExists) $

@@ -23,10 +23,11 @@ 	, propertyDesc 	, propertyChildren 	, RevertableProperty(..)-	, (<!>)+	, MkRevertableProperty(..) 	, IsProp(..) 	, Combines(..) 	, CombinedType+	, ResultCombiner 	, Propellor(..) 	, LiftPropellor(..) 	, EndAction(..)

@@ -1,53 +0,0 @@-{- QuickCheck with additional instances- -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE TypeSynonymInstances #-}--module Utility.QuickCheck-	( module X-	, module Utility.QuickCheck-	) where--import Test.QuickCheck as X-import Data.Time.Clock.POSIX-import System.Posix.Types-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Applicative-import Prelude--instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where-	arbitrary = M.fromList <$> arbitrary--instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where-	arbitrary = S.fromList <$> arbitrary--{- Times before the epoch are excluded. -}-instance Arbitrary POSIXTime where-	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral--instance Arbitrary EpochTime where-	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral--{- Pids are never negative, or 0. -}-instance Arbitrary ProcessID where-	arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)--{- Inodes are never negative. -}-instance Arbitrary FileID where-	arbitrary = nonNegative arbitrarySizedIntegral--{- File sizes are never negative. -}-instance Arbitrary FileOffset where-	arbitrary = nonNegative arbitrarySizedIntegral--nonNegative :: (Num a, Ord a) => Gen a -> Gen a-nonNegative g = g `suchThat` (>= 0)--positive :: (Num a, Ord a) => Gen a -> Gen a-positive g = g `suchThat` (> 0)

@@ -23,12 +23,10 @@ 	toRecurrance, 	toSchedule, 	parseSchedule,-	prop_schedule_roundtrips, 	prop_past_sane, ) where  import Utility.Data-import Utility.QuickCheck import Utility.PartialPrelude import Utility.Misc @@ -38,6 +36,7 @@ import Data.Time.Calendar import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate+import Data.Time.Format () import Data.Tuple.Utils import Data.Char import Control.Applicative@@ -336,41 +335,6 @@ 	(rws, tws) = separate (== "at") (words s) 	recurrance = unwords rws 	scheduledtime = unwords tws--instance Arbitrary Schedule where-	arbitrary = Schedule <$> arbitrary <*> arbitrary--instance Arbitrary ScheduledTime where-	arbitrary = oneof-		[ pure AnyTime-		, SpecificTime -			<$> choose (0, 23)-			<*> choose (1, 59)-		]--instance Arbitrary Recurrance where-	arbitrary = oneof-		[ pure Daily-		, Weekly <$> arbday-		, Monthly <$> arbday-		, Yearly <$> arbday-		, Divisible-			<$> positive arbitrary-			<*> oneof -- no nested Divisibles-				[ pure Daily-				, Weekly <$> arbday-				, Monthly <$> arbday-				, Yearly <$> arbday-				]-		]-	  where-		arbday = oneof-			[ Just <$> nonNegative arbitrary-			, pure Nothing-			]--prop_schedule_roundtrips :: Schedule -> Bool-prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s  prop_past_sane :: Bool prop_past_sane = and