    {-# LANGUAGE TypeFamilies #-}

    module Propellor.Property.Tor where

    import Propellor.Base
    import qualified Propellor.Property.File as File
    import qualified Propellor.Property.Apt as Apt
    import qualified Propellor.Property.Service as Service
    import qualified Propellor.Property.ConfFile as ConfFile
    import Utility.FileMode
    import Utility.DataUnits

    import System.Posix.Files
    import Data.Char
    import Data.List

    type HiddenServiceName = String

    type NodeName = String

    -- | Sets up a tor bridge. (Not a relay or exit node.)
    --
    -- Uses port 443
    isBridge :: Property DebianLike
    isBridge = configured
    	[ ("BridgeRelay", "1")
    	, ("Exitpolicy", "reject *:*")
    	, ("ORPort", "443")
    	]
    	`describe` "tor bridge"
    	`requires` server

    -- | Sets up a tor relay.
    --
    -- Uses port 443
    isRelay :: Property DebianLike
    isRelay = configured
    	[ ("BridgeRelay", "0")
    	, ("Exitpolicy", "reject *:*")
    	, ("ORPort", "443")
    	]
    	`describe` "tor relay"
    	`requires` server

    -- | Makes the tor node be named, with a known private key.
    --
    -- This can be moved to a different IP without needing to wait to
    -- accumulate trust.
    named :: NodeName -> Property (HasInfo + DebianLike)
    named n = configured [("Nickname", n')]
    	`describe` ("tor node named " ++ n')
    	`requires` torPrivKey (Context ("tor " ++ n))
      where
    	n' = saneNickname n

    -- | Configures tor with secret_id_key, ed25519_master_id_public_key,
    -- and ed25519_master_id_secret_key from privdata.
    torPrivKey :: Context -> Property (HasInfo + DebianLike)
    torPrivKey context = mconcat (map go keyfiles)
    	`onChange` restarted
    	`requires` torPrivKeyDirExists
      where
    	keyfiles = map (torPrivKeyDir </>)
    		[ "secret_id_key"
    		, "ed25519_master_id_public_key"
    		, "ed25519_master_id_secret_key"
    		]
    	go f = f `File.hasPrivContent` context
    		`onChange` File.ownerGroup f user (userGroup user)

    torPrivKeyDirExists :: Property DebianLike
    torPrivKeyDirExists = File.dirExists torPrivKeyDir
    	`onChange` setperms
    	`requires` installed
      where
    	setperms = File.ownerGroup torPrivKeyDir user (userGroup user)
    		`before` File.mode torPrivKeyDir 0O2700

    torPrivKeyDir :: FilePath
    torPrivKeyDir = "/var/lib/tor/keys"

    -- | A tor server (bridge, relay, or exit)
    -- Don't use if you just want to run tor for personal use.
    server :: Property DebianLike
    server = configured [("SocksPort", "0")]
    	`requires` installed
    	`requires` Apt.installed ["ntp"]
    	`describe` "tor server"

    installed :: Property DebianLike
    installed = Apt.installed ["tor"]

    -- | Specifies configuration settings. Any lines in the config file
    -- that set other values for the specified settings will be removed,
    -- while other settings are left as-is. Tor is restarted when
    -- configuration is changed.
    configured :: [(String, String)] -> Property DebianLike
    configured settings = File.fileProperty "tor configured" go mainConfig
    	`onChange` restarted
      where
    	ks = map fst settings
    	go ls = sort $ map toconfig $
    		filter (\(k, _) -> k `notElem` ks) (map fromconfig ls)
    		++ settings
    	toconfig (k, v) = k ++ " " ++ v
    	fromconfig = separate (== ' ')

    data BwLimit
    	= PerSecond String
    	| PerDay String
    	| PerMonth String

    -- | Limit incoming and outgoing traffic to the specified
    -- amount each.
    --
    -- For example, PerSecond "30 kibibytes" is the minimum limit
    -- for a useful relay.
    bandwidthRate :: BwLimit -> Property DebianLike
    bandwidthRate (PerSecond s) = bandwidthRate' s 1
    bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
    bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)

    bandwidthRate' :: String -> Integer -> Property DebianLike
    bandwidthRate' s divby = case readSize dataUnits s of
    	Just sz -> let v = show (sz `div` divby) ++ " bytes"
    		in configured [("BandwidthRate", v)]
    			`describe` ("tor BandwidthRate " ++ v)
    	Nothing -> property ("unable to parse " ++ s) noChange

    -- | Enables a hidden service for a given port.
    --
    -- If used without `hiddenServiceData`, tor will generate a new
    -- private key.
    hiddenService :: HiddenServiceName -> Port -> Property DebianLike
    hiddenService hn port = hiddenService' hn [port]

    hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike
    hiddenService' hn ports = ConfFile.adjustSection
    	(unwords ["hidden service", hn, "available on ports", intercalate "," (map val ports')])
    	(== oniondir)
    	(not . isPrefixOf "HiddenServicePort")
    	(const (oniondir : onionports))
    	(++ oniondir : onionports)
    	mainConfig
    	`onChange` restarted
      where
    	oniondir = unwords ["HiddenServiceDir", varLib </> hn]
    	onionports = map onionport ports'
    	ports' = sort ports
    	onionport port = unwords ["HiddenServicePort", val port, "127.0.0.1:" ++ val port]

    -- | Same as `hiddenService` but also causes propellor to display
    -- the onion address of the hidden service.
    hiddenServiceAvailable :: HiddenServiceName -> Port -> Property DebianLike
    hiddenServiceAvailable hn port = hiddenServiceAvailable' hn [port]

    hiddenServiceAvailable' :: HiddenServiceName -> [Port] -> Property DebianLike
    hiddenServiceAvailable' hn ports = hiddenServiceHostName $ hiddenService' hn ports
      where
    	hiddenServiceHostName p =  adjustPropertySatisfy p $ \satisfy -> do
    		r <- satisfy
    		mh <- liftIO $ tryIO $ readFile (varLib </> hn </> "hostname")
    		case mh of
    			Right h -> infoMessage ["hidden service hostname:", h]
    			Left _e -> warningMessage "hidden service hostname not available yet"
    		return r

    -- | Load the private key for a hidden service from the privdata.
    hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
    hiddenServiceData hn context = combineProperties desc $ props
    	& installonion "hostname"
    	& installonion "private_key"
      where
    	desc = unwords ["hidden service data available in", varLib </> hn]
    	installonion :: FilePath -> Property (HasInfo + DebianLike)
    	installonion f = withPrivData (PrivFile $ varLib </> hn </> f) context $ \getcontent ->
    		property' desc $ \w -> getcontent $ install w $ varLib </> hn </> f
    	install w f privcontent = ifM (liftIO $ doesFileExist f)
    		( noChange
    		, ensureProperty w $ propertyList desc $ toProps
    			[ property desc $ makeChange $ do
    				createDirectoryIfMissing True (takeDirectory f)
    				writeFileProtected f (unlines (privDataLines privcontent))
    			, File.mode (takeDirectory f) $ combineModes
    				[ownerReadMode, ownerWriteMode, ownerExecuteMode]
    			, File.ownerGroup (takeDirectory f) user (userGroup user)
    			, File.ownerGroup f user (userGroup user)
    			]
    		)

    restarted :: Property DebianLike
    restarted = Service.restarted "tor"

    mainConfig :: FilePath
    mainConfig = "/etc/tor/torrc"

    varLib :: FilePath
    varLib = "/var/lib/tor"

    varRun :: FilePath
    varRun = "/var/run/tor"

    user :: User
    user = User "debian-tor"

    type NickName = String

    -- | Convert String to a valid tor NickName.
    saneNickname :: String -> NickName
    saneNickname s
    	| null n = "unnamed"
    	| otherwise = n
      where
    	legal c = isNumber c || isAsciiUpper c || isAsciiLower c
    	n = take 19 $ filter legal s