summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2019-07-02 00:43:40 -0400
committerJoey Hess2019-07-02 00:43:40 -0400
commit665ea0d3d9e1b0e90278fd659dee0ef8642030da (patch)
tree9969435c0c78c046c4dcc45ec9726229025701ed /src/Propellor/Property
parente20662e6a8881db55394a6366be17ca4e509bc2a (diff)
Revert "custom type error messages"
This reverts commits 14f6ae30809d8bbdb10b91cc59757e865a365df8 de21ef26861db458b0dfb0212cf501f9f8ed459b e20662e6a8881db55394a6366be17ca4e509bc2a Until this bug is resolved, these custom error types hide more basic errors. https://gitlab.haskell.org/ghc/ghc/issues/16894
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Aiccu.hs5
-rw-r--r--src/Propellor/Property/Atomic.hs12
-rw-r--r--src/Propellor/Property/Systemd.hs1
-rw-r--r--src/Propellor/Property/Tor.hs30
4 files changed, 25 insertions, 23 deletions
diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs
index 8bf3f283..1b28759c 100644
--- a/src/Propellor/Property/Aiccu.hs
+++ b/src/Propellor/Property/Aiccu.hs
@@ -47,7 +47,8 @@ hasConfig :: TunnelId -> UserName -> Property (HasInfo + DebianLike)
hasConfig t u = prop `onChange` restarted
where
prop :: Property (HasInfo + UnixLike)
- prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ \getpassword ->
- property' "aiccu configured" $ \w -> getpassword $ ensureProperty w . go
+ prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $
+ property' "aiccu configured" . writeConfig
+ writeConfig getpassword w = getpassword $ ensureProperty w . go
go (Password u', p) = confPath `File.hasContentProtected` config u' t p
go (f, _) = error $ "Unexpected type of privdata: " ++ show f
diff --git a/src/Propellor/Property/Atomic.hs b/src/Propellor/Property/Atomic.hs
index 2c7433f6..8519048b 100644
--- a/src/Propellor/Property/Atomic.hs
+++ b/src/Propellor/Property/Atomic.hs
@@ -46,8 +46,10 @@ type CheckAtomicResourcePair a = AtomicResourcePair a -> Propellor (AtomicResour
-- inactiveAtomicResource, and if it was successful,
-- atomically activating that resource.
atomicUpdate
- -- Constriaint inherited from ensureProperty.
- :: (EnsurePropertyAllowed t t ~ 'True)
+ -- Constriaints inherited from ensureProperty.
+ :: ( Cannot_ensureProperty_WithInfo t ~ 'True
+ , (Targets t `NotSuperset` Targets t) ~ 'CanCombine
+ )
=> SingI t
=> AtomicResourcePair a
-> CheckAtomicResourcePair a
@@ -90,8 +92,10 @@ atomicUpdate rbase rcheck rswap mkp = property' d $ \w -> do
-- children: a symlink with the name of the directory itself, and two copies
-- of the directory, with names suffixed with ".1" and ".2"
atomicDirUpdate
- -- Constriaint inherited from ensureProperty.
- :: (EnsurePropertyAllowed t t ~ 'True)
+ -- Constriaints inherited from ensureProperty.
+ :: ( Cannot_ensureProperty_WithInfo t ~ 'True
+ , (Targets t `NotSuperset` Targets t) ~ 'CanCombine
+ )
=> SingI t
=> FilePath
-> (FilePath -> Property (MetaTypes t))
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 5d597ac6..bfc0f9a5 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -391,7 +391,6 @@ mungename = replace "/" "_"
containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg p = RevertableProperty (mk True) (mk False)
where
- mk :: Bool -> Property (HasInfo + Linux)
mk b = tightenTargets $
pureInfoProperty desc $
mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 862af983..426d4209 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -172,22 +172,20 @@ hiddenServiceData hn context = combineProperties desc $ props
where
desc = unwords ["hidden service data available in", varLib </> hn]
installonion :: FilePath -> Property (HasInfo + DebianLike)
- installonion basef =
- let f = varLib </> hn </> basef
- in withPrivData (PrivFile f) context $ \getcontent ->
- property' desc $ \w -> getcontent $ \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)
- ]
- )
+ 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"