-- | Specific configuration for Joey Hess's sites. Probably not useful to
-- others except as an example.

{-# LANGUAGE FlexibleContexts, TypeFamilies #-}

module Propellor.Property.SiteSpecific.JoeySites where

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import qualified Propellor.Property.ConfFile as ConfFile
import qualified Propellor.Property.Gpg as Gpg
import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Git as Git
import qualified Propellor.Property.Cron as Cron
import qualified Propellor.Property.Service as Service
import qualified Propellor.Property.User as User
import qualified Propellor.Property.Group as Group
import qualified Propellor.Property.Sudo as Sudo
import qualified Propellor.Property.Borg as Borg
import qualified Propellor.Property.Apache as Apache
import qualified Propellor.Property.Postfix as Postfix
import qualified Propellor.Property.Systemd as Systemd
import qualified Propellor.Property.Network as Network
import qualified Propellor.Property.Fail2Ban as Fail2Ban
import qualified Propellor.Property.LetsEncrypt as LetsEncrypt
import qualified Propellor.Property.Mount as Mount
import Utility.Split

import Data.List
import System.Posix.Files

kgbServer :: Property (HasInfo + DebianLike)
kgbServer :: Property (HasInfo + DebianLike)
kgbServer = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"kgb-bot"
	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))
& [Char]
"/etc/default/kgb-bot" [Char] -> [Char] -> Property UnixLike
`File.containsLine` [Char]
"BOT_ENABLED=1"
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"kgb bot enabled"
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.running [Char]
"kgb-bot"
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
"/etc/kgb-bot/kgb.conf" Context
anyContext
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"kgb-bot"
  where
	desc :: [Char]
desc = [Char]
"kgb.kitenet.net setup"

