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