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(-) 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