-- git.kitenet.net and git.joeyh.name
gitServer :: [Host] -> Property (HasInfo + DebianLike)
gitServer :: [Host] -> Property (HasInfo + DebianLike)
gitServer [Host]
hosts = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"git.kitenet.net setup" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char]
-> BorgRepo
-> Times
-> [[Char]]
-> [KeepPolicy]
-> Property DebianLike
Borg.backup [Char]
"/srv/git" BorgRepo
borgrepo
		([Char] -> Times
Cron.Times [Char]
"33 3 * * *")
		[]
		[Int -> KeepPolicy
Borg.KeepDays Int
30]
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` forall c.
IsContext c =>
Maybe [Char]
-> User
-> c
-> (SshKeyType, [Char])
-> Property (HasInfo + UnixLike)
Ssh.userKeyAt (forall a. a -> Maybe a
Just [Char]
sshkey)
			([Char] -> User
User [Char]
"root")
			([Char] -> Context
Context [Char]
"git.kitenet.net")
			(SshKeyType
SshEd25519, [Char]
"ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIOvgBVYP6srImGbJ+kg1K68HeUQqxHEBQswMWSqu9WOu root@kite")
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Host] -> [Char] -> User -> Property UnixLike
Ssh.knownHost [Host]
hosts [Char]
"usw-s002.rsync.net" ([Char] -> User
User [Char]
"root")
	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))
& forall c. IsContext c => User -> c -> Property (HasInfo + UnixLike)
Ssh.authorizedKeys ([Char] -> User
User [Char]
"family") ([Char] -> Context
Context [Char]
"git.kitenet.net")
	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))
& User -> Property DebianLike
User.accountFor ([Char] -> User
User [Char]
"family")
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"git", [Char]
"rsync", [Char]
"cgit"]
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"git-annex"]
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"kgb-client"]
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentExposed [Char]
"/etc/kgb-bot/kgb-client.conf" Context
anyContext
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property UnixLike
File.dirExists [Char]
"/etc/kgb-bot/"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
Git.daemonRunning [Char]
"/srv/git"
	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))
& [Char]
"/etc/cgitrc" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"clone-url=https://git.joeyh.name/git/$CGIT_REPO_URL git://git.joeyh.name/$CGIT_REPO_URL"
		, [Char]
"css=/cgit-css/cgit.css"
		, [Char]
"logo=/cgit-css/cgit.png"
		, [Char]
"enable-http-clone=1"
		, [Char]
"root-title=Joey's git repositories"
		, [Char]
"root-desc="
		, [Char]
"enable-index-owner=0"
		, [Char]
"snapshots=tar.gz"
		, [Char]
"enable-git-config=1"
		, [Char]
"scan-path=/srv/git"
		]
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"cgit configured"
	-- I keep the website used for git.kitenet.net/git.joeyh.name checked into git..
	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))
& User -> [Char] -> [Char] -> Maybe [Char] -> Property DebianLike
Git.cloned ([Char] -> User
User [Char]
"joey") [Char]
"/srv/git/joey/git.kitenet.net.git" [Char]
"/srv/web/git.kitenet.net" forall a. Maybe a
Nothing
	-- Don't need global apache configuration for cgit.
	forall {a} {k} (x :: [a]) (z :: [a]) (y :: k).
CheckCombinableNote x z (NoteFor ('Text "!")) =>
Props (MetaTypes x)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
-> Props (MetaTypes (Combine x z))
! [Char] -> RevertableProperty DebianLike DebianLike
Apache.confEnabled [Char]
"cgit"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
website [Char]
"git.kitenet.net"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
website [Char]
"git.joeyh.name"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
Apache.modEnabled [Char]
"cgi"
  where
	sshkey :: [Char]
sshkey = [Char]
"/root/.ssh/git.kitenet.net.key"
	borgrepo :: BorgRepo
borgrepo = [Char] -> [BorgRepoOpt] -> BorgRepo
rsyncNetBorgRepo [Char]
"git.kitenet.net.borg" [[Char] -> BorgRepoOpt
Borg.UseSshKey [Char]
sshkey]
	website :: [Char] -> RevertableProperty DebianLike DebianLike
website [Char]
hn = [Char]
-> [Char]
-> AgreeTOS
-> [[Char]]
-> RevertableProperty DebianLike DebianLike
Apache.httpsVirtualHost' [Char]
hn [Char]
"/srv/web/git.kitenet.net/" AgreeTOS
letos
		[ [Char]
Apache.iconDir
		, [Char]
"  <Directory /srv/web/git.kitenet.net/>"
		, [Char]
"    Options Indexes ExecCGI FollowSymlinks"
		, [Char]
"    AllowOverride None"
		, [Char]
"    AddHandler cgi-script .cgi"
		, [Char]
"    DirectoryIndex index.cgi"
		,      [Char]
Apache.allowAll
		, [Char]
"  </Directory>"
		, [Char]
""
		, [Char]
"  ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/"
		, [Char]
"  <Directory /usr/lib/cgi-bin>"
		, [Char]
"    SetHandler cgi-script"
		, [Char]
"    Options ExecCGI"
		, [Char]
"  </Directory>"
		]

type AnnexUUID = String

-- | A website, with files coming from a git-annex repository.
annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property (HasInfo + DebianLike)
annexWebSite :: [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> Property (HasInfo + DebianLike)
annexWebSite [Char]
origin [Char]
hn [Char]
uuid [([Char], [Char])]
remotes = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList ([Char]
hn forall a. [a] -> [a] -> [a]
++[Char]
" website using git-annex") forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& User -> [Char] -> [Char] -> Maybe [Char] -> Property DebianLike
Git.cloned ([Char] -> User
User [Char]
"joey") [Char]
origin [Char]
dir forall a. Maybe a
Nothing
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
setup
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
hn
	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))
& [Char]
postupdatehook [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"#!/bin/sh"
		, [Char]
"exec git update-server-info"
		] forall x y. Combines x y => x -> y -> CombinedType x y
`onChange`
			([Char]
postupdatehook [Char] -> FileMode -> Property UnixLike
`File.mode` ([FileMode] -> FileMode
combineModes (FileMode
ownerWriteModeforall a. a -> [a] -> [a]
:[FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)))
	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))
& RevertableProperty DebianLike DebianLike
setupapache
  where
	dir :: [Char]
dir = [Char]
"/srv/web/" forall a. [a] -> [a] -> [a]
++ [Char]
hn
	postupdatehook :: [Char]
postupdatehook = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
".git/hooks/post-update"
	setup :: Property UnixLike
setup = User -> [[Char]] -> UncheckedProperty UnixLike
userScriptProperty ([Char] -> User
User [Char]
"joey") [[Char]]
setupscript
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	setupscript :: [[Char]]
setupscript =
		[ [Char]
"cd " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
shellEscape [Char]
dir
		, [Char]
"git annex reinit " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
shellEscape [Char]
uuid
		] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
addremote [([Char], [Char])]
remotes forall a. [a] -> [a] -> [a]
++
		[ [Char]
"git annex get"
		, [Char]
"git update-server-info"
		]
	addremote :: ([Char], [Char]) -> [Char]
addremote ([Char]
name, [Char]
url) = [Char]
"git remote add " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
shellEscape [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
shellEscape [Char]
url
	setupapache :: RevertableProperty DebianLike DebianLike
setupapache = [Char]
-> [Char]
-> AgreeTOS
-> [[Char]]
-> RevertableProperty DebianLike DebianLike
Apache.httpsVirtualHost' [Char]
hn [Char]
dir AgreeTOS
letos
		[ [Char]
"  ServerAlias www."forall a. [a] -> [a] -> [a]
++[Char]
hn
		,    [Char]
Apache.iconDir
		, [Char]
"  <Directory "forall a. [a] -> [a] -> [a]
++[Char]
dirforall a. [a] -> [a] -> [a]
++[Char]
">"
		, [Char]
"    Options Indexes FollowSymLinks ExecCGI"
		, [Char]
"    AllowOverride None"
		, [Char]
"    AddHandler cgi-script .cgi"
		, [Char]
"    DirectoryIndex index.html index.cgi"
		,      [Char]
Apache.allowAll
		, [Char]
"  </Directory>"
		]

letos :: LetsEncrypt.AgreeTOS
letos :: AgreeTOS
letos = Maybe [Char] -> AgreeTOS
LetsEncrypt.AgreeTOS (forall a. a -> Maybe a
Just [Char]
"id@joeyh.name")

apacheSite :: HostName -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
apacheSite :: [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
hn [[Char]]
middle = [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
Apache.siteEnabled [Char]
hn forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
apachecfg [Char]
hn [[Char]]
middle

apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile
apachecfg :: [Char] -> [[Char]] -> [[Char]]
apachecfg [Char]
hn [[Char]]
middle =
	[ [Char]
"<VirtualHost *:" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> [Char]
val Port
port forall a. [a] -> [a] -> [a]
++ [Char]
">"
	, [Char]
"  ServerAdmin grue@joeyh.name"
	, [Char]
"  ServerName "forall a. [a] -> [a] -> [a]
++[Char]
hnforall a. [a] -> [a] -> [a]
++[Char]
":" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> [Char]
val Port
port
	]
	forall a. [a] -> [a] -> [a]
++ [[Char]]
middle forall a. [a] -> [a] -> [a]
++
	[ [Char]
""
	, [Char]
"  ErrorLog /var/log/apache2/error.log"
	, [Char]
"  LogLevel warn"
	, [Char]
"  CustomLog /var/log/apache2/access.log combined"
	, [Char]
"  ServerSignature On"
	, [Char]
"  "
	, [Char]
Apache.iconDir
	, [Char]
"</VirtualHost>"
	]
	  where
		port :: Port
port = Int -> Port
Port Int
80

gitAnnexDistributor :: Property (HasInfo + DebianLike)
gitAnnexDistributor :: Property (HasInfo + DebianLike)
gitAnnexDistributor = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties [Char]
"git-annex distributor, including rsync server and signer" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"rsync"]
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
"/etc/rsyncd.conf" ([Char] -> Context
Context [Char]
"git-annex distributor")
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"rsync"
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
"/etc/rsyncd.secrets" ([Char] -> Context
Context [Char]
"git-annex distributor")
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"rsync"
	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))
& [Char]
"/etc/default/rsync" [Char] -> [Char] -> Property UnixLike
`File.containsLine` [Char]
"RSYNC_ENABLE=true"
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.running [Char]
"rsync"
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
"rsync"
	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))
& [Char] -> Property UnixLike
endpoint [Char]
"/srv/web/downloads.kitenet.net/git-annex/autobuild"
	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))
& [Char] -> Property UnixLike
endpoint [Char]
"/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-yosemite"
	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))
& [Char] -> Property UnixLike
endpoint [Char]
"/srv/web/downloads.kitenet.net/git-annex/autobuild/windows"
	-- git-annex distribution signing key
	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))
& GpgKeyId -> User -> Property (HasInfo + DebianLike)
Gpg.keyImported ([Char] -> GpgKeyId
Gpg.GpgKeyId [Char]
"89C809CB") ([Char] -> User
User [Char]
"joey")
	-- used for building rpms
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"rpm", [Char]
"createrepo-c"]
  where
	endpoint :: [Char]
-> Property
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
endpoint [Char]
d = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties ([Char]
"endpoint " forall a. [a] -> [a] -> [a]
++ [Char]
d) forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		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))
& [Char] -> Property UnixLike
File.dirExists [Char]
d
		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))
& [Char] -> User -> Group -> Property UnixLike
File.ownerGroup [Char]
d ([Char] -> User
User [Char]
"joey") ([Char] -> Group
Group [Char]
"joey")

downloads :: Property (HasInfo + DebianLike)
downloads :: Property (HasInfo + DebianLike)
downloads = [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> Property (HasInfo + DebianLike)
annexWebSite [Char]
"/srv/git/downloads.git"
	[Char]
"downloads.kitenet.net"
	[Char]
"840760dc-08f0-11e2-8c61-576b7e66acfd"
	[]

tmp :: Property (HasInfo + DebianLike)
tmp :: Property (HasInfo + DebianLike)
tmp = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"tmp.joeyh.name" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char]
-> [Char]
-> [Char]
-> [([Char], [Char])]
-> Property (HasInfo + DebianLike)
annexWebSite [Char]
"/srv/git/joey/tmp.git"
		[Char]
"tmp.joeyh.name"
		[Char]
"26fd6e38-1226-11e2-a75f-ff007033bdba"
		[]
	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))
& [Char] -> Times -> Property UnixLike
Cron.jobDropped [Char]
"pump rss" ([Char] -> Times
Cron.Times [Char]
"15 * * * *")

ircBouncer :: Property (HasInfo + DebianLike)
ircBouncer :: Property (HasInfo + DebianLike)
ircBouncer = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"IRC bouncer" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"znc"]
	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))
& User -> Property DebianLike
User.accountFor ([Char] -> User
User [Char]
"znc")
	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))
& [Char] -> Property UnixLike
File.dirExists ([Char] -> [Char]
takeDirectory [Char]
conf)
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
conf Context
anyContext
	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))
& [Char] -> User -> Group -> Property UnixLike
File.ownerGroup [Char]
conf ([Char] -> User
User [Char]
"znc") ([Char] -> Group
Group [Char]
"znc")
	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))
& [Char] -> Times -> User -> [Char] -> [Char] -> Property DebianLike
Cron.job [Char]
"znconboot" ([Char] -> Times
Cron.Times [Char]
"@reboot") ([Char] -> User
User [Char]
"znc") [Char]
"~" [Char]
"znc"
	-- ensure running if it was not already
	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))
& User -> [[Char]] -> UncheckedProperty UnixLike
userScriptProperty ([Char] -> User
User [Char]
"znc") [[Char]
"znc || true"]
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"znc running"
  where
	conf :: [Char]
conf = [Char]
"/home/znc/.znc/configs/znc.conf"

githubBackup :: Property (HasInfo + DebianLike)
githubBackup :: Property (HasInfo + DebianLike)
githubBackup = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"github-backup box" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"github-backup", [Char]
"moreutils"]
	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 (HasInfo + UnixLike)
githubKeys
	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))
& [Char] -> Times -> User -> [Char] -> [Char] -> Property DebianLike
Cron.niceJob [Char]
"github-backup run" ([Char] -> Times
Cron.Times [Char]
"30 4 * * *") ([Char] -> User
User [Char]
"joey")
		[Char]
"/home/joey/lib/backup" [Char]
backupcmd
  where
	backupcmd :: [Char]
backupcmd = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"&&" forall a b. (a -> b) -> a -> b
$
		[ [Char]
"mkdir -p github"
		, [Char]
"cd github"
		, [Char]
". $HOME/.github-keys"
		, [Char]
"github-backup joeyh"
		]

githubKeys :: Property (HasInfo + UnixLike)
githubKeys :: Property (HasInfo + UnixLike)
githubKeys =
	let f :: [Char]
f = [Char]
"/home/joey/.github-keys"
	in forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
f Context
anyContext
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> User -> Group -> Property UnixLike
File.ownerGroup [Char]
f ([Char] -> User
User [Char]
"joey") ([Char] -> Group
Group [Char]
"joey")


rsyncNetBackup :: [Host] -> Property DebianLike
rsyncNetBackup :: [Host] -> Property DebianLike
rsyncNetBackup [Host]
hosts = [Char] -> Times -> User -> [Char] -> [Char] -> Property DebianLike
Cron.niceJob [Char]
"rsync.net copied in daily" ([Char] -> Times
Cron.Times [Char]
"30 5 * * *")
	([Char] -> User
User [Char]
"joey") [Char]
"/home/joey/lib/backup" [Char]
"mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Host] -> [Char] -> User -> Property UnixLike
Ssh.knownHost [Host]
hosts [Char]
"usw-s002.rsync.net" ([Char] -> User
User [Char]
"joey")

podcatcher :: Property DebianLike
podcatcher :: Property DebianLike
podcatcher = [Char] -> Times -> User -> [Char] -> [Char] -> Property DebianLike
Cron.niceJob [Char]
"podcatcher run hourly" ([Char] -> Times
Cron.Times [Char]
"55 * * * *")
	([Char] -> User
User [Char]
"joey") [Char]
"/home/joey/lib/sound/podcasts"
	[Char]
"timeout 2h xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed [[Char]
"git-annex", [Char]
"myrepos"]

spamdEnabled :: Property DebianLike
spamdEnabled :: Property DebianLike
spamdEnabled = [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"spamd"

spamassassinConfigured :: Property DebianLike
spamassassinConfigured :: Property DebianLike
spamassassinConfigured = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"spamassassin configured" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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
spamdEnabled
	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))
& [Char]
"/etc/default/spamd" [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"# Propellor deployed"
		, [Char]
"OPTIONS=\"--create-prefs --max-children 5 --helper-home-dir\""
		, [Char]
"NICE=\"--nicelevel 15\""
		] 
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"spamd configured"
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"spamd"
	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))
& [Char]
"/etc/default/spamassassin" [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"# Propellor deployed"
		, [Char]
"CRON=1"
		]
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"spamassassin configured"
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"cron"

kiteMailServer :: Property (HasInfo + DebianLike)
kiteMailServer :: Property (HasInfo + DebianLike)
kiteMailServer = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"kitenet.net mail server" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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
Postfix.installed
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"postfix-pcre"]
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"postgrey"
	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
spamassassinConfigured
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"spamass-milter"
	-- Add -m to prevent modifying messages Subject or body.
	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))
& [Char]
"/etc/default/spamass-milter" [Char] -> [Char] -> Property UnixLike
`File.containsLine`
		[Char]
"OPTIONS=\"-m -u spamass-milter -i 127.0.0.1\""
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"spamass-milter"
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"spamass-milter configured"

	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"amavisd-milter"
	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))
& [Char]
"/etc/default/amavisd-milter" [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"# Propellor deployed"
		, [Char]
"MILTERSOCKET=/var/spool/postfix/amavis/amavis.sock"
		, [Char]
"MILTERSOCKETOWNER=\"postfix:postfix\""
		, [Char]
"MILTERSOCKETMODE=\"0660\""
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"amavisd-milter"
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"amavisd-milter configured for postfix"
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"clamav-freshclam"
	-- Workaround https://bugs.debian.org/569150
	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))
& [Char] -> Times -> User -> [Char] -> [Char] -> Property DebianLike
Cron.niceJob [Char]
"amavis-expire" Times
Cron.Daily ([Char] -> User
User [Char]
"root") [Char]
"/"
		[Char]
"find /var/lib/amavis/virusmails/ -type f -ctime +2 -delete"

	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 (HasInfo + DebianLike)
dkimInstalled

	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
Postfix.saslAuthdInstalled
	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
Fail2Ban.installed
	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))
& [Char] -> Property DebianLike
Fail2Ban.jailEnabled [Char]
"postfix-sasl"
	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))
& [Char]
"/etc/default/saslauthd" [Char] -> [Char] -> Property UnixLike
`File.containsLine` [Char]
"MECHANISMS=sasldb"
	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))
& [Char] -> User -> Property (HasInfo + UnixLike)
Postfix.saslPasswdSet [Char]
"kitenet.net" ([Char] -> User
User [Char]
"errol")
	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))
& [Char] -> User -> Property (HasInfo + UnixLike)
Postfix.saslPasswdSet [Char]
"kitenet.net" ([Char] -> User
User [Char]
"joey")

	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"maildrop"]
	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))
& [Char]
"/etc/maildroprc" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"# Global maildrop filter file (deployed with propellor)"
		, [Char]
"DEFAULT=\"$HOME/Maildir\""
		, [Char]
"MAILBOX=\"$DEFAULT/.\""
		, [Char]
"# Filter spam to a spam folder, unless .keepspam exists"
		, [Char]
"if (/^X-Spam-Status: Yes/)"
		, [Char]
"{"
		, [Char]
"  `test -e \"$HOME/.keepspam\"`"
		, [Char]
"  if ( $RETURNCODE != 0 )"
		, [Char]
