summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
AgeCommit message (Collapse)Author
2017-07-05DiskImage: Removed grubBootedJoey Hess
Properties that used to need it as a parameter now look at Info about the bootloader that is installed in the chroot that the disk image is created from. (API change) This is a simplication, and avoids the user needing to repeat themselves in the propellor config, thus avoiding mistakes. When no boot loader is installed, or multiple different ones are, disk image creation will fail, which seems reasonable. This commit was sponsored by Jake Vosloo on Patreon.
2017-06-17use stretch in debian stable examplesJoey Hess
2017-05-15Removed dependency on MissingH, instead depends on split and hashable.Joey Hess
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.
2017-03-15Added Monoid instances for Property and RevertableProperty.Joey Hess
* 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.
2017-03-15Property types changed to use a Maybe (Propellor Result). (API change)Joey Hess
* 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.
2017-03-11don't propagate DNS info from DiskImage chrootsJoey Hess
* DiskImage building properties used to propagate DNS info out from the chroot used to build the disk image to the Host. That is no longer done, since that chroot only exists as a side effect of the disk image creation and servers will not be running in it. * The IsInfo types class's propagateInfo function changed to use a PropagateInfo data type. (API change) This is particularly important when using hostChroot, since the host could well have DNS settings then. This commit was sponsored by Ole-Morten Duesund on Patreon.
2017-02-26noteJoey Hess
2017-02-26convert fromIPAddr to valJoey Hess
2017-02-26use val instead of showJoey Hess
2017-02-26ConfigurableValue instances for User, GroupJoey Hess
2017-02-26fix tabs for indentationJoey Hess
2017-02-26use ConfigurableValue where applicableJoey Hess
* Removed fromPort (use val instead). (API change) * Removed several Show instances that were only used for generating configuration, replacing with ConfigurableValue instances. (API change) It's somewhat annoying that IsInfo requires a Show instance. That's needed to be able to display Info in ghci, but some non-derived Show instances had to be kept to support that.
2017-02-26Added ConfigurableValue type classJoey Hess
* Added ConfigurableValue type class, for values that can be used in a config file, or to otherwise configure a program. * The val function converts such values to String. This was motivated by the bug caused by type Port = Int changing to newtype Port = Port Int deriving Show After that change, some things that used show port to generate config files were broken. By using the ConfigurableValue type class instead, such breakage can be prevented.
2017-02-04improve layoutJoey Hess
2017-02-03add types for Arch LinuxZihao Wang
Signed-off-by: Zihao Wang <dev@wzhd.org>
2017-01-18add Ord instance for PortFélix Sipma
2016-12-26Added --build option, which makes propellor simply build itself.Joey Hess
2016-06-20add DeriveDataTypeable extension to ExceptionFélix Sipma
2016-06-13add DebianKernel datatypeFélix Sipma
(cherry picked from commit 3590a1241580ddcdd153e2619a3c02ce18a8db8c but without the changes to src/Propellor/Precompiled.hs)
2016-06-13remove ANDROID in architectureToDebianArchStringFélix Sipma
(cherry picked from commit 39966bc40c7a15543601e417e35fbb5c6bc1d5c4)
2016-06-13remove ANDROIDJoey Hess
(cherry picked from commit d5d42f4fb51fee4e5eb2e17d82f1339876c8fc03)
2016-06-13reformat Architecture definitionFélix Sipma
(cherry picked from commit 1f036a1448c7a7332080c28c5074d9c06e69806b)
2016-06-13add several ArchitecturesJoey Hess
Cherry-picked from aa8e99c305a07d99cc63e17ca3461f421859bdc5, but without changes to a module that is being added on the precompiled branch.
2016-06-13convert Architecture to a sumtypeFélix Sipma
TODO: remove ANDROID (used in GitAnnexBuilder) TODO: add other architectures TODO: rename ARMHF TODO: rename ARMEL (cherry picked from commit 6f36f6cade4e1d8b15c714565e223562c6573099)
2016-06-13add stopPropellorMessageJoey Hess
2016-05-07Compiling propellor on GHC 8.0.1-rc4davean
ConstrainedClassMethods was added in GHC 7.6.1.3 so I think its sufficiently backwards compatible for you?
2016-05-01Remove Propellor.DotDir from the propellor library, as its use of ↵Joey Hess
Paths_propellor prevents use of the module out of propellor's tree. Failure looked like: /home/lukas/.propellor/.cabal-sandbox/lib/x86_64-linux-ghc-7.10.3/propellor-3.0. 1-0JokOieT9kY9W7enKSzFHh/libHSpropellor-3.0.1-0JokOieT9kY9W7enKSzFHh.a(DotDir.o) :(.text+0x591): undefined reference to `propezu0JokOieT9kY9W7enKSzzFHh_Pathszupropellor_getLibDir_closure' This module is only needed for the wrapper program anyway, which handles --init. This does mean that ./propellor --init in propellor's tree will fail even though the help shows --init as an option.
2016-04-01separate propellor --initJoey Hess
2016-03-30show childProperty same as propertyJoey Hess
2016-03-28implemented pickOSJoey Hess
Fell down the fromSing rabbit hole, followed by the OMH ghc doesh't work rabbit hole. Suboptimal.
2016-03-27improve haddocks and move code around to make them more clearJoey Hess
2016-03-27split out singletons libJoey Hess
2016-03-27ported DiskImageJoey Hess
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
2016-03-27refactorJoey Hess
2016-03-26ported propagateContainerJoey Hess
Renamed several utility functions along the way.
2016-03-25cleanup warningsJoey Hess
2016-03-25continued portingJoey Hess
2016-03-25ported Property.AptJoey Hess
2016-03-25fix CheckCombinableJoey Hess
Was wrong when there was a non-target in the MetaTypes list. Also, rework to improve type checker errors.
2016-03-25use MetaTypes moreJoey Hess
2016-03-25add type alias for Sing to be less confusing for usersJoey Hess
2016-03-24fix combineWith to only accept properties that have common targetsJoey Hess
2016-03-24fix bug in NonTargets implJoey Hess
2016-03-24convert ensurePropertyJoey Hess
Moved to its own module to keep everything related in one place.
2016-03-24IncludesInfoJoey Hess
2016-03-24refactorJoey Hess
2016-03-241st stage integrating MetaTypesJoey Hess
2016-03-24renameJoey Hess
2016-03-24temporarily remove UsedPortJoey Hess
This can come back later as a full Resource data type. For now, I want to focus on merging what I have working.
2016-03-24fix exportJoey Hess