{-# LANGUAGE TypeFamilies #-}

-- | Maintainer: Jelmer Vernooij <jelmer@samba.org>

module Propellor.Property.Aiccu (
	installed,
	restarted,
	confPath,
	UserName,
	TunnelId,
	hasConfig,
) where

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import qualified Propellor.Property.File as File

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

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

confPath :: FilePath
confPath :: Package
confPath = Package
"/etc/aiccu.conf"

type TunnelId = String

config :: UserName -> TunnelId -> PrivData -> [File.Line]
config :: Package -> Package -> PrivData -> [Package]
config Package
u Package
t PrivData
p = 
	[ Package
"protocol tic"
	, Package
"server tic.sixxs.net"
	, Package
"username " forall a. [a] -> [a] -> [a]
++ Package
u
	, Package
"password " forall a. [a] -> [a] -> [a]
++ PrivData -> Package
privDataVal PrivData
p
	, Package
"ipv6_interface sixxs"
	, Package
"tunnel_id " forall a. [a] -> [a] -> [a]
++ Package
t
	, Package
"daemonize true"
	, Package
"automatic true"
	, Package
"requiretls true"
	, Package
"makebeats true"
	]

-- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId
-- and sixx.net UserName.
hasConfig :: TunnelId -> UserName -> Property (HasInfo + DebianLike)
hasConfig :: Package -> Package -> Property (HasInfo + DebianLike)
hasConfig Package
t Package
u = Property (HasInfo + UnixLike)
prop forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
restarted
  where
  	prop :: Property (HasInfo + UnixLike)
	prop :: Property (HasInfo + UnixLike)
prop = forall c s metatypes.
(IsContext c, IsPrivDataSource s,
 IncludesInfo metatypes ~ 'True) =>
[s]
-> c
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withSomePrivData [(Package -> PrivDataField
Password (Package
uforall a. [a] -> [a] -> [a]
++Package
"/"forall a. [a] -> [a] -> [a]
++Package
t)), (Package -> PrivDataField
Password Package
u)] (Package -> Context
Context Package
"aiccu") forall a b. (a -> b) -> a -> b
$ \((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result
getpassword ->
		forall {k} (metatypes :: k).
SingI metatypes =>
Package
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Package
"aiccu configured" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> ((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result
getpassword forall a b. (a -> b) -> a -> b
$ forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivDataField, PrivData) -> Property UnixLike
go
	go :: (PrivDataField, PrivData) -> Property UnixLike
go (Password Package
u', PrivData
p) = Package
confPath Package -> [Package] -> Property UnixLike
`File.hasContentProtected` Package -> Package -> PrivData -> [Package]
config Package
u' Package
t PrivData
p
	go (PrivDataField
f, PrivData
_) = forall a. HasCallStack => Package -> a
error forall a b. (a -> b) -> a -> b
$ Package
"Unexpected type of privdata: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Package
show PrivDataField
f