summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--debian/changelog8
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property/Docker.hs4
-rw-r--r--src/Propellor/Property/File.hs6
-rw-r--r--src/Propellor/Property/Parted.hs72
-rw-r--r--src/Propellor/Property/Ssh.hs6
-rw-r--r--src/Propellor/Types.hs2
-rw-r--r--src/Propellor/Types/ConfigurableValue.hs32
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
generated by cgit v1.3-2-g0d8e (git 2.53.0) at 2026-06-13 20:28:06 +0000