module Propellor.Property.HostingProvider.Linode where

import Propellor.Base
import qualified Propellor.Property.Grub as Grub
import qualified Propellor.Property.File as File

-- | Configures grub to use the serial console as set up by Linode.
-- Useful when running a distribution supplied kernel.
-- <https://www.linode.com/docs/tools-reference/custom-kernels-distros/run-a-distribution-supplied-kernel-with-kvm>
serialGrub :: Property (HasInfo + DebianLike)
serialGrub :: Property
  (HasInfo
   + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
serialGrub = String
"/etc/default/grub" String -> [String] -> Property UnixLike
`File.containsLines`
	[ String
"GRUB_CMDLINE_LINUX=\"console=ttyS0,19200n8\""
	, String
"GRUB_DISABLE_LINUX_UUID=true"
	, String
"GRUB_SERIAL_COMMAND=\"serial --speed=19200 --unit=0 --word=8 --parity=no --stop=1\""
	, String
"GRUB_TERMINAL=serial"
	]
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Grub.mkConfig
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` GrubTarget
-> Property
     (HasInfo
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Grub.installed GrubTarget
Grub.PC
	forall p. IsProp p => p -> String -> p
`describe` String
"GRUB configured for Linode serial console"

-- | Linode's pv-grub-x86_64 (only used for its older XEN instances)
-- does not support booting recent Debian kernels compressed
-- with xz. This sets up pv-grub chaining to enable it.
chainPVGrub :: Grub.TimeoutSecs -> Property (HasInfo + DebianLike)
chainPVGrub :: TimeoutSecs
-> Property
     (HasInfo
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
chainPVGrub = String
-> String
-> TimeoutSecs
-> Property
     (HasInfo
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Grub.chainPVGrub String
"hd0" String
"xen/xvda"

-- | Linode disables mlocate's cron job's execute permissions,
-- presumably to avoid disk IO. This ensures it's executable,
-- if it's installed. It does the same for its replacement plocate,
-- in cae Linode starts messing with that.
locateEnabled :: Property DebianLike
locateEnabled :: Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
locateEnabled = 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 {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList String
"locate enabled" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property UnixLike
go String
"/etc/cron.daily/mlocate"
		forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property UnixLike
go String
"/etc/cron.daily/plocate"
  where
	go :: String -> Property UnixLike
go String
f = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (String -> IO Bool
doesFileExist String
f)
			(String
f String -> FileMode -> Property UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))