"  to ${MAILBOX}spam"
		, [Char]
"}"
		]
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"maildrop configured"

	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))
& [Char]
"/etc/aliases" forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
`File.hasPrivContentExposed` Context
ctx
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
Postfix.newaliases
	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))
& Context -> Property (HasInfo + UnixLike)
hasPostfixCert Context
ctx

	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))
& [Char]
"/etc/postfix/mydomain" [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"/.*\\.kitenet\\.net/\tOK"
		, [Char]
"/ikiwiki\\.info/\tOK"
		, [Char]
"/joeyh\\.name/\tOK"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Postfix.reloaded
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"postfix mydomain file configured"
	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))
& [Char]
"/etc/postfix/obscure_client_relay.pcre" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		-- Remove received lines for mails relayed from trusted
		-- clients. These can be a privacy violation, or trigger
		-- spam filters.
		[ [Char]
"/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE"
		-- Munge local Received line for postfix running on a
		-- trusted client that relays through. These can trigger
		-- spam filters.
		, [Char]
"/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE X-Question: 42"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Postfix.reloaded
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"postfix obscure_client_relay file configured"
	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))
& forall x.
Combines (Property x) (Property UnixLike) =>
[Char]
-> ([Char] -> Property x)
-> CombinedType (Property x) (Property UnixLike)
Postfix.mappedFile [Char]
"/etc/postfix/virtual"
		(forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [[Char]] -> Property UnixLike
File.containsLines
			[ [Char]
"# *@joeyh.name to joey"
			, [Char]
"@joeyh.name\tjoey"
			]
		) forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"postfix virtual file configured"
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Postfix.reloaded
	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))
& forall x.
Combines (Property x) (Property UnixLike) =>
[Char]
-> ([Char] -> Property x)
-> CombinedType (Property x) (Property UnixLike)
Postfix.mappedFile [Char]
"/etc/postfix/relay_clientcerts"
		(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentExposed Context
ctx)
	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))
& [Char]
Postfix.mainCfFile [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"myhostname = kitenet.net"
		, [Char]
"mydomain = $myhostname"
		, [Char]
"append_dot_mydomain = no"
		, [Char]
"myorigin = kitenet.net"
		, [Char]
"mydestination = $myhostname, localhost.$mydomain, $mydomain, kite.$mydomain., localhost, regexp:$config_directory/mydomain"
		, [Char]
"mailbox_command = maildrop"
		, [Char]
"virtual_alias_maps = hash:/etc/postfix/virtual"

		, [Char]
"# Allow clients with trusted certs to relay mail through."
		, [Char]
"relay_clientcerts = hash:/etc/postfix/relay_clientcerts"
		, [Char]
"smtpd_relay_restrictions = permit_mynetworks,permit_tls_clientcerts,permit_sasl_authenticated,reject_unauth_destination"

		, [Char]
"# Filter out client relay lines from headers."
		, [Char]
"header_checks = pcre:$config_directory/obscure_client_relay.pcre"

		, [Char]
"# Password auth for relaying"
		, [Char]
"smtpd_sasl_auth_enable = yes"
		, [Char]
"smtpd_sasl_security_options = noanonymous"
		, [Char]
"smtpd_sasl_local_domain = kitenet.net"

		, [Char]
"# Enable postgrey and sasl auth and client certs."
		, [Char]
"smtpd_recipient_restrictions = permit_tls_clientcerts,permit_sasl_authenticated,,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023"

		, [Char]
"# Enable spamass-milter, amavis-milter (opendkim is not enabled because it causes mails forwarded from eg gmail to be rejected)"
		, [Char]
"smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock"
		, [Char]
"# opendkim is used for outgoing mail"
		, [Char]
"non_smtpd_milters = inet:localhost:8891"
		, [Char]
"milter_connect_macros = j {daemon_name} v {if_name} _"
		, [Char]
"# If a milter is broken, fall back to just accepting mail."
		, [Char]
"milter_default_action = accept"

		, [Char]
"# TLS setup -- server"
		, [Char]
"smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"
		, [Char]
"smtpd_tls_cert_file = /etc/ssl/certs/postfix.pem"
		, [Char]
"smtpd_tls_key_file = /etc/ssl/private/postfix.pem"
		, [Char]
"smtpd_tls_loglevel = 1"
		, [Char]
"smtpd_tls_received_header = yes"
		, [Char]
"smtpd_use_tls = yes"
		, [Char]
"smtpd_tls_ask_ccert = yes"
		, [Char]
"smtpd_tls_session_cache_database = btree:${data_directory}/smtpd_scache"

		, [Char]
"# TLS setup -- client"
		, [Char]
"smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"
		, [Char]
"smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"
		, [Char]
"smtp_tls_key_file = /etc/ssl/private/postfix.pem"
		, [Char]
"smtp_tls_loglevel = 1"
		, [Char]
"smtp_use_tls = yes"
		, [Char]
"smtp_tls_session_cache_database = btree:${data_directory}/smtp_scache"

		, [Char]
"# Allow larger attachments, up to 200 mb."
		, [Char]
"# (Avoid setting too high; the postfix queue must have"
		, [Char]
"# 1.5 times this much space free, or postfix will reject"
		, [Char]
"# ALL mail!)"
		, [Char]
"message_size_limit = 204800000"
		, [Char]
"virtual_mailbox_limit = 20480000"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
Postfix.dedupMainCf
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Postfix.reloaded
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"postfix configured"

	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"dovecot-imapd"
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"dovecot-pop3d"
	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))
& [Char]
"/etc/dovecot/conf.d/10-mail.conf" [Char] -> [Char] -> Property UnixLike
`File.containsLine`
		[Char]
"mail_location = maildir:~/Maildir"
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.reloaded [Char]
"dovecot"
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"dovecot mail.conf"
	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))
& [Char]
"/etc/dovecot/conf.d/10-auth.conf" [Char] -> [Char] -> Property UnixLike
`File.containsLine`
		[Char]
"!include auth-passwdfile.conf.ext"
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"dovecot"
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"dovecot auth.conf"
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
dovecotusers Context
ctx
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` ([Char]
dovecotusers [Char] -> FileMode -> Property UnixLike
`File.mode`
			[FileMode] -> FileMode
combineModes [FileMode
ownerReadMode, FileMode
groupReadMode])
	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))
& [Char] -> User -> Group -> Property UnixLike
File.ownerGroup [Char]
dovecotusers ([Char] -> User
User [Char]
"root") ([Char] -> Group
Group [Char]
"dovecot")

	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"mutt", [Char]
"bsd-mailx", [Char]
"alpine"]

	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))
& [Char]
pinescript [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"#!/bin/sh"
		, [Char]
"# deployed with propellor"
		, [Char]
"set -e"
		, [Char]
"exec alpine \"$@\""
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` ([Char]
pinescript [Char] -> FileMode -> Property UnixLike
`File.mode`
			[FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"pine wrapper script"
	-- Make pine use dovecot pipe to read maildir.
	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))
& [Char]
"/etc/pine.conf" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"# deployed with propellor"
		, [Char]
"inbox-path={localhost}inbox"
		, [Char]
"rsh-command=" forall a. [a] -> [a] -> [a]
++ [Char]
imapalpinescript
		]
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"pine configured to use local imap server"
	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))
& [Char]
imapalpinescript [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"#!/bin/sh"
		, [Char]
"# deployed with propellor"
		, [Char]
"set -e"
		, [Char]
"exec /usr/lib/dovecot/imap 2>/dev/null"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` ([Char]
imapalpinescript [Char] -> FileMode -> Property UnixLike
`File.mode`
			[FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))
		forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"imap script for pine"

	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))
& Service -> RevertableProperty DebianLike DebianLike
Postfix.service Service
ssmtp

	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"fetchmail"]
  where
	ctx :: Context
ctx = [Char] -> Context
Context [Char]
"kitenet.net"
	pinescript :: [Char]
pinescript = [Char]
"/usr/local/bin/pine"
	imapalpinescript :: [Char]
imapalpinescript = [Char]
"/usr/local/bin/imap-for-alpine"
	dovecotusers :: [Char]
dovecotusers = [Char]
"/etc/dovecot/users"

	ssmtp :: Service
ssmtp = ServiceType -> [Char] -> ServiceOpts -> Service
Postfix.Service
		(Maybe [Char] -> [Char] -> ServiceType
Postfix.InetService forall a. Maybe a
Nothing [Char]
"ssmtp")
		[Char]
"smtpd" ServiceOpts
Postfix.defServiceOpts

-- Configures postfix to have the dkim milter, and no other milters.
dkimMilter :: Property (HasInfo + DebianLike)
dkimMilter :: Property (HasInfo + DebianLike)
dkimMilter = [Char]
Postfix.mainCfFile [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
	[ [Char]
"smtpd_milters = inet:localhost:8891"
	, [Char]
"non_smtpd_milters = inet:localhost:8891"
	, [Char]
"milter_default_action = accept"
	]
	forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"postfix dkim milter"
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
Postfix.dedupMainCf
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Postfix.reloaded
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property (HasInfo + DebianLike)
dkimInstalled
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Postfix.installed

-- This does not configure postfix to use the dkim milter,
-- nor does it set up domainkey DNS.
dkimInstalled :: Property (HasInfo + DebianLike)
dkimInstalled :: Property (HasInfo + DebianLike)
dkimInstalled = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"opendkim"
  where
	go :: Property
  (MetaTypes
     (Combine
        (Combine
           (Combine
              (Combine
                 (Combine
                    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
                    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                       'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
                 '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                    'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
              '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                 'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
go = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"opendkim installed" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"opendkim"
		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))
& [Char] -> Property UnixLike
File.dirExists [Char]
"/etc/mail"
		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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContent [Char]
"/etc/mail/dkim.key" ([Char] -> Context
Context [Char]
"kitenet.net")
		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))
& [Char] -> User -> Group -> Property UnixLike
File.ownerGroup [Char]
"/etc/mail/dkim.key" ([Char] -> User
User [Char]
"root") ([Char] -> Group
Group [Char]
"root")
		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))
& [Char]
"/etc/default/opendkim" [Char] -> [Char] -> Property UnixLike
`File.containsLine`
			[Char]
"SOCKET=\"inet:8891@localhost\""
			forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` 
				([Char] -> [[Char]] -> UncheckedProperty UnixLike
cmdProperty [Char]
"/lib/opendkim/opendkim.service.generate" []
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange)
			forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"opendkim"
		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))
