module Propellor.Property.OS (
cleanInstallOnce,
Confirmation(..),
preserveNetwork,
preserveResolvConf,
preserveRootSshAuthorized,
oldOSRemoved,
) where
import Propellor.Base
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Network as Network
import qualified Propellor.Property.User as User
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Reboot as Reboot
import Propellor.Property.Mount
import Propellor.Property.Chroot.Util (stdPATH)
import System.Posix.Files (rename, fileExist)
import Control.Exception (throw)
cleanInstallOnce :: Confirmation -> Property DebianLike
cleanInstallOnce :: Confirmation -> Property DebianLike
cleanInstallOnce Confirmation
confirmation = 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
<$> HostName -> IO Bool
doesFileExist HostName
flagfile) (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
Property DebianLike
go Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
(Property DebianLike)
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` HostName
-> Confirmation
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
confirmed HostName
"clean install confirmed" Confirmation
confirmation
where
go :: CombinedType
(Property DebianLike)
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
go =
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
finalized
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
(Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Bool -> Property DebianLike
User.shadowConfig Bool
True
Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property DebianLike)
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Bool
-> (Result -> Bool)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Reboot.atEnd Bool
True (Result -> Result -> Bool
forall a. Eq a => a -> a -> Bool
/= Result
FailedChange)
Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
(Property DebianLike)
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
propellorbootstrapped
Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property DebianLike)
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
flipped
Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property DebianLike)
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
osbootstrapped
osbootstrapped :: Property Linux
osbootstrapped :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
osbootstrapped = HostName
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS (HostName
newOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" bootstrapped") ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w Maybe System
o -> case Maybe System
o of
(Just d :: System
d@(System (Debian DebianKernel
_ DebianSuite
_) Architecture
_)) -> OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$
System
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
debootstrap System
d
(Just u :: System
u@(System (Buntish HostName
_) Architecture
_)) -> OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$
System
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
debootstrap System
u
Maybe System
_ -> Propellor Result
HasCallStack => Propellor Result
unsupportedOS'
debootstrap :: System -> Property Linux
debootstrap :: System
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
debootstrap System
targetos =
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> HostName
-> System
-> DebootstrapConfig
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Debootstrap.built' Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Debootstrap.sourceInstall
HostName
newOSDir System
targetos DebootstrapConfig
Debootstrap.DefaultConfig
flipped :: Property Linux
flipped :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
flipped = HostName
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property (HostName
newOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" moved into place") (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ do
HostName
devfstype <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"devtmpfs" (Maybe HostName -> HostName) -> IO (Maybe HostName) -> IO HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO (Maybe HostName)
getFsType HostName
"/dev"
[HostName]
mnts <- (HostName -> Bool) -> [HostName] -> [HostName]
forall a. (a -> Bool) -> [a] -> [a]
filter (HostName -> [HostName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (HostName
"/"HostName -> [HostName] -> [HostName]
forall a. a -> [a] -> [a]
: [HostName]
trickydirs)) ([HostName] -> [HostName]) -> IO [HostName] -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [HostName]
mountPoints
[HostName] -> (HostName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([HostName] -> [HostName]
forall a. [a] -> [a]
reverse [HostName]
mnts) HostName -> IO ()
umountLazy
[(HostName, HostName, IO Bool)]
renamesout <- (HostName -> (HostName, HostName, IO Bool))
-> [HostName] -> [(HostName, HostName, IO Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\HostName
d -> (HostName
d, HostName
oldOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
d, Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ HostName
d HostName -> [HostName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (HostName
oldOSDirHostName -> [HostName] -> [HostName]
forall a. a -> [a] -> [a]
:HostName
newOSDirHostName -> [HostName] -> [HostName]
forall a. a -> [a] -> [a]
:[HostName]
trickydirs)))
([HostName] -> [(HostName, HostName, IO Bool)])
-> IO [HostName] -> IO [(HostName, HostName, IO Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO [HostName]
dirContents HostName
"/"
[(HostName, HostName, IO Bool)]
renamesin <- (HostName -> (HostName, HostName, IO Bool))
-> [HostName] -> [(HostName, HostName, IO Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\HostName
d -> let dest :: HostName
dest = HostName
"/" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName -> HostName
takeFileName HostName
d in (HostName
d, HostName
dest, Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO Bool
fileExist HostName
dest))
([HostName] -> [(HostName, HostName, IO Bool)])
-> IO [HostName] -> IO [(HostName, HostName, IO Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO [HostName]
dirContents HostName
newOSDir
Bool -> HostName -> IO ()
createDirectoryIfMissing Bool
True HostName
oldOSDir
[(HostName, HostName, IO Bool)] -> IO ()
massRename ([(HostName, HostName, IO Bool)]
renamesout [(HostName, HostName, IO Bool)]
-> [(HostName, HostName, IO Bool)]
-> [(HostName, HostName, IO Bool)]
forall a. [a] -> [a] -> [a]
++ [(HostName, HostName, IO Bool)]
renamesin)
HostName -> IO ()
removeDirectoryRecursive HostName
newOSDir
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> HostName -> Bool -> IO ()
setEnv HostName
"PATH" HostName
stdPATH Bool
True
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> IO ()
unsetEnv HostName
"LANG"
IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (HostName -> HostName -> HostName -> MountOpts -> IO Bool
mount HostName
devfstype HostName
devfstype HostName
"/dev" MountOpts
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
HostName -> IO ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName
"failed mounting /dev using " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
devfstype HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
"; falling back to MAKEDEV generic"
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> [CommandParam] -> IO Bool
boolSystem HostName
"sh" [HostName -> CommandParam
Param HostName
"-c", HostName -> CommandParam
Param HostName
"cd /dev && /sbin/MAKEDEV generic"]
IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (HostName -> HostName -> HostName -> MountOpts -> IO Bool
mount HostName
"sysfs" HostName
"sysfs" HostName
"/sys" MountOpts
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
HostName -> IO ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage HostName
"failed mounting /sys"
IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (HostName -> HostName -> HostName -> MountOpts -> IO Bool
mount HostName
"devpts" HostName
"devpts" HostName
"/dev/pts" MountOpts
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
HostName -> IO ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage HostName
"failed mounting /dev/pts"
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
propellorbootstrapped :: Property UnixLike
propellorbootstrapped :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
propellorbootstrapped = HostName
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
"propellor re-debootstrapped in new os" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
finalized :: Property UnixLike
finalized :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
finalized = HostName
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
"clean OS installed" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ do
IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ HostName -> HostName -> IO ()
writeFile HostName
flagfile HostName
""
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
flagfile :: HostName
flagfile = HostName
"/etc/propellor-cleaninstall"
trickydirs :: [HostName]
trickydirs =
[ HostName
"/tmp"
, HostName
"/proc"
]
massRename :: [(FilePath, FilePath, IO Bool)] -> IO ()
massRename :: [(HostName, HostName, IO Bool)] -> IO ()
massRename = [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go []
where
go :: [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go [(HostName, HostName)]
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go [(HostName, HostName)]
undo ((HostName
from, HostName
to, IO Bool
test):[(HostName, HostName, IO Bool)]
rest) = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
test
( IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryNonAsync (HostName -> HostName -> IO ()
rename HostName
from HostName
to)
IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
([(HostName, HostName)] -> SomeException -> IO ()
forall {t :: * -> *} {e} {b}.
(Foldable t, Exception e) =>
t (HostName, HostName) -> e -> IO b
rollback [(HostName, HostName)]
undo)
(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go ((HostName
to, HostName
from)(HostName, HostName)
-> [(HostName, HostName)] -> [(HostName, HostName)]
forall a. a -> [a] -> [a]
:[(HostName, HostName)]
undo) [(HostName, HostName, IO Bool)]
rest)
, [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go [(HostName, HostName)]
undo [(HostName, HostName, IO Bool)]
rest
)
rollback :: t (HostName, HostName) -> e -> IO b
rollback t (HostName, HostName)
undo e
e = do
((HostName, HostName) -> IO ()) -> t (HostName, HostName) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((HostName -> HostName -> IO ()) -> (HostName, HostName) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HostName -> HostName -> IO ()
rename) t (HostName, HostName)
undo
e -> IO b
forall a e. Exception e => e -> a
throw e
e
data Confirmation = Confirmed HostName
confirmed :: Desc -> Confirmation -> Property UnixLike
confirmed :: HostName
-> Confirmation
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
confirmed HostName
desc (Confirmed HostName
c) = HostName
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
desc (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ do
HostName
hostname <- (Host -> HostName) -> Propellor HostName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> HostName
hostName
if HostName
hostname HostName -> HostName -> Bool
forall a. Eq a => a -> a -> Bool
/= HostName
c
then do
HostName -> Propellor ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage HostName
"Run with a bad confirmation, not matching hostname."
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
else Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
preserveNetwork :: Property DebianLike
preserveNetwork :: Property DebianLike
preserveNetwork = Property DebianLike
go Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Network.cleanInterfacesFile
where
go :: Property DebianLike
go :: Property DebianLike
go = HostName
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' HostName
"preserve network configuration" ((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
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
[HostName]
ls <- IO [HostName] -> Propellor [HostName]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HostName] -> Propellor [HostName])
-> IO [HostName] -> Propellor [HostName]
forall a b. (a -> b) -> a -> b
$ HostName -> [HostName]
lines (HostName -> [HostName]) -> IO HostName -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> [HostName] -> IO HostName
readProcess HostName
"ip"
[HostName
"route", HostName
"list", HostName
"scope", HostName
"global"]
case HostName -> [HostName]
words (HostName -> [HostName]) -> Maybe HostName -> Maybe [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HostName] -> Maybe HostName
forall a. [a] -> Maybe a
headMaybe [HostName]
ls of
Just (HostName
"default":HostName
"via":HostName
_:HostName
"dev":HostName
iface:[HostName]
_) ->
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ HostName -> Property DebianLike
Network.preserveStatic HostName
iface
Maybe [HostName]
_ -> do
HostName -> Propellor ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage HostName
"did not find any default ipv4 route"
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
preserveResolvConf :: Property Linux
preserveResolvConf :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
preserveResolvConf = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (HostName -> IO Bool
fileExist HostName
oldloc) (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
HostName
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (HostName
newloc HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" copied from old OS") ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w -> do
[HostName]
ls <- IO [HostName] -> Propellor [HostName]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HostName] -> Propellor [HostName])
-> IO [HostName] -> Propellor [HostName]
forall a b. (a -> b) -> a -> b
$ HostName -> [HostName]
lines (HostName -> [HostName]) -> IO HostName -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFile HostName
oldloc
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> 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,
'Targeting 'OSArchLinux]
w (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
$ HostName
newloc HostName
-> [HostName]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [HostName]
ls
where
newloc :: HostName
newloc = HostName
"/etc/resolv.conf"
oldloc :: HostName
oldloc = HostName
oldOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
newloc
preserveRootSshAuthorized :: Property UnixLike
preserveRootSshAuthorized :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
preserveRootSshAuthorized = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (HostName -> IO Bool
fileExist HostName
oldloc) (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
HostName
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' HostName
desc ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
[HostName]
ks <- IO [HostName] -> Propellor [HostName]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HostName] -> Propellor [HostName])
-> IO [HostName] -> Propellor [HostName]
forall a b. (a -> b) -> a -> b
$ HostName -> [HostName]
lines (HostName -> [HostName]) -> IO HostName -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFile HostName
oldloc
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> 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,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w (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
$ HostName
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties HostName
desc (Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
[Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ (HostName
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [HostName]
-> [Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
forall a b. (a -> b) -> [a] -> [b]
map (RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (HostName
-> RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> HostName
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User
-> HostName
-> RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Ssh.authorizedKey (HostName -> User
User HostName
"root")) [HostName]
ks
where
desc :: HostName
desc = HostName
newloc HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" copied from old OS"
newloc :: HostName
newloc = HostName
"/root/.ssh/authorized_keys"
oldloc :: HostName
oldloc = HostName
oldOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
newloc
oldOSRemoved :: Confirmation -> Property UnixLike
oldOSRemoved :: Confirmation
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
oldOSRemoved Confirmation
confirmation = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (HostName -> IO Bool
doesDirectoryExist HostName
oldOSDir) (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` HostName
-> Confirmation
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
confirmed HostName
"old OS backup removal confirmed" Confirmation
confirmation
where
go :: Property UnixLike
go :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = HostName
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
"old OS backup removed" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ do
IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ HostName -> IO ()
removeDirectoryRecursive HostName
oldOSDir
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
oldOSDir :: FilePath
oldOSDir :: HostName
oldOSDir = HostName
"/old-os"
newOSDir :: FilePath
newOSDir :: HostName
newOSDir = HostName
"/new-os"