From 5e4c57652cef29d9729dce22da3f98dc909b3ff2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 20 Nov 2014 00:21:40 -0400 Subject: fix docker container provisioning Since the containers are no longer on the host list, they were not found while provisioning, oops. To fix, had to add to a host's info a map of the containers docked to it. Unfortunately, that required Propellor.Types.Info be glommed into Propellor.Types, since it needed to refer to Host. --- src/Propellor/Types/Info.hs | 66 --------------------------------------------- 1 file changed, 66 deletions(-) delete mode 100644 src/Propellor/Types/Info.hs (limited to 'src/Propellor/Types/Info.hs') diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs deleted file mode 100644 index 6aba1f9f..00000000 --- a/src/Propellor/Types/Info.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Propellor.Types.Info where - -import Propellor.Types.OS -import Propellor.Types.PrivData -import qualified Propellor.Types.Dns as Dns - -import qualified Data.Set as S -import Data.Monoid - --- | Information about a host. -data Info = Info - { _os :: Val System - , _privDataFields :: S.Set (PrivDataField, Context) - , _sshPubKey :: Val String - , _aliases :: S.Set HostName - , _dns :: S.Set Dns.Record - , _namedconf :: Dns.NamedConfMap - , _dockerinfo :: DockerInfo - } - deriving (Eq, Show) - -instance Monoid Info where - mempty = Info mempty mempty mempty mempty mempty mempty mempty - mappend old new = Info - { _os = _os old <> _os new - , _privDataFields = _privDataFields old <> _privDataFields new - , _sshPubKey = _sshPubKey old <> _sshPubKey new - , _aliases = _aliases old <> _aliases new - , _dns = _dns old <> _dns new - , _namedconf = _namedconf old <> _namedconf new - , _dockerinfo = _dockerinfo old <> _dockerinfo new - } - -data Val a = Val a | NoVal - deriving (Eq, Show) - -instance Monoid (Val a) where - mempty = NoVal - mappend old new = case new of - NoVal -> old - _ -> new - -fromVal :: Val a -> Maybe a -fromVal (Val a) = Just a -fromVal NoVal = Nothing - -data DockerInfo = DockerInfo - { _dockerRunParams :: [HostName -> String] - } - -instance Eq DockerInfo where - x == y = and - [ let simpl v = map (\a -> a "") (_dockerRunParams v) - in simpl x == simpl y - ] - -instance Monoid DockerInfo where - mempty = DockerInfo mempty - mappend old new = DockerInfo - { _dockerRunParams = _dockerRunParams old <> _dockerRunParams new - } - -instance Show DockerInfo where - show a = unlines - [ "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) - ] -- cgit v1.2.3