& [Char]
"/etc/opendkim.conf" [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
			[ [Char]
"KeyFile /etc/mail/dkim.key"
			, [Char]
"SubDomains yes"
			, [Char]
"Domain *"
			, [Char]
"Selector mail"
			]

-- This is the dkim public key, corresponding with /etc/mail/dkim.key
-- This value can be included in a domain's additional records to make
-- it use this domainkey.
domainKey :: (BindDomain, Record)
domainKey :: (BindDomain, Record)
domainKey = ([Char] -> BindDomain
RelDomain [Char]
"mail._domainkey", [Char] -> Record
TXT [Char]
"v=DKIM1; k=rsa; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB")

postfixSaslPasswordClient :: Property (HasInfo + DebianLike)
postfixSaslPasswordClient :: Property (HasInfo + DebianLike)
postfixSaslPasswordClient = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties [Char]
"postfix uses SASL password to authenticate with smarthost" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& forall x.
Combines (Property x) (Property UnixLike) =>
[Char]
-> ([Char] -> Property x)
-> CombinedType (Property x) (Property UnixLike)
Postfix.mappedFile [Char]
"/etc/postfix/sasl_passwd" 
		(forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
`File.hasPrivContent` ([Char] -> Context
Context [Char]
"kitenet.net"))
	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))
& [Char]
Postfix.mainCfFile [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"# TLS setup for SASL auth to kite"
		, [Char]
"smtp_sasl_auth_enable = yes"
		, [Char]
"smtp_tls_security_level = encrypt"
		, [Char]
"smtp_sasl_tls_security_options = noanonymous"
		, [Char]
"relayhost = kitenet.net:587"
		, [Char]
"smtp_sasl_password_maps = hash:/etc/postfix/sasl_passwd"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Postfix.reloaded
	-- Comes after so it does not set relayhost but uses the setting 
	-- above.
	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
Postfix.satellite

hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
hasPostfixCert Context
ctx = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties [Char]
"postfix tls cert installed" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char]
"/etc/ssl/certs/postfix.pem" forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
`File.hasPrivContentExposed` Context
ctx
	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))
& [Char]
"/etc/ssl/private/postfix.pem" forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
`File.hasPrivContent` Context
ctx

-- Legacy static web sites and redirections from kitenet.net to newer
-- sites.
legacyWebSites :: Property (HasInfo + DebianLike)
legacyWebSites :: Property (HasInfo + DebianLike)
legacyWebSites = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"legacy web sites" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"apache2"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
Apache.modEnabled [Char]
"rewrite"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
Apache.modEnabled [Char]
"cgi"
	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))
& [Char] -> RevertableProperty DebianLike DebianLike
Apache.modEnabled [Char]
"speling"
	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
userDirHtml
	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))
& [Char]
-> [Char]
-> AgreeTOS
-> [[Char]]
-> RevertableProperty DebianLike DebianLike
Apache.httpsVirtualHost' [Char]
"kitenet.net" [Char]
"/var/www" AgreeTOS
letos [[Char]]
kitenetcfg
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"anna.kitenet.net"
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
"anna.kitenet.net"
		[ [Char]
"DocumentRoot /home/anna/html"
		, [Char]
"<Directory /home/anna/html/>"
		, [Char]
"  Options Indexes ExecCGI"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"
		]
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"sows-ear.kitenet.net"
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"www.sows-ear.kitenet.net"
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
"sows-ear.kitenet.net"
		[ [Char]
"ServerAlias www.sows-ear.kitenet.net"
		, [Char]
"DocumentRoot /srv/web/sows-ear.kitenet.net"
		, [Char]
"<Directory /srv/web/sows-ear.kitenet.net>"
		, [Char]
"  Options FollowSymLinks"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"
		, [Char]
"RewriteEngine On"
		, [Char]
"RewriteRule .* http://www.sowsearpoetry.org/ [L]"
		]
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"wortroot.kitenet.net"
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"www.wortroot.kitenet.net"
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
"wortroot.kitenet.net"
		[ [Char]
"ServerAlias www.wortroot.kitenet.net"
		, [Char]
"DocumentRoot /srv/web/wortroot.kitenet.net"
		, [Char]
"<Directory /srv/web/wortroot.kitenet.net>"
		, [Char]
"  Options FollowSymLinks"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"
		]
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"creeksidepress.com"
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
"creeksidepress.com"
		[ [Char]
"ServerAlias www.creeksidepress.com"
		, [Char]
"DocumentRoot /srv/web/www.creeksidepress.com"
		, [Char]
"<Directory /srv/web/www.creeksidepress.com>"
		, [Char]
"  Options FollowSymLinks"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"
		]
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"joey.kitenet.net"
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
"joey.kitenet.net"
		[ [Char]
"DocumentRoot /var/www"
		, [Char]
"<Directory /var/www/>"
		, [Char]
"  Options Indexes ExecCGI"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"

		, [Char]
"RewriteEngine On"

		, [Char]
"# Old ikiwiki filenames for joey's wiki."
		, [Char]
"rewritecond $1 !.*/index$"
		, [Char]
"rewriterule (.+).html$ http://joeyh.name/$1/ [l]"

		, [Char]
"rewritecond $1 !.*/index$"
		, [Char]
"rewriterule (.+).rss$ http://joeyh.name/$1/index.rss [l]"

		, [Char]
"# Redirect all to joeyh.name."
		, [Char]
"rewriterule (.*) http://joeyh.name$1 [r]"
		]
	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))
& [Char] -> Property (HasInfo + UnixLike)
alias [Char]
"house.joeyh.name"
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
apacheSite [Char]
"house.joeyh.name"
		[ [Char]
"DocumentRoot /srv/web/house.joeyh.name"
		, [Char]
"<Directory /srv/web/house.joeyh.name>"
		, [Char]
"  Options Indexes ExecCGI"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"
		]
  where
	kitenetcfg :: [[Char]]
kitenetcfg =
		-- /var/www is empty
		[ [Char]
"DocumentRoot /var/www"
		, [Char]
"<Directory /var/www>"
		, [Char]
"  Options Indexes FollowSymLinks MultiViews ExecCGI Includes"
		, [Char]
"  AllowOverride None"
		, [Char]
Apache.allowAll
		, [Char]
"</Directory>"
		, [Char]
"RewriteEngine On"
		, [Char]
"# Force hostname to kitenet.net"
		, [Char]
"RewriteCond %{HTTP_HOST} !^kitenet\\.net [NC]"
		, [Char]
"RewriteCond %{HTTP_HOST} !^$"
		, [Char]
"RewriteRule ^/(.*) http://kitenet\\.net/$1 [L,R]"

		, [Char]
"# Moved pages"
		, [Char]
"RewriteRule /programs/debhelper http://joeyh.name/code/debhelper/ [L]"
		, [Char]
"RewriteRule /programs/satutils http://joeyh.name/code/satutils/ [L]"
		, [Char]
"RewriteRule /programs/filters http://joeyh.name/code/filters/ [L]"
		, [Char]
"RewriteRule /programs/ticker http://joeyh.name/code/ticker/ [L]"
		, [Char]
"RewriteRule /programs/pdmenu http://joeyh.name/code/pdmenu/ [L]"
		, [Char]
"RewriteRule /programs/sleepd http://joeyh.name/code/sleepd/ [L]"
		, [Char]
"RewriteRule /programs/Lingua::EN::Words2Nums http://joeyh.name/code/Words2Nums/ [L]"
		, [Char]
"RewriteRule /programs/wmbattery http://joeyh.name/code/wmbattery/ [L]"
		, [Char]
"RewriteRule /programs/dpkg-repack http://joeyh.name/code/dpkg-repack/ [L]"
		, [Char]
"RewriteRule /programs/debconf http://joeyh.name/code/debconf/ [L]"
		, [Char]
"RewriteRule /programs/perlmoo http://joeyh.name/code/perlmoo/ [L]"
		, [Char]
"RewriteRule /programs/alien http://joeyh.name/code/alien/ [L]"
		, [Char]
"RewriteRule /~joey/blog/entry/(.+)-[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9].html http://joeyh.name/blog/entry/$1/ [L]"
		, [Char]
"RewriteRule /~anna/.* http://waldeneffect\\.org/ [R]"
		, [Char]
"RewriteRule /~anna/.* http://waldeneffect\\.org/ [R]"
		, [Char]
"RewriteRule /~anna http://waldeneffect\\.org/ [R]"
		, [Char]
"RewriteRule /simpleid/ http://openid.kitenet.net:8086/simpleid/"
		, [Char]
"# Even the kite home page is not here any more!"
		, [Char]
"RewriteRule ^/$ http://www.kitenet.net/ [R]"
		, [Char]
"RewriteRule ^/index.html http://www.kitenet.net/ [R]"
		, [Char]
"RewriteRule ^/joey http://www.kitenet.net/joey/ [R]"
		, [Char]
"RewriteRule ^/joey/index.html http://www.kitenet.net/joey/ [R]"
		, [Char]
"RewriteRule ^/wifi http://www.kitenet.net/wifi/ [R]"
		, [Char]
"RewriteRule ^/wifi/index.html http://www.kitenet.net/wifi/ [R]"

		, [Char]
"# Old ikiwiki filenames for kitenet.net wiki."
		, [Char]
"rewritecond $1 !^/~"
		, [Char]
"rewritecond $1 !^/doc/"
		, [Char]
"rewritecond $1 !^/cgi-bin/"
		, [Char]
"rewritecond $1 !.*/index$"
		, [Char]
"rewriterule (.+).html$ $1/ [r]"

		, [Char]
"# Old ikiwiki filenames for joey's wiki."
		, [Char]
"rewritecond $1 ^/~joey/"
		, [Char]
"rewritecond $1 !.*/index$"
		, [Char]
"rewriterule (.+).html$ http://kitenet.net/$1/ [L,R]"

		, [Char]
"# ~joey to joeyh.name"
		, [Char]
"rewriterule /~joey/(.*) http://joeyh.name/$1 [L]"

		, [Char]
"# Old familywiki location."
		, [Char]
"rewriterule /~family/(.*).html http://family.kitenet.net/$1 [L]"
		, [Char]
"rewriterule /~family/(.*).rss http://family.kitenet.net/$1/index.rss [L]"
		, [Char]
"rewriterule /~family(.*) http://family.kitenet.net$1 [L]"

		, [Char]
"rewriterule /~kyle/bywayofscience(.*) http://bywayofscience.branchable.com$1 [L]"
		, [Char]
"rewriterule /~kyle/family/wiki/(.*).html http://macleawiki.branchable.com/$1 [L]"
		, [Char]
"rewriterule /~kyle/family/wiki/(.*).rss http://macleawiki.branchable.com/$1/index.rss [L]"
		, [Char]
"rewriterule /~kyle/family/wiki(.*) http://macleawiki.branchable.com$1 [L]"
		]

userDirHtml :: Property DebianLike
userDirHtml :: Property DebianLike
userDirHtml = forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
File.fileProperty [Char]
"apache userdir is html" (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
munge) [Char]
conf
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Apache.reloaded
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> RevertableProperty DebianLike DebianLike
Apache.modEnabled [Char]
"userdir"
  where
	munge :: [Char] -> [Char]
munge = forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [Char]
"public_html" [Char]
"html"
	conf :: [Char]
conf = [Char]
"/etc/apache2/mods-available/userdir.conf"

