4728540 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

verify-migration: ensure that graph is linear

4728540Sridhar Ratnakumar8 years ago

lib/command/src/Obelisk/Command.hs+1−1

compare with master

unifiedsplit

@@ -403,7 +403,7 @@ ob = \case

403 ObInternal_CreateMigration ->

404 createMigrationEdgeFromHEAD "."

405 ObInternal_VerifyMigration ->

406− verifyGraph "."

406+ verifyMigration "."

407 ObInternal_Migrate fromHash ->

408 migrateObelisk "." fromHash

409 ObInternal_CLIDemo -> cliDemo

lib/command/src/Obelisk/Command/Upgrade.hs+14−4

@@ -8,7 +8,7 @@

8module Obelisk.Command.Upgrade where

10import Control.Monad (forM, unless, void)

11−import Control.Monad.Catch (onException)

11+import Control.Monad.Catch (onException, try)

12import Control.Monad.IO.Class (liftIO)

13import Data.Maybe (catMaybes)

14import Data.Monoid (Any (..), getAny)

@@ -183,12 +183,22 @@ computeVertexHash :: MonadObelisk m => FilePath -> m Hash

183computeVertexHash = getDirectoryHash [migrationDirName]

184

185-- | Verify the integrity of the migration graph in relation to the Git repo.

186−verifyGraph :: MonadObelisk m => FilePath -> m ()

186+verifyMigration :: MonadObelisk m => FilePath -> m ()

187−verifyGraph obDir = do

187+verifyMigration obDir = do

188− upgradeGraph <- withSpinner "Reading graph" $

188+ upgradeGraph <- withSpinner "Reading migration graph" $

189 getMigrationGraph @Text obDir MigrationGraph_ObeliskUpgrade

190 withSpinner "Checking graph integrity" $

191 ensureGraphIntegrity upgradeGraph

192+ withSpinner "Checking graph is linear" $

193+ -- We don't support merge commits (i.e., diamonds in a graph) yet.

194+ -- Until we do, ensure that the graph is a linear list.

195+ try (ensureGraphLinearity upgradeGraph) >>= \case

196+ Left (NonLinearGraph_MultipleAdjacents vertex) ->

197+ failWith $ "Graph is not linear; branches at vertex: " <> tshow vertex

198+ Left (NonLinearGraph_NotConnected isolatedVertices) ->

199+ failWith $ "Graph is partly linear, but with isolated vertices: " <> tshow isolatedVertices

200+ Right () ->

201+ pure ()

192 liftIO (doesDirectoryExist $ obDir </> ".git") >>= \case

202 liftIO (doesDirectoryExist $ obDir </> ".git") >>= \case

193 True ->

203 True ->

194 withSpinner "Checking existence of HEAD vertex" $

204 withSpinner "Checking existence of HEAD vertex" $

lib/migration/src/Obelisk/Migration.hs+31−1

@@ -13,6 +13,7 @@ import Data.Map (Map)

13import qualified Data.Map as Map

14import Data.Maybe (catMaybes)

15import Data.Semigroup ((<>))

16+import Data.Set (Set)

16import qualified Data.Set as Set

17import qualified Data.Set as Set

17import Data.Text (Text)

18import Data.Text (Text)

18import qualified Data.Text as T

19import qualified Data.Text as T

@@ -33,6 +34,8 @@ data Migration action = Migration

33-- A path is a list of edges

34-- A path is a list of edges

34type Path = [(Hash, Hash)]

35type Path = [(Hash, Hash)]

37+data GraphInternalError = GraphInternalError Text

38+ deriving Show

37data CyclicGraphError = CyclicGraphError

40data CyclicGraphError = CyclicGraphError

38 deriving Show

41 deriving Show

@@ -49,11 +52,18 @@ data NonEquivalentPaths = NonEquivalentPaths Hash Hash

49data MissingEdgeInActionMap = MissingEdgeInActionMap (Hash, Hash)

