module Propellor.Property.Network where
import Propellor.Base
import Propellor.Property.File
import Data.Char
type Interface = String
type InterfaceOptions = [(String, String)]
type InterfaceStanza = ([String], InterfaceOptions)
ifUp :: Interface -> Property DebianLike
ifUp :: Interface -> Property DebianLike
ifUp Interface
iface = 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
$ Interface
-> [Interface]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty Interface
"ifup" [Interface
iface]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
cleanInterfacesFile :: Property DebianLike
cleanInterfacesFile :: Property DebianLike
cleanInterfacesFile = Interface -> [Interface] -> InterfaceOptions -> Property DebianLike
interfaceFileContains Interface
interfacesFile
[ Interface
"source-directory interfaces.d"
, Interface
""
, Interface
"# The loopback network interface"
, Interface
"auto lo"
, Interface
"iface lo inet loopback"
]
[]
forall p. IsProp p => p -> Interface -> p
`describe` (Interface
"clean " forall a. [a] -> [a] -> [a]
++ Interface
interfacesFile)
dhcp :: Interface -> Property DebianLike
dhcp :: Interface -> Property DebianLike
dhcp Interface
iface = Interface -> InterfaceOptions -> Property DebianLike
dhcp' Interface
iface forall a. Monoid a => a
mempty
dhcp' :: Interface -> InterfaceOptions -> Property DebianLike
dhcp' :: Interface -> InterfaceOptions -> Property DebianLike
dhcp' Interface
iface InterfaceOptions
options = Interface -> [Interface] -> InterfaceOptions -> Property DebianLike
interfaceFileContains (Interface -> Interface
interfaceDFile Interface
iface)
[ Interface
"auto " forall a. [a] -> [a] -> [a]
++ Interface
iface
, Interface
"iface " forall a. [a] -> [a] -> [a]
++ Interface
iface forall a. [a] -> [a] -> [a]
++ Interface
" inet dhcp"
] InterfaceOptions
options
forall p. IsProp p => p -> Interface -> p
`describe` (Interface
"dhcp " forall a. [a] -> [a] -> [a]
++ Interface
iface)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
interfacesDEnabled
newtype Gateway = Gateway IPAddr
static :: Interface -> IPAddr -> Maybe Gateway -> Property DebianLike
static :: Interface -> IPAddr -> Maybe Gateway -> Property DebianLike
static Interface
iface IPAddr
addr Maybe Gateway
gateway = Interface
-> IPAddr
-> Maybe Gateway
-> InterfaceOptions
-> Property DebianLike
static' Interface
iface IPAddr
addr Maybe Gateway
gateway forall a. Monoid a => a
mempty
static' :: Interface -> IPAddr -> Maybe Gateway -> InterfaceOptions -> Property DebianLike
static' :: Interface
-> IPAddr
-> Maybe Gateway
-> InterfaceOptions
-> Property DebianLike
static' Interface
iface IPAddr
addr Maybe Gateway
gateway InterfaceOptions
options =
Interface
-> [(IPAddr, Maybe Gateway, InterfaceOptions)]
-> Property DebianLike
static'' Interface
iface [(IPAddr
addr, Maybe Gateway
gateway, InterfaceOptions
options)]
static'' :: Interface -> [(IPAddr, Maybe Gateway, InterfaceOptions)] -> Property DebianLike
static'' :: Interface
-> [(IPAddr, Maybe Gateway, InterfaceOptions)]
-> Property DebianLike
static'' Interface
iface [(IPAddr, Maybe Gateway, InterfaceOptions)]
confs =
Interface -> [InterfaceStanza] -> Property DebianLike
interfaceFileContains' (Interface -> Interface
interfaceDFile Interface
iface) [InterfaceStanza]
stanzas
forall p. IsProp p => p -> Interface -> p
`describe` (Interface
"static IP address for " forall a. [a] -> [a] -> [a]
++ Interface
iface)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
interfacesDEnabled
where
stanzas :: [InterfaceStanza]
stanzas = forall a b. (a -> b) -> [a] -> [b]
map (IPAddr, Maybe Gateway, InterfaceOptions) -> InterfaceStanza
stanza [(IPAddr, Maybe Gateway, InterfaceOptions)]
confs
stanza :: (IPAddr, Maybe Gateway, InterfaceOptions) -> InterfaceStanza
stanza (IPAddr
addr, Maybe Gateway
gateway, InterfaceOptions
options) = (IPAddr -> [Interface]
headerlines IPAddr
addr, forall {t}.
ConfigurableValue t =>
t -> Maybe Gateway -> InterfaceOptions -> InterfaceOptions
options' IPAddr
addr Maybe Gateway
gateway InterfaceOptions
options)
headerlines :: IPAddr -> [Interface]
headerlines IPAddr
addr =
[ Interface
"auto " forall a. [a] -> [a] -> [a]
++ Interface
iface
, Interface
"iface " forall a. [a] -> [a] -> [a]
++ Interface
iface forall a. [a] -> [a] -> [a]
++ Interface
" " forall a. [a] -> [a] -> [a]
++ (IPAddr -> Interface
inet IPAddr
addr) forall a. [a] -> [a] -> [a]
++ Interface
" static"
]
options' :: t -> Maybe Gateway -> InterfaceOptions -> InterfaceOptions
options' t
addr Maybe Gateway
gateway InterfaceOptions
options = forall a. [Maybe a] -> [a]
catMaybes
[ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Interface
"address", forall t. ConfigurableValue t => t -> Interface
val t
addr)
, case Maybe Gateway
gateway of
Just (Gateway IPAddr
gaddr) ->
forall a. a -> Maybe a
Just (Interface
"gateway", forall t. ConfigurableValue t => t -> Interface
val IPAddr
gaddr)
Maybe Gateway
Nothing -> forall a. Maybe a
Nothing
] forall a. [a] -> [a] -> [a]
++ InterfaceOptions
options
inet :: IPAddr -> Interface
inet IPAddr
addr = case IPAddr
addr of
IPv4 Interface
_ -> Interface
"inet"
IPv6 Interface
_ -> Interface
"inet6"
preserveStatic :: Interface -> Property DebianLike
preserveStatic :: Interface -> Property DebianLike
preserveStatic Interface
iface = 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
$
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
<$> Interface -> IO Bool
doesFileExist Interface
f) Property DebianLike
setup
forall p. IsProp p => p -> Interface -> p
`describe` Interface
desc
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
interfacesDEnabled
where
f :: Interface
f = Interface -> Interface
interfaceDFile Interface
iface
desc :: Interface
desc = Interface
"static " forall a. [a] -> [a] -> [a]
++ Interface
iface
setup :: Property DebianLike
setup :: Property DebianLike
setup = forall {k} (metatypes :: k).
SingI metatypes =>
Interface
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Interface
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
o -> do
[Interface]
ls <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Interface -> [Interface]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface -> [Interface] -> IO Interface
readProcess Interface
"ip"
[Interface
"-o", Interface
"addr", Interface
"show", Interface
iface, Interface
"scope", Interface
"global"]
[Interface]
stanzas <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Interface -> IO [Interface]
mkstanza [Interface]
ls
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
o forall a b. (a -> b) -> a -> b
$ Interface
-> [Interface]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
hasContent Interface
f forall a b. (a -> b) -> a -> b
$ (Interface
"auto " forall a. [a] -> [a] -> [a]
++ Interface
iface) forall a. a -> [a] -> [a]
: [Interface]
stanzas
mkstanza :: Interface -> IO [Interface]
mkstanza Interface
ipline = case Interface -> [Interface]
words Interface
ipline of
(Interface
_:Interface
iface':Interface
"inet":Interface
addr:[Interface]
_) | Interface
iface' forall a. Eq a => a -> a -> Bool
== Interface
iface -> do
Maybe Interface
gw <- IO (Maybe Interface)
getgateway
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
[ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Interface
"iface " forall a. [a] -> [a] -> [a]
++ Interface
iface forall a. [a] -> [a] -> [a]
++ Interface
" inet static"
, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Interface
"\taddress " forall a. [a] -> [a] -> [a]
++ Interface
addr
, (Interface
"\tgateway " forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Interface
gw
]
[Interface]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
getgateway :: IO (Maybe Interface)
getgateway = do
[Interface]
rs <- Interface -> [Interface]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface -> [Interface] -> IO Interface
readProcess Interface
"ip"
[Interface
"route", Interface
"show", Interface
"scope", Interface
"global", Interface
"dev", Interface
iface]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Interface -> [Interface]
words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
headMaybe [Interface]
rs of
Just (Interface
"default":Interface
"via":Interface
gw:[Interface]
_) -> forall a. a -> Maybe a
Just Interface
gw
Maybe [Interface]
_ -> forall a. Maybe a
Nothing
ipv6to4 :: Property DebianLike
ipv6to4 :: Property DebianLike
ipv6to4 = 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
$ Interface -> [Interface] -> InterfaceOptions -> Property DebianLike
interfaceFileContains (Interface -> Interface
interfaceDFile Interface
"sit0")
[ Interface
"auto sit0"
, Interface
"iface sit0 inet6 static"
]
[ (Interface
"address", Interface
"2002:5044:5531::1")
, (Interface
"netmask", Interface
"64")
, (Interface
"gateway", Interface
"::192.88.99.1")
]
forall p. IsProp p => p -> Interface -> p
`describe` Interface
"ipv6to4"
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
interfacesDEnabled
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Interface -> Property DebianLike
ifUp Interface
"sit0"
interfacesFile :: FilePath
interfacesFile :: Interface
interfacesFile = Interface
"/etc/network/interfaces"
interfaceDFile :: Interface -> FilePath
interfaceDFile :: Interface -> Interface
interfaceDFile Interface
i = Interface
"/etc/network/interfaces.d" Interface -> Interface -> Interface
</> Interface -> Interface
escapeInterfaceDName Interface
i
escapeInterfaceDName :: Interface -> FilePath
escapeInterfaceDName :: Interface -> Interface
escapeInterfaceDName = forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Interface
"_-"))
interfacesDEnabled :: Property DebianLike
interfacesDEnabled :: Property DebianLike
interfacesDEnabled = 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
$
Interface
-> Interface
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
containsLine Interface
interfacesFile Interface
"source-directory interfaces.d"
forall p. IsProp p => p -> Interface -> p
`describe` Interface
"interfaces.d directory enabled"
interfaceFileContains :: FilePath -> [String] -> InterfaceOptions -> Property DebianLike
interfaceFileContains :: Interface -> [Interface] -> InterfaceOptions -> Property DebianLike
interfaceFileContains Interface
f [Interface]
headerlines InterfaceOptions
options =
Interface -> [InterfaceStanza] -> Property DebianLike
interfaceFileContains' Interface
f [([Interface]
headerlines, InterfaceOptions
options)]
interfaceFileContains' :: FilePath -> [InterfaceStanza] -> Property DebianLike
interfaceFileContains' :: Interface -> [InterfaceStanza] -> Property DebianLike
interfaceFileContains' Interface
f [InterfaceStanza]
stanzas = 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
$ Interface
-> [Interface]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
hasContent Interface
f forall a b. (a -> b) -> a -> b
$
Interface
warning forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InterfaceStanza -> [Interface]
stanza [InterfaceStanza]
stanzas
where
stanza :: InterfaceStanza -> [Interface]
stanza ([Interface]
headerlines, InterfaceOptions
options) = [Interface]
headerlines forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Interface, Interface) -> Interface
fmt InterfaceOptions
options
fmt :: (Interface, Interface) -> Interface
fmt (Interface
k, Interface
v) = Interface
"\t" forall a. [a] -> [a] -> [a]
++ Interface
k forall a. [a] -> [a] -> [a]
++ Interface
" " forall a. [a] -> [a] -> [a]
++ Interface
v
warning :: Interface
warning = Interface
"# Deployed by propellor, do not edit."