-- Alarm clock: see
-- <http://joeyh.name/blog/entry/a_programmable_alarm_clock_using_systemd/>
--
-- oncalendar example value: "*-*-* 7:30"
alarmClock :: String -> User -> String -> Property Linux
alarmClock :: [Char] -> User -> [Char] -> Property Linux
alarmClock [Char]
oncalendar (User [Char]
user) [Char]
command = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties [Char]
"goodmorning timer installed" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char]
"/etc/systemd/system/goodmorning.timer" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"[Unit]"
		, [Char]
"Description=good morning"
		, [Char]
""
		, [Char]
"[Timer]"
		, [Char]
"Unit=goodmorning.service"
		, [Char]
"OnCalendar=" forall a. [a] -> [a] -> [a]
++ [Char]
oncalendar
		, [Char]
"WakeSystem=true"
		, [Char]
"Persistent=false"
		, [Char]
""
		, [Char]
"[Install]"
		, [Char]
"WantedBy=multi-user.target"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (Property Linux
Systemd.daemonReloaded
			forall x y. Combines x y => x -> y -> CombinedType x y
`before` [Char] -> Property Linux
Systemd.restarted [Char]
"goodmorning.timer")
	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))
& [Char]
"/etc/systemd/system/goodmorning.service" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"[Unit]"
		, [Char]
"Description=good morning"
		, [Char]
"RefuseManualStart=true"
		, [Char]
"RefuseManualStop=true"
		, [Char]
"ConditionACPower=true"
		, [Char]
"StopWhenUnneeded=yes"
		, [Char]
""
		, [Char]
"[Service]"
		, [Char]
"Type=oneshot"
		, [Char]
"ExecStart=/bin/systemd-inhibit --what=handle-lid-switch --why=goodmorning /bin/su " forall a. [a] -> [a] -> [a]
++ [Char]
user forall a. [a] -> [a] -> [a]
++ [Char]
" -c \"" forall a. [a] -> [a] -> [a]
++ [Char]
command forall a. [a] -> [a] -> [a]
++ [Char]
"\""
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property Linux
Systemd.daemonReloaded
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
"goodmorning.timer"
	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))
& [Char] -> Property Linux
Systemd.started [Char]
"goodmorning.timer"
	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))
& [Char]
"/etc/systemd/logind.conf" [Char] -> ([Char], [Char], [Char]) -> Property UnixLike
`ConfFile.containsIniSetting`
		([Char]
"Login", [Char]
"LidSwitchIgnoreInhibited", [Char]
"no")

house :: IsContext c => User -> [Host] -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike)
house :: forall c.
IsContext c =>
User
-> [Host]
-> c
-> (SshKeyType, [Char])
-> Property (HasInfo + DebianLike)
house User
user [Host]
hosts c
ctx (SshKeyType, [Char])
sshkey = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"home automation" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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
Apache.installed
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"libmodbus-dev", [Char]
"rrdtool", [Char]
"rsync"]
	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))
& User -> [Char] -> [Char] -> Maybe [Char] -> Property DebianLike
Git.cloned User
user [Char]
"https://git.joeyh.name/git/joey/house.git" [Char]
d forall a. Maybe a
Nothing
	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 UnixLike
websitesymlink
	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
build
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
setupservicename
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
setupserviceinstalled
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property Linux
Systemd.started [Char]
setupservicename
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
pollerservicename
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
pollerserviceinstalled
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property Linux
Systemd.started [Char]
pollerservicename
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
controllerservicename
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
controllerserviceinstalled
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property Linux
Systemd.started [Char]
controllerservicename
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
watchdogservicename
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
watchdogserviceinstalled
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property Linux
Systemd.started [Char]
watchdogservicename
	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))
& [Char] -> Property DebianLike
Apt.serviceInstalledRunning [Char]
"watchdog"
	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))
& [Char]
"/etc/watchdog.conf" [Char] -> [[Char]] -> Property UnixLike
`File.containsLines`
		[ [Char]
"watchdog-device = /dev/watchdog0"
		, [Char]
"watchdog-timeout = 16" -- maximum supported by cubietruck
		, [Char]
"interval = 1"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.reloaded [Char]
"watchdog"
	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))
& Group -> Maybe Int -> Property UnixLike
Group.exists ([Char] -> Group
Group [Char]
"gpio") forall a. Maybe a
Nothing
	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))
& User -> Group -> Property DebianLike
User.hasGroup User
user ([Char] -> Group
Group [Char]
"gpio")
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"i2c-tools"]
	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))
& User -> Group -> Property DebianLike
User.hasGroup User
user ([Char] -> Group
Group [Char]
"i2c")
	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))
& [Char]
"/etc/modules-load.d/house.conf" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent` [[Char]
"i2c-dev"]
	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))
& [Char] -> Times -> User -> [Char] -> [Char] -> Property DebianLike
Cron.niceJob [Char]
"house upload"
		([Char] -> Times
Cron.Times [Char]
"1 * * * *") User
user [Char]
d [Char]
rsynccommand
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` forall c.
IsContext c =>
Maybe [Char]
-> User
-> c
-> (SshKeyType, [Char])
-> Property (HasInfo + UnixLike)
Ssh.userKeyAt (forall a. a -> Maybe a
Just [Char]
sshkeyfile) User
user c
ctx (SshKeyType, [Char])
sshkey
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> User -> Group -> Property UnixLike
File.ownerGroup ([Char] -> [Char]
takeDirectory [Char]
sshkeyfile)
			User
user (User -> Group
userGroup User
user)
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property UnixLike
File.dirExists ([Char] -> [Char]
takeDirectory [Char]
sshkeyfile)
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Host] -> [Char] -> User -> Property UnixLike
Ssh.knownHost [Host]
hosts [Char]
"kitenet.net" User
user
	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))
& forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentExposed [Char]
"/etc/darksky-forecast-url" Context
anyContext
  where
	d :: [Char]
d = [Char]
"/home/joey/house"
	sshkeyfile :: [Char]
sshkeyfile = [Char]
d [Char] -> [Char] -> [Char]
</> [Char]
".ssh/key"
	build :: Property DebianLike
build = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
doesFileExist ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"controller")) forall a b. (a -> b) -> a -> b
$
		User -> [[Char]] -> UncheckedProperty UnixLike
userScriptProperty ([Char] -> User
User [Char]
"joey")
			[ [Char]
"cd " forall a. [a] -> [a] -> [a]
++ [Char]
d
			, [Char]
"cabal update"
			, [Char]
"make"
			]
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed
			[ [Char]
"ghc", [Char]
"cabal-install", [Char]
"make"
			, [Char]
"libghc-http-types-dev"
			, [Char]
"libghc-aeson-dev"
			, [Char]
"libghc-wai-dev"
			, [Char]
"libghc-warp-dev"
			, [Char]
"libghc-http-client-dev"
			, [Char]
"libghc-http-client-tls-dev"
			, [Char]
"libghc-reactive-banana-dev"
			, [Char]
"libghc-hinotify-dev"
			]
	pollerservicename :: [Char]
pollerservicename = [Char]
"house-poller"
	pollerservicefile :: [Char]
pollerservicefile = [Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
pollerservicename forall a. [a] -> [a] -> [a]
++ [Char]
".service"
	pollerserviceinstalled :: Property UnixLike
pollerserviceinstalled = [Char]
pollerservicefile [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"[Unit]"
		, [Char]
"Description=house poller"
		, [Char]
""
		, [Char]
"[Service]"
		, [Char]
"ExecStart=" forall a. [a] -> [a] -> [a]
++ [Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
"/poller"
		, [Char]
"WorkingDirectory=" forall a. [a] -> [a] -> [a]
++ [Char]
d
		, [Char]
"User=joey"
		, [Char]
"Group=joey"
		, [Char]
"Restart=always"
		, [Char]
""
		, [Char]
"[Install]"
		, [Char]
"WantedBy=multi-user.target"
		, [Char]
"WantedBy=house-controller.target"
		]
	controllerservicename :: [Char]
controllerservicename = [Char]
"house-controller"
	controllerservicefile :: [Char]
controllerservicefile = [Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
controllerservicename forall a. [a] -> [a] -> [a]
++ [Char]
".service"
	controllerserviceinstalled :: Property UnixLike
controllerserviceinstalled = [Char]
controllerservicefile [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"[Unit]"
		, [Char]
"Description=house controller"
		, [Char]
""
		, [Char]
"[Service]"
		, [Char]
"ExecStart=" forall a. [a] -> [a] -> [a]
++ [Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
"/controller"
		, [Char]
"WorkingDirectory=" forall a. [a] -> [a] -> [a]
++ [Char]
d
		, [Char]
"User=joey"
		, [Char]
"Group=joey"
		, [Char]
"Restart=always"
		, [Char]
""
		, [Char]
"[Install]"
		, [Char]
"WantedBy=multi-user.target"
		]
	watchdogservicename :: [Char]
watchdogservicename = [Char]
"house-watchdog"
	watchdogservicefile :: [Char]
watchdogservicefile = [Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
watchdogservicename forall a. [a] -> [a] -> [a]
++ [Char]
".service"
	watchdogserviceinstalled :: Property UnixLike
watchdogserviceinstalled = [Char]
watchdogservicefile [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"[Unit]"
		, [Char]
"Description=house watchdog"
		, [Char]
""
		, [Char]
"[Service]"
		, [Char]
"ExecStart=" forall a. [a] -> [a] -> [a]
++ [Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
"/watchdog"
		, [Char]
"WorkingDirectory=" forall a. [a] -> [a] -> [a]
++ [Char]
d
		, [Char]
"User=root"
		, [Char]
"Group=root"
		, [Char]
"Restart=always"
		, [Char]
""
		, [Char]
"[Install]"
		, [Char]
"WantedBy=multi-user.target"
		]
	setupservicename :: [Char]
setupservicename = [Char]
"house-setup"
	setupservicefile :: [Char]
setupservicefile = [Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
setupservicename forall a. [a] -> [a] -> [a]
++ [Char]
".service"
	setupserviceinstalled :: Property UnixLike
setupserviceinstalled = [Char]
setupservicefile [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"[Unit]"
		, [Char]
"Description=house setup"
		, [Char]
""
		, [Char]
"[Service]"
		, [Char]
"ExecStart=" forall a. [a] -> [a] -> [a]
++ [Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
"/setup"
		, [Char]
"WorkingDirectory=" forall a. [a] -> [a] -> [a]
++ [Char]
d
		, [Char]
"User=root"
		, [Char]
"Group=root"
		, [Char]
"Type=oneshot"
		, [Char]
""
		, [Char]
"[Install]"
		, [Char]
"WantedBy=multi-user.target"
		, [Char]
"WantedBy=house-poller.target"
		, [Char]
"WantedBy=house-controller.target"
		, [Char]
"WantedBy=house-watchdog.target"
		]
	-- Any changes to the rsync command will need my .authorized_keys
	-- rsync server command to be updated too.
	rsynccommand :: [Char]
rsynccommand = [Char]
"rsync -e 'ssh -i" forall a. [a] -> [a] -> [a]
++ [Char]
sshkeyfile forall a. [a] -> [a] -> [a]
++ [Char]
"' -avz rrds/ joey@kitenet.net:/srv/web/house.joeyh.name/rrds/ >/dev/null 2>&1"

	websitesymlink :: Property UnixLike
	websitesymlink :: Property UnixLike
websitesymlink = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
isSymbolicLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO FileStatus
getSymbolicLinkStatus [Char]
"/var/www/html")
		(forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"website symlink" forall a b. (a -> b) -> a -> b
$ IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ do
			[Char] -> IO ()
removeDirectoryRecursive [Char]
"/var/www/html"
			[Char] -> [Char] -> IO ()
createSymbolicLink [Char]
d [Char]
"/var/www/html"
		)

data Interfaces = Interfaces
	{ Interfaces -> [Char]
ethernetInterface :: String
	, Interfaces -> [Char]
wifiInterface :: String
	, Interfaces -> [Char]
wifiInterfaceOld :: String
	}

-- Connect to the starlink dish directly (no starlink router)
connectStarlinkDish :: Interfaces -> Property DebianLike
connectStarlinkDish :: Interfaces -> Property DebianLike
connectStarlinkDish Interfaces
ifs = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"connected via starlink dish" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	-- Use dhcpcd for ipv6 prefix delegation to the wifi interface.
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"dhcpcd"]
	-- dhcpcd is run by ifup on boot. When the daemon was enabled,
	-- that somehow prevented prefix delegation from happening,
	-- so disable the daemon from being run by systemd.
	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))
& [Char] -> Property Linux
Systemd.stopped [Char]
"dhcpcd"
	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))
& [Char] -> RevertableProperty Linux Linux
Systemd.masked [Char]
"dhcpcd"
	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))
