summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--config-joey.hs75
-rw-r--r--config-simple.hs3
-rw-r--r--debian/changelog11
-rw-r--r--doc/haskell_newbie.mdwn1
-rw-r--r--propellor.cabal5
-rw-r--r--src/Propellor.hs74
-rw-r--r--src/Propellor/Base.hs57
-rw-r--r--src/Propellor/Bootstrap.hs2
-rw-r--r--src/Propellor/CmdLine.hs2
-rw-r--r--src/Propellor/Engine.hs8
-rw-r--r--src/Propellor/Git.hs2
-rw-r--r--src/Propellor/Location.hs5
-rw-r--r--src/Propellor/PropAccum.hs50
-rw-r--r--src/Propellor/Property.hs55
-rw-r--r--src/Propellor/Property/Aiccu.hs2
-rw-r--r--src/Propellor/Property/Apache.hs55
-rw-r--r--src/Propellor/Property/Apt.hs2
-rw-r--r--src/Propellor/Property/Chroot.hs6
-rw-r--r--src/Propellor/Property/ConfFile.hs2
-rw-r--r--src/Propellor/Property/Cron.hs2
-rw-r--r--src/Propellor/Property/DebianMirror.hs2
-rw-r--r--src/Propellor/Property/Debootstrap.hs2
-rw-r--r--src/Propellor/Property/DiskImage.hs2
-rw-r--r--src/Propellor/Property/Dns.hs2
-rw-r--r--src/Propellor/Property/DnsSec.hs2
-rw-r--r--src/Propellor/Property/Docker.hs6
-rw-r--r--src/Propellor/Property/File.hs2
-rw-r--r--src/Propellor/Property/Firewall.hs2
-rw-r--r--src/Propellor/Property/Git.hs2
-rw-r--r--src/Propellor/Property/Gpg.hs2
-rw-r--r--src/Propellor/Property/Group.hs2
-rw-r--r--src/Propellor/Property/Grub.hs2
-rw-r--r--src/Propellor/Property/HostingProvider/CloudAtCost.hs2
-rw-r--r--src/Propellor/Property/HostingProvider/DigitalOcean.hs2
-rw-r--r--src/Propellor/Property/HostingProvider/Linode.hs2
-rw-r--r--src/Propellor/Property/Hostname.hs2
-rw-r--r--src/Propellor/Property/Journald.hs3
-rw-r--r--src/Propellor/Property/Kerberos.hs2
-rw-r--r--src/Propellor/Property/LightDM.hs2
-rw-r--r--src/Propellor/Property/List.hs24
-rw-r--r--src/Propellor/Property/Logcheck.hs2
-rw-r--r--src/Propellor/Property/Mount.hs2
-rw-r--r--src/Propellor/Property/Network.hs2
-rw-r--r--src/Propellor/Property/Nginx.hs2
-rw-r--r--src/Propellor/Property/OS.hs2
-rw-r--r--src/Propellor/Property/Obnam.hs2
-rw-r--r--src/Propellor/Property/OpenId.hs38
-rw-r--r--src/Propellor/Property/Parted.hs2
-rw-r--r--src/Propellor/Property/Partition.hs2
-rw-r--r--src/Propellor/Property/Postfix.hs2
-rw-r--r--src/Propellor/Property/Prosody.hs2
-rw-r--r--src/Propellor/Property/Reboot.hs2
-rw-r--r--src/Propellor/Property/Rsync.hs2
-rw-r--r--src/Propellor/Property/Scheduled.hs2
-rw-r--r--src/Propellor/Property/Service.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/Branchable.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/GitHome.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/IABak.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs2
-rw-r--r--src/Propellor/Property/Ssh.hs2
-rw-r--r--src/Propellor/Property/Sudo.hs2
-rw-r--r--src/Propellor/Property/Systemd.hs8
-rw-r--r--src/Propellor/Property/Systemd/Core.hs2
-rw-r--r--src/Propellor/Property/Tor.hs2
-rw-r--r--src/Propellor/Property/Unbound.hs2
-rw-r--r--src/Propellor/Property/User.hs2
-rw-r--r--src/Propellor/Property/Uwsgi.hs2
-rw-r--r--src/Propellor/Protocol.hs2
-rw-r--r--src/Propellor/Shim.hs2
-rw-r--r--src/Propellor/Spin.hs2
-rw-r--r--src/Propellor/Ssh.hs2
-rw-r--r--src/Propellor/Types.hs69
-rw-r--r--src/Propellor/Utilities.hs27
74 files changed, 424 insertions, 264 deletions
diff --git a/config-joey.hs b/config-joey.hs
index a240cd12..9aa6413f 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -3,7 +3,6 @@
module Main where
import Propellor
-import Propellor.CmdLine
import Propellor.Property.Scheduled
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
@@ -17,9 +16,9 @@ import qualified Propellor.Property.Hostname as Hostname
import qualified Propellor.Property.Tor as Tor
import qualified Propellor.Property.Dns as Dns
import qualified Propellor.Property.OpenId as OpenId
-import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.Git as Git
import qualified Propellor.Property.Postfix as Postfix
+import qualified Propellor.Property.Apache as Apache
import qualified Propellor.Property.Grub as Grub
import qualified Propellor.Property.Obnam as Obnam
import qualified Propellor.Property.Gpg as Gpg
@@ -322,14 +321,10 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
& alias "ns3.kitenet.net"
& myDnsSecondary
- & Docker.configured
- & Docker.docked openidProvider
- `requires` Apt.serviceInstalledRunning "ntp"
- & Docker.docked ancientKitenet
- & Docker.docked jerryPlay
- & Docker.garbageCollected `period` (Weekly (Just 1))
-
& Systemd.nspawned oldusenetShellBox
+ & Systemd.nspawned ancientKitenet
+ & Systemd.nspawned openidProvider
+ `requires` Apt.serviceInstalledRunning "ntp"
& JoeySites.scrollBox
& alias "scroll.joeyh.name"
@@ -424,40 +419,36 @@ iabak = host "iabak.archiveteam.org"
webserver :: Systemd.Container
webserver = standardStableContainer "webserver"
& Systemd.bind "/var/www"
- & Apt.serviceInstalledRunning "apache2"
+ & Apache.installed
-- My own openid provider. Uses php, so containerized for security
-- and administrative sanity.
-openidProvider :: Docker.Container
-openidProvider = standardStableDockerContainer "openid-provider"
- & alias "openid.kitenet.net"
- & Docker.publish "8081:80"
- & OpenId.providerFor [User "joey", User "liw"]
- "openid.kitenet.net:8081"
-
--- Exhibit: kite's 90's website.
-ancientKitenet :: Docker.Container
-ancientKitenet = standardStableDockerContainer "ancient-kitenet"
- & alias "ancient.kitenet.net"
- & Docker.publish "1994:80"
- & Apt.serviceInstalledRunning "apache2"
+openidProvider :: Systemd.Container
+openidProvider = standardStableContainer "openid-provider"
+ & alias hn
+ & OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))
+ where
+ hn = "openid.kitenet.net"
+
+-- Exhibit: kite's 90's website on port 1994.
+ancientKitenet :: Systemd.Container
+ancientKitenet = standardStableContainer "ancient-kitenet"
+ & alias hn
& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"
(Just "remotes/origin/old-kitenet.net")
+ & Apache.installed
+ & Apache.listenPorts [p]
+ & Apache.virtualHost hn p "/var/www/html"
+ & Apache.siteDisabled "000-default"
+ where
+ p = Port 1994
+ hn = "ancient.kitenet.net"
oldusenetShellBox :: Systemd.Container
oldusenetShellBox = standardStableContainer "oldusenet-shellbox"
& alias "shell.olduse.net"
& JoeySites.oldUseNetShellBox
-jerryPlay :: Docker.Container
-jerryPlay = standardDockerContainer "jerryplay" Unstable "amd64"
- & alias "jerryplay.kitenet.net"
- & Docker.publish "2202:22"
- & Docker.publish "8001:80"
- & Apt.installed ["ssh"]
- & User.hasPassword (User "root")
- & Ssh.permitRootLogin (Ssh.RootLogin True)
-
kiteShellBox :: Systemd.Container
kiteShellBox = standardStableContainer "kiteshellbox"
& JoeySites.kiteShellBox
@@ -505,26 +496,6 @@ standardContainer name suite arch = Systemd.container name chroot
standardStableContainer :: Systemd.MachineName -> Systemd.Container
standardStableContainer name = standardContainer name (Stable "jessie") "amd64"
-standardStableDockerContainer :: Docker.ContainerName -> Docker.Container
-standardStableDockerContainer name = standardDockerContainer name (Stable "jessie") "amd64"
-
-standardDockerContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container
-standardDockerContainer name suite arch = Docker.container name (dockerImage system)
- & os system
- & Apt.stdSourcesList `onChange` Apt.upgrade
- & Apt.unattendedUpgrades
- & Apt.cacheCleaned
- & Docker.tweaked
- where
- system = System (Debian suite) arch
-
--- Docker images I prefer to use.
-dockerImage :: System -> Docker.Image
-dockerImage (System (Debian Unstable) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)
-dockerImage (System (Debian Testing) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)
-dockerImage (System (Debian (Stable _)) arch) = Docker.latestImage ("joeyh/debian-stable-" ++ arch)
-dockerImage _ = Docker.latestImage "debian-stable-official" -- does not currently exist!
-
myDnsSecondary :: Property HasInfo
myDnsSecondary = propertyList "dns secondary for all my domains" $ props
& Dns.secondary hosts "kitenet.net"
diff --git a/config-simple.hs b/config-simple.hs
index 576ecc73..67c06120 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -2,13 +2,12 @@
-- the propellor program.
import Propellor
-import Propellor.CmdLine
-import Propellor.Property.Scheduled
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Network as Network
--import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Cron as Cron
+import Propellor.Property.Scheduled
--import qualified Propellor.Property.Sudo as Sudo
import qualified Propellor.Property.User as User
--import qualified Propellor.Property.Hostname as Hostname
diff --git a/debian/changelog b/debian/changelog
index 932a708b..55076ae8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,7 +1,14 @@
-propellor (2.8.2) UNRELEASED; urgency=medium
+propellor (2.9.0) UNRELEASED; urgency=medium
- * Added basic Uwsgi module, contributed by Félix Sipma.
+ * Added basic Uwsgi module, maintained by Félix Sipma.
* Add Apt.hasForeignArch. Thanks, Per Olofsson.
+ * Improved documentation, particularly of the Propellor module.
+ * The Propellor module no longer exports many of the things it used to,
+ being now focused on only what's needed to write config.hs.
+ Use Propellor.Base to get all the things exported by Propellor before.
+ (API change)
+ * Some renaming of instance methods, and moving of functions to more
+ appropriate modules. (API change)
-- Joey Hess <id@joeyh.name> Thu, 08 Oct 2015 11:09:01 -0400
diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn
index ec42629c..0bab3b79 100644
--- a/doc/haskell_newbie.mdwn
+++ b/doc/haskell_newbie.mdwn
@@ -16,7 +16,6 @@ So, `-- ` starts a comment in this file.
[[!format haskell """
import Propellor
-import Propellor.CmdLine
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.User as User
diff --git a/propellor.cabal b/propellor.cabal
index 32f3772d..86337505 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
Name: propellor
-Version: 2.8.1
+Version: 2.9.0
Cabal-Version: >= 1.8
License: BSD3
Maintainer: Joey Hess <id@joeyh.name>
@@ -69,6 +69,8 @@ Library
Exposed-Modules:
Propellor
+ Propellor.Base
+ Propellor.Location
Propellor.Property
Propellor.Property.Aiccu
Propellor.Property.Apache
@@ -126,6 +128,7 @@ Library
Propellor.Property.SiteSpecific.Branchable
Propellor.Property.SiteSpecific.IABak
Propellor.PropAccum
+ Propellor.Utilities
Propellor.CmdLine
Propellor.Info
Propellor.Message
diff --git a/src/Propellor.hs b/src/Propellor.hs
index 51079ed0..4f777f11 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -1,15 +1,12 @@
-{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
--- | Pulls in lots of useful modules for building and using Properties.
---
--- When propellor runs on a Host, it ensures that its list of Properties
+-- | When propellor runs on a Host, it ensures that its list of Properties
-- is satisfied, taking action as necessary when a Property is not
-- currently satisfied.
--
-- A simple propellor program example:
--
-- > import Propellor
--- > import Propellor.CmdLine
-- > import qualified Propellor.Property.File as File
-- > import qualified Propellor.Property.Apt as Apt
-- >
@@ -30,54 +27,53 @@
-- git clone <git://git.joeyh.name/propellor>
module Propellor (
- module Propellor.Types
+ -- * Core data types
+ Host(..)
+ , Property
+ , RevertableProperty
+ , (<!>)
+ -- * Core config file
+ , defaultMain
+ , host
+ , (&)
+ , (!)
+ , describe
+ -- * Combining properties
+ -- | Properties are often combined together in your propellor
+ -- configuration. For example:
+ --
+ -- > "/etc/foo/config" `File.containsLine` "bar=1"
+ -- > `requires` File.dirExists "/etc/foo"
+ , requires
+ , before
+ , onChange
+ -- * Included modules
+ -- | These are only the core modules you'll need. There are many
+ -- more in propellor that you can import.
+ , module Propellor.Types
+ -- | Additional data types used by propellor
, module Propellor.Property
- , module Propellor.Property.List
+ -- | Everything you need to build your own properties,
+ -- and useful property combinators
, module Propellor.Property.Cmd
- , module Propellor.PropAccum
+ -- | Properties to run shell commands
, module Propellor.Info
- , module Propellor.PrivData
+ -- | Properties that set `Info`
+ , module Propellor.Property.List
+ -- | Combining a list of properties into a single property
, module Propellor.Types.PrivData
- , module Propellor.Engine
- , module Propellor.Exception
- , module Propellor.Message
- , localdir
+ -- | Private data access for properties
, module X
) where
import Propellor.Types
+import Propellor.CmdLine (defaultMain)
import Propellor.Property
-import Propellor.Engine
import Propellor.Property.List
import Propellor.Property.Cmd
-import Propellor.PrivData
import Propellor.Types.PrivData
-import Propellor.Message
-import Propellor.Exception
import Propellor.Info
import Propellor.PropAccum
-import Utility.PartialPrelude as X
-import Utility.Process as X
-import Utility.Exception as X
-import Utility.Env as X
-import Utility.Directory as X
-import Utility.Tmp as X
-import Utility.Monad as X
-import Utility.Misc as X
-
-import System.Directory as X
-import System.IO as X
-import System.FilePath as X
-import Data.Maybe as X
-import Data.Either as X
-import Control.Applicative as X
-import Control.Monad as X
import Data.Monoid as X
-import Control.Monad.IfElse as X
-import "mtl" Control.Monad.Reader as X
-
--- | This is where propellor installs itself when deploying a host.
-localdir :: FilePath
-localdir = "/usr/local/propellor"
diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs
new file mode 100644
index 00000000..3c13bb7d
--- /dev/null
+++ b/src/Propellor/Base.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE PackageImports #-}
+
+-- | Pulls in lots of useful modules for building and using Properties.
+
+module Propellor.Base (
+ -- * Propellor modules
+ module Propellor.Types
+ , module Propellor.Property
+ , module Propellor.Property.Cmd
+ , module Propellor.Property.List
+ , module Propellor.Types.PrivData
+ , module Propellor.PropAccum
+ , module Propellor.Info
+ , module Propellor.PrivData
+ , module Propellor.Engine
+ , module Propellor.Exception
+ , module Propellor.Message
+ , module Propellor.Location
+ , module Propellor.Utilities
+
+ -- * System modules
+ , module System.Directory
+ , module System.IO
+ , module System.FilePath
+ , module Data.Maybe
+ , module Data.Either
+ , module Control.Applicative
+ , module Control.Monad
+ , module Data.Monoid
+ , module Control.Monad.IfElse
+ , module Control.Monad.Reader
+) where
+
+import Propellor.Types
+import Propellor.Property
+import Propellor.Engine
+import Propellor.Property.List
+import Propellor.Property.Cmd
+import Propellor.PrivData
+import Propellor.Types.PrivData
+import Propellor.Message
+import Propellor.Exception
+import Propellor.Info
+import Propellor.PropAccum
+import Propellor.Location
+import Propellor.Utilities
+
+import System.Directory
+import System.IO
+import System.FilePath
+import Data.Maybe
+import Data.Either
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+import Control.Monad.IfElse
+import "mtl" Control.Monad.Reader
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 0cb37092..6a5d5acb 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -5,7 +5,7 @@ module Propellor.Bootstrap (
buildPropellor,
) where
-import Propellor
+import Propellor.Base
import System.Posix.Files
import Data.List
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 0cc8294d..33bb0bdc 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -9,7 +9,7 @@ import System.Exit
import System.PosixCompat
import Network.Socket
-import Propellor
+import Propellor.Base
import Propellor.Gpg
import Propellor.Git
import Propellor.Bootstrap
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index dd3d4653..0fdbb995 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -26,6 +26,7 @@ import Propellor.Types
import Propellor.Message
import Propellor.Exception
import Propellor.Info
+import Propellor.Property
import Utility.Exception
import Utility.PartialPrelude
import Utility.Monad
@@ -62,13 +63,6 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
return ret
--- | For when code running in the Propellor monad needs to ensure a
--- Property.
---
--- This can only be used on a Property that has NoInfo.
-ensureProperty :: Property NoInfo -> Propellor Result
-ensureProperty = catchPropellor . propertySatisfy
-
-- | Ensures a list of Properties, with a display of each as it runs.
ensureProperties :: [Property NoInfo] -> Propellor Result
ensureProperties ps = ensure ps NoChange
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index 0b9b4b35..a4418340 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -1,6 +1,6 @@
module Propellor.Git where
-import Propellor
+import Propellor.Base
import Propellor.PrivData.Paths
import Propellor.Gpg
import Utility.FileMode
diff --git a/src/Propellor/Location.hs b/src/Propellor/Location.hs
new file mode 100644
index 00000000..3fc09538
--- /dev/null
+++ b/src/Propellor/Location.hs
@@ -0,0 +1,5 @@
+module Propellor.Location where
+
+-- | This is where propellor installs itself when deploying a host.
+localdir :: FilePath
+localdir = "/usr/local/propellor"
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index dec204a2..61cf3dc8 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -2,10 +2,10 @@
module Propellor.PropAccum
( host
- , props
, PropAccum(..)
+ , (&)
+ , (&^)
, (!)
- , PropList
, propigateContainer
) where
@@ -25,49 +25,41 @@ import Propellor.PrivData
host :: HostName -> Host
host hn = Host hn [] mempty
--- | Starts accumulating a list of properties.
---
--- > propertyList "foo" $ props
--- > & someproperty
--- > ! oldproperty
--- > & otherproperty
-props :: PropList
-props = PropList []
-
-- | Something that can accumulate properties.
class PropAccum h where
-- | Adds a property.
- --
- -- Can add Properties and RevertableProperties
- (&) :: IsProp p => h -> p -> h
+ addProp :: IsProp p => h -> p -> h
- -- | Like (&), but adds the property at the front of the list.
- (&^) :: IsProp p => h -> p -> h
+ -- | Like addProp, but adds the property at the front of the list.
+ addPropFront :: IsProp p => h -> p -> h
getProperties :: h -> [Property HasInfo]
-instance PropAccum Host where
- (Host hn ps is) & p = Host hn (ps ++ [toProp p])
- (is <> getInfoRecursive p)
- (Host hn ps is) &^ p = Host hn (toProp p : ps)
- (getInfoRecursive p <> is)
- getProperties = hostProperties
-
-data PropList = PropList [Property HasInfo]
+-- | Adds a property to a `Host` or other `PropAccum`
+--
+-- Can add Properties and RevertableProperties
+(&) :: (PropAccum h, IsProp p) => h -> p -> h
+(&) = addProp
-instance PropAccum PropList where
- PropList l & p = PropList (toProp p : l)
- PropList l &^ p = PropList (l ++ [toProp p])
- getProperties (PropList l) = reverse l
+-- | Adds a property before any other properties.
+(&^) :: (PropAccum h, IsProp p) => h -> p -> h
+(&^) = addPropFront
-- | Adds a property in reverted form.
(!) :: PropAccum h => h -> RevertableProperty -> h
h ! p = h & revert p
-infixl 1 &^
infixl 1 &
+infixl 1 &^
infixl 1 !
+instance PropAccum Host where
+ (Host hn ps is) `addProp` p = Host hn (ps ++ [toProp p])
+ (is <> getInfoRecursive p)
+ (Host hn ps is) `addPropFront` p = Host hn (toProp p : ps)
+ (getInfoRecursive p <> is)
+ getProperties = hostProperties
+
-- | Adjust the provided Property, adding to its
-- propertyChidren the properties of the provided container.
--
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index e8d70a80..667dc52b 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,7 +1,31 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleContexts #-}
-module Propellor.Property where
+module Propellor.Property (
+ -- * Property combinators
+ requires
+ , before
+ , onChange
+ , onChangeFlagOnFail
+ , flagFile
+ , flagFile'
+ , check
+ , fallback
+ , trivial
+ , revert
+ -- * Property descriptions
+ , describe
+ , (==>)
+ -- * Constructing properties
+ , Propellor
+ , property
+ , ensureProperty
+ , withOS
+ , makeChange
+ , noChange
+ , doNothing
+ , endAction
+) where
import System.Directory
import System.FilePath
@@ -12,6 +36,7 @@ import "mtl" Control.Monad.RWS.Strict
import Propellor.Types
import Propellor.Info
+import Propellor.Exception
import Utility.Monad
-- | Constructs a Property, from a description and an action to run to
@@ -39,6 +64,18 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
writeFile flagfile ""
return r
+-- | Indicates that the first property depends on the second,
+-- so before the first is ensured, the second must be ensured.
+requires :: Combines x y => x -> y -> CombinedType x y
+requires = (<<>>)
+
+-- | Combines together two properties, resulting in one property
+-- that ensures the first, and if the first succeeds, ensures the second.
+--
+-- The combined property uses the description of the first property.
+before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
+before x y = (y `requires` x) `describe` getDesc x
+
-- | Whenever a change has to be made for a Property, causes a hook
-- Property to also be run, but not otherwise.
onChange
@@ -88,11 +125,22 @@ onChangeFlagOnFail flagfile = combineWith go
writeFile flagfile ""
removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile
+-- | Changes the description of a property.
+describe :: IsProp p => p -> Desc -> p
+describe = setDesc
+
-- | Alias for @flip describe@
(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
(==>) = flip describe
infixl 1 ==>
+-- | For when code running in the Propellor monad needs to ensure a
+-- Property.
+--
+-- This can only be used on a Property that has NoInfo.
+ensureProperty :: Property NoInfo -> Propellor Result
+ensureProperty = catchPropellor . propertySatisfy
+
-- | Makes a Property only need to do anything when a test succeeds.
check :: IO Bool -> Property i -> Property i
check c p = adjustPropertySatisfy p $ \satisfy -> ifM (liftIO c)
@@ -129,7 +177,7 @@ trivial p = adjustPropertySatisfy p $ \satisfy -> do
withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
--- | Undoes the effect of a property.
+-- | Undoes the effect of a RevertableProperty.
revert :: RevertableProperty -> RevertableProperty
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
@@ -142,6 +190,7 @@ noChange = return NoChange
doNothing :: Property NoInfo
doNothing = property "noop property" noChange
--- | Registers an action that should be run at the very end,
+-- | Registers an action that should be run at the very end, after
+-- propellor has checks all the properties of a host.
endAction :: Desc -> (Result -> Propellor Result) -> Propellor ()
endAction desc a = tell [EndAction desc a]
diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs
index a1b24472..47841a7b 100644
--- a/src/Propellor/Property/Aiccu.hs
+++ b/src/Propellor/Property/Aiccu.hs
@@ -9,7 +9,7 @@ module Propellor.Property.Aiccu (
hasConfig,
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import qualified Propellor.Property.File as File
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index fe81dcd8..91b2e6a2 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -1,10 +1,33 @@
module Propellor.Property.Apache where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
+installed :: Property NoInfo
+installed = Apt.installed ["apache2"]
+
+restarted :: Property NoInfo
+restarted = Service.restarted "apache2"
+
+reloaded :: Property NoInfo
+reloaded = Service.reloaded "apache2"
+
+-- | A basic virtual host, publishing a directory, and logging to
+-- the combined apache log file.
+virtualHost :: HostName -> Port -> FilePath -> RevertableProperty
+virtualHost hn (Port p) docroot = siteEnabled hn
+ [ "<VirtualHost *:"++show p++">"
+ , "ServerName "++hn++":"++show p
+ , "DocumentRoot " ++ docroot
+ , "ErrorLog /var/log/apache2/error.log"
+ , "LogLevel warn"
+ , "CustomLog /var/log/apache2/access.log combined"
+ , "ServerSignature On"
+ , "</VirtualHost>"
+ ]
+
type ConfigFile = [String]
siteEnabled :: HostName -> ConfigFile -> RevertableProperty
@@ -19,13 +42,16 @@ siteEnabled hn cf = enable <!> disable
`requires` installed
`onChange` reloaded
]
- disable = combineProperties
- ("apache site disabled " ++ hn)
- (map File.notPresent (siteCfg hn))
+ disable = siteDisabled hn
+ isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param hn]
+
+siteDisabled :: HostName -> Property NoInfo
+siteDisabled hn = combineProperties
+ ("apache site disabled " ++ hn)
+ (map File.notPresent (siteCfg hn))
`onChange` cmdProperty "a2dissite" ["--quiet", hn]
`requires` installed
`onChange` reloaded
- isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param hn]
siteAvailable :: HostName -> ConfigFile -> Property NoInfo
siteAvailable hn cf = combineProperties ("apache site available " ++ hn) $
@@ -48,6 +74,16 @@ modEnabled modname = enable <!> disable
`onChange` reloaded
isenabled = boolSystem "a2query" [Param "-q", Param "-m", Param modname]
+-- | Make apache listen on the specified ports.
+--
+-- Note that ports are also specified inside a site's config file,
+-- so that also needs to be changed.
+listenPorts :: [Port] -> Property NoInfo
+listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps
+ `onChange` restarted
+ where
+ portline (Port n) = "Listen " ++ show n
+
-- This is a list of config files because different versions of apache
-- use different filenames. Propellor simply writes them all.
siteCfg :: HostName -> [FilePath]
@@ -58,15 +94,6 @@ siteCfg hn =
, "/etc/apache2/sites-available/" ++ hn ++ ".conf"
]
-installed :: Property NoInfo
-installed = Apt.installed ["apache2"]
-
-restarted :: Property NoInfo
-restarted = Service.restarted "apache2"
-
-reloaded :: Property NoInfo
-reloaded = Service.reloaded "apache2"
-
-- | Configure apache to use SNI to differentiate between
-- https hosts.
--
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 15c45629..14f170af 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -8,7 +8,7 @@ import Data.List
import System.IO
import Control.Monad
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
import Propellor.Property.File (Line)
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index b059e3eb..ab914180 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -12,7 +12,7 @@ module Propellor.Property.Chroot (
chain,
) where
-import Propellor
+import Propellor.Base
import Propellor.Types.CmdLine
import Propellor.Types.Chroot
import Propellor.Types.Info
@@ -34,8 +34,8 @@ data BuilderConf
deriving (Show)
instance PropAccum Chroot where
- (Chroot l s c h) & p = Chroot l s c (h & p)
- (Chroot l s c h) &^ p = Chroot l s c (h &^ p)
+ (Chroot l s c h) `addProp` p = Chroot l s c (h & p)
+ (Chroot l s c h) `addPropFront` p = Chroot l s c (h `addPropFront` p)
getProperties (Chroot _ _ _ h) = hostProperties h
-- | Defines a Chroot at the given location, built with debootstrap.
diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs
index 0bc1b76d..dac4e564 100644
--- a/src/Propellor/Property/ConfFile.hs
+++ b/src/Propellor/Property/ConfFile.hs
@@ -12,7 +12,7 @@ module Propellor.Property.ConfFile (
lacksIniSection,
) where
-import Propellor
+import Propellor.Base
import Propellor.Property.File
import Data.List (isPrefixOf, foldl')
diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs
index e9bb93ac..74cab92a 100644
--- a/src/Propellor/Property/Cron.hs
+++ b/src/Propellor/Property/Cron.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Cron where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import Propellor.Bootstrap
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index d16c5281..6f1ff7b2 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -7,7 +7,7 @@ module Propellor.Property.DebianMirror
, mirrorCdn
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 2551d679..bb177007 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -10,7 +10,7 @@ module Propellor.Property.Debootstrap (
programPath,
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Chroot.Util
import Utility.Path
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 8d35991e..8d503e28 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -36,7 +36,7 @@ module Propellor.Property.DiskImage (
noFinalization,
) where
-import Propellor
+import Propellor.Base
import Propellor.Property.Chroot (Chroot)
import Propellor.Property.Chroot.Util (removeChroot)
import qualified Propellor.Property.Chroot as Chroot
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 056733cd..963b82f6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -13,7 +13,7 @@ module Propellor.Property.Dns (
genZone,
) where
-import Propellor
+import Propellor.Base
import Propellor.Types.Dns
import Propellor.Types.Info
import Propellor.Property.File
diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs
index 3acaee8d..22481ad0 100644
--- a/src/Propellor/Property/DnsSec.hs
+++ b/src/Propellor/Property/DnsSec.hs
@@ -1,6 +1,6 @@
module Propellor.Property.DnsSec where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
-- | Puts the DNSSEC key files in place from PrivData.
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index e6365276..6aa17438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -45,7 +45,7 @@ module Propellor.Property.Docker (
chain,
) where
-import Propellor hiding (init)
+import Propellor.Base hiding (init)
import Propellor.Types.Docker
import Propellor.Types.Container
import Propellor.Types.CmdLine
@@ -97,8 +97,8 @@ instance HasImage Container where
getImageName (Container i _) = i
instance PropAccum Container where
- (Container i h) & p = Container i (h & p)
- (Container i h) &^ p = Container i (h &^ p)
+ (Container i h) `addProp` p = Container i (h `addProp` p)
+ (Container i h) `addPropFront` p = Container i (h `addPropFront` p)
getProperties (Container _ h) = hostProperties h
-- | Defines a Container with a given name, image, and properties.
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index a1d3037f..b491ccbe 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -1,6 +1,6 @@
module Propellor.Property.File where
-import Propellor
+import Propellor.Base
import Utility.FileMode
import System.Posix.Files
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index a685a46f..20b44845 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -16,7 +16,7 @@ import Data.Monoid
import Data.Char
import Data.List
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Network as Network
diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs
index 48871b40..d69fe250 100644
--- a/src/Propellor/Property/Git.hs
+++ b/src/Propellor/Property/Git.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Git where
-import Propellor
+import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index e57749ae..a16df11d 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Gpg where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Utility.FileSystemEncoding
diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs
index d4dc0fb2..ce8a8398 100644
--- a/src/Propellor/Property/Group.hs
+++ b/src/Propellor/Property/Group.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Group where
-import Propellor
+import Propellor.Base
type GID = Int
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 1084ef9e..6b763d08 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Grub where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
index bc53635c..6097c642 100644
--- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs
+++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
@@ -1,6 +1,6 @@
module Propellor.Property.HostingProvider.CloudAtCost where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Hostname as Hostname
import qualified Propellor.Property.File as File
import qualified Propellor.Property.User as User
diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
index a5de9818..f49b86b3 100644
--- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs
+++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
@@ -2,7 +2,7 @@ module Propellor.Property.HostingProvider.DigitalOcean (
distroKernel
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Reboot as Reboot
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
index 40be4c2e..274412a0 100644
--- a/src/Propellor/Property/HostingProvider/Linode.hs
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -1,6 +1,6 @@
module Propellor.Property.HostingProvider.Linode where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Grub as Grub
import qualified Propellor.Property.File as File
import Utility.FileMode
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 20181213..7766d497 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Hostname where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import Data.List
diff --git a/src/Propellor/Property/Journald.hs b/src/Propellor/Property/Journald.hs
index 3ab4e9d7..6c8bda80 100644
--- a/src/Propellor/Property/Journald.hs
+++ b/src/Propellor/Property/Journald.hs
@@ -1,5 +1,6 @@
module Propellor.Property.Journald where
-import Propellor
+
+import Propellor.Base
import qualified Propellor.Property.Systemd as Systemd
import Utility.DataUnits
diff --git a/src/Propellor/Property/Kerberos.hs b/src/Propellor/Property/Kerberos.hs
index 5d07f4dc..cb6e06cc 100644
--- a/src/Propellor/Property/Kerberos.hs
+++ b/src/Propellor/Property/Kerberos.hs
@@ -4,7 +4,7 @@ module Propellor.Property.Kerberos where
import Utility.Process
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import Propellor.Property.User
diff --git a/src/Propellor/Property/LightDM.hs b/src/Propellor/Property/LightDM.hs
index b010eb2f..bc5ef22a 100644
--- a/src/Propellor/Property/LightDM.hs
+++ b/src/Propellor/Property/LightDM.hs
@@ -4,7 +4,7 @@
module Propellor.Property.LightDM where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.ConfFile as ConfFile
-- | Configures LightDM to skip the login screen and autologin as a user.
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 283c5ec7..a88d44d7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleInstances #-}
module Propellor.Property.List (
+ props,
PropertyList(..),
PropertyListType,
) where
@@ -12,6 +13,22 @@ import Propellor.PropAccum
import Data.Monoid
+-- | Starts accumulating a list of properties.
+--
+-- > propertyList "foo" $ props
+-- > & someproperty
+-- > ! oldproperty
+-- > & otherproperty
+props :: PropList
+props = PropList []
+
+data PropList = PropList [Property HasInfo]
+
+instance PropAccum PropList where
+ PropList l `addProp` p = PropList (toProp p : l)
+ PropList l `addPropFront` p = PropList (l ++ [toProp p])
+ getProperties (PropList l) = reverse l
+
class PropertyList l where
-- | Combines a list of properties, resulting in a single property
-- that when run will run each property in the list in turn,
@@ -21,12 +38,7 @@ class PropertyList l where
-- Note that Property HasInfo and Property NoInfo are not the same
-- type, and so cannot be mixed in a list. To make a list of
-- mixed types, which can also include RevertableProperty,
- -- use `props`:
- --
- -- > propertyList "foo" $ props
- -- > & someproperty
- -- > ! oldproperty
- -- > & otherproperty
+ -- use `props`
propertyList :: Desc -> l -> Property (PropertyListType l)
-- | Combines a list of properties, resulting in one property that
diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs
index 26f4e3a4..22621cc2 100644
--- a/src/Propellor/Property/Logcheck.hs
+++ b/src/Propellor/Property/Logcheck.hs
@@ -9,7 +9,7 @@ module Propellor.Property.Logcheck (
installed,
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 4070ebcb..30d057f5 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Mount where
-import Propellor
+import Propellor.Base
import Utility.Path
type FsType = String -- ^ type of filesystem to mount ("auto" to autodetect)
diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs
index e01edb62..cb340042 100644
--- a/src/Propellor/Property/Network.hs
+++ b/src/Propellor/Property/Network.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Network where
-import Propellor
+import Propellor.Base
import Propellor.Property.File
type Interface = String
diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs
index a8c7b187..d0d4d3a9 100644
--- a/src/Propellor/Property/Nginx.hs
+++ b/src/Propellor/Property/Nginx.hs
@@ -2,7 +2,7 @@
module Propellor.Property.Nginx where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 5364456a..e176e33d 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -7,7 +7,7 @@ module Propellor.Property.OS (
oldOSRemoved,
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Network as Network
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 94b023f3..091a6d90 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Obnam where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
import qualified Propellor.Property.Gpg as Gpg
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 1f6f2559..ae437518 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -1,21 +1,34 @@
module Propellor.Property.OpenId where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.Apache as Apache
import Data.List
-providerFor :: [User] -> String -> Property HasInfo
-providerFor users baseurl = propertyList desc $ map toProp
- [ Apt.serviceInstalledRunning "apache2"
- , Apt.installed ["simpleid"]
- `onChange` Service.restarted "apache2"
- , File.fileProperty (desc ++ " configured")
+-- | Openid provider, using the simpleid PHP CGI, with apache.
+--
+-- Runs on usual port by default. When a nonstandard port is specified,
+-- apache is limited to listening only on that port. Warning: Specifying
+-- a port won't compose well with other apache properties on the same
+-- host.
+--
+-- It's probably a good idea to put this property inside a docker or
+-- systemd-nspawn container.
+providerFor :: [User] -> HostName -> Maybe Port -> Property HasInfo
+providerFor users hn mp = propertyList desc $ props
+ & Apt.serviceInstalledRunning "apache2"
+ & apacheconfigured
+ & Apt.installed ["simpleid"]
+ `onChange` Apache.restarted
+ & File.fileProperty (desc ++ " configured")
(map setbaseurl) "/etc/simpleid/config.inc"
- ] ++ map identfile users
+ & propertyList desc (map identfile users)
where
+ baseurl = hn ++ case mp of
+ Nothing -> ""
+ Just (Port p) -> show p
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
@@ -23,6 +36,13 @@ providerFor users baseurl = propertyList desc $ map toProp
"define('SIMPLEID_BASE_URL', '"++url++"');"
| otherwise = l
+ apacheconfigured = case mp of
+ Nothing -> toProp $
+ Apache.virtualHost hn (Port 80) "/var/www/html"
+ Just p -> propertyList desc $ props
+ & Apache.listenPorts [p]
+ & Apache.virtualHost hn p "/var/www/html"
+
-- the identities directory controls access, so open up
-- file mode
identfile (User u) = File.hasPrivContentExposed
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index a4f0f98e..7bd38a65 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -21,7 +21,7 @@ module Propellor.Property.Parted (
installed,
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Partition as Partition
import Utility.DataUnits
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index c85ef8b9..56bc1575 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -2,7 +2,7 @@
module Propellor.Property.Partition where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
-- | Filesystems etc that can be used for a partition.
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index b062cbac..562444da 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -2,7 +2,7 @@
module Propellor.Property.Postfix where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs
index e47b9ac5..78a2c529 100644
--- a/src/Propellor/Property/Prosody.hs
+++ b/src/Propellor/Property/Prosody.hs
@@ -2,7 +2,7 @@
module Propellor.Property.Prosody where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 5ca7a6bc..ef0182d3 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Reboot where
-import Propellor
+import Propellor.Base
now :: Property NoInfo
now = cmdProperty "reboot" []
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
index 8423eff6..894b8cc7 100644
--- a/src/Propellor/Property/Rsync.hs
+++ b/src/Propellor/Property/Rsync.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Rsync where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
type Src = FilePath
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 06efacdf..64a530bc 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -9,7 +9,7 @@ module Propellor.Property.Scheduled
, YearDay
) where
-import Propellor
+import Propellor.Base
import Utility.Scheduled
import Data.Time.Clock
diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs
index 9cc010e8..76c9aff7 100644
--- a/src/Propellor/Property/Service.hs
+++ b/src/Propellor/Property/Service.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Service where
-import Propellor
+import Propellor.Base
type ServiceName = String
diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs
index f5950e52..c62c1335 100644
--- a/src/Propellor/Property/SiteSpecific/Branchable.hs
+++ b/src/Propellor/Property/SiteSpecific/Branchable.hs
@@ -1,6 +1,6 @@
module Propellor.Property.SiteSpecific.Branchable where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import qualified Propellor.Property.User as User
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index f2a2f012..a10e5877 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -2,7 +2,7 @@
module Propellor.Property.SiteSpecific.GitAnnexBuilder where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.User as User
import qualified Propellor.Property.Cron as Cron
diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs
index 40f2ecd8..9b01b5e2 100644
--- a/src/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/src/Propellor/Property/SiteSpecific/GitHome.hs
@@ -1,6 +1,6 @@
module Propellor.Property.SiteSpecific.GitHome where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs
index eaef2817..93cf0b71 100644
--- a/src/Propellor/Property/SiteSpecific/IABak.hs
+++ b/src/Propellor/Property/SiteSpecific/IABak.hs
@@ -1,6 +1,6 @@
module Propellor.Property.SiteSpecific.IABak where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Git as Git
import qualified Propellor.Property.Cron as Cron
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 0a59452c..3f3205e6 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -3,7 +3,7 @@
module Propellor.Property.SiteSpecific.JoeySites where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Gpg as Gpg
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index fbd57057..4450dd07 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -25,7 +25,7 @@ module Propellor.Property.Ssh (
listenPort
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
import Propellor.Property.User
diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs
index 0257f3f1..ed6ba2d5 100644
--- a/src/Propellor/Property/Sudo.hs
+++ b/src/Propellor/Property/Sudo.hs
@@ -2,7 +2,7 @@ module Propellor.Property.Sudo where
import Data.List
-import Propellor
+import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e44ef717..8194fc85 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -40,7 +40,7 @@ module Propellor.Property.Systemd (
bindRo,
) where
-import Propellor
+import Propellor.Base
import Propellor.Types.Chroot
import Propellor.Types.Container
import Propellor.Types.Info
@@ -62,8 +62,8 @@ data Container = Container MachineName Chroot.Chroot Host
deriving (Show)
instance PropAccum Container where
- (Container n c h) & p = Container n c (h & p)
- (Container n c h) &^ p = Container n c (h &^ p)
+ (Container n c h) `addProp` p = Container n c (h `addProp` p)
+ (Container n c h) `addPropFront` p = Container n c (h `addPropFront` p)
getProperties (Container _ _ h) = hostProperties h
-- | Starts a systemd service.
@@ -376,8 +376,8 @@ instance Publishable (Proto, Bound Port) where
--
-- > foo :: Host
-- > foo = host "foo.example.com"
--- > & Systemd.running Systemd.networkd
-- > & Systemd.nspawned webserver
+-- > `requires` Systemd.running Systemd.networkd
-- >
-- > webserver :: Systemd.container
-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped (System (Debian Testing) "amd64") mempty)
diff --git a/src/Propellor/Property/Systemd/Core.hs b/src/Propellor/Property/Systemd/Core.hs
index b27a8e38..7842f177 100644
--- a/src/Propellor/Property/Systemd/Core.hs
+++ b/src/Propellor/Property/Systemd/Core.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Systemd.Core where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
-- dbus is only a Recommends of systemd, but is needed for communication
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index e2ee3dad..e5fcdaa4 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -1,6 +1,6 @@
module Propellor.Property.Tor where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index 0fa42052..f1280b0e 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -17,7 +17,7 @@ module Propellor.Property.Unbound
, cachingDnsServer
) where
-import Propellor
+import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index c029999f..c3314738 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -2,7 +2,7 @@ module Propellor.Property.User where
import System.Posix
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
data Eep = YesReallyDeleteHome
diff --git a/src/Propellor/Property/Uwsgi.hs b/src/Propellor/Property/Uwsgi.hs
index d1cdb550..8beea17a 100644
--- a/src/Propellor/Property/Uwsgi.hs
+++ b/src/Propellor/Property/Uwsgi.hs
@@ -2,7 +2,7 @@
module Propellor.Property.Uwsgi where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index b6d38d06..e90155f3 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -11,7 +11,7 @@ module Propellor.Protocol where
import Data.List
-import Propellor
+import Propellor.Base
data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush | NeedPrecompiled
deriving (Read, Show, Eq)
diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs
index e2941420..27545afb 100644
--- a/src/Propellor/Shim.hs
+++ b/src/Propellor/Shim.hs
@@ -6,7 +6,7 @@
module Propellor.Shim (setup, cleanEnv, file) where
-import Propellor
+import Propellor.Base
import Utility.LinuxMkLibs
import Utility.FileMode
import Utility.FileSystemEncoding
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index c5b31cef..ecefbf6e 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -16,7 +16,7 @@ import qualified Data.ByteString as B
import qualified Data.Set as S
import Network.Socket (getAddrInfo, defaultHints, AddrInfo(..), AddrInfoFlag(..), SockAddr)
-import Propellor
+import Propellor.Base
import Propellor.Protocol
import Propellor.PrivData.Paths
import Propellor.Git
diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs
index 3fe78f7a..b00eb651 100644
--- a/src/Propellor/Ssh.hs
+++ b/src/Propellor/Ssh.hs
@@ -1,6 +1,6 @@
module Propellor.Ssh where
-import Propellor
+import Propellor.Base
import Utility.UserInfo
import System.PosixCompat
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index ce93e144..fc700df0 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -10,12 +10,12 @@
module Propellor.Types
( Host(..)
- , Desc
, Property
, Info
, HasInfo
, NoInfo
, CInfo
+ , Desc
, infoProperty
, simpleProperty
, adjustPropertySatisfy
@@ -27,7 +27,6 @@ module Propellor.Types
, IsProp(..)
, Combines(..)
, CombinedType
- , before
, combineWith
, Propellor(..)
, EndAction(..)
@@ -93,6 +92,12 @@ type Desc = String
-- | The core data type of Propellor, this represents a property
-- that the system should have, and an action to ensure it has the
-- property.
+--
+-- A property can have associated `Info` or not. This is tracked at the
+-- type level with Property `NoInfo` and Property `HasInfo`.
+--
+-- There are many instances and type families, which are mostly used
+-- internally, so you needn't worry about them.
data Property i where
IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
@@ -164,17 +169,17 @@ propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs
--- | A property that can be reverted.
+-- | A property that can be reverted. The first Property is run
+-- normally and the second is run when it's reverted.
data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
--- | Makes a revertable property; the first Property is run
--- normally and the second is run when it's reverted.
+-- | Shorthand to construct a revertable property.
(<!>) :: Property i1 -> Property i2 -> RevertableProperty
p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
+-- | Class of types that can be used as properties of a host.
class IsProp p where
- -- | Sets description.
- describe :: p -> Desc -> p
+ setDesc :: p -> Desc -> p
toProp :: p -> Property HasInfo
getDesc :: p -> Desc
-- | Gets the info of the property, combined with all info
@@ -182,28 +187,28 @@ class IsProp p where
getInfoRecursive :: p -> Info
instance IsProp (Property HasInfo) where
- describe (IProperty _ a i cs) d = IProperty d a i cs
+ setDesc (IProperty _ a i cs) d = IProperty d a i cs
toProp = id
getDesc = propertyDesc
getInfoRecursive (IProperty _ _ i cs) =
i <> mconcat (map getInfoRecursive cs)
instance IsProp (Property NoInfo) where
- describe (SProperty _ a cs) d = SProperty d a cs
+ setDesc (SProperty _ a cs) d = SProperty d a cs
toProp = toIProperty
getDesc = propertyDesc
getInfoRecursive _ = mempty
instance IsProp RevertableProperty where
-- | Sets the description of both sides.
- describe (RevertableProperty p1 p2) d =
- RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
+ setDesc (RevertableProperty p1 p2) d =
+ RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
-- | Return the Info of the currently active side.
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
--- | Type level calculation of the type that results from combining two types
--- with `requires`.
+-- | Type level calculation of the type that results from combining two
+-- types of properties.
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty
@@ -211,15 +216,11 @@ type instance CombinedType RevertableProperty (Property HasInfo) = RevertablePro
type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
class Combines x y where
- -- | Indicates that the first property depends on the second,
- -- so before the first is ensured, the second will be ensured.
- requires :: x -> y -> CombinedType x y
-
--- | Combines together two properties, resulting in one property
--- that ensures the first, and if the first succeeds, ensures the second.
--- The property uses the description of the first property.
-before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
-before x y = (y `requires` x) `describe` getDesc x
+ -- | Combines two properties. The second property is ensured
+ -- first, and only once it is successfully ensures will the first
+ -- be ensured. The combined property will have the description of
+ -- the first property.
+ (<<>>) :: x -> y -> CombinedType x y
-- | Combines together two properties, yielding a property that
-- has the description and info of the first, and that has the second
@@ -231,36 +232,36 @@ combineWith
-> Property x
-> Property y
-> CombinedType (Property x) (Property y)
-combineWith f x y = adjustPropertySatisfy (x `requires` y) $ \_ ->
+combineWith f x y = adjustPropertySatisfy (x <<>> y) $ \_ ->
f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y)
instance Combines (Property HasInfo) (Property HasInfo) where
- requires (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
+ (IProperty d1 a1 i1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (a2 <> a1) i1 (y : cs1)
instance Combines (Property HasInfo) (Property NoInfo) where
- requires (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
+ (IProperty d1 a1 i1 cs1) <<>> y@(SProperty _d2 a2 _cs2) =
IProperty d1 (a2 <> a1) i1 (toIProperty y : cs1)
instance Combines (Property NoInfo) (Property HasInfo) where
- requires (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
+ (SProperty d1 a1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (a2 <> a1) mempty (y : map toIProperty cs1)
instance Combines (Property NoInfo) (Property NoInfo) where
- requires (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
+ (SProperty d1 a1 cs1) <<>> y@(SProperty _d2 a2 _cs2) =
SProperty d1 (a2 <> a1) (y : cs1)
instance Combines RevertableProperty (Property HasInfo) where
- requires (RevertableProperty p1 p2) y =
- RevertableProperty (p1 `requires` y) p2
+ (RevertableProperty p1 p2) <<>> y =
+ RevertableProperty (p1 <<>> y) p2
instance Combines RevertableProperty (Property NoInfo) where
- requires (RevertableProperty p1 p2) y =
- RevertableProperty (p1 `requires` toIProperty y) p2
+ (RevertableProperty p1 p2) <<>> y =
+ RevertableProperty (p1 <<>> toIProperty y) p2
instance Combines RevertableProperty RevertableProperty where
- requires (RevertableProperty x1 x2) (RevertableProperty y1 y2) =
+ (RevertableProperty x1 x2) <<>> (RevertableProperty y1 y2) =
RevertableProperty
- (x1 `requires` y1)
+ (x1 <<>> y1)
-- when reverting, run actions in reverse order
- (y2 `requires` x2)
+ (y2 <<>> x2)
diff --git a/src/Propellor/Utilities.hs b/src/Propellor/Utilities.hs
new file mode 100644
index 00000000..33af4eda
--- /dev/null
+++ b/src/Propellor/Utilities.hs
@@ -0,0 +1,27 @@
+-- | Re-exports some of propellor's internal utility modules.
+--
+-- These are used in the implementation of propellor, including some of its
+-- properties. However, there is no API stability; any of these can change
+-- or be removed without a major version number increase.
+--
+-- Use outside propellor at your own risk.
+
+module Propellor.Utilities (
+ module Utility.PartialPrelude
+ , module Utility.Process
+ , module Utility.Exception
+ , module Utility.Env
+ , module Utility.Directory
+ , module Utility.Tmp
+ , module Utility.Monad
+ , module Utility.Misc
+) where
+
+import Utility.PartialPrelude
+import Utility.Process
+import Utility.Exception
+import Utility.Env
+import Utility.Directory
+import Utility.Tmp
+import Utility.Monad
+import Utility.Misc