52data MissingEdgeInActionMap = MissingEdgeInActionMap (Hash, Hash)

50 deriving Show

53 deriving Show

55+data NonLinearGraph

56+ = NonLinearGraph_MultipleAdjacents Hash

57+ | NonLinearGraph_NotConnected (Set Hash)

58+ deriving Show

59+

60+instance Exception GraphInternalError

52instance Exception CyclicGraphError

61instance Exception CyclicGraphError

53instance Exception MultipleTerminalVertices

62instance Exception MultipleTerminalVertices

54instance Exception NoTerminalVertex

63instance Exception NoTerminalVertex

55instance Exception NonEquivalentPaths

64instance Exception NonEquivalentPaths

56instance Exception MissingEdgeInActionMap

65instance Exception MissingEdgeInActionMap

66+instance Exception NonLinearGraph

58class Action action where

68class Action action where

59 parseEdgeMeta :: String -> action

69 parseEdgeMeta :: String -> action

@@ -62,6 +72,7 @@ instance Action Text where

62 parseEdgeMeta = T.pack

72 parseEdgeMeta = T.pack

64-- | Get the directed-acylic graph of migration

74-- | Get the directed-acylic graph of migration

75+-- TODO: Consider calling getDag only when reading the graph for efficiency.

65getDag :: (MonadThrow m, Ord a) => AdjacencyMap a -> m (AdjacencyMap a)

76getDag :: (MonadThrow m, Ord a) => AdjacencyMap a -> m (AdjacencyMap a)

66getDag g = case topSort g of

77getDag g = case topSort g of

67 Just _ -> pure g

78 Just _ -> pure g

@@ -89,7 +100,7 @@ readGraph root name = doesDirectoryExist root >>= \case

89 False -> do

100 False -> do

90 return Nothing

101 return Nothing

102

92−-- | Ensures that the migration graph is correct

103+-- | Ensure that the migration graph is correct

93--

104--

94-- In a correct migration graph: for all pairs of nodes, all paths between

105-- In a correct migration graph: for all pairs of nodes, all paths between

95-- those nodes have the same migration value

106-- those nodes have the same migration value

@@ -122,6 +133,25 @@ ensureGraphIntegrity m = do

122 -- further above).

133 -- further above).

123 visitFrom mempty mempty firstVertex

134 visitFrom mempty mempty firstVertex

124

135

136+-- | Ensure that the graph is a fully connected linear list

137+ensureGraphLinearity :: MonadThrow m => Migration action -> m ()

138+ensureGraphLinearity m = do

139+ graph <- fmap adjacencyMap $ getDag $ _migration_graph m

140+ firstVertex <- getFirst $ _migration_graph m

141+ let

142+ visitFrom start = case Map.lookup start graph of

143+ Nothing -> throwM $ GraphInternalError $ "Vertex not found: " <> start

144+ Just adjs -> case (Set.toList adjs) of

145+ [] -> [start]

146+ [adj] -> start : visitFrom adj

147+ _ -> throwM $ NonLinearGraph_MultipleAdjacents start

148+ visitedVertices = Set.fromList $ visitFrom firstVertex

149+ allVertices = vertexSet $ _migration_graph m

150+ unvisitedVertices = Set.difference allVertices visitedVertices

151+ if Set.null unvisitedVertices

152+ then pure ()

153+ else throwM $ NonLinearGraph_NotConnected unvisitedVertices

154+

125-- | Find the concatenated actions between two vertices

155-- | Find the concatenated actions between two vertices

126--

156--

127-- All paths between the vertices must have the same mappend'ed action;

157-- All paths between the vertices must have the same mappend'ed action;

migration/80cb6b08443d55bb512e4a35b4768b72-59742705e53838ae13066a2239a72040/obelisk-handoffnew file

No changes to the content.

migration/80cb6b08443d55bb512e4a35b4768b72-59742705e53838ae13066a2239a72040/obelisk-upgradenew file

No changes to the content.