module Propellor.Property.Apache where

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.LetsEncrypt as LetsEncrypt

installed :: Property DebianLike
installed :: Property DebianLike
installed = [Package] -> Property DebianLike
Apt.installed [Package
"apache2"]

restarted :: Property DebianLike
restarted :: Property DebianLike
restarted = Package -> Property DebianLike
Service.restarted Package
"apache2"

reloaded :: Property DebianLike
reloaded :: Property DebianLike
reloaded = Package -> Property DebianLike
Service.reloaded Package
"apache2"

type ConfigLine = String

type ConfigFile = [ConfigLine]

siteEnabled :: Domain -> ConfigFile -> RevertableProperty DebianLike DebianLike
siteEnabled :: Package -> [Package] -> RevertableProperty DebianLike DebianLike
siteEnabled Package
domain [Package]
cf = Package -> [Package] -> Property DebianLike
siteEnabled' Package
domain [Package]
cf Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Package -> Property DebianLike
siteDisabled Package
domain

siteEnabled' :: Domain -> ConfigFile -> Property DebianLike
siteEnabled' :: Package -> [Package] -> Property DebianLike
siteEnabled' Package
domain [Package]
cf = Package -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Package
"apache site enabled " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain) (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Package -> [Package] -> Property DebianLike
siteAvailable Package
domain [Package]
cf
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
	Props DebianLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isenabled)
		(Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"a2ensite" [Package
"--quiet", Package
domain])
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
			Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
  where
	isenabled :: IO Bool
isenabled = Package -> [CommandParam] -> IO Bool
boolSystem Package
"a2query" [Package -> CommandParam
Param Package
"-q", Package -> CommandParam
Param Package
"-s", Package -> CommandParam
Param Package
domain]

siteDisabled :: Domain -> Property DebianLike
siteDisabled :: Package -> Property DebianLike
siteDisabled Package
domain = Package -> Props UnixLike -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties
	(Package
"apache site disabled " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain)
	([Property UnixLike] -> Props UnixLike
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property UnixLike] -> Props UnixLike)
-> [Property UnixLike] -> Props UnixLike
forall a b. (a -> b) -> a -> b
$ (Package -> Property UnixLike) -> [Package] -> [Property UnixLike]
forall a b. (a -> b) -> [a] -> [b]
map Package -> Property UnixLike
File.notPresent (Package -> [Package]
siteCfg Package
domain))
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"a2dissite" [Package
"--quiet", Package
domain] UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange)
		Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded

siteAvailable :: Domain -> ConfigFile -> Property DebianLike
siteAvailable :: Package -> [Package] -> Property DebianLike
siteAvailable Package
domain [Package]
cf = Package -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Package
"apache site available " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain) (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	[Property DebianLike] -> Props DebianLike
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property DebianLike] -> Props DebianLike)
-> [Property DebianLike] -> Props DebianLike
forall a b. (a -> b) -> a -> b
$ (Property UnixLike -> Property DebianLike)
-> [Property UnixLike] -> [Property DebianLike]
forall a b. (a -> b) -> [a] -> [b]
map Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets ([Property UnixLike] -> [Property DebianLike])
-> [Property UnixLike] -> [Property DebianLike]
forall a b. (a -> b) -> a -> b
$
		(Package -> Property UnixLike) -> [Package] -> [Property UnixLike]
forall a b. (a -> b) -> [a] -> [b]
map (Package -> [Package] -> Property UnixLike
`File.hasContent` (Package
commentPackage -> [Package] -> [Package]
forall a. a -> [a] -> [a]
:[Package]
cf)) (Package -> [Package]
siteCfg Package
domain)
  where
	comment :: Package
comment = Package
"# deployed with propellor, do not modify"

modEnabled :: String -> RevertableProperty DebianLike DebianLike
modEnabled :: Package -> RevertableProperty DebianLike DebianLike
modEnabled Package
modname = Property DebianLike
enable Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
disable
  where
	enable :: CombinedType (Property DebianLike) (Property DebianLike)
enable = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isenabled)
		(Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"a2enmod" [Package
"--quiet", Package
modname])
			Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` (Package
"apache module enabled " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
modname)
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
			Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
	disable :: CombinedType (Property DebianLike) (Property DebianLike)
disable = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
isenabled
		(Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"a2dismod" [Package
"--quiet", Package
modname])
			Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` (Package
"apache module disabled " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
modname)
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
			Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
	isenabled :: IO Bool
isenabled = Package -> [CommandParam] -> IO Bool
boolSystem Package
"a2query" [Package -> CommandParam
Param Package
"-q", Package -> CommandParam
Param Package
"-m", Package -> CommandParam
Param Package
modname]

-- | Control whether an apache configuration file is enabled. 
--
-- The String is the base name of the configuration, eg "charset" or "gitweb".
confEnabled :: String -> RevertableProperty DebianLike DebianLike
confEnabled :: Package -> RevertableProperty DebianLike DebianLike
confEnabled Package
confname = Property DebianLike
enable Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
disable
  where
	enable :: CombinedType (Property DebianLike) (Property DebianLike)
