diff options
| author | Joey Hess <joeyh@joeyh.name> | 2017-02-26 15:27:22 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2017-02-26 16:08:04 -0400 |
| commit | 2ba4b6fb3d29b2b65aa60f4bd591ed8cf6a63e27 (patch) | |
| tree | 873d0e3cd1582e68aa080ec032833f6a9a890407 | |
| parent | d19bdf24ccce2556cf462d74335a8f131448da95 (diff) | |
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.
| -rw-r--r-- | debian/changelog | 8 | ||||
| -rw-r--r-- | propellor.cabal | 1 | ||||
| -rw-r--r-- | src/Propellor/Property/Docker.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Property/File.hs | 6 | ||||
| -rw-r--r-- | src/Propellor/Property/Parted.hs | 72 | ||||
| -rw-r--r-- | src/Propellor/Property/Ssh.hs | 6 | ||||
| -rw-r--r-- | src/Propellor/Types.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Types/ConfigurableValue.hs | 32 |
8 files changed, 90 insertions, 41 deletions
diff --git a/debian/changelog b/debian/changelog index d4587ceb..bbcf7bdc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +propellor (3.3.2) 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. + + -- Joey Hess <id@joeyh.name> Sun, 26 Feb 2017 15:15:33 -0400 + propellor (3.3.1) unstable; urgency=medium * Apt: Removed the mirrors.kernel.org line from stdSourcesList etc. diff --git a/propellor.cabal b/propellor.cabal index 345b51dd..54011d26 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -171,6 +171,7 @@ Library Propellor.EnsureProperty Propellor.Exception Propellor.Types + Propellor.Types.ConfigurableValue Propellor.Types.Core Propellor.Types.Chroot Propellor.Types.CmdLine 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 diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 23066c18..097c332d 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -36,6 +36,7 @@ module Propellor.Types ( , adjustPropertySatisfy -- * Other included types , module Propellor.Types.OS + , module Propellor.Types.ConfigurableValue , module Propellor.Types.Dns , module Propellor.Types.Result , module Propellor.Types.ZFS @@ -46,6 +47,7 @@ import Data.Monoid import Propellor.Types.Core import Propellor.Types.Info import Propellor.Types.OS +import Propellor.Types.ConfigurableValue import Propellor.Types.Dns import Propellor.Types.Result import Propellor.Types.MetaTypes diff --git a/src/Propellor/Types/ConfigurableValue.hs b/src/Propellor/Types/ConfigurableValue.hs new file mode 100644 index 00000000..10a608f8 --- /dev/null +++ b/src/Propellor/Types/ConfigurableValue.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} + +module Propellor.Types.ConfigurableValue where + +-- | A value that can be used in a configuration file, or otherwise used to +-- configure a program. +-- +-- Unlike Show, there should only be instances of this type class for +-- values that have a standard serialization that is understood outside of +-- Haskell code. +-- +-- When converting a type alias such as "type Foo = String" or "type Foo = Int" +-- to a newtype, it's unsafe to derive a Show instance, because there may +-- be code that shows the type to configure a value. Instead, define a +-- ConfigurableValue instance. +class ConfigurableValue t where + val :: t -> String + +instance ConfigurableValue String where + val = id + +instance ConfigurableValue Int where + val = show + +instance ConfigurableValue Integer where + val = show + +instance ConfigurableValue Float where + val = show + +instance ConfigurableValue Double where + val = show |
