on master help sign in
Merge branch 'master' of https://github.com/agentm/project-m36

Conflicts: test/TutorialD/Interpreter.hs

commita8fc80120c145f5d07c941dc996c291800393954 authorAgentM <agentm@themactionfaction.com> dateThu 24 Aug 2017, 17:13 (9 years ago) parentf1eb2deb5ef26a
4 files changed+37−15
src/bin/TutorialD/Interpreter/Base.hs−1 src/lib/ProjectM36/Error.hs+2−1 src/lib/ProjectM36/TransactionGraph/Persist.hs+34−12 test/TransactionGraph/Automerge.hs+1−1
src/bin/TutorialD/Interpreter/Base.hs−1
@@ -17,7 +17,6 @@ import System.IO
1717import ProjectM36.Relation.Show.Term
1818import GHC.Generics
1919import Data.Monoid
20−import Control.Monad (void)
2120import qualified Data.UUID as U
2221import Control.Monad.Random
2322import Data.List.NonEmpty as NE
src/lib/ProjectM36/Error.hs+2−1
@@ -96,7 +96,8 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
9696 deriving (Show,Eq,Generic,Binary,Typeable, NFData)
9797
9898data PersistenceError = InvalidDirectoryError FilePath |
99− MissingTransactionError TransactionId
99+ MissingTransactionError TransactionId |
100+ WrongDatabaseFormatVersionError String String
100101 deriving (Show, Eq, Generic, Binary, NFData)
101102
102103--collapse list of errors into normal error- if there is just one, just return one
src/lib/ProjectM36/TransactionGraph/Persist.hs+34−12
@@ -20,6 +20,7 @@ import Data.Text.Encoding
2020import Control.Monad (foldM)
2121import Data.Either (isRight)
2222import Data.Maybe (fromMaybe)
23+import qualified Data.List as L
2324import Control.Exception.Base
2425import qualified Data.Text.IO as TIO
2526import Data.ByteString (ByteString)
@@ -28,18 +29,25 @@ import qualified Crypto.Hash.SHA256 as SHA256
2829import Control.Arrow
2930import Data.Time.Clock
3031import Data.Text.Read
32+import System.FilePath.Glob
3133
3234type LockFileHash = ByteString
3335
3436{-
35−The "m36v1" file at the top-level of the destination directory contains the the transaction graph as a set of transaction ids referencing their parents (1 or more)
37+The "m36vX" file at the top-level of the destination directory contains the the transaction graph as a set of transaction ids referencing their parents (1 or more)
3638Each Transaction is written to it own directory named by its transaction id. Partially written transactions ids are prefixed with a "." to indicate incompleteness in the graph.
3739
3840Persistence requires a POSIX-compliant, journaled-metadata filesystem.
3941-}
4042
43+expectedVersion :: Int
44+expectedVersion = 2
45+
46+transactionLogFileName :: FilePath
47+transactionLogFileName = "m36v" ++ show expectedVersion
48+
4149transactionLogPath :: FilePath -> FilePath
42−transactionLogPath dbdir = dbdir </> "m36v1"
50+transactionLogPath dbdir = dbdir </> transactionLogFileName
4351
4452headsPath :: FilePath -> FilePath
4553headsPath dbdir = dbdir </> "heads"
@@ -53,18 +61,32 @@ verify that the database directory is valid or bootstrap it
5361- return error or lock file handle which is already locked with a read lock
5462-}
5563
64+checkForOtherVersions :: FilePath -> IO (Either PersistenceError ())
65+checkForOtherVersions dbdir = do
66+ versionMatches <- globDir1 (compile "m36v*") dbdir
67+ let otherVersions = L.delete transactionLogFileName (map takeFileName versionMatches)
68+ if not (null otherVersions) then
69+ pure (Left (WrongDatabaseFormatVersionError transactionLogFileName (head otherVersions)))
70+ else
71+ pure (Right ())
72+
73+
5674setupDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Either PersistenceError (Handle, LockFileHash))
5775setupDatabaseDir sync dbdir bootstrapGraph = do
5876 dbdirExists <- doesDirectoryExist dbdir
59− m36exists <- doesFileExist (transactionLogPath dbdir)
60− if dbdirExists && m36exists then do
61− --no directories to write, just
62− lockFileH <- openLockFile dbdir
63− gDigest <- bracket_ (lockFile lockFileH WriteLock) (unlockFile lockFileH) (readGraphTransactionIdFileDigest dbdir)
64− pure (Right (lockFileH, gDigest))
65− else if not m36exists then do
66− locks <- bootstrapDatabaseDir sync dbdir bootstrapGraph
67− pure (Right locks)
77+ eWrongVersion <- checkForOtherVersions dbdir
78+ case eWrongVersion of
79+ Left err -> pure (Left err)
80+ Right () -> do
81+ m36exists <- doesFileExist (transactionLogPath dbdir)
82+ if dbdirExists && m36exists then do
83+ --no directories to write, just
84+ lockFileH <- openLockFile dbdir
85+ gDigest <- bracket_ (lockFile lockFileH WriteLock) (unlockFile lockFileH) (readGraphTransactionIdFileDigest dbdir)
86+ pure (Right (lockFileH, gDigest))
87+ else if not m36exists then do
88+ locks <- bootstrapDatabaseDir sync dbdir bootstrapGraph
89+ pure (Right locks)
6890 else
6991 pure (Left (InvalidDirectoryError dbdir))
7092{-
@@ -172,7 +194,7 @@ readTransactionIfNecessary dbdir transId mScriptSession graphIn =
172194writeGraphTransactionIdFile :: DiskSync -> FilePath -> TransactionGraph -> IO LockFileHash
173195writeGraphTransactionIdFile sync destDirectory (TransactionGraph _ transSet) = writeFileSync sync graphFile uuidInfo >> pure digest
174196 where
175− graphFile = destDirectory </> "m36v1"
197+ graphFile = transactionLogPath destDirectory
176198 uuidInfo = T.intercalate "\n" graphLines
177199 digest = SHA256.hash (encodeUtf8 uuidInfo)
178200 graphLines = S.toList $ S.map graphLine transSet
test/TransactionGraph/Automerge.hs+1−1
@@ -25,7 +25,7 @@ checkEither :: IO (Either RelationalError a) -> IO a
2525checkEither io = do
2626 ret <- io
2727 case ret of
28− Left err -> assertFailure (show err)
28+ Left err -> assertFailure (show err) >> undefined
2929 Right a -> pure a
3030
3131testAutomergeSuccess :: Test