From 665ea0d3d9e1b0e90278fd659dee0ef8642030da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Jul 2019 00:43:40 -0400 Subject: 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 --- src/Propellor/Property/Aiccu.hs | 5 +++-- src/Propellor/Property/Atomic.hs | 12 ++++++++---- src/Propellor/Property/Systemd.hs | 1 - src/Propellor/Property/Tor.hs | 30 ++++++++++++++---------------- 4 files changed, 25 insertions(+), 23 deletions(-) (limited to 'src/Propellor/Property') 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" -- cgit v1.2.3