& [Char]
"/etc/dhcpcd.conf" [Char] -> [Char] -> Property UnixLike
`File.containsLine`
		([Char]
"ia_pd 1 " forall a. [a] -> [a] -> [a]
++ Interfaces -> [Char]
wifiInterface Interfaces
ifs)
	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))
& [Char]
"/etc/dhcpcd.conf" [Char] -> [Char] -> Property UnixLike
`File.lacksLine`
		([Char]
"ia_pd 1 " forall a. [a] -> [a] -> [a]
++ Interfaces -> [Char]
wifiInterfaceOld Interfaces
ifs)
	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))
& [Char] -> Property DebianLike
Network.dhcp (Interfaces -> [Char]
ethernetInterface Interfaces
ifs)
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Network.cleanInterfacesFile

-- Connect to the starlink router with its ethernet adapter.
--
-- Static route because with dhcp it sometimes fails to get an address from
-- starlink.
connectStarlinkRouter :: Interfaces -> Property DebianLike
connectStarlinkRouter :: Interfaces -> Property DebianLike
connectStarlinkRouter Interfaces
ifs = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"connected via starlink router" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char] -> IPAddr -> Maybe Gateway -> Property DebianLike
Network.static (Interfaces -> [Char]
ethernetInterface Interfaces
ifs) ([Char] -> IPAddr
IPv4 [Char]
"192.168.1.62")
		(forall a. a -> Maybe a
Just (IPAddr -> Gateway
Network.Gateway ([Char] -> IPAddr
IPv4 [Char]
"192.168.1.1")))
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Network.cleanInterfacesFile

-- My home router, running hostapd and dnsmasq.
homeRouter :: Interfaces -> String -> HostapdConfig -> Property DebianLike
homeRouter :: Interfaces -> [Char] -> HostapdConfig -> Property DebianLike
homeRouter Interfaces
ifs [Char]
wifinetworkname (HostapdConfig [[Char]]
hostapdconfig) = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"home router" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char] -> Property UnixLike
File.notPresent ([Char] -> [Char]
Network.interfaceDFile (Interfaces -> [Char]
wifiInterfaceOld Interfaces
ifs))
	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))
& [Char] -> IPAddr -> Maybe Gateway -> Property DebianLike
Network.static (Interfaces -> [Char]
wifiInterface Interfaces
ifs) ([Char] -> IPAddr
IPv4 [Char]
"10.1.1.1") forall a. Maybe a
Nothing
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Network.cleanInterfacesFile
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"hostapd"]
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
"/etc/hostapd/hostapd.conf"
			([ [Char]
"interface=" forall a. [a] -> [a] -> [a]
++ Interfaces -> [Char]
wifiInterface Interfaces
ifs
			, [Char]
"ssid=" forall a. [a] -> [a] -> [a]
++ [Char]
wifinetworkname
			] forall a. [a] -> [a] -> [a]
++ [[Char]]
hostapdconfig)
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property UnixLike
File.dirExists [Char]
"/etc/hostapd"
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
"/etc/default/hostapd"
			[ [Char]
"DAEMON_CONF=/etc/hostapd/hostapd.conf" ]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.running [Char]
"hostapd"
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
"hostapd"
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
"/etc/resolv.conf"
		[ [Char]
"domain kitenet.net"
		, [Char]
"search kitenet.net"
		, [Char]
"nameserver 8.8.8.8"
		, [Char]
"nameserver 8.8.4.4"
		]
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"dnsmasq"]
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
"/etc/dnsmasq.conf"
		[ [Char]
"domain-needed"
		, [Char]
"bogus-priv"
		, [Char]
"interface=" forall a. [a] -> [a] -> [a]
++ Interfaces -> [Char]
wifiInterface Interfaces
ifs
		, [Char]
"domain=lan"
		-- lease time is short because the house
		-- controller wants to know when clients disconnect
		, [Char]
"dhcp-range=10.1.1.100,10.1.1.150,10m"
		, [Char]
"no-hosts"
		, [Char]
"address=/sky.lan/10.1.1.1"
		, [Char]
"address=/house.lan/10.1.1.2"
		-- allow accessing starlink dish when it's not online yet
		, [Char]
"address=/dishy.starlink.com/192.168.100.1"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"dnsmasq"
	-- Avoid DHCPNAK of lease obtained at boot, after NTP slews clock
	-- forward too far, causing that lease to not be valid.
	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))
& [Char]
"/etc/default/dnsmasq" [Char] -> [Char] -> Property UnixLike
`File.containsLine` [Char]
"DNSMASQ_OPTS=\"--dhcp-authoritative\""
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"dnsmasq"
	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))
& [Char] -> Property DebianLike
ipmasq (Interfaces -> [Char]
wifiInterface Interfaces
ifs)
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"radvd"]
	-- This needs ipv6 prefix delegation to the wifi interface to be
	-- enabled.
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
"/etc/radvd.conf"
		[ [Char]
"interface " forall a. [a] -> [a] -> [a]
++ Interfaces -> [Char]
wifiInterface Interfaces
ifs forall a. [a] -> [a] -> [a]
++ [Char]
" {"
		, [Char]
"  AdvSendAdvert on;"
		, [Char]
"  MinRtrAdvInterval 3;"
		, [Char]
"  MaxRtrAdvInterval 10;"
		, [Char]
"  prefix ::/64 {"
		, [Char]
"    AdvOnLink on;"
		, [Char]
"    AdvAutonomous on;"
		, [Char]
"    AdvRouterAddr on;"
		, [Char]
"  };"
		, [Char]
"};"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> Property DebianLike
Service.restarted [Char]
"radvd"
	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))
& [Char]
"/etc/sysctl.conf" [Char] -> [Char] -> Property UnixLike
`File.containsLine` [Char]
"net.ipv6.conf.all.forwarding=1"

-- | Enable IP masqerading, on whatever other interfaces come up, besides the
-- provided intif.
ipmasq :: String -> Property DebianLike
ipmasq :: [Char] -> Property DebianLike
ipmasq [Char]
intif = [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
ifupscript
	[ [Char]
"#!/bin/sh"
	, [Char]
"INTIF=" forall a. [a] -> [a] -> [a]
++ [Char]
intif
	, [Char]
"if [ \"$IFACE\" = $INTIF ] || [ \"$IFACE\" = lo ]; then"
	, [Char]
"exit 0"
	, [Char]
"fi"
	, [Char]
"iptables -F"
	, [Char]
"iptables -A FORWARD -i $IFACE -o $INTIF -m state --state ESTABLISHED,RELATED -j ACCEPT"
	, [Char]
"iptables -A FORWARD -i $INTIF -o $IFACE -j ACCEPT"
	, [Char]
"iptables -t nat -A POSTROUTING -o $IFACE -j MASQUERADE"
	, [Char]
"echo 1 > /proc/sys/net/ipv4/ip_forward"
	]
	forall x y. Combines x y => x -> y -> CombinedType x y
`before` [Char] -> Property UnixLike
scriptmode [Char]
ifupscript
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed [[Char]
"iptables"]
  where
	ifupscript :: [Char]
ifupscript = [Char]
"/etc/network/if-up.d/ipmasq"
	scriptmode :: [Char] -> Property UnixLike
scriptmode [Char]
f = [Char]
f [Char] -> FileMode -> Property UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)

laptopSoftware :: Property DebianLike
laptopSoftware :: Property DebianLike
laptopSoftware = [[Char]] -> Property DebianLike
Apt.installed
	[ [Char]
"intel-microcode", [Char]
"acpi"
	, [Char]
"procmeter3", [Char]
"xfce4", [Char]
"procmeter3", [Char]
"unclutter-xfixes"
	, [Char]
"mplayer", [Char]
"fbreader", [Char]
"firefox", [Char]
"chromium"
	, [Char]
"libdatetime-event-sunrise-perl", [Char]
"libtime-duration-perl"
	, [Char]
"network-manager", [Char]
"network-manager-openvpn-gnome", [Char]
"openvpn"
	, [Char]
"gtk-redshift", [Char]
"powertop"
	, [Char]
"gimp", [Char]
"gthumb", [Char]
"inkscape", [Char]
"sozi", [Char]
"xzgv", [Char]
"hugin"
	, [Char]
"mpc", [Char]
"mpd", [Char]
"ncmpc", [Char]
"sonata", [Char]
"mpdtoys"
	, [Char]
"bsdgames", [Char]
"nethack-console"
	, [Char]
"xmonad", [Char]
"libghc-xmonad-dev", [Char]
"libghc-xmonad-contrib-dev"
	, [Char]
"ttf-bitstream-vera", [Char]
"fonts-symbola", [Char]
"fonts-noto-color-emoji"
	, [Char]
"mairix", [Char]
"offlineimap", [Char]
"mutt", [Char]
"slrn"
	, [Char]
"mtr", [Char]
"nmap", [Char]
"whois", [Char]
"wireshark", [Char]
"tcpdump", [Char]
"iftop"
	, [Char]
"pmount", [Char]
"tree", [Char]
"pv"
	, [Char]
"arbtt", [Char]
"hledger", [Char]
"bc"
	, [Char]
"apache2", [Char]
"ikiwiki", [Char]
"libhighlight-perl"
	, [Char]
"avahi-daemon", [Char]
"avahi-discover"
	, [Char]
"pal"
	, [Char]
"yeahconsole", [Char]
"xkbset", [Char]
"xinput"
	, [Char]
"assword", [Char]
"pumpa"
	, [Char]
"vorbis-tools", [Char]
"audacity"
	, [Char]
"ekiga"
	, [Char]
"bluez-firmware", [Char]
"blueman", [Char]
"pulseaudio-module-bluetooth"
	, [Char]
"fwupd"
	, [Char]
"xul-ext-ublock-origin", [Char]
"xul-ext-pdf.js", [Char]
"xul-ext-status4evar"
	, [Char]
"vim-syntastic", [Char]
"vim-fugitive"
	, [Char]
"adb", [Char]
"gthumb"
	, [Char]
"w3m", [Char]
"sm", [Char]
"weechat"
	, [Char]
"borgbackup", [Char]
"wipe", [Char]
"smartmontools", [Char]
"libgfshare-bin"
	, [Char]
"units"
	, [Char]
"virtualbox", [Char]
"virtualbox-guest-additions-iso", [Char]
"qemu-kvm"
	]
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
baseSoftware
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
devSoftware

