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