{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
module Propellor.Info (
osDebian,
osBuntish,
osArchLinux,
osFreeBSD,
setInfoProperty,
addInfoProperty,
pureInfoProperty,
pureInfoProperty',
askInfo,
getOS,
hasContainerCapability,
ipv4,
ipv6,
alias,
addDNS,
hostMap,
aliasMap,
findHost,
findHostNoAlias,
getAddresses,
hostAddresses,
) where
import Propellor.Types
import Propellor.Types.Info
import Propellor.Types.MetaTypes
import Propellor.Types.Container
import "mtl" Control.Monad.Reader
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import Control.Applicative
import Prelude
setInfoProperty
:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
=> Property metatypes
-> Info
-> Property (MetaTypes metatypes')
setInfoProperty :: Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty (Property metatypes
_ Desc
d Maybe (Propellor Result)
a Info
oldi [ChildProperty]
c) Info
newi =
MetaTypes metatypes'
-> Desc
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> Property (MetaTypes metatypes')
forall metatypes.
metatypes
-> Desc
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> Property metatypes
Property MetaTypes metatypes'
forall k (t :: k). SingI t => Sing t
sing Desc
d Maybe (Propellor Result)
a (Info
oldi Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> Info
newi) [ChildProperty]
c
addInfoProperty
:: (IncludesInfo metatypes ~ 'True)
=> Property metatypes
-> Info
-> Property metatypes
addInfoProperty :: Property metatypes -> Info -> Property metatypes
addInfoProperty (Property metatypes
t Desc
d Maybe (Propellor Result)
a Info
oldi [ChildProperty]
c) Info
newi =
metatypes
-> Desc
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> Property metatypes
forall metatypes.
metatypes
-> Desc
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> Property metatypes
Property metatypes
t Desc
d Maybe (Propellor Result)
a (Info
oldi Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> Info
newi) [ChildProperty]
c
pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
pureInfoProperty :: Desc -> v -> Property (HasInfo + UnixLike)
pureInfoProperty Desc
desc v
v = Desc -> Info -> Property (HasInfo + UnixLike)
pureInfoProperty' Desc
desc (v -> Info
forall v. IsInfo v => v -> Info
toInfo v
v)
pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
pureInfoProperty' Desc
desc Info
i = Property UnixLike
-> Info
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty Property UnixLike
p Info
i
where
p :: Property UnixLike
p :: Property UnixLike
p = Desc -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Desc -> Propellor Result -> Property (MetaTypes metatypes)
property (Desc
"has " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
desc) (Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange)
askInfo :: (IsInfo v) => Propellor v
askInfo :: Propellor v
askInfo = (Host -> v) -> Propellor v
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Info -> v
forall v. IsInfo v => Info -> v
fromInfo (Info -> v) -> (Host -> Info) -> Host -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo)
hasContainerCapability :: ContainerCapability -> Propellor Bool
hasContainerCapability :: ContainerCapability -> Propellor Bool
hasContainerCapability ContainerCapability
c = ContainerCapability -> [ContainerCapability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ContainerCapability
c
([ContainerCapability] -> Bool)
-> Propellor [ContainerCapability] -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Propellor [ContainerCapability]
forall v. IsInfo v => Propellor v
askInfo :: Propellor [ContainerCapability])
osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
osDebian = DebianKernel
-> DebianSuite -> Architecture -> Property (HasInfo + Debian)
osDebian' DebianKernel
Linux
osDebian' :: DebianKernel -> DebianSuite -> Architecture -> Property (HasInfo + Debian)
osDebian' :: DebianKernel
-> DebianSuite -> Architecture -> Property (HasInfo + Debian)
osDebian' DebianKernel
kernel DebianSuite
suite Architecture
arch = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSDebian])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSDebian]))
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSDebian])
forall a b. (a -> b) -> a -> b
$ System -> Property (HasInfo + UnixLike)
os (Distribution -> Architecture -> System
System (DebianKernel -> DebianSuite -> Distribution
Debian DebianKernel
kernel DebianSuite
suite) Architecture
arch)
osBuntish :: Release -> Architecture -> Property (HasInfo + Buntish)
osBuntish :: Desc -> Architecture -> Property (HasInfo + Buntish)
osBuntish Desc
release Architecture
arch = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSBuntish])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ System -> Property (HasInfo + UnixLike)
os (Distribution -> Architecture -> System
System (Desc -> Distribution
Buntish Desc
release) Architecture
arch)
osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
osFreeBSD FreeBSDRelease
release Architecture
arch = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ System -> Property (HasInfo + UnixLike)
os (Distribution -> Architecture -> System
System (FreeBSDRelease -> Distribution
FreeBSD FreeBSDRelease
release) Architecture
arch)
osArchLinux :: Architecture -> Property (HasInfo + ArchLinux)
osArchLinux :: Architecture -> Property (HasInfo + ArchLinux)
osArchLinux Architecture
arch = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSArchLinux])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ System -> Property (HasInfo + UnixLike)
os (Distribution -> Architecture -> System
System (Distribution
ArchLinux) Architecture
arch)
os :: System -> Property (HasInfo + UnixLike)
os :: System -> Property (HasInfo + UnixLike)
os System
system = Desc -> InfoVal System -> Property (HasInfo + UnixLike)
forall v. IsInfo v => Desc -> v -> Property (HasInfo + UnixLike)
pureInfoProperty (Desc
"Operating " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ System -> Desc
forall a. Show a => a -> Desc
show System
system) (System -> InfoVal System
forall v. v -> InfoVal v
InfoVal System
system)
getOS :: Propellor (Maybe System)
getOS :: Propellor (Maybe System)
getOS = InfoVal System -> Maybe System
forall v. InfoVal v -> Maybe v
fromInfoVal (InfoVal System -> Maybe System)
-> Propellor (InfoVal System) -> Propellor (Maybe System)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor (InfoVal System)
forall v. IsInfo v => Propellor v
askInfo
ipv4 :: String -> Property (HasInfo + UnixLike)
ipv4 :: Desc -> Property (HasInfo + UnixLike)
ipv4 = Bool -> Record -> Property (HasInfo + UnixLike)
addDNS Bool
False (Record
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (Desc -> Record)
-> Desc
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPAddr -> Record
Address (IPAddr -> Record) -> (Desc -> IPAddr) -> Desc -> Record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desc -> IPAddr
IPv4
ipv6 :: String -> Property (HasInfo + UnixLike)
ipv6 :: Desc -> Property (HasInfo + UnixLike)
ipv6 = Bool -> Record -> Property (HasInfo + UnixLike)
addDNS Bool
False (Record
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (Desc -> Record)
-> Desc
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPAddr -> Record
Address (IPAddr -> Record) -> (Desc -> IPAddr) -> Desc -> Record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desc -> IPAddr
IPv6
alias :: Domain -> Property (HasInfo + UnixLike)
alias :: Desc -> Property (HasInfo + UnixLike)
alias Desc
d = Desc -> Info -> Property (HasInfo + UnixLike)
pureInfoProperty' (Desc
"alias " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
d) (Info -> Property (HasInfo + UnixLike))
-> Info -> Property (HasInfo + UnixLike)
forall a b. (a -> b) -> a -> b
$ Info
forall a. Monoid a => a
mempty
Info -> AliasesInfo -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo` [Desc] -> AliasesInfo
toAliasesInfo [Desc
d]
Info -> DnsInfoPropagated -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo` (Set Record -> DnsInfoPropagated
toDnsInfoPropagated (Set Record -> DnsInfoPropagated)
-> Set Record -> DnsInfoPropagated
forall a b. (a -> b) -> a -> b
$ Record -> Set Record
forall a. a -> Set a
S.singleton (Record -> Set Record) -> Record -> Set Record
forall a b. (a -> b) -> a -> b
$ BindDomain -> Record
CNAME (BindDomain -> Record) -> BindDomain -> Record
forall a b. (a -> b) -> a -> b
$ Desc -> BindDomain
AbsDomain Desc
d)
addDNS
:: Bool
-> Record
-> Property (HasInfo + UnixLike)
addDNS :: Bool -> Record -> Property (HasInfo + UnixLike)
addDNS Bool
prop Record
r
| Bool
prop = Desc -> DnsInfoPropagated -> Property (HasInfo + UnixLike)
forall v. IsInfo v => Desc -> v -> Property (HasInfo + UnixLike)
pureInfoProperty (Record -> Desc
rdesc Record
r) (Set Record -> DnsInfoPropagated
toDnsInfoPropagated Set Record
s)
| Bool
otherwise = Desc -> DnsInfoUnpropagated -> Property (HasInfo + UnixLike)
forall v. IsInfo v => Desc -> v -> Property (HasInfo + UnixLike)
pureInfoProperty (Record -> Desc
rdesc Record
r) (Set Record -> DnsInfoUnpropagated
toDnsInfoUnpropagated Set Record
s)
where
s :: Set Record
s = Record -> Set Record
forall a. a -> Set a
S.singleton Record
r
rdesc :: Record -> Desc
rdesc (CNAME BindDomain
d) = [Desc] -> Desc
unwords [Desc
"alias", BindDomain -> Desc
ddesc BindDomain
d]
rdesc (Address (IPv4 Desc
addr)) = [Desc] -> Desc
unwords [Desc
"ipv4", Desc
addr]
rdesc (Address (IPv6 Desc
addr)) = [Desc] -> Desc
unwords [Desc
"ipv6", Desc
addr]
rdesc (MX Int
n BindDomain
d) = [Desc] -> Desc
unwords [Desc
"MX", Int -> Desc
forall a. Show a => a -> Desc
show Int
n, BindDomain -> Desc
ddesc BindDomain
d]
rdesc (NS BindDomain
d) = [Desc] -> Desc
unwords [Desc
"NS", BindDomain -> Desc
ddesc BindDomain
d]
rdesc (TXT Desc
t) = [Desc] -> Desc
unwords [Desc
"TXT", Desc
t]
rdesc (SRV Word16
x Word16
y Word16
z BindDomain
d) = [Desc] -> Desc
unwords [Desc
"SRV", Word16 -> Desc
forall a. Show a => a -> Desc
show Word16
x, Word16 -> Desc
forall a. Show a => a -> Desc
show Word16
y, Word16 -> Desc
forall a. Show a => a -> Desc
show Word16
z, BindDomain -> Desc
ddesc BindDomain
d]
rdesc (SSHFP Int
x Int
y Desc
t) = [Desc] -> Desc
unwords [Desc
"SSHFP", Int -> Desc
forall a. Show a => a -> Desc
show Int
x, Int -> Desc
forall a. Show a => a -> Desc
show Int
y, Desc
t]
rdesc (INCLUDE Desc
f) = [Desc] -> Desc
unwords [Desc
"$INCLUDE", Desc
f]
rdesc (PTR Desc
x) = [Desc] -> Desc
unwords [Desc
"PTR", Desc
x]
ddesc :: BindDomain -> Desc
ddesc (AbsDomain Desc
domain) = Desc
domain
ddesc (RelDomain Desc
domain) = Desc
domain
ddesc BindDomain
RootDomain = Desc
"@"
hostMap :: [Host] -> M.Map HostName Host
hostMap :: [Host] -> Map Desc Host
hostMap [Host]
l = [(Desc, Host)] -> Map Desc Host
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Desc, Host)] -> Map Desc Host)
-> [(Desc, Host)] -> Map Desc Host
forall a b. (a -> b) -> a -> b
$ [Desc] -> [Host] -> [(Desc, Host)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Host -> Desc) -> [Host] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map Host -> Desc
hostName [Host]
l) [Host]
l
aliasMap :: [Host] -> M.Map HostName Host
aliasMap :: [Host] -> Map Desc Host
aliasMap = [(Desc, Host)] -> Map Desc Host
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Desc, Host)] -> Map Desc Host)
-> ([Host] -> [(Desc, Host)]) -> [Host] -> Map Desc Host
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Desc, Host)]] -> [(Desc, Host)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Desc, Host)]] -> [(Desc, Host)])
-> ([Host] -> [[(Desc, Host)]]) -> [Host] -> [(Desc, Host)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Host -> [(Desc, Host)]) -> [Host] -> [[(Desc, Host)]]
forall a b. (a -> b) -> [a] -> [b]
map (\Host
h -> (Desc -> (Desc, Host)) -> [Desc] -> [(Desc, Host)]
forall a b. (a -> b) -> [a] -> [b]
map (\Desc
aka -> (Desc
aka, Host
h)) ([Desc] -> [(Desc, Host)]) -> [Desc] -> [(Desc, Host)]
forall a b. (a -> b) -> a -> b
$ AliasesInfo -> [Desc]
fromAliasesInfo (AliasesInfo -> [Desc]) -> AliasesInfo -> [Desc]
forall a b. (a -> b) -> a -> b
$ Info -> AliasesInfo
forall v. IsInfo v => Info -> v
fromInfo (Info -> AliasesInfo) -> Info -> AliasesInfo
forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
h)
findHost :: [Host] -> HostName -> Maybe Host
findHost :: [Host] -> Desc -> Maybe Host
findHost [Host]
l Desc
hn = ([Host] -> Desc -> Maybe Host
findHostNoAlias [Host]
l Desc
hn) Maybe Host -> Maybe Host -> Maybe Host
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Host] -> Desc -> Maybe Host
findAlias [Host]
l Desc
hn)
findHostNoAlias :: [Host] -> HostName -> Maybe Host
findHostNoAlias :: [Host] -> Desc -> Maybe Host
findHostNoAlias [Host]
l Desc
hn = Desc -> Map Desc Host -> Maybe Host
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Desc
hn ([Host] -> Map Desc Host
hostMap [Host]
l)
findAlias :: [Host] -> HostName -> Maybe Host
findAlias :: [Host] -> Desc -> Maybe Host
findAlias [Host]
l Desc
hn = Desc -> Map Desc Host -> Maybe Host
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Desc
hn ([Host] -> Map Desc Host
aliasMap [Host]
l)
getAddresses :: Info -> [IPAddr]
getAddresses :: Info -> [IPAddr]
getAddresses = (Record -> Maybe IPAddr) -> [Record] -> [IPAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Record -> Maybe IPAddr
getIPAddr ([Record] -> [IPAddr]) -> (Info -> [Record]) -> Info -> [IPAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Record -> [Record]
forall a. Set a -> [a]
S.toList (Set Record -> [Record])
-> (Info -> Set Record) -> Info -> [Record]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> Set Record
getDnsInfo
hostAddresses :: HostName -> [Host] -> [IPAddr]
hostAddresses :: Desc -> [Host] -> [IPAddr]
hostAddresses Desc
hn [Host]
hosts = [IPAddr] -> (Host -> [IPAddr]) -> Maybe Host -> [IPAddr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Info -> [IPAddr]
getAddresses (Info -> [IPAddr]) -> (Host -> Info) -> Host -> [IPAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo) ([Host] -> Desc -> Maybe Host
findHost [Host]
hosts Desc
hn)