enable = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isenabled)
		(Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"a2enconf" [Package
"--quiet", Package
confname])
			Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` (Package
"apache configuration enabled " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
confname)
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
			Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
	disable :: CombinedType (Property DebianLike) (Property DebianLike)
disable = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
isenabled
		(Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"a2disconf" [Package
"--quiet", Package
confname])
			Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` (Package
"apache configuration disabled " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
confname)
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
			Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
	isenabled :: IO Bool
isenabled = Package -> [CommandParam] -> IO Bool
boolSystem Package
"a2query" [Package -> CommandParam
Param Package
"-q", Package -> CommandParam
Param Package
"-c", Package -> CommandParam
Param Package
confname]

-- | 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 DebianLike
listenPorts :: [Port] -> Property DebianLike
listenPorts [Port]
ps = Package
"/etc/apache2/ports.conf" Package -> [Package] -> Property UnixLike
`File.hasContent` (Port -> Package) -> [Port] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map Port -> Package
forall t. ConfigurableValue t => t -> Package
portline [Port]
ps
	Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
restarted
  where
	portline :: t -> Package
portline t
port = Package
"Listen " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ t -> Package
forall t. ConfigurableValue t => t -> Package
val t
port

-- This is a list of config files because different versions of apache
-- use different filenames. Propellor simply writes them all.
siteCfg :: Domain -> [FilePath]
siteCfg :: Package -> [Package]
siteCfg Package
domain =
	-- Debian pre-2.4
	[ Package
"/etc/apache2/sites-available/" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain
	-- Debian 2.4+
	, Package
"/etc/apache2/sites-available/" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
".conf"
	]