baseSoftware :: Property DebianLike
baseSoftware :: Property DebianLike
baseSoftware = [[Char]] -> Property DebianLike
Apt.installed
	[ [Char]
"bash", [Char]
"bash-completion", [Char]
"vim", [Char]
"screen", [Char]
"less", [Char]
"moreutils"
	, [Char]
"git", [Char]
"mr", [Char]
"etckeeper", [Char]
"git-annex", [Char]
"ssh", [Char]
"vim-vimoutliner"
	]

devSoftware :: Property DebianLike
devSoftware :: Property DebianLike
devSoftware = [[Char]] -> Property DebianLike
Apt.installed
	[ [Char]
"build-essential", [Char]
"debhelper", [Char]
"devscripts"
	, [Char]
"ghc", [Char]
"cabal-install", [Char]
"haskell-stack"
	, [Char]
"hothasktags", [Char]
"hdevtools", [Char]
"hlint"
	, [Char]
"gdb", [Char]
"time"
	, [Char]
"dpkg-repack", [Char]
"lintian"
	, [Char]
"pristine-tar", [Char]
"github-backup"
	]

cubieTruckOneWire :: Property DebianLike
cubieTruckOneWire :: Property DebianLike
cubieTruckOneWire = Property UnixLike
utilitysetup
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
dtsinstalled
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
utilityinstalled
  where
	dtsinstalled :: CombinedType (Property UnixLike) (Property UnixLike)
dtsinstalled = [Char] -> [[Char]] -> Property UnixLike
File.hasContent [Char]
"/etc/easy-peasy-devicetree-squeezy/my.dts" [[Char]]
mydts
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property UnixLike
File.dirExists [Char]
"/etc/easy-peasy-devicetree-squeezy"
	utilityinstalled :: CombinedType (Property DebianLike) (Property DebianLike)
utilityinstalled = User -> [Char] -> [Char] -> Maybe [Char] -> Property DebianLike
Git.cloned ([Char] -> User
User [Char]
"root") [Char]
"https://git.joeyh.name/git/easy-peasy-devicetree-squeezy.git" [Char]
"/usr/local/easy-peasy-devicetree-squeezy" forall a. Maybe a
Nothing
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> LinkTarget -> RevertableProperty UnixLike UnixLike
File.isSymlinkedTo [Char]
"/usr/sbin/easy-peasy-devicetree-squeezy" ([Char] -> LinkTarget
File.LinkTarget [Char]
"/usr/local/easy-peasy-devicetree-squeezy/easy-peasy-devicetree-squeezy")
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed [[Char]
"pv", [Char]
"device-tree-compiler", [Char]
"cpp", [Char]
"linux-source"]
	utilitysetup :: Property UnixLike
utilitysetup = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
doesFileExist [Char]
dtb) forall a b. (a -> b) -> a -> b
$ 
		[Char] -> [[Char]] -> UncheckedProperty UnixLike
cmdProperty [Char]
"easy-peasy-devicetree-squeezy"
			[[Char]
"--debian", [Char]
"sun7i-a20-cubietruck"]
			forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	dtb :: [Char]
dtb = [Char]
"/etc/flash-kernel/dtbs/sun7i-a20-cubietruck.dtb"
	mydts :: [[Char]]
mydts =
		[ [Char]
"/* Device tree addition enabling onewire sensors on CubieTruck GPIO pin PC21 */"
		, [Char]
"#include <dt-bindings/gpio/gpio.h>"
		, [Char]
""
		, [Char]
"/ {"
		, [Char]
"\tonewire_device {"
		, [Char]
"\t\tcompatible = \"w1-gpio\";"
		, [Char]
"\t\tgpios = <&pio 2 21 GPIO_ACTIVE_HIGH>; /* PC21 */"
		, [Char]
"\t\tpinctrl-names = \"default\";"
		, [Char]
"\t\tpinctrl-0 = <&my_w1_pin>;"
		, [Char]
"\t};"
		, [Char]
"};"
		, [Char]
""
		, [Char]
"&pio {"
		, [Char]
"\tmy_w1_pin: my_w1_pin@0 {"
		, [Char]
"\t\tallwinner,pins = \"PC21\";"
		, [Char]
"\t\tallwinner,function = \"gpio_in\";"
		, [Char]
"\t};"
		, [Char]
"};"
		]

-- My home networked attached storage server.
homeNAS :: Property DebianLike
homeNAS :: Property DebianLike
homeNAS = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
"home NAS" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"uhubctl"]
	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))
