| Age | Commit message (Collapse) | Author |
|---|
|
includes the caller.
This commit was sponsored by Jochen Bartl on Patreon.
|
|
|
|
* Propellor.Property.XFCE added with some useful properties for the
desktop environment.
* Added File.applyPath property.
This commit was sponsored by Riku Voipio.
|
|
MissingH is a heavy dependency, which pulls in parsec and a bunch of stuff.
So eliminating it makes propellor easier to install and less likely to
fail to build.
changesFileContent now uses hashable's hash. This may not be stable across
upgrades, I'm not sure -- but it's surely ok here, as the hash is not
stored.
socketFile also uses hash. I *think* this is ok, even if it's not stable.
If it's not stable, an upgrade might make propellor hash a hostname to a
different number, but with 9 digets of number in use, the chances of a
collision are small. In any case, I've opned a bug report asking for the
stability to be documented, and I think it's intended to be stable, only
the documentation is bad.
NB: I have not checked that the arch linux and freebsd packages for the new
deps, that Propellor.Bootstrap lists, are the right names or even exist.
Since propellor depends on hashable, it could be changed to use
unordered-containers, rather than containers, which would be faster and
perhaps less deps too.
This commit was sponsored by Alexander Thompson on Patreon.
|
|
|
|
* Added Monoid instances for Property and RevertableProperty.
* Removed applyToList. Instead, use mconcat. (API change)
Eg, if you had: applyToList accountFor [User "joey", User "root"]
use instead: mconcat (map accountFor [User "joey", User "root"])
mappend x y is basically the same as x `before` y. In particular, if x
fails to be ensured, it won't ensure y. This seems to make sense, since
applyToList had that behavior, and so does the Monoid for Propellor
Result. The alternative would be to try to ensure both and combine
the results. However, I don't see any reason to do it that way.
It would be nice if the description of both properties were displayed when
ensuring the combination. But then, it would need to display eg:
ensuring x..ok
ensuring y..failed
ensuring x and ensuring y..failed
Without a way to get rid of that redundant last line, I don't want to do
that.
Note that the haddocks for the Monoid instances need a really wide screen
to display! This is IMHO an infelicity in haddock, and I can't do anything
about it really.
This commit was sponsored by Fernando Jimenez on Patreon.
|
|
* Property types changed to use a Maybe (Propellor Result). (API change)
* When Nothing needs to be done to ensure a property, propellor
will avoid displaying its description at all. The doNothing property
is an example of such a property.
This is mostly in preparation for Monoid instances for Property types, but
is's also nice that anything that uses doNothing will avoid printing out
any message at all. At least, I think it probably is. It might potentially
be confusing for something that sometimes takes an action and sometimes
resolves to doNothing and in either case has a description set to not
always show the description. If this did turn out to be confusing, the
change to doNothing could be reverted.
This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
|
|
|
|
|
|
encoding-related crashes in eg, Propellor.Property.File.
|
|
Only a couple of the constraints were really redundant. The rest are
essential to propellor's tracking of Info propigation, so I silenced the
warning for those.
It would be better to only silence the warning for the functions with the
extra constraints, but IIRC warnings can only be silenced on an entire file
basis.
This commit was sponsored by Andreas on Patreon.
|
|
|
|
I don't know why this works, or a better way to do it, but it does..
|
|
|
|
|
|
I think Joey wrote this at some point .. though it's possible I did
|
|
It's now exporting a conflicting isSymbolicLink
https://github.com/haskell/directory/issues/52
Only a few places in propellor use isSymbolicLink, but to prevent future
problems, made as much of it as possible import Utility.Directory, which
re-exports System.Directory without the conflicting symbol.
(Utility.Tmp and System.Console.Concurrent.Internal cannot import
Utility.Directory due to cycles, and don't use isSymbolicLink anyway.)
|
|
|
|
|
|
|
|
Fell down the fromSing rabbit hole, followed by the OMH ghc doesh't work
rabbit hole. Suboptimal.
|
|
|
|
Unfortunately, DiskImage needs to add properties to the Chroot it's
presented with, and the metatypes are not included in the Chroot, so it
can't guarantee that the properties it's adding match the OS in the Chroot.
I partially worked around this by making the properties that DiskImage adds
check the OS, so they don't assume Debian.
It would be nicer to parameterize the Chroot type with the metatypes of the
inner OS. I worked for several hours on a patch along those lines, but it
doesn't quite compile. Failed at the final hurdle :/ The patch is below
for later..
--- src/Propellor/Property/Chroot.hs 2016-03-27 16:06:44.285464820 -0400
+++ /home/joey/Chroot.hs 2016-03-27 15:32:29.073416143 -0400
@@ -1,9 +1,9 @@
-{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, DataKinds #-}
module Propellor.Property.Chroot (
debootstrapped,
bootstrapped,
- provisioned,
+ --provisioned,
Chroot(..),
ChrootBootstrapper(..),
Debootstrapped(..),
@@ -11,7 +11,7 @@
noServices,
inChroot,
-- * Internal use
- provisioned',
+ --provisioned',
propagateChrootInfo,
propellChroot,
chain,
@@ -20,6 +20,7 @@
import Propellor.Base
import Propellor.Container
+import Propellor.Types.MetaTypes
import Propellor.Types.CmdLine
import Propellor.Types.Chroot
import Propellor.Types.Info
@@ -38,27 +39,29 @@
-- | Specification of a chroot. Normally you'll use `debootstrapped` or
-- `bootstrapped` to construct a Chroot value.
-data Chroot where
- Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
-
-instance IsContainer Chroot where
- containerProperties (Chroot _ _ h) = containerProperties h
- containerInfo (Chroot _ _ h) = containerInfo h
- setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
+--
+-- The inner and outer type variables are the metatypes of the inside of
+-- the chroot and the system it runs in.
+data Chroot inner outer where
+ Chroot :: ChrootBootstrapper b inner outer => FilePath -> b -> Host -> (inner, outer) -> Chroot inner outer
+
+instance IsContainer (Chroot inner outer) where
+ containerProperties (Chroot _ _ h _) = containerProperties h
+ containerInfo (Chroot _ _ h _) = containerInfo h
-chrootSystem :: Chroot -> Maybe System
+chrootSystem :: Chroot inner outer -> Maybe System
chrootSystem = fromInfoVal . fromInfo . containerInfo
-instance Show Chroot where
- show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
+instance Show (Chroot inner outer) where
+ show c@(Chroot loc _ _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
-- | Class of things that can do initial bootstrapping of an operating
-- System in a chroot.
-class ChrootBootstrapper b where
+class ChrootBootstrapper b inner outer where
-- | Do initial bootstrapping of an operating system in a chroot.
-- If the operating System is not supported, return
-- Left error message.
- buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux)
+ buildchroot :: b -> Maybe System -> FilePath -> Either String (Property outer)
-- | Use this to bootstrap a chroot by extracting a tarball.
--
@@ -68,9 +71,8 @@
-- detect automatically.
data ChrootTarball = ChrootTarball FilePath
-instance ChrootBootstrapper ChrootTarball where
- buildchroot (ChrootTarball tb) _ loc = Right $
- tightenTargets $ extractTarball loc tb
+instance ChrootBootstrapper ChrootTarball UnixLike UnixLike where
+ buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
extractTarball :: FilePath -> FilePath -> Property UnixLike
extractTarball target src = check (unpopulated target) $
@@ -88,7 +90,7 @@
-- | Use this to bootstrap a chroot with debootstrap.
data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
-instance ChrootBootstrapper Debootstrapped where
+instance ChrootBootstrapper Debootstrapped DebianLike Linux where
buildchroot (Debootstrapped cf) system loc = case system of
(Just s@(System (Debian _) _)) -> Right $ debootstrap s
(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
@@ -107,13 +109,22 @@
-- > & osDebian Unstable "amd64"
-- > & Apt.installed ["ghc", "haskell-platform"]
-- > & ...
-debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
+-- debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot DebianLike
+debootstrapped
+ :: (SingI inner, SingI outer, ChrootBootstrapper Debootstrapped (MetaTypes inner) (MetaTypes outer))
+ => Debootstrap.DebootstrapConfig
+ -> FilePath
+ -> Chroot (MetaTypes inner) (MetaTypes outer)
debootstrapped conf = bootstrapped (Debootstrapped conf)
-- | Defines a Chroot at the given location, bootstrapped with the
-- specified ChrootBootstrapper.
-bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Chroot
-bootstrapped bootstrapper location = Chroot location bootstrapper h
+bootstrapped
+ :: (SingI inner, SingI outer, ChrootBootstrapper b (MetaTypes inner) (MetaTypes outer))
+ => b
+ -> FilePath
+ -> Chroot (MetaTypes inner) (MetaTypes outer)
+bootstrapped bootstrapper location = Chroot location bootstrapper h (sing, sing)
where
h = Host location [] mempty
@@ -123,45 +134,79 @@
-- Reverting this property removes the chroot. Anything mounted inside it
-- is first unmounted. Note that it does not ensure that any processes
-- that might be running inside the chroot are stopped.
-provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
+-- provisioned :: SingI outer => Chroot inner outer -> RevertableProperty (HasInfo + MetaTypes outer) Linux
+provisioned
+ ::
+ ( SingI outer
+ , SingI metatypes
+ , Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+ , (HasInfo + outer) ~ MetaTypes metatypes
+ , CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer)) ~ Property outer
+ , IncludesInfo (MetaTypes metatypes) ~ 'True)
+ => Chroot inner outer -> RevertableProperty (HasInfo + outer) Linux
provisioned c = provisioned' (propagateChrootInfo c) c False
provisioned'
- :: (Property Linux -> Property (HasInfo + Linux))
- -> Chroot
+ ::
+ ( Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+ , CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer)) ~ Property outer
+ , SingI outer
+ )
+ => (Property outer -> Property (HasInfo + outer))
+ -> Chroot inner outer
-> Bool
- -> RevertableProperty (HasInfo + Linux) Linux
-provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
- (propigator $ setup `describe` chrootDesc c "exists")
+ -> RevertableProperty (HasInfo + outer) Linux
+provisioned' propigator c systemdonly =
+ (propigator $ setup c systemdonly `describe` chrootDesc c "exists")
<!>
- (teardown `describe` chrootDesc c "removed")
- where
- setup :: Property Linux
- setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
- `requires` built
-
- built = case buildchroot bootstrapper (chrootSystem c) loc of
- Right p -> p
- Left e -> cantbuild e
-
- cantbuild e = property (chrootDesc c "built") (error e)
-
- teardown :: Property Linux
- teardown = check (not <$> unpopulated loc) $
- property ("removed " ++ loc) $
- makeChange (removeChroot loc)
-
-propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
-propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
- p `addInfoProperty` chrootInfo c
+ (teardown c `describe` chrootDesc c "removed")
-chrootInfo :: Chroot -> Info
-chrootInfo (Chroot loc _ h) = mempty `addInfo`
+-- chroot removal code is currently linux specific..
+teardown :: Chroot inner outer -> Property Linux
+teardown (Chroot loc _ _ _) = check (not <$> unpopulated loc) $
+ property ("removed " ++ loc) $
+ makeChange (removeChroot loc)
+
+setup
+ ::
+ ( SingI outer
+ , Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+ )
+ => Chroot inner outer
+ -> Bool
+ -> CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer))
+setup c systemdonly = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
+ `requires` built c
+
+built :: (SingI outer, ChrootBootstrapper b inner outer) => Chroot inner outer -> Property (MetaTypes outer)
+built c@(Chroot loc bootstrapper _ _) =
+ case buildchroot bootstrapper (chrootSystem c) loc of
+ Right p -> error "FOO" -- p
+ Left e -> error "FOO" -- cantbuild c e
+
+cantbuild :: Chroot inner outer -> String -> Property UnixLike
+cantbuild c e = property (chrootDesc c "built") (error e)
+
+propagateChrootInfo
+ ::
+ ( SingI metatypes
+ , (HasInfo + outer) ~ MetaTypes metatypes
+ , IncludesInfo (MetaTypes metatypes) ~ 'True
+ )
+ => Chroot inner outer
+ -> Property outer
+ -> Property (MetaTypes metatypes)
+propagateChrootInfo c@(Chroot location _ _ _) p =
+ propagateContainer location c $
+ p `addInfoProperty` chrootInfo c
+
+chrootInfo :: Chroot inner outer -> Info
+chrootInfo (Chroot loc _ h _) = mempty `addInfo`
mempty { _chroots = M.singleton loc h }
-- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
-propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+propellChroot :: SingI outer => Chroot inner outer -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property (MetaTypes outer)
+propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
let d = localdir </> shimdir c
let me = localdir </> "propellor"
shim <- liftIO $ ifM (doesDirectoryExist d)
@@ -199,8 +244,8 @@
liftIO cleanup
return r
-toChain :: HostName -> Chroot -> Bool -> IO CmdLine
-toChain parenthost (Chroot loc _ _) systemdonly = do
+toChain :: HostName -> Chroot inner outer -> Bool -> IO CmdLine
+toChain parenthost (Chroot loc _ _ _) systemdonly = do
onconsole <- isConsole <$> getMessageHandle
return $ ChrootChain parenthost loc systemdonly onconsole
@@ -224,8 +269,8 @@
putStrLn $ "\n" ++ show r
chain _ _ = errorMessage "bad chain command"
-inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
-inChrootProcess keepprocmounted (Chroot loc _ _) cmd = do
+inChrootProcess :: Bool -> Chroot inner outer -> [String] -> IO (CreateProcess, IO ())
+inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do
mountproc
return (proc "chroot" (loc:cmd), cleanup)
where
@@ -244,26 +289,24 @@
provisioningLock :: FilePath -> FilePath
provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
-shimdir :: Chroot -> FilePath
-shimdir (Chroot loc _ _) = "chroot" </> mungeloc loc ++ ".shim"
+shimdir :: Chroot inner outer -> FilePath
+shimdir (Chroot loc _ _ _) = "chroot" </> mungeloc loc ++ ".shim"
mungeloc :: FilePath -> String
mungeloc = replace "/" "_"
-chrootDesc :: Chroot -> String -> String
-chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
+chrootDesc :: Chroot inner outer -> String -> String
+chrootDesc (Chroot loc _ _ _) desc = "chroot " ++ loc ++ " " ++ desc
|
|
|
|
|
|
|
|
I wanted to keep propertyList [foo, bar] working, but had some difficulty
making the type class approach work. Anyway, that's unlikely to be useful,
since foo and bar probably have different types, or could easiy have their
types updated breaking it.
|
|
|
|
|
|
|
|
Moved to its own module to keep everything related in one place.
|
|
|
|
|
|
Seems that Canonical have trademarked numerous words ending in "buntu",
and would like to trademark anything ending in that to the extent their
lawyers can make that happen.
|
|
Removed references to *buntu from code and documentation because of
an unfortunate trademark use policy.
http://joeyh.name/blog/entry/trademark_nonsense/
That included changing a data constructor to "FooBuntu", an API change.
|
|
Import Prelude after modules that cause warnings due to AMP change
|
|
|
|
|
|
contents remain the same
Don't much like using Data.Hash.MD5, but it's available in dependencies and
pulling in a real hash library would be overkill. And md5 is a perfectly ok
hash to use here.
|
|
|
|
* Properties that run an arbitrary command, such as cmdProperty
and scriptProperty are converted to use UncheckedProperty, since
they cannot tell on their own if the command truely made a change or not.
(API Change)
Transition guide:
- When GHC complains about an UncheckedProperty, add:
`assume` MadeChange
- Since these properties used to always return MadeChange, that
change is always safe to make.
- Or, if you know that the command should modifiy a file, use:
`changesFile` filename
* A few properties have had their Result improved, for example
Apt.buldDep and Apt.autoRemove now check if a change was made or not.
|
|
needs its result checked, and checkResult and changesFile to check for changes.
|
|
|
|
RevertableProperty used to be assumed to contain info, but this is now made
explicit, with RevertableProperty HasInfo or RevertableProperty NoInfo.
Transition guide:
- If you define a RevertableProperty, expect some type check
failures like: "Expecting one more argument to ‘RevertableProperty’".
- Change it to "RevertableProperty NoInfo"
- The compiler will then tell you if it needs "HasInfo" instead.
- If you have code that uses the RevertableProperty constructor
that fails to type check, use the more powerful <!> operator
|
|
* Various property combinators that combined a RevertableProperty
with a non-revertable property used to yield a RevertableProperty.
This was a bug, because the combined property could not be fully
reverted in many cases. Fixed by making the combined property
instead be a Property HasInfo.
* combineWith now takes an addional parameter to control how revert
actions are combined (API change).
|
|
Hmm, do I really need my own type class for LiftPropellor? This seems like
a general problem so I am probably reinventing the wheel.
|
|
|
|
|
|
|
|
|
