From 2ba4b6fb3d29b2b65aa60f4bd591ed8cf6a63e27 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 Feb 2017 15:27:22 -0400 Subject: Added ConfigurableValue type class * Added ConfigurableValue type class, for values that can be used in a config file, or to otherwise configure a program. * The val function converts such values to String. This was motivated by the bug caused by type Port = Int changing to newtype Port = Port Int deriving Show After that change, some things that used show port to generate config files were broken. By using the ConfigurableValue type class instead, such breakage can be prevented. --- src/Propellor/Property/Docker.hs | 4 +-- src/Propellor/Property/File.hs | 6 ++++ src/Propellor/Property/Parted.hs | 72 ++++++++++++++++++++-------------------- src/Propellor/Property/Ssh.hs | 6 ++-- 4 files changed, 47 insertions(+), 41 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 0bfcc781..68fa2926 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -660,10 +660,10 @@ listImages :: IO [ImageUID] listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"] runProp :: String -> RunParam -> Property (HasInfo + Linux) -runProp field val = tightenTargets $ pureInfoProperty (param) $ +runProp field v = tightenTargets $ pureInfoProperty (param) $ mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] } where - param = field++"="++val + param = field++"="++v genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux) genProp field mkval = tightenTargets $ pureInfoProperty field $ diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 869fa48b..459fe2c7 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -20,6 +20,12 @@ f `hasContent` newcontent = fileProperty (\_oldcontent -> newcontent) f -- | Ensures that a line is present in a file, adding it to the end if not. +-- +-- For example: +-- +-- > & "/etc/default/daemon.conf" `File.containsLine` ("cachesize = " ++ val 1024) +-- +-- The above example uses `val` to serialize a `ConfigurableValue` containsLine :: FilePath -> Line -> Property UnixLike f `containsLine` l = f `containsLines` [l] diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index 40af3357..4d8924a5 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -30,14 +30,14 @@ import Data.Char import System.Posix.Files class PartedVal a where - val :: a -> String + pval :: a -> String -- | Types of partition tables supported by parted. data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN deriving (Show) instance PartedVal TableType where - val = map toLower . show + pval = map toLower . show -- | A disk's partition table. data PartTable = PartTable TableType [Partition] @@ -82,9 +82,9 @@ data PartType = Primary | Logical | Extended deriving (Show) instance PartedVal PartType where - val Primary = "primary" - val Logical = "logical" - val Extended = "extended" + pval Primary = "primary" + pval Logical = "logical" + pval Extended = "extended" -- | All partition sizing is done in megabytes, so that parted can -- automatically lay out the partitions. @@ -94,7 +94,7 @@ newtype PartSize = MegaBytes Integer deriving (Show) instance PartedVal PartSize where - val (MegaBytes n) + pval (MegaBytes n) | n > 0 = show n ++ "MB" -- parted can't make partitions smaller than 1MB; -- avoid failure in edge cases @@ -119,33 +119,33 @@ data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag deriving (Show) instance PartedVal PartFlag where - val BootFlag = "boot" - val RootFlag = "root" - val SwapFlag = "swap" - val HiddenFlag = "hidden" - val RaidFlag = "raid" - val LvmFlag = "lvm" - val LbaFlag = "lba" - val LegacyBootFlag = "legacy_boot" - val IrstFlag = "irst" - val EspFlag = "esp" - val PaloFlag = "palo" + pval BootFlag = "boot" + pval RootFlag = "root" + pval SwapFlag = "swap" + pval HiddenFlag = "hidden" + pval RaidFlag = "raid" + pval LvmFlag = "lvm" + pval LbaFlag = "lba" + pval LegacyBootFlag = "legacy_boot" + pval IrstFlag = "irst" + pval EspFlag = "esp" + pval PaloFlag = "palo" instance PartedVal Bool where - val True = "on" - val False = "off" + pval True = "on" + pval False = "off" instance PartedVal Partition.Fs where - val Partition.EXT2 = "ext2" - val Partition.EXT3 = "ext3" - val Partition.EXT4 = "ext4" - val Partition.BTRFS = "btrfs" - val Partition.REISERFS = "reiserfs" - val Partition.XFS = "xfs" - val Partition.FAT = "fat" - val Partition.VFAT = "vfat" - val Partition.NTFS = "ntfs" - val Partition.LinuxSwap = "linux-swap" + pval Partition.EXT2 = "ext2" + pval Partition.EXT3 = "ext3" + pval Partition.EXT4 = "ext4" + pval Partition.BTRFS = "btrfs" + pval Partition.REISERFS = "reiserfs" + pval Partition.XFS = "xfs" + pval Partition.FAT = "fat" + pval Partition.VFAT = "vfat" + pval Partition.NTFS = "ntfs" + pval Partition.LinuxSwap = "linux-swap" data Eep = YesReallyDeleteDiskContents @@ -168,19 +168,19 @@ partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts [] format (p, dev) = Partition.formatted' (partMkFsOpts p) Partition.YesReallyFormatPartition (partFs p) dev - mklabel = ["mklabel", val tabletype] + mklabel = ["mklabel", pval tabletype] mkflag partnum (f, b) = [ "set" , show partnum - , val f - , val b + , pval f + , pval b ] mkpart partnum offset p = [ "mkpart" - , val (partType p) - , val (partFs p) - , val offset - , val (offset <> partSize p) + , pval (partType p) + , pval (partFs p) + , pval offset + , pval (offset <> partSize p) ] ++ case partName p of Just n -> ["name", show partnum, n] Nothing -> [] diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index bce522f6..322cddef 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -69,11 +69,11 @@ setSshdConfigBool :: ConfigKeyword -> Bool -> Property DebianLike setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed) setSshdConfig :: ConfigKeyword -> String -> Property DebianLike -setSshdConfig setting val = File.fileProperty desc f sshdConfig +setSshdConfig setting v = File.fileProperty desc f sshdConfig `onChange` restarted where - desc = unwords [ "ssh config:", setting, val ] - cfgline = setting ++ " " ++ val + desc = unwords [ "ssh config:", setting, v ] + cfgline = setting ++ " " ++ v wantedline s | s == cfgline = True | (setting ++ " ") `isPrefixOf` s = False -- cgit v1.2.3 From 55ed8e8743e861e2230e40670a56034353cf4e32 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 Feb 2017 16:11:38 -0400 Subject: use ConfigurableValue where applicable * Removed fromPort (use val instead). (API change) * Removed several Show instances that were only used for generating configuration, replacing with ConfigurableValue instances. (API change) It's somewhat annoying that IsInfo requires a Show instance. That's needed to be able to display Info in ghci, but some non-derived Show instances had to be kept to support that. --- debian/changelog | 5 ++++- src/Propellor/Property/Apache.hs | 10 +++++----- src/Propellor/Property/Apt/PPA.hs | 27 +++++++++++++-------------- src/Propellor/Property/Docker.hs | 2 +- src/Propellor/Property/Firewall.hs | 6 +++--- src/Propellor/Property/FreeBSD/Poudriere.hs | 12 +++++++----- src/Propellor/Property/Logcheck.hs | 12 ++++++------ src/Propellor/Property/Munin.hs | 2 +- src/Propellor/Property/OpenId.hs | 2 +- src/Propellor/Property/Sbuild.hs | 28 ++++++++++++++-------------- src/Propellor/Property/Ssh.hs | 2 +- src/Propellor/Property/Systemd.hs | 2 +- src/Propellor/Property/Tor.hs | 4 ++-- src/Propellor/Types/OS.hs | 16 ++++++++++------ src/Propellor/Types/ZFS.hs | 7 ++++++- 15 files changed, 75 insertions(+), 62 deletions(-) (limited to 'src/Propellor/Property') diff --git a/debian/changelog b/debian/changelog index bbcf7bdc..e3009188 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,11 @@ -propellor (3.3.2) UNRELEASED; urgency=medium +propellor (3.4.0) UNRELEASED; urgency=medium * Added ConfigurableValue type class, for values that can be used in a config file, or to otherwise configure a program. * The val function converts such values to String. + * Removed fromPort (use val instead). (API change) + * Removed several Show instances that were only used for generating + configuration, replacing with ConfigurableValue instances. (API change) -- Joey Hess Sun, 26 Feb 2017 15:15:33 -0400 diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs index f321143f..d912acc1 100644 --- a/src/Propellor/Property/Apache.hs +++ b/src/Propellor/Property/Apache.hs @@ -72,7 +72,7 @@ listenPorts :: [Port] -> Property DebianLike listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps `onChange` restarted where - portline port = "Listen " ++ fromPort port + portline port = "Listen " ++ val port -- This is a list of config files because different versions of apache -- use different filenames. Propellor simply writes them all. @@ -135,8 +135,8 @@ virtualHost domain port docroot = virtualHost' domain port docroot [] -- | Like `virtualHost` but with additional config lines added. virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike virtualHost' domain port docroot addedcfg = siteEnabled domain $ - [ "" - , "ServerName " ++ domain ++ ":" ++ fromPort port + [ "" + , "ServerName " ++ domain ++ ":" ++ val port , "DocumentRoot " ++ docroot , "ErrorLog /var/log/apache2/error.log" , "LogLevel warn" @@ -202,8 +202,8 @@ httpsVirtualHost' domain docroot letos addedcfg = setup teardown ] sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf" vhost p ls = - [ "" - , "ServerName " ++ domain ++ ":" ++ fromPort p + [ "" + , "ServerName " ++ domain ++ ":" ++ val p , "DocumentRoot " ++ docroot , "ErrorLog /var/log/apache2/error.log" , "LogLevel warn" diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs index 49fa9fa7..346125ff 100644 --- a/src/Propellor/Property/Apt/PPA.hs +++ b/src/Propellor/Property/Apt/PPA.hs @@ -25,8 +25,8 @@ data PPA = PPA , ppaArchive :: String -- ^ The name of the archive. } deriving (Eq, Ord) -instance Show PPA where - show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p] +instance ConfigurableValue PPA where + val p = concat ["ppa:", ppaAccount p, "/", ppaArchive p] instance IsString PPA where -- | Parse strings like "ppa:zfs-native/stable" into a PPA. @@ -40,9 +40,9 @@ instance IsString PPA where -- | Adds a PPA to the local system repositories. addPpa :: PPA -> Property DebianLike addPpa p = - cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv + cmdPropertyEnv "apt-add-repository" ["--yes", val p] Apt.noninteractiveEnv `assume` MadeChange - `describe` ("Added PPA " ++ (show p)) + `describe` ("Added PPA " ++ (val p)) `requires` installed -- | A repository key ID to be downloaded with apt-key. @@ -52,14 +52,11 @@ data AptKeyId = AptKeyId , 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]) + `describe` (unwords ["Add third-party Apt key", desc keyId]) where akcmd = tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId] @@ -72,10 +69,12 @@ addKeyId keyId = nkid = take 8 (akiId keyId) in (isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"] + desc k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k] -- | 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. +-- sources.list. It's also an instance of both 'ConfigurableValue' +-- 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. @@ -85,8 +84,8 @@ data AptSource = AptSource , 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] +instance ConfigurableValue AptSource where + val asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc] instance IsString AptSource where fromString s = @@ -103,7 +102,7 @@ addRepository :: AptRepository -> Property DebianLike addRepository (AptRepositoryPPA p) = addPpa p addRepository (AptRepositorySource src) = check repoExists addSrc - `describe` unwords ["Adding APT repository", show src] + `describe` unwords ["Adding APT repository", val src] `requires` installed where allSourceLines = @@ -112,4 +111,4 @@ addRepository (AptRepositorySource src) = . filter (not . isPrefixOf "#") . filter (/= "") . lines <$> allSourceLines repoExists = isInfixOf [src] <$> activeSources - addSrc = cmdProperty "apt-add-source" [show src] + addSrc = cmdProperty "apt-add-source" [val src] diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 68fa2926..d2b2ee35 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -323,7 +323,7 @@ class Publishable p where toPublish :: p -> String instance Publishable (Bound Port) where - toPublish p = fromPort (hostSide p) ++ ":" ++ fromPort (containerSide p) + toPublish p = val (hostSide p) ++ ":" ++ val (containerSide p) -- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort instance Publishable String where diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index 3ea19ffa..ce08cc06 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -51,9 +51,9 @@ toIpTable r = map Param $ toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] toIpTableArg (Proto proto) = ["-p", map toLower $ show proto] -toIpTableArg (DPort port) = ["--dport", fromPort port] +toIpTableArg (DPort port) = ["--dport", val port] toIpTableArg (DPortRange (portf, portt)) = - ["--dport", fromPort portf ++ ":" ++ fromPort portt] + ["--dport", val portf ++ ":" ++ val portt] toIpTableArg (InIFace iface) = ["-i", iface] toIpTableArg (OutIFace iface) = ["-o", iface] toIpTableArg (Ctstate states) = @@ -100,7 +100,7 @@ toIpTableArg (NotDestination ipwm) = ] toIpTableArg (NatDestination ip mport) = [ "--to-destination" - , fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport + , fromIPAddr ip ++ maybe "" (\p -> ":" ++ val p) mport ] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs index 58477468..e6ddea16 100644 --- a/src/Propellor/Property/FreeBSD/Poudriere.hs +++ b/src/Propellor/Property/FreeBSD/Poudriere.hs @@ -19,6 +19,7 @@ poudriereConfigPath = "/usr/local/etc/poudriere.conf" newtype PoudriereConfigured = PoudriereConfigured String deriving (Typeable, Monoid, Show) + instance IsInfo PoudriereConfigured where propagateInfo _ = False @@ -68,7 +69,7 @@ jail j@(Jail name version arch) = tightenTargets $ nx <- liftIO $ not <$> jailExists j return $ c && nx - (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", show arch, "-v", show version] + (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", val arch, "-v", val version] createJail = cmdProperty cmd args in check chk createJail @@ -101,9 +102,10 @@ data PoudriereZFS = PoudriereZFS ZFS.ZFS ZFS.ZFSProperties data Jail = Jail String FBSDVersion PoudriereArch data PoudriereArch = I386 | AMD64 deriving (Eq) -instance Show PoudriereArch where - show I386 = "i386" - show AMD64 = "amd64" + +instance ConfigurableValue PoudriereArch where + val I386 = "i386" + val AMD64 = "amd64" fromArchitecture :: Architecture -> PoudriereArch fromArchitecture X86_64 = AMD64 @@ -127,7 +129,7 @@ instance ToShellConfigLines PoudriereZFS where toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool pool) dataset) _) = [ ("NO_ZFS", "no") , ("ZPOOL", pool) - , ("ZROOTFS", show dataset) + , ("ZROOTFS", val dataset) ] type ConfigLine = String diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs index ced9fce2..8eaf56fd 100644 --- a/src/Propellor/Property/Logcheck.hs +++ b/src/Propellor/Property/Logcheck.hs @@ -16,21 +16,21 @@ import qualified Propellor.Property.File as File data ReportLevel = Workstation | Server | Paranoid type Service = String -instance Show ReportLevel where - show Workstation = "workstation" - show Server = "server" - show Paranoid = "paranoid" +instance ConfigurableValue ReportLevel where + val Workstation = "workstation" + val Server = "server" + val Paranoid = "paranoid" -- The common prefix used by default in syslog lines. defaultPrefix :: String defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ " ignoreFilePath :: ReportLevel -> Service -> FilePath -ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) n +ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (val t) n ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls - `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")") + `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ val t ++ ")") installed :: Property DebianLike installed = Apt.installed ["logcheck"] diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs index dd74d91b..13c72f3a 100644 --- a/src/Propellor/Property/Munin.hs +++ b/src/Propellor/Property/Munin.hs @@ -47,7 +47,7 @@ hostListFragment' hs os = concatMap muninHost hs muninHost :: Host -> [String] muninHost h = [ "[" ++ (hostName h) ++ "]" , " address " ++ maybe (hostName h) (fromIPAddr . fst) (hOverride h) - ] ++ (maybe [] (\x -> [" port " ++ (fromPort $ snd x)]) (hOverride h)) ++ [""] + ] ++ (maybe [] (\x -> [" port " ++ (val $ snd x)]) (hOverride h)) ++ [""] hOverride :: Host -> Maybe (IPAddr, Port) hOverride h = lookup (hostName h) os diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs index 0abf38a6..00daa57d 100644 --- a/src/Propellor/Property/OpenId.hs +++ b/src/Propellor/Property/OpenId.hs @@ -28,7 +28,7 @@ providerFor users hn mp = propertyList desc $ props where baseurl = hn ++ case mp of Nothing -> "" - Just p -> ':' : fromPort p + Just p -> ':' : val p url = "http://"++baseurl++"/simpleid" desc = "openid provider " ++ url setbaseurl l diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index db5982cd..aaa83e6f 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -111,8 +111,8 @@ type Suite = String -- the same suite and the same architecture, so neither do we data SbuildSchroot = SbuildSchroot Suite Architecture -instance Show SbuildSchroot where - show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch +instance ConfigurableValue SbuildSchroot where + val (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch -- | Whether an sbuild schroot should use ccache during builds -- @@ -151,7 +151,7 @@ built s@(SbuildSchroot suite arch) mirror cc = where go :: Property DebianLike go = check (unpopulated (schrootRoot s) <||> ispartial) $ - property' ("built sbuild schroot for " ++ show s) make + property' ("built sbuild schroot for " ++ val s) make make w = do de <- liftIO standardPathEnv let params = Param <$> @@ -170,18 +170,18 @@ built s@(SbuildSchroot suite arch) mirror cc = -- TODO we should kill any sessions still using the chroot -- before destroying it (as suggested by sbuild-destroychroot) deleted = check (not <$> unpopulated (schrootRoot s)) $ - property ("no sbuild schroot for " ++ show s) $ do + property ("no sbuild schroot for " ++ val s) $ do liftIO $ removeChroot $ schrootRoot s liftIO $ nukeFile - ("/etc/sbuild/chroot" show s ++ "-sbuild") + ("/etc/sbuild/chroot" val s ++ "-sbuild") makeChange $ nukeFile (schrootConf s) enhancedConf = - combineProperties ("enhanced schroot conf for " ++ show s) $ props + combineProperties ("enhanced schroot conf for " ++ val s) $ props & aliasesLine -- enable ccache and eatmydata for speed & ConfFile.containsIniSetting (schrootConf s) - ( show s ++ "-sbuild" + ( val s ++ "-sbuild" , "command-prefix" , intercalate "," commandPrefix ) @@ -196,7 +196,7 @@ built s@(SbuildSchroot suite arch) mirror cc = then ensureProperty w $ ConfFile.containsIniSetting (schrootConf s) - ( show s ++ "-sbuild" + ( val s ++ "-sbuild" , "aliases" , aliases ) @@ -263,7 +263,7 @@ updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ updated :: SbuildSchroot -> Property DebianLike updated s@(SbuildSchroot suite arch) = check (doesDirectoryExist (schrootRoot s)) $ go - `describe` ("updated schroot for " ++ show s) + `describe` ("updated schroot for " ++ val s) `requires` installed where go :: Property DebianLike @@ -283,13 +283,13 @@ updated s@(SbuildSchroot suite arch) = -- given suite and architecture, so we don't need the suffix to be random. fixConfFile :: SbuildSchroot -> Property UnixLike fixConfFile s@(SbuildSchroot suite arch) = - property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do + property' ("schroot for " ++ val s ++ " config file fixed") $ \w -> do confs <- liftIO $ dirContents dir let old = concat $ filter (tempPrefix `isPrefixOf`) confs liftIO $ moveFile old new liftIO $ moveFile - ("/etc/sbuild/chroot" show s ++ "-propellor") - ("/etc/sbuild/chroot" show s ++ "-sbuild") + ("/etc/sbuild/chroot" val s ++ "-propellor") + ("/etc/sbuild/chroot" val s ++ "-sbuild") ensureProperty w $ File.fileProperty "replace dummy suffix" (map munge) new where @@ -361,10 +361,10 @@ piupartsConf s@(SbuildSchroot _ arch) = orig = "/etc/schroot/sbuild" dir = "/etc/schroot/piuparts" - sec = show s ++ "-piuparts" + sec = val s ++ "-piuparts" f = schrootPiupartsConf s munge = replace "-sbuild]" "-piuparts]" - desc = "piuparts schroot conf for " ++ show s + desc = "piuparts schroot conf for " ++ val s -- normally the piuparts schroot conf has no aliases, but we have to add -- one, for dgit compatibility, if this is the default sid chroot diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 322cddef..828601b8 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -120,7 +120,7 @@ dotFile f user = do listenPort :: Port -> RevertableProperty DebianLike DebianLike listenPort port = enable disable where - portline = "Port " ++ fromPort port + portline = "Port " ++ val port enable = sshdConfig `File.containsLine` portline `describe` ("ssh listening on " ++ portline) `onChange` restarted diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 78529f73..e1e20974 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -421,7 +421,7 @@ class Publishable a where toPublish :: a -> String instance Publishable Port where - toPublish port = fromPort port + toPublish port = val port instance Publishable (Bound Port) where toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v) diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 72bd45f5..24d5b687 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -128,7 +128,7 @@ hiddenService hn port = hiddenService' hn [port] hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike hiddenService' hn ports = ConfFile.adjustSection - (unwords ["hidden service", hn, "available on ports", intercalate "," (map fromPort ports')]) + (unwords ["hidden service", hn, "available on ports", intercalate "," (map val ports')]) (== oniondir) (not . isPrefixOf "HiddenServicePort") (const (oniondir : onionports)) @@ -139,7 +139,7 @@ hiddenService' hn ports = ConfFile.adjustSection oniondir = unwords ["HiddenServiceDir", varLib hn] onionports = map onionport ports' ports' = sort ports - onionport port = unwords ["HiddenServicePort", fromPort port, "127.0.0.1:" ++ fromPort port] + onionport port = unwords ["HiddenServicePort", val port, "127.0.0.1:" ++ val port] -- | Same as `hiddenService` but also causes propellor to display -- the onion address of the hidden service. diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 696c36b0..8d7f1ba3 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -18,10 +18,11 @@ module Propellor.Types.OS ( Group(..), userGroup, Port(..), - fromPort, systemToTargetOS, ) where +import Propellor.Types.ConfigurableValue + import Network.BSD (HostName) import Data.Typeable import Data.String @@ -75,10 +76,13 @@ instance IsString FBSDVersion where fromString "9.3-RELEASE" = FBSD093 fromString _ = error "Invalid FreeBSD release" +instance ConfigurableValue FBSDVersion where + val FBSD101 = "10.1-RELEASE" + val FBSD102 = "10.2-RELEASE" + val FBSD093 = "9.3-RELEASE" + instance Show FBSDVersion where - show FBSD101 = "10.1-RELEASE" - show FBSD102 = "10.2-RELEASE" - show FBSD093 = "9.3-RELEASE" + show = val isStable :: DebianSuite -> Bool isStable (Stable _) = True @@ -148,5 +152,5 @@ userGroup (User u) = Group u newtype Port = Port Int deriving (Eq, Ord, Show) -fromPort :: Port -> String -fromPort (Port p) = show p +instance ConfigurableValue Port where + val (Port p) = show p diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs index 3ce4b22c..42ff74ec 100644 --- a/src/Propellor/Types/ZFS.hs +++ b/src/Propellor/Types/ZFS.hs @@ -6,6 +6,8 @@ module Propellor.Types.ZFS where +import Propellor.Types.ConfigurableValue + import Data.String import qualified Data.Set as Set import qualified Data.String.Utils as SU @@ -37,8 +39,11 @@ fromPropertyList props = zfsName :: ZFS -> String zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset] +instance ConfigurableValue ZDataset where + val (ZDataset paths) = intercalate "/" paths + instance Show ZDataset where - show (ZDataset paths) = intercalate "/" paths + show = val instance IsString ZDataset where fromString s = ZDataset $ SU.split "/" s -- cgit v1.2.3 From 663fb4cc4545dc25e062fb0bc4af933402923506 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 Feb 2017 16:36:51 -0400 Subject: fix minor bug in pval (MegaBytes 0) --- src/Propellor/Property/Parted.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index 4d8924a5..f7ac379f 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -95,10 +95,10 @@ newtype PartSize = MegaBytes Integer instance PartedVal PartSize where pval (MegaBytes n) - | n > 0 = show n ++ "MB" + | n > 0 = val n ++ "MB" -- parted can't make partitions smaller than 1MB; -- avoid failure in edge cases - | otherwise = show "1MB" + | otherwise = "1MB" -- | Rounds up to the nearest MegaByte. toPartSize :: ByteSize -> PartSize -- cgit v1.2.3 From db4121edeeba2899926333df46308ca0baf45b71 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 Feb 2017 16:40:34 -0400 Subject: use val instead of show --- src/Propellor/Property/Apt.hs | 2 +- src/Propellor/Property/Attic.hs | 10 +++++----- src/Propellor/Property/Borg.hs | 10 +++++----- src/Propellor/Property/Ccache.hs | 2 +- src/Propellor/Property/Dns.hs | 12 ++++++------ src/Propellor/Property/Grub.hs | 2 +- src/Propellor/Property/Obnam.hs | 2 +- src/Propellor/Property/SiteSpecific/JoeySites.hs | 6 +++--- src/Propellor/Property/Unbound.hs | 4 ++-- src/Propellor/Types/ConfigurableValue.hs | 11 +++++++++++ 10 files changed, 36 insertions(+), 25 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 9a55c367..4490aa95 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -452,7 +452,7 @@ suitePinBlock p suite pin = [ "Explanation: This file added by propellor" , "Package: " ++ p , "Pin: release " ++ suitePin suite - , "Pin-Priority: " ++ show pin + , "Pin-Priority: " ++ val pin ] dpkgStatus :: FilePath diff --git a/src/Propellor/Property/Attic.hs b/src/Propellor/Property/Attic.hs index 4415f8c0..3059a04b 100644 --- a/src/Propellor/Property/Attic.hs +++ b/src/Propellor/Property/Attic.hs @@ -131,11 +131,11 @@ backup' dir backupdir crontimes extraargs kp = cronjob -- passed to the `backup` property, they will run attic prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> AtticParam -keepParam (KeepHours n) = "--keep-hourly=" ++ show n -keepParam (KeepDays n) = "--keep-daily=" ++ show n -keepParam (KeepWeeks n) = "--keep-daily=" ++ show n -keepParam (KeepMonths n) = "--keep-monthly=" ++ show n -keepParam (KeepYears n) = "--keep-yearly=" ++ show n +keepParam (KeepHours n) = "--keep-hourly=" ++ val n +keepParam (KeepDays n) = "--keep-daily=" ++ val n +keepParam (KeepWeeks n) = "--keep-daily=" ++ val n +keepParam (KeepMonths n) = "--keep-monthly=" ++ val n +keepParam (KeepYears n) = "--keep-yearly=" ++ val n -- | Policy for backup generations to keep. For example, KeepDays 30 will -- keep the latest backup for each day when a backup was made, and keep the diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs index 16030562..7ed39794 100644 --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -137,11 +137,11 @@ backup' dir backupdir crontimes extraargs kp = cronjob -- passed to the `backup` property, they will run borg prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> BorgParam -keepParam (KeepHours n) = "--keep-hourly=" ++ show n -keepParam (KeepDays n) = "--keep-daily=" ++ show n -keepParam (KeepWeeks n) = "--keep-daily=" ++ show n -keepParam (KeepMonths n) = "--keep-monthly=" ++ show n -keepParam (KeepYears n) = "--keep-yearly=" ++ show n +keepParam (KeepHours n) = "--keep-hourly=" ++ val n +keepParam (KeepDays n) = "--keep-daily=" ++ val n +keepParam (KeepWeeks n) = "--keep-daily=" ++ val n +keepParam (KeepMonths n) = "--keep-monthly=" ++ val n +keepParam (KeepYears n) = "--keep-yearly=" ++ val n -- | Policy for backup generations to keep. For example, KeepDays 30 will -- keep the latest backup for each day when a backup was made, and keep the diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index c0b8d539..a2bef117 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -76,7 +76,7 @@ limitToParams NoLimit = [] limitToParams (MaxSize s) = case maxSizeParam s of Just param -> [Right param] Nothing -> [Left $ "unable to parse data size " ++ s] -limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ show f] +limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ val f] limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2 -- | Configures a ccache in /var/cache for a group diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 2e2710a6..3fcffed3 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -307,17 +307,17 @@ rValue :: Record -> Maybe String rValue (Address (IPv4 addr)) = Just addr rValue (Address (IPv6 addr)) = Just addr rValue (CNAME d) = Just $ dValue d -rValue (MX pri d) = Just $ show pri ++ " " ++ dValue d +rValue (MX pri d) = Just $ val pri ++ " " ++ dValue d rValue (NS d) = Just $ dValue d rValue (SRV priority weight port target) = Just $ unwords - [ show priority - , show weight - , show port + [ val priority + , val weight + , val port , dValue target ] rValue (SSHFP x y s) = Just $ unwords - [ show x - , show y + [ val x + , val y , s ] rValue (INCLUDE f) = Just f diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs index a03fc5a0..9dd5e8e1 100644 --- a/src/Propellor/Property/Grub.hs +++ b/src/Propellor/Property/Grub.hs @@ -69,7 +69,7 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc $ props & File.dirExists "/boot/grub" & "/boot/grub/menu.lst" `File.hasContent` [ "default 1" - , "timeout " ++ show timeout + , "timeout " ++ val timeout , "" , "title grub-xen shim" , "root (" ++ rootdev ++ ")" diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index 5bf3ff06..66d3c08d 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -150,7 +150,7 @@ keepParam ps = "--keep=" ++ intercalate "," (map go ps) go (KeepWeeks n) = mk n 'w' go (KeepMonths n) = mk n 'm' go (KeepYears n) = mk n 'y' - mk n c = show n ++ [c] + mk n c = val n ++ [c] isKeepParam :: ObnamParam -> Bool isKeepParam p = "--keep=" `isPrefixOf` p diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 445bce07..c14d1707 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -314,9 +314,9 @@ apacheSite hn middle = Apache.siteEnabled hn $ apachecfg hn middle apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile apachecfg hn middle = - [ "" + [ "" , " ServerAdmin grue@joeyh.name" - , " ServerName "++hn++":"++show port + , " ServerName "++hn++":" ++ val port ] ++ middle ++ [ "" @@ -329,7 +329,7 @@ apachecfg hn middle = , "" ] where - port = 80 :: Int + port = Port 80 gitAnnexDistributor :: Property (HasInfo + DebianLike) gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 23a5b30d..9eb8f8c9 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -133,10 +133,10 @@ genAddress dom ttl addr = case addr of IPv6 _ -> genAddress' "AAAA" dom ttl addr genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String -genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr +genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> val ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr genMX :: BindDomain -> Int -> BindDomain -> String -genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest +genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ val priority ++ " " ++ dValue dest genPTR :: BindDomain -> ReverseIP -> String genPTR dom revip = revip ++ ". " ++ "PTR" ++ " " ++ dValue dom diff --git a/src/Propellor/Types/ConfigurableValue.hs b/src/Propellor/Types/ConfigurableValue.hs index 10a608f8..6235bee9 100644 --- a/src/Propellor/Types/ConfigurableValue.hs +++ b/src/Propellor/Types/ConfigurableValue.hs @@ -2,6 +2,8 @@ module Propellor.Types.ConfigurableValue where +import Data.Word + -- | A value that can be used in a configuration file, or otherwise used to -- configure a program. -- @@ -30,3 +32,12 @@ instance ConfigurableValue Float where instance ConfigurableValue Double where val = show + +instance ConfigurableValue Word8 where + val = show + +instance ConfigurableValue Word16 where + val = show + +instance ConfigurableValue Word32 where + val = show -- cgit v1.2.3 From ae7359a0b0cf58ec83a7ea80fc51d4e6f5be72bf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 Feb 2017 16:45:33 -0400 Subject: convert from* in Firewall to val --- src/Propellor/Property/Firewall.hs | 71 +++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 36 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index ce08cc06..ab667da3 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -15,7 +15,6 @@ module Propellor.Property.Firewall ( TCPFlag(..), Frequency(..), IPWithMask(..), - fromIPWithMask ) where import Data.Monoid @@ -44,9 +43,9 @@ rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable toIpTable :: Rule -> [CommandParam] toIpTable r = map Param $ - fromChain (ruleChain r) : + val (ruleChain r) : toIpTableArg (ruleRules r) ++ - ["-t", fromTable (ruleTable r), "-j", fromTarget (ruleTarget r)] + ["-t", val (ruleTable r), "-j", val (ruleTarget r)] toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] @@ -64,12 +63,12 @@ toIpTableArg (Ctstate states) = toIpTableArg (ICMPType i) = [ "-m" , "icmp" - , "--icmp-type", fromICMPTypeMatch i + , "--icmp-type", val i ] toIpTableArg (RateLimit f) = [ "-m" , "limit" - , "--limit", fromFrequency f + , "--limit", val f ] toIpTableArg (TCPFlags m c) = [ "-m" @@ -87,16 +86,16 @@ toIpTableArg (GroupOwner (Group g)) = ] toIpTableArg (Source ipwm) = [ "-s" - , intercalate "," (map fromIPWithMask ipwm) + , intercalate "," (map val ipwm) ] toIpTableArg (Destination ipwm) = [ "-d" - , intercalate "," (map fromIPWithMask ipwm) + , intercalate "," (map val ipwm) ] toIpTableArg (NotDestination ipwm) = [ "!" , "-d" - , intercalate "," (map fromIPWithMask ipwm) + , intercalate "," (map val ipwm) ] toIpTableArg (NatDestination ip mport) = [ "--to-destination" @@ -107,10 +106,10 @@ toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int deriving (Eq, Show) -fromIPWithMask :: IPWithMask -> String -fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip -fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm -fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m +instance ConfigurableValue IPWithMask where + val (IPWithNoMask ip) = fromIPAddr ip + val (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm + val (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m data Rule = Rule { ruleChain :: Chain @@ -122,33 +121,33 @@ data Rule = Rule data Table = Filter | Nat | Mangle | Raw | Security deriving (Eq, Show) -fromTable :: Table -> String -fromTable Filter = "filter" -fromTable Nat = "nat" -fromTable Mangle = "mangle" -fromTable Raw = "raw" -fromTable Security = "security" +instance ConfigurableValue Table where + val Filter = "filter" + val Nat = "nat" + val Mangle = "mangle" + val Raw = "raw" + val Security = "security" data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String deriving (Eq, Show) -fromTarget :: Target -> String -fromTarget ACCEPT = "ACCEPT" -fromTarget REJECT = "REJECT" -fromTarget DROP = "DROP" -fromTarget LOG = "LOG" -fromTarget (TargetCustom t) = t +instance ConfigurableValue Target where + val ACCEPT = "ACCEPT" + val REJECT = "REJECT" + val DROP = "DROP" + val LOG = "LOG" + val (TargetCustom t) = t data Chain = INPUT | OUTPUT | FORWARD | PREROUTING | POSTROUTING | ChainCustom String deriving (Eq, Show) -fromChain :: Chain -> String -fromChain INPUT = "INPUT" -fromChain OUTPUT = "OUTPUT" -fromChain FORWARD = "FORWARD" -fromChain PREROUTING = "PREROUTING" -fromChain POSTROUTING = "POSTROUTING" -fromChain (ChainCustom c) = c +instance ConfigurableValue Chain where + val INPUT = "INPUT" + val OUTPUT = "OUTPUT" + val FORWARD = "FORWARD" + val PREROUTING = "PREROUTING" + val POSTROUTING = "POSTROUTING" + val (ChainCustom c) = c data Proto = TCP | UDP | ICMP deriving (Eq, Show) @@ -159,15 +158,15 @@ data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int deriving (Eq, Show) -fromICMPTypeMatch :: ICMPTypeMatch -> String -fromICMPTypeMatch (ICMPTypeName t) = t -fromICMPTypeMatch (ICMPTypeCode c) = show c +instance ConfigurableValue ICMPTypeMatch where + val (ICMPTypeName t) = t + val (ICMPTypeCode c) = val c data Frequency = NumBySecond Int deriving (Eq, Show) -fromFrequency :: Frequency -> String -fromFrequency (NumBySecond n) = show n ++ "/second" +instance ConfigurableValue Frequency where + val (NumBySecond n) = val n ++ "/second" type TCPFlagMask = [TCPFlag] -- cgit v1.2.3 From aa225472fb586486b5839e5362a555a476e9a45d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 Feb 2017 16:48:26 -0400 Subject: convert fromIPAddr to val --- debian/changelog | 2 +- src/Propellor/Property/Dns.hs | 2 +- src/Propellor/Property/Firewall.hs | 8 ++++---- src/Propellor/Property/Munin.hs | 2 +- src/Propellor/Property/Unbound.hs | 2 +- src/Propellor/Spin.hs | 2 +- src/Propellor/Types/Dns.hs | 9 +++++---- 7 files changed, 14 insertions(+), 13 deletions(-) (limited to 'src/Propellor/Property') diff --git a/debian/changelog b/debian/changelog index e3009188..f965a58c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,7 +3,7 @@ propellor (3.4.0) UNRELEASED; urgency=medium * Added ConfigurableValue type class, for values that can be used in a config file, or to otherwise configure a program. * The val function converts such values to String. - * Removed fromPort (use val instead). (API change) + * Removed fromPort and fromIPAddr (use val instead). (API change) * Removed several Show instances that were only used for generating configuration, replacing with ConfigurableValue instances. (API change) diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 3fcffed3..889aece5 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -250,7 +250,7 @@ confStanza c = cfgline f v = "\t" ++ f ++ " " ++ v ++ ";" ipblock name l = [ "\t" ++ name ++ " {" ] ++ - (map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++ + (map (\ip -> "\t\t" ++ val ip ++ ";") l) ++ [ "\t};" ] mastersblock | null (confMasters c) = [] diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index ab667da3..736a4458 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -99,7 +99,7 @@ toIpTableArg (NotDestination ipwm) = ] toIpTableArg (NatDestination ip mport) = [ "--to-destination" - , fromIPAddr ip ++ maybe "" (\p -> ":" ++ val p) mport + , val ip ++ maybe "" (\p -> ":" ++ val p) mport ] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' @@ -107,9 +107,9 @@ data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMa deriving (Eq, Show) instance ConfigurableValue IPWithMask where - val (IPWithNoMask ip) = fromIPAddr ip - val (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm - val (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m + val (IPWithNoMask ip) = val ip + val (IPWithIPMask ip ipm) = val ip ++ "/" ++ val ipm + val (IPWithNumMask ip m) = val ip ++ "/" ++ val m data Rule = Rule { ruleChain :: Chain diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs index 13c72f3a..6dab25ef 100644 --- a/src/Propellor/Property/Munin.hs +++ b/src/Propellor/Property/Munin.hs @@ -46,7 +46,7 @@ hostListFragment' hs os = concatMap muninHost hs where muninHost :: Host -> [String] muninHost h = [ "[" ++ (hostName h) ++ "]" - , " address " ++ maybe (hostName h) (fromIPAddr . fst) (hOverride h) + , " address " ++ maybe (hostName h) (val . fst) (hOverride h) ] ++ (maybe [] (\x -> [" port " ++ (val $ snd x)]) (hOverride h)) ++ [""] hOverride :: Host -> Maybe (IPAddr, Port) hOverride h = lookup (hostName h) os diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 9eb8f8c9..470aad7e 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -133,7 +133,7 @@ genAddress dom ttl addr = case addr of IPv6 _ -> genAddress' "AAAA" dom ttl addr genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String -genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> val ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr +genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> val ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ val addr genMX :: BindDomain -> Int -> BindDomain -> String genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ val priority ++ " " ++ dValue dest diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index c6699961f..447f8e9f 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -169,7 +169,7 @@ getSshTarget target hst warningMessage $ "DNS seems out of date for " ++ target ++ " (" ++ why ++ "); using IP address from configuration instead." return ip - configips = map fromIPAddr $ mapMaybe getIPAddr $ + configips = map val $ mapMaybe getIPAddr $ S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst -- Update the privdata, repo url, and git repo over the ssh diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 8f15d156..4cb8b111 100644 --- a/src/Propellor/Types/Dns.hs +++ b/src/Propellor/Types/Dns.hs @@ -5,6 +5,7 @@ module Propellor.Types.Dns where import Propellor.Types.OS (HostName) import Propellor.Types.Empty import Propellor.Types.Info +import Propellor.Types.ConfigurableValue import Data.Word import qualified Data.Map as M @@ -19,9 +20,9 @@ type Domain = String data IPAddr = IPv4 String | IPv6 String deriving (Read, Show, Eq, Ord) -fromIPAddr :: IPAddr -> String -fromIPAddr (IPv4 addr) = addr -fromIPAddr (IPv6 addr) = addr +instance ConfigurableValue IPAddr where + val (IPv4 addr) = addr + val (IPv6 addr) = addr newtype AliasesInfo = AliasesInfo (S.Set HostName) deriving (Show, Eq, Ord, Monoid, Typeable) @@ -102,7 +103,7 @@ type ReverseIP = String reverseIP :: IPAddr -> ReverseIP reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa" -reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonicalIP addr) ++ ".ip6.arpa" +reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ val $ canonicalIP addr) ++ ".ip6.arpa" -- | Converts an IP address (particularly IPv6) to canonical, fully -- expanded form. -- cgit v1.2.3 From 45f0bd252c8b86adee862ae70928a329f5ab6eb9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 1 Mar 2017 16:14:53 -0400 Subject: removed my repos from github; don't need to run gitriddance anymore --- src/Propellor/Property/SiteSpecific/JoeySites.hs | 20 -------------------- 1 file changed, 20 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index c14d1707..2da1cc05 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -405,8 +405,6 @@ githubBackup = propertyList "github-backup box" $ props & githubKeys & Cron.niceJob "github-backup run" (Cron.Times "30 4 * * *") (User "joey") "/home/joey/lib/backup" backupcmd - & Cron.niceJob "gitriddance" (Cron.Times "30 4 * * *") (User "joey") - "/home/joey/lib/backup" gitriddancecmd where backupcmd = intercalate "&&" $ [ "mkdir -p github" @@ -414,11 +412,6 @@ githubBackup = propertyList "github-backup box" $ props , ". $HOME/.github-keys" , "github-backup joeyh" ] - gitriddancecmd = intercalate "&&" $ - [ "cd github" - , ". $HOME/.github-keys" - ] ++ map gitriddance githubMirrors - gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")" githubKeys :: Property (HasInfo + UnixLike) githubKeys = @@ -427,19 +420,6 @@ githubKeys = `onChange` File.ownerGroup f (User "joey") (Group "joey") --- these repos are only mirrored on github, I don't want --- all the proprietary features -githubMirrors :: [(String, String)] -githubMirrors = - [ ("ikiwiki", plzuseurl "http://ikiwiki.info/todo/") - , ("git-annex", plzuseurl "http://git-annex.branchable.com/todo/") - , ("myrepos", plzuseurl "http://myrepos.branchable.com/todo/") - , ("propellor", plzuseurl "http://propellor.branchable.com/todo/") - , ("etckeeper", plzuseurl "http://etckeeper.branchable.com/todo/") - ] - 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 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" -- cgit v1.2.3