& [Char]
"/etc/udev/rules.d/52-startech-hub.rules" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent`
		[ [Char]
"# let users power control startech hub with uhubctl"
		, [Char]
"ATTR{idVendor}==\"" forall a. [a] -> [a] -> [a]
++ [Char]
hubvendor forall a. [a] -> [a] -> [a]
++ [Char]
"\", ATTR{idProduct}==\"005a\", MODE=\"0666\""
		]
	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))
& [Char]
-> USBHubPort -> USBDriveId -> Maybe [Char] -> Property DebianLike
autoMountDrivePort [Char]
"archive-10"
		([Char] -> Int -> USBHubPort
USBHubPort [Char]
hubvendor Int
1)
		([Char] -> [Char] -> USBDriveId
USBDriveId [Char]
wd [Char]
"1230")
		(forall a. a -> Maybe a
Just [Char]
"archive-oldest")
	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))
& [Char]
-> USBHubPort -> USBDriveId -> Maybe [Char] -> Property DebianLike
autoMountDrivePort [Char]
"archive-11"
		([Char] -> Int -> USBHubPort
USBHubPort [Char]
hubvendor Int
2)
		([Char] -> [Char] -> USBDriveId
USBDriveId [Char]
wd [Char]
"25ee")
		(forall a. a -> Maybe a
Just [Char]
"archive-older")
	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))
& [Char]
-> USBHubPort -> USBDriveId -> Maybe [Char] -> Property DebianLike
autoMountDrivePort [Char]
"archive-12"
		([Char] -> Int -> USBHubPort
USBHubPort [Char]
hubvendor Int
3)
		([Char] -> [Char] -> USBDriveId
USBDriveId [Char]
seagate [Char]
"3322")
		(forall a. a -> Maybe a
Just [Char]
"archive-old")
	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))
& [Char]
-> USBHubPort -> USBDriveId -> Maybe [Char] -> Property DebianLike
autoMountDrivePort [Char]
"archive-13"
		([Char] -> Int -> USBHubPort
USBHubPort [Char]
hubvendor Int
4)
		([Char] -> [Char] -> USBDriveId
USBDriveId [Char]
wd [Char]
"25a3")
		(forall a. a -> Maybe a
Just [Char]
"archive")
	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))
& [Char]
-> USBHubPort -> USBDriveId -> Maybe [Char] -> Property DebianLike
autoMountDrivePort [Char]
"archive-14"
		([Char] -> Int -> USBHubPort
USBHubPort [Char]
hubvendor Int
2)
		([Char] -> [Char] -> USBDriveId
USBDriveId [Char]
wd [Char]
"25a3")
		forall a. Maybe a
Nothing
	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))
& [Char] -> Maybe [Char] -> Property DebianLike
autoMountDrive [Char]
"passport" forall a. Maybe a
Nothing
	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))
& [[Char]] -> Property DebianLike
Apt.installed [[Char]
"git-annex", [Char]
"borgbackup"]
  where
	hubvendor :: [Char]
hubvendor = [Char]
"0409"
	wd :: [Char]
wd = [Char]
"1058"
	seagate :: [Char]
seagate = [Char]
"0bc2"

data USBHubPort = USBHubPort
	{ USBHubPort -> [Char]
hubVendor :: String
	, USBHubPort -> Int
hubPort :: Int
	}

data USBDriveId = USBDriveId
	{ USBDriveId -> [Char]
driveVendorId :: String
	, USBDriveId -> [Char]
driveProductId :: String
	}

-- Makes a USB drive with the given label automount, and unmount after idle
-- for a while.
--
-- The hub port is turned on and off automatically as needed, using
-- uhubctl.
autoMountDrivePort :: Mount.Label -> USBHubPort -> USBDriveId -> Maybe FilePath -> Property DebianLike
autoMountDrivePort :: [Char]
-> USBHubPort -> USBDriveId -> Maybe [Char] -> Property DebianLike
autoMountDrivePort [Char]
label USBHubPort
hp USBDriveId
drive Maybe [Char]
malias = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent ([Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
hub)
		[ [Char]
"[Unit]"
		, [Char]
"Description=Startech usb hub port " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (USBHubPort -> Int
hubPort USBHubPort
hp) forall a. [a] -> [a] -> [a]
++ [Char]
" vendor " forall a. [a] -> [a] -> [a]
++ USBDriveId -> [Char]
driveVendorId USBDriveId
drive forall a. [a] -> [a] -> [a]
++ [Char]
" driveid " forall a. [a] -> [a] -> [a]
++ USBDriveId -> [Char]
driveProductId USBDriveId
drive
		, [Char]
"PartOf=" forall a. [a] -> [a] -> [a]
++ [Char]
mount
		, [Char]
"[Service]"
		, [Char]
"Type=oneshot"
		, [Char]
"RemainAfterExit=true"
		, [Char]
"ExecStart=/bin/sh -c 'uhubctl -a on " forall a. [a] -> [a] -> [a]
++ [Char]
selecthubport forall a. [a] -> [a] -> [a]
++ [Char]
"'"
		, [Char]
"ExecStop=/bin/sh -c 'uhubctl -a off " forall a. [a] -> [a] -> [a]
++ [Char]
selecthubport
			-- Powering off the port does not remove device
			-- files, so ask udev to remove the devfile; it will
			-- be added back after the drive next spins up
			-- and so avoid mount happening before the drive is
			-- spun up.
			-- (This only works when the devfile is in
			-- by-label.)
			forall a. [a] -> [a] -> [a]
++ [Char]
"; udevadm trigger --action=remove " forall a. [a] -> [a] -> [a]
++ [Char]
devfile forall a. [a] -> [a] -> [a]
++ [Char]
" || true'"
		, [Char]
"[Install]"
		, [Char]
"WantedBy="
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property Linux
Systemd.daemonReloaded
	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))
& [[Char]] -> [Char] -> Maybe [Char] -> Property DebianLike
autoMountDrive' 
		[ [Char]
"Requires=" forall a. [a] -> [a] -> [a]
++ [Char]
hub
		, [Char]
"After=" forall a. [a] -> [a] -> [a]
++ [Char]
hub
		] [Char]
label Maybe [Char]
malias
  where
	devfile :: [Char]
devfile = [Char]
"/dev/disk/by-label/" forall a. [a] -> [a] -> [a]
++ [Char]
label
	mountpoint :: [Char]
mountpoint = [Char]
"/media/joey/" forall a. [a] -> [a] -> [a]
++ [Char]
label
	desc :: [Char]
desc = [Char]
"auto mount with hub port power control " forall a. [a] -> [a] -> [a]
++ [Char]
mountpoint
	hub :: [Char]
hub = [Char]
"startech-hub-port-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (USBHubPort -> Int
hubPort USBHubPort
hp) forall a. [a] -> [a] -> [a]
++ [Char]
"-vendor-" forall a. [a] -> [a] -> [a]
++ USBDriveId -> [Char]
driveVendorId USBDriveId
drive forall a. [a] -> [a] -> [a]
++ [Char]
"-drivedid-" forall a. [a] -> [a] -> [a]
++ USBDriveId -> [Char]
driveProductId USBDriveId
drive forall a. [a] -> [a] -> [a]
++ [Char]
".service"
	mount :: [Char]
mount = [Char]
svcbase forall a. [a] -> [a] -> [a]
++ [Char]
".mount"
	svcbase :: [Char]
svcbase = [Char] -> [Char]
Systemd.escapePath [Char]
mountpoint
	selecthubport :: [Char]
selecthubport = [[Char]] -> [Char]
unwords
		[ [Char]
"-p", forall a. Show a => a -> [Char]
show (USBHubPort -> Int
hubPort USBHubPort
hp)
		, [Char]
"-n", USBHubPort -> [Char]
hubVendor USBHubPort
hp
		, [Char]
"-l", forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
			-- The hub's location id, eg "1-1.4", does not seem
			-- as stable as uhubctl claims it will be,
			-- and the vendor is not sufficient since I have 2
			-- hubs from the same vendor. So search for the
			-- drive lsusb to find that. This works even if the
			-- port is powered off, as long as it's been on at
			-- some point before.
			[ [Char]
"$(lsusb -tvv | perl -lne \"if (\\\\$h && m!/sys/bus/usb/devices/(.*?) !) {\\\\$v=\\\\$1}; if (m/Hub/) { \\\\$h=1 } else { \\\\$h=0 }; if (/"
			, USBDriveId -> [Char]
driveVendorId USBDriveId
drive forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ USBDriveId -> [Char]
driveProductId USBDriveId
drive
			forall a. [a] -> [a] -> [a]
++ [Char]
"/) { print \\\\$v; last}\")"
			]
		]

-- Makes a USB drive with the given label automount, and unmount after idle
-- for a while.
autoMountDrive :: Mount.Label -> Maybe FilePath -> Property DebianLike
autoMountDrive :: [Char] -> Maybe [Char] -> Property DebianLike
autoMountDrive = [[Char]] -> [Char] -> Maybe [Char] -> Property DebianLike
autoMountDrive' []

autoMountDrive' :: [String] -> Mount.Label -> Maybe FilePath -> Property DebianLike
autoMountDrive' :: [[Char]] -> [Char] -> Maybe [Char] -> Property DebianLike
autoMountDrive' [[Char]]
mountunitadd [Char]
label Maybe [Char]
malias = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	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))
& [Char] -> User -> Group -> Property UnixLike
File.ownerGroup [Char]
mountpoint ([Char] -> User
User [Char]
"joey") ([Char] -> Group
Group [Char]
"joey")
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property UnixLike
File.dirExists [Char]
mountpoint
	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))
& case Maybe [Char]
malias of
		Just [Char]
t -> ([Char]
"/media/joey/" forall a. [a] -> [a] -> [a]
++ [Char]
t) [Char] -> LinkTarget -> RevertableProperty UnixLike UnixLike
`File.isSymlinkedTo`
			[Char] -> LinkTarget
File.LinkTarget [Char]
mountpoint
		Maybe [Char]
Nothing -> forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent ([Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
mount)
		([ [Char]
"[Unit]"
		, [Char]
"Description=" forall a. [a] -> [a] -> [a]
++ [Char]
label
		] forall a. [a] -> [a] -> [a]
++ [[Char]]
mountunitadd forall a. [a] -> [a] -> [a]
++
		[ [Char]
"[Mount]"
		-- avoid mounting whenever the block device is available,
		-- only want to automount on demand
		, [Char]
"Options=noauto"
		, [Char]
"What=" forall a. [a] -> [a] -> [a]
++ [Char]
devfile
		, [Char]
"Where=" forall a. [a] -> [a] -> [a]
++ [Char]
mountpoint
		, [Char]
"[Install]"
		, [Char]
"WantedBy="
		])
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property Linux
Systemd.daemonReloaded
	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))
& [Char] -> [[Char]] -> Property UnixLike
File.hasContent ([Char]
"/etc/systemd/system/" forall a. [a] -> [a] -> [a]
++ [Char]
automount)
		[ [Char]
"[Unit]"
		, [Char]
"Description=Automount " forall a. [a] -> [a] -> [a]
++ [Char]
label
		, [Char]
"[Automount]"
		, [Char]
"Where=" forall a. [a] -> [a] -> [a]
++ [Char]
mountpoint
		, [Char]
"TimeoutIdleSec=300"
		, [Char]
"[Install]"
		, [Char]
"WantedBy=multi-user.target"
		]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property Linux
Systemd.daemonReloaded
	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))
& [Char] -> Property Linux
Systemd.enabled [Char]
automount
	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))
& [Char] -> Property Linux
Systemd.started [Char]
automount
	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))
& [Char] -> [[Char]] -> RevertableProperty DebianLike Linux
Sudo.sudoersDFile ([Char]
"automount-" forall a. [a] -> [a] -> [a]
++ [Char]
label)
		[ [Char]
"joey ALL= NOPASSWD: " forall a. [a] -> [a] -> [a]
++ [Char]
sudocommands
		]
  where
	devfile :: [Char]
devfile = [Char]
"/dev/disk/by-label/" forall a. [a] -> [a] -> [a]
++ [Char]
label
	mountpoint :: [Char]
mountpoint = [Char]
"/media/joey/" forall a. [a] -> [a] -> [a]
++ [Char]
label
	desc :: [Char]
desc = [Char]
"auto mount " forall a. [a] -> [a] -> [a]
++ [Char]
mountpoint
	automount :: [Char]
automount = [Char]
svcbase forall a. [a] -> [a] -> [a]
++ [Char]
".automount"
	mount :: [Char]
mount = [Char]
svcbase forall a. [a] -> [a] -> [a]
++ [Char]
".mount"
	svcbase :: [Char]
svcbase = [Char] -> [Char]
Systemd.escapePath [Char]
mountpoint
	sudocommands :: [Char]
sudocommands = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" , " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
c -> [Char]
"/bin/systemctl " forall a. [a] -> [a] -> [a]
++ [Char]
c)
		[ [Char]
"stop " forall a. [a] -> [a] -> [a]
++ [Char]
mountpoint
		, [Char]
"start " forall a. [a] -> [a] -> [a]
++ [Char]
mountpoint
		]

rsyncNetBorgRepo :: String -> [Borg.BorgRepoOpt] -> Borg.BorgRepo
rsyncNetBorgRepo :: [Char] -> [BorgRepoOpt] -> BorgRepo
rsyncNetBorgRepo [Char]
d [BorgRepoOpt]
os = [BorgRepoOpt] -> [Char] -> BorgRepo
Borg.BorgRepoUsing [BorgRepoOpt]
os' ([Char]
"2318@usw-s002.rsync.net:" forall a. [a] -> [a] -> [a]
++ [Char]
d)
  where
	-- rsync.net has a newer borg here
	os' :: [BorgRepoOpt]
os' = ([Char], [Char]) -> BorgRepoOpt
Borg.UsesEnvVar ([Char]
"BORG_REMOTE_PATH", [Char]
"borg1") forall a. a -> [a] -> [a]
: [BorgRepoOpt]
os

noExim :: Property DebianLike
noExim :: Property DebianLike
noExim = [[Char]] -> Property DebianLike
Apt.removed [[Char]
"exim4", [Char]
"exim4-base", [Char]
"exim4-daemon-light"]
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Apt.autoRemove

data HostapdConfig = HostapdConfig [String]

hostapd2GhzConfig :: HostapdConfig
hostapd2GhzConfig :: HostapdConfig
hostapd2GhzConfig = [[Char]] -> HostapdConfig
HostapdConfig
	[ [Char]
"hw_mode=g"
	, [Char]
"channel=5"
	, [Char]
"country_code=US"
	, [Char]
"ieee80211d=1"
	, [Char]
"ieee80211n=1"
	, [Char]
"wmm_enabled=1"
	]

-- For wifi adapters such as the Alfa AWUS036ACHM
--
-- Note that for maximum speed, this needs channel 5 or 6.
-- This should make it be capable of 150 Mb/s.
hostapd2GhzConfig_mt76 :: HostapdConfig
hostapd2GhzConfig_mt76 :: HostapdConfig
hostapd2GhzConfig_mt76 = [[Char]] -> HostapdConfig
HostapdConfig forall a b. (a -> b) -> a -> b
$ [[Char]]
c forall a. [a] -> [a] -> [a]
++ 
	[ [Char]
"ht_capab=[HT40+][HT40-][GF][SHORT-GI-20][SHORT-GI-40]"
	]
  where
	HostapdConfig [[Char]]
c = HostapdConfig
hostapd2GhzConfig

hostapd5GhzConfig :: HostapdConfig
hostapd5GhzConfig :: HostapdConfig
hostapd5GhzConfig = [[Char]] -> HostapdConfig
HostapdConfig
	[ [Char]
"hw_mode=a"
	, [Char]
"channel=36"
	, [Char]
"country_code=US"
	, [Char]
"ieee80211d=1"
	, [Char]
"ieee80211n=1"
	, [Char]
"ieee80211ac=1"
	, [Char]
"wmm_enabled=1"
	]