-- | Configure apache to use SNI to differentiate between
-- https hosts.
--
-- This was off by default in apache 2.2.22. Newver versions enable
-- it by default. This property uses the filename used by the old version.
multiSSL :: Property DebianLike
multiSSL :: Property DebianLike
multiSSL = IO Bool -> Property DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Package -> IO Bool
doesDirectoryExist Package
"/etc/apache2/conf.d") (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	Package
"/etc/apache2/conf.d/ssl" Package -> [Package] -> Property UnixLike
`File.hasContent`
		[ Package
"NameVirtualHost *:443"
		, Package
"SSLStrictSNIVHostCheck off"
		]
		Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` Package
"apache SNI enabled"
		Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded

-- | Config file fragment that can be inserted into a <Directory>
-- stanza to allow global read access to the directory.
--
-- Works with multiple versions of apache that have different ways to do
-- it.
allowAll :: ConfigLine
allowAll :: Package
allowAll = [Package] -> Package
unlines
	[ Package
"<IfVersion < 2.4>"
	, Package
"Order allow,deny"
	, Package
"allow from all"
	, Package
"</IfVersion>"
	, Package
"<IfVersion >= 2.4>"
	, Package
"Require all granted"
	, Package
"</IfVersion>"
	]

-- | Config file fragment that can be inserted into a <VirtualHost>
-- stanza to allow apache to display directory index icons.
iconDir :: ConfigLine
iconDir :: Package
iconDir = [Package] -> Package
unlines
	[ Package
"<Directory \"/usr/share/apache2/icons\">"
	, Package
"Options Indexes MultiViews"
	, Package
"AllowOverride None"
	, Package
allowAll
	, Package
"  </Directory>"
	]

type WebRoot = FilePath

-- | A basic virtual host, publishing a directory, and logging to
-- the combined apache log file. Not https capable.
virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty DebianLike DebianLike
virtualHost :: Package
-> Port -> Package -> RevertableProperty DebianLike DebianLike
virtualHost Package
domain Port
port Package
docroot = Package
-> Port
-> Package
-> [Package]
-> RevertableProperty DebianLike DebianLike
virtualHost' Package
domain Port
port Package
docroot []

-- | Like `virtualHost` but with additional config lines added.
virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
virtualHost' :: Package
-> Port
-> Package
-> [Package]
-> RevertableProperty DebianLike DebianLike
virtualHost' Package
domain Port
port Package
docroot [Package]
addedcfg = Package -> [Package] -> RevertableProperty DebianLike DebianLike
siteEnabled Package
domain ([Package] -> RevertableProperty DebianLike DebianLike)
-> [Package] -> RevertableProperty DebianLike DebianLike
forall a b. (a -> b) -> a -> b
$
	[ Package
"<VirtualHost *:" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Port -> Package
forall t. ConfigurableValue t => t -> Package
val Port
port Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
">"
	, Package
"ServerName " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Port -> Package
forall t. ConfigurableValue t => t -> Package
val Port
port
	, Package
"DocumentRoot " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
docroot
	, Package
"ErrorLog /var/log/apache2/error.log"
	, Package
"LogLevel warn"
	, Package
"CustomLog /var/log/apache2/access.log combined"
	, Package
"ServerSignature On"
	]
	[Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [Package]
addedcfg [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++
	[ Package
"</VirtualHost>"
	]

-- | A virtual host using https, with the certificate obtained
-- using `Propellor.Property.LetsEncrypt.letsEncrypt`.
--
-- http connections are redirected to https.
--
-- Example:
--
-- > httpsVirtualHost "example.com" "/var/www"
-- > 	(LetsEncrypt.AgreeTOS (Just "me@my.domain"))
--
-- Note that reverting this property does not remove the certificate from
-- letsencrypt's cert store.
httpsVirtualHost :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> RevertableProperty DebianLike DebianLike
httpsVirtualHost :: Package
-> Package -> AgreeTOS -> RevertableProperty DebianLike DebianLike
httpsVirtualHost Package
domain Package
docroot AgreeTOS
letos = Package
-> Package
-> AgreeTOS
-> [Package]
-> RevertableProperty DebianLike DebianLike
httpsVirtualHost' Package
domain Package
docroot AgreeTOS
letos []

-- | Like `httpsVirtualHost` but with additional config lines added.
httpsVirtualHost' :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
httpsVirtualHost' :: Package
-> Package
-> AgreeTOS
-> [Package]
-> RevertableProperty DebianLike DebianLike
httpsVirtualHost' Package
domain Package
docroot AgreeTOS
letos [Package]
addedcfg = Property DebianLike
setup Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
teardown
  where
	setup :: CombinedType (Property DebianLike) (Property DebianLike)
setup = Property DebianLike
setuphttp
		Property DebianLike
-> RevertableProperty DebianLike DebianLike
-> CombinedType
     (Property DebianLike) (RevertableProperty DebianLike DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Package -> RevertableProperty DebianLike DebianLike
modEnabled Package
"rewrite"
		Property DebianLike
-> RevertableProperty DebianLike DebianLike
-> CombinedType
     (Property DebianLike) (RevertableProperty DebianLike DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Package -> RevertableProperty DebianLike DebianLike
modEnabled Package
"ssl"
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
setuphttps
	teardown :: Property DebianLike
teardown = Package -> Property DebianLike
siteDisabled Package
domain
	setuphttp :: CombinedType (Property DebianLike) (Property UnixLike)
setuphttp = (Package -> [Package] -> Property DebianLike
siteEnabled' Package
domain ([Package] -> Property DebianLike)
-> [Package] -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
		-- The sslconffile is only created after letsencrypt gets
		-- the cert. The "*" is needed to make apache not error
		-- when the file doesn't exist.
		(Package
"IncludeOptional " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package -> Package
sslconffile Package
"*")
		Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: Port -> [Package] -> [Package]
forall t. ConfigurableValue t => t -> [Package] -> [Package]
vhost (Int -> Port
Port Int
80)
			[ Package
"RewriteEngine On"
			-- Pass through .well-known directory on http for the
			-- letsencrypt acme challenge.
			, Package
"RewriteRule ^/.well-known/(.*) - [L]"
			-- Everything else redirects to https
			, Package
"RewriteRule ^/(.*) https://" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
"/$1 [L,R,NE]"
			])
		Property DebianLike
-> Property UnixLike
-> CombinedType (Property DebianLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Package -> Property UnixLike
File.dirExists (Package -> Package
takeDirectory Package
cf)
	setuphttps :: CombinedType (Property DebianLike) (Property DebianLike)
setuphttps = AgreeTOS -> Package -> Package -> Property DebianLike
LetsEncrypt.letsEncrypt AgreeTOS
letos Package
domain Package
docroot
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
postsetuphttps
	postsetuphttps :: Property DebianLike
postsetuphttps = Package -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Package
domain Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
" ssl cert installed") (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Package -> [Package] -> Property UnixLike
File.hasContent Package
cf [Package]
sslvhost
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
		-- always reload since the cert has changed
		Props DebianLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Property DebianLike
reloaded
	  where
		sslvhost :: [Package]
sslvhost = Port -> [Package] -> [Package]
forall t. ConfigurableValue t => t -> [Package] -> [Package]
vhost (Int -> Port
Port Int
443)
			[ Package
"SSLEngine on"
			, Package
"SSLCertificateFile " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package -> Package
LetsEncrypt.certFile Package
domain
			, Package
"SSLCertificateKeyFile " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package -> Package
LetsEncrypt.privKeyFile Package
domain
			, Package
"SSLCertificateChainFile " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package -> Package
LetsEncrypt.chainFile Package
domain
			]
	cf :: Package
cf = Package -> Package
sslconffile Package
"letsencrypt"
	sslconffile :: Package -> Package
sslconffile Package
s = Package
"/etc/apache2/sites-available/ssl/" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
"/" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
s Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
".conf"
	vhost :: t -> [Package] -> [Package]
vhost t
p [Package]
ls =
		[ Package
"<VirtualHost *:" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ t -> Package
forall t. ConfigurableValue t => t -> Package
val t
p Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
">"
		, Package
"ServerName " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
domain Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ t -> Package
forall t. ConfigurableValue t => t -> Package
val t
p
		, Package
"DocumentRoot " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
docroot
		, Package
"ErrorLog /var/log/apache2/error.log"
		, Package
"LogLevel warn"
		, Package
"CustomLog /var/log/apache2/access.log combined"
		, Package
"ServerSignature On"
		] [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [Package]
ls [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [Package]
addedcfg [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++
		[ Package
"</VirtualHost>"
		]