    module Propellor.Property.Network where

    import Propellor.Base
    import Propellor.Property.File

    import Data.Char

    type Interface = String

    -- | Options to put in a stanza of an ifupdown interfaces file.
    type InterfaceOptions = [(String, String)]

    ifUp :: Interface -> Property DebianLike
    ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
    	`assume` MadeChange

    -- | Resets /etc/network/interfaces to a clean and empty state,
    -- containing just the standard loopback interface, and with
    -- interfacesD enabled.
    --
    -- This can be used as a starting point to defining other interfaces.
    --
    -- No interfaces are brought up or down by this property.
    cleanInterfacesFile :: Property DebianLike
    cleanInterfacesFile = interfaceFileContains interfacesFile
    	[ "source-directory interfaces.d"
    	, ""
    	, "# The loopback network interface"
    	, "auto lo"
    	, "iface lo inet loopback"
    	]
    	[]
    	`describe` ("clean " ++ interfacesFile)

    -- | Configures an interface to get its address via dhcp.
    dhcp :: Interface -> Property DebianLike
    dhcp iface = dhcp' iface mempty

    dhcp' :: Interface -> InterfaceOptions -> Property DebianLike
    dhcp' iface options = interfaceFileContains (interfaceDFile iface)
    	[ "auto " ++ iface
    	, "iface " ++ iface ++ " inet dhcp"
    	] options
    	`describe` ("dhcp " ++ iface)
    	`requires` interfacesDEnabled

    newtype Gateway = Gateway IPAddr

    -- | Configures an interface with a static address and gateway.
    static :: Interface -> IPAddr -> Maybe Gateway -> Property DebianLike
    static iface addr gateway = static' iface addr gateway mempty

    static' :: Interface -> IPAddr -> Maybe Gateway -> InterfaceOptions -> Property DebianLike
    static' iface addr gateway options =
    	interfaceFileContains (interfaceDFile iface) headerlines options'
    	`describe` ("static IP address for " ++ iface)
    	`requires` interfacesDEnabled
      where
    	headerlines =
    		[ "auto " ++ iface
    		, "iface " ++ iface ++ " " ++ inet ++ " static"
    		]
    	options' = catMaybes
    		[ Just $ ("address", val addr)
    		, case gateway of
    			Just (Gateway gaddr) ->
    				Just ("gateway", val gaddr)
    			Nothing -> Nothing
    		] ++ options
    	inet = case addr of
    		IPv4 _ -> "inet"
    		IPv6 _ -> "inet6"

    -- | Writes a static interface file for the specified interface
    -- to preserve its current configuration.
    --
    -- The interface has to be up already. It could have been brought up by
    -- DHCP, or by other means. The current ipv4 addresses
    -- and routing configuration of the interface are written into the file.
    --
    -- If the interface file already exists, this property does nothing,
    -- no matter its content.
    --
    -- (ipv6 addresses are not included because it's assumed they come up
    -- automatically in most situations.)
    preserveStatic :: Interface -> Property DebianLike
    preserveStatic iface = tightenTargets $
    	check (not <$> doesFileExist f) setup
    		`describe` desc
    		`requires` interfacesDEnabled
      where
    	f = interfaceDFile iface
    	desc = "static " ++ iface
    	setup :: Property DebianLike
    	setup = property' desc $ \o -> do
    		ls <- liftIO $ lines <$> readProcess "ip"
    			["-o", "addr", "show", iface, "scope", "global"]
    		stanzas <- liftIO $ concat <$> mapM mkstanza ls
    		ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
    	mkstanza ipline = case words ipline of
    		-- Note that the IP address is written CIDR style, so
    		-- the netmask does not need to be specified separately.
    		(_:iface':"inet":addr:_) | iface' == iface -> do
    			gw <- getgateway
    			return $ catMaybes
    				[ Just $ "iface " ++ iface ++ " inet static"
    				, Just $ "\taddress " ++ addr
    				, ("\tgateway " ++) <$> gw
    				]
    		_ -> return []
    	getgateway = do
    		rs <- lines <$> readProcess "ip"
    			["route", "show", "scope", "global", "dev", iface]
    		return $ case words <$> headMaybe rs of
    			Just ("default":"via":gw:_) -> Just gw
    			_ -> Nothing

    -- | 6to4 ipv6 connection, should work anywhere
    ipv6to4 :: Property DebianLike
    ipv6to4 = tightenTargets $ interfaceFileContains (interfaceDFile "sit0")
    	[ "auto sit0"
    	, "iface sit0 inet6 static"
    	]
    	[ ("address", "2002:5044:5531::1")
    	, ("netmask", "64")
    	, ("gateway", "::192.88.99.1")
    	]
    	`describe` "ipv6to4"
    	`requires` interfacesDEnabled
    	`onChange` ifUp "sit0"

    interfacesFile :: FilePath
    interfacesFile = "/etc/network/interfaces"

    -- | A file in the interfaces.d directory.
    interfaceDFile :: Interface -> FilePath
    interfaceDFile i = "/etc/network/interfaces.d" </> escapeInterfaceDName i

    -- | /etc/network/interfaces.d/ files have to match -- ^[a-zA-Z0-9_-]+$
    -- see "man 5 interfaces"
    escapeInterfaceDName :: Interface -> FilePath
    escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))

    -- | Ensures that files in the the interfaces.d directory are used.
    -- interfacesDEnabled :: Property DebianLike
    interfacesDEnabled :: Property DebianLike
    interfacesDEnabled = tightenTargets $
    	containsLine interfacesFile "source-directory interfaces.d"
    		`describe` "interfaces.d directory enabled"

    interfaceFileContains :: FilePath -> [String] -> InterfaceOptions -> Property DebianLike
    interfaceFileContains f headerlines options = tightenTargets $ hasContent f $
    	warning : headerlines ++ map fmt options
      where
    	fmt (k, v) = "\t" ++ k ++ " " ++ v
    	warning = "# Deployed by propellor, do not edit."