module ProjectM36.TransactionGraph.Persist where
import ProjectM36.Error
import ProjectM36.Transaction
import ProjectM36.Transaction.Persist
import ProjectM36.RelationalExpression
import ProjectM36.Base
import ProjectM36.ScriptSession
import ProjectM36.Persist (writeFileSync, renameSync, DiskSync)
import ProjectM36.FileLock
import System.Directory
import System.FilePath
import System.IO.Temp
import Data.Time.Clock.POSIX
import qualified Data.UUID as U
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text.Encoding
import Control.Monad (foldM)
import Data.Either (isRight)
import Data.Maybe (fromMaybe)
import qualified Data.List as L
import Control.Exception.Base
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import Data.ByteString (ByteString)
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif
import qualified Crypto.Hash.SHA256 as SHA256
import Control.Arrow
import Data.Time.Clock
import Data.Text.Read
import System.FilePath.Glob

type LockFileHash = ByteString

{-
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)
Each 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.

Persistence requires a POSIX-compliant, journaled-metadata filesystem.
-}

expectedVersion :: Int
expectedVersion :: Int
expectedVersion = Int
6

transactionLogFileName :: FilePath 
transactionLogFileName :: FilePath
transactionLogFileName = FilePath
"m36v" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
expectedVersion

transactionLogPath :: FilePath -> FilePath
transactionLogPath :: FilePath -> FilePath
transactionLogPath FilePath
dbdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath
transactionLogFileName

headsPath :: FilePath -> FilePath
headsPath :: FilePath -> FilePath
headsPath FilePath
dbdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath
"heads"

lockFilePath :: FilePath -> FilePath
lockFilePath :: FilePath -> FilePath
lockFilePath FilePath
dbdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath
"lockFile"

{-
verify that the database directory is valid or bootstrap it 
-note: checking for the existence of every transaction may be prohibitively expensive
- return error or lock file handle which is already locked with a read lock
-}

checkForOtherVersions :: FilePath -> IO (Either PersistenceError ())
checkForOtherVersions :: FilePath -> IO (Either PersistenceError ())
checkForOtherVersions FilePath
dbdir = do
  [FilePath]
versionMatches <- Pattern -> FilePath -> IO [FilePath]
globDir1 (FilePath -> Pattern
compile FilePath
"m36v*") FilePath
dbdir
  let otherVersions :: [FilePath]
otherVersions = FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
L.delete FilePath
transactionLogFileName ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeFileName [FilePath]
versionMatches)
  if Bool -> Bool
not ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
otherVersions) then
     Either PersistenceError () -> IO (Either PersistenceError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PersistenceError -> Either PersistenceError ()
forall a b. a -> Either a b
Left (FilePath -> FilePath -> PersistenceError
WrongDatabaseFormatVersionError FilePath
transactionLogFileName ([FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
otherVersions)))
     else
     Either PersistenceError () -> IO (Either PersistenceError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either PersistenceError ()
forall a b. b -> Either a b
Right ())
 

setupDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Either PersistenceError (LockFile, LockFileHash))
setupDatabaseDir :: DiskSync
-> FilePath
-> TransactionGraph
-> IO (Either PersistenceError (LockFile, LockFileHash))
setupDatabaseDir DiskSync
sync FilePath
dbdir TransactionGraph
bootstrapGraph = do
  Bool
dbdirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dbdir
  Either PersistenceError ()
eWrongVersion <- FilePath -> IO (Either PersistenceError ())
checkForOtherVersions FilePath
dbdir
  case Either PersistenceError ()
eWrongVersion of
    Left PersistenceError
err -> Either PersistenceError (LockFile, LockFileHash)
-> IO (Either PersistenceError (LockFile, LockFileHash))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PersistenceError
-> Either PersistenceError (LockFile, LockFileHash)
forall a b. a -> Either a b
Left PersistenceError
err)
    Right () -> do
      Bool
m36exists <- FilePath -> IO Bool
doesFileExist (FilePath -> FilePath
transactionLogPath FilePath
dbdir)  
      if Bool
dbdirExists Bool -> Bool -> Bool
&& Bool
m36exists then do
        --no directories to write, just 
        LockFile
locker <- FilePath -> IO LockFile
openLockFile (FilePath -> FilePath
lockFilePath FilePath
dbdir)
        LockFileHash
gDigest <- IO () -> IO () -> IO LockFileHash -> IO LockFileHash
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (LockFile -> LockType -> IO ()
lockFile LockFile
locker LockType
WriteLock) (LockFile -> IO ()
unlockFile LockFile
locker) (FilePath -> IO LockFileHash
readGraphTransactionIdFileDigest FilePath
dbdir)
        Either PersistenceError (LockFile, LockFileHash)
-> IO (Either PersistenceError (LockFile, LockFileHash))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((LockFile, LockFileHash)
-> Either PersistenceError (LockFile, LockFileHash)
forall a b. b -> Either a b
Right (LockFile
locker, LockFileHash
gDigest))
      else if Bool -> Bool
not Bool
m36exists then 
        (LockFile, LockFileHash)
-> Either PersistenceError (LockFile, LockFileHash)
forall a b. b -> Either a b
Right ((LockFile, LockFileHash)
 -> Either PersistenceError (LockFile, LockFileHash))
-> IO (LockFile, LockFileHash)
-> IO (Either PersistenceError (LockFile, LockFileHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiskSync
-> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash)
bootstrapDatabaseDir DiskSync
sync FilePath
dbdir TransactionGraph
bootstrapGraph
         else
           Either PersistenceError (LockFile, LockFileHash)
-> IO (Either PersistenceError (LockFile, LockFileHash))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PersistenceError
-> Either PersistenceError (LockFile, LockFileHash)
forall a b. a -> Either a b
Left (FilePath -> PersistenceError
InvalidDirectoryError FilePath
dbdir))
{- 
initialize a database directory with the graph from which to bootstrap- return lock file handle which must be closed by the caller
-}
bootstrapDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash)
bootstrapDatabaseDir :: DiskSync
-> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash)
bootstrapDatabaseDir DiskSync
sync FilePath
dbdir TransactionGraph
bootstrapGraph = do
  FilePath -> IO ()
createDirectory FilePath
dbdir
  LockFile
locker <- FilePath -> IO LockFile
openLockFile (FilePath -> FilePath
lockFilePath FilePath
dbdir)
  let allTransIds :: [TransactionId]
allTransIds = (Transaction -> TransactionId) -> [Transaction] -> [TransactionId]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> TransactionId
transactionId (Set Transaction -> [Transaction]
forall a. Set a -> [a]
S.toList (TransactionGraph -> Set Transaction
transactionsForGraph TransactionGraph
bootstrapGraph))
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False (FilePath -> FilePath
ProjectM36.TransactionGraph.Persist.objectFilesPath FilePath
dbdir)
  LockFileHash
digest  <- IO () -> IO () -> IO LockFileHash -> IO LockFileHash
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (LockFile -> LockType -> IO ()
lockFile LockFile
locker LockType
WriteLock) (LockFile -> IO ()
unlockFile LockFile
locker) (DiskSync
-> FilePath
-> [TransactionId]
-> TransactionGraph
-> IO LockFileHash
transactionGraphPersist DiskSync
sync FilePath
dbdir [TransactionId]
allTransIds TransactionGraph
bootstrapGraph)
  (LockFile, LockFileHash) -> IO (LockFile, LockFileHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LockFile
locker, LockFileHash
digest)

objectFilesPath :: FilePath -> FilePath
objectFilesPath :: FilePath -> FilePath
objectFilesPath FilePath
dbdir = FilePath
dbdir FilePath -> FilePath -> FilePath
</> FilePath
"compiled_modules"
{- 
incrementally updates an existing database directory
--algorithm: 
--assume that all transaction data has already been written
-assume that all non-head transactions have already been written because this is an incremental (and concurrent!) write method
--store the head names with a symlink to the transaction under "heads"
-}
transactionGraphPersist :: DiskSync -> FilePath -> [TransactionId] -> TransactionGraph -> IO LockFileHash
transactionGraphPersist :: DiskSync
-> FilePath
-> [TransactionId]
-> TransactionGraph
-> IO LockFileHash
transactionGraphPersist DiskSync
sync FilePath
destDirectory [TransactionId]
transIds TransactionGraph
graph = do
  DiskSync
-> [TransactionId] -> FilePath -> TransactionGraph -> IO ()
transactionsPersist DiskSync
sync [TransactionId]
transIds FilePath
destDirectory TransactionGraph
graph
  --write graph file
  LockFileHash
newDigest <- DiskSync -> FilePath -> TransactionGraph -> IO LockFileHash
writeGraphTransactionIdFile DiskSync
sync FilePath
destDirectory TransactionGraph
graph
  --write heads file
  DiskSync -> FilePath -> TransactionGraph -> IO ()
transactionGraphHeadsPersist DiskSync
sync FilePath
destDirectory TransactionGraph
graph
  LockFileHash -> IO LockFileHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockFileHash
newDigest
  
-- | The incremental writer writes the transactions ids specified by the second argument.

-- There was a bug here via #128 because automerge added multiple transactions to the graph but this function used to only write the head transactions from the graph. Automerge creates multiple transactions, so these are now passed in as the second argument.
transactionsPersist :: DiskSync -> [TransactionId] -> FilePath -> TransactionGraph -> IO ()
transactionsPersist :: DiskSync
-> [TransactionId] -> FilePath -> TransactionGraph -> IO ()
transactionsPersist DiskSync
sync [TransactionId]
transIds FilePath
destDirectory TransactionGraph
graphIn = (TransactionId -> IO ()) -> [TransactionId] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TransactionId -> IO ()
writeTrans [TransactionId]
transIds
  where writeTrans :: TransactionId -> IO ()
writeTrans TransactionId
tid =
          case TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
tid TransactionGraph
graphIn of 
            Left RelationalError
err -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath
"writeTransaction: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RelationalError -> FilePath
forall a. Show a => a -> FilePath
show RelationalError
err)
            Right Transaction
trans -> DiskSync -> FilePath -> Transaction -> IO ()
writeTransaction DiskSync
sync FilePath
destDirectory Transaction
trans

{- 
write graph heads to a file which can be atomically swapped
-}
--writing the heads in a directory is a synchronization nightmare, so just write the binary to a file and swap atomically
transactionGraphHeadsPersist :: DiskSync -> FilePath -> TransactionGraph -> IO ()
transactionGraphHeadsPersist :: DiskSync -> FilePath -> TransactionGraph -> IO ()
transactionGraphHeadsPersist DiskSync
sync FilePath
dbdir TransactionGraph
graph = do
  let headFileStr :: (HeadName, Transaction) -> T.Text
      headFileStr :: (HeadName, Transaction) -> HeadName
headFileStr (HeadName
headName, Transaction
trans) =  HeadName
headName HeadName -> HeadName -> HeadName
forall a. Semigroup a => a -> a -> a
<> HeadName
" " HeadName -> HeadName -> HeadName
forall a. Semigroup a => a -> a -> a
<> TransactionId -> HeadName
U.toText (Transaction -> TransactionId
transactionId Transaction
trans)
  FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTempDirectory FilePath
dbdir FilePath
".heads.tmp" ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tempHeadsDir -> do
    let tempHeadsPath :: FilePath
tempHeadsPath = FilePath
tempHeadsDir FilePath -> FilePath -> FilePath
</> FilePath
"heads"
        headsStrLines :: [HeadName]
headsStrLines = ((HeadName, Transaction) -> HeadName)
-> [(HeadName, Transaction)] -> [HeadName]
forall a b. (a -> b) -> [a] -> [b]
map (HeadName, Transaction) -> HeadName
headFileStr ([(HeadName, Transaction)] -> [HeadName])
-> [(HeadName, Transaction)] -> [HeadName]
forall a b. (a -> b) -> a -> b
$ Map HeadName Transaction -> [(HeadName, Transaction)]
forall k a. Map k a -> [(k, a)]
M.toList (TransactionGraph -> Map HeadName Transaction
transactionHeadsForGraph TransactionGraph
graph)
    DiskSync -> FilePath -> HeadName -> IO ()
writeFileSync DiskSync
sync FilePath
tempHeadsPath (HeadName -> IO ()) -> HeadName -> IO ()
forall a b. (a -> b) -> a -> b
$ HeadName -> [HeadName] -> HeadName
T.intercalate HeadName
"\n" [HeadName]
headsStrLines
    DiskSync -> FilePath -> FilePath -> IO ()
renameSync DiskSync
sync FilePath
tempHeadsPath (FilePath -> FilePath
headsPath FilePath
dbdir)
                                                             
transactionGraphHeadsLoad :: FilePath -> IO [(HeadName,TransactionId)]
transactionGraphHeadsLoad :: FilePath -> IO [(HeadName, TransactionId)]
transactionGraphHeadsLoad FilePath
dbdir = do
  FilePath
headsData <- FilePath -> IO FilePath
readFile (FilePath -> FilePath
headsPath FilePath
dbdir)
  let headsAssocs :: [(FilePath, FilePath)]
headsAssocs = (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
l -> let [FilePath
headName, FilePath
uuidStr] = FilePath -> [FilePath]
words FilePath
l in
                          (FilePath
headName,FilePath
uuidStr)
                          ) (FilePath -> [FilePath]
lines FilePath
headsData)
  [(HeadName, TransactionId)] -> IO [(HeadName, TransactionId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> HeadName
T.pack FilePath
headName, TransactionId
uuid) | (FilePath
headName, Just TransactionId
uuid) <- ((FilePath, FilePath) -> (FilePath, Maybe TransactionId))
-> [(FilePath, FilePath)] -> [(FilePath, Maybe TransactionId)]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Maybe TransactionId)
-> (FilePath, FilePath) -> (FilePath, Maybe TransactionId)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FilePath -> Maybe TransactionId
U.fromString) [(FilePath, FilePath)]
headsAssocs]
  
{-  
load any transactions which are not already part of the incoming transaction graph
-}

transactionGraphLoad :: FilePath -> TransactionGraph -> Maybe ScriptSession -> IO (Either PersistenceError TransactionGraph)
transactionGraphLoad :: FilePath
-> TransactionGraph
-> Maybe ScriptSession
-> IO (Either PersistenceError TransactionGraph)
transactionGraphLoad FilePath
dbdir TransactionGraph
graphIn Maybe ScriptSession
mScriptSession = do
  --optimization: perform tail-bisection search to find last-recorded transaction in the existing stream- replay the rest
  --read in all missing transactions from transaction directories and add to graph
  Either PersistenceError [(TransactionId, UTCTime, [TransactionId])]
uuidInfo <- FilePath
-> IO
     (Either
        PersistenceError [(TransactionId, UTCTime, [TransactionId])])
readGraphTransactionIdFile FilePath
dbdir
  [(HeadName, TransactionId)]
freshHeadsAssoc <- FilePath -> IO [(HeadName, TransactionId)]
transactionGraphHeadsLoad FilePath
dbdir
  case Either PersistenceError [(TransactionId, UTCTime, [TransactionId])]
uuidInfo of
    Left PersistenceError
err -> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ PersistenceError -> Either PersistenceError TransactionGraph
forall a b. a -> Either a b
Left PersistenceError
err
    Right [(TransactionId, UTCTime, [TransactionId])]
info -> do  
      let folder :: Either PersistenceError TransactionGraph
-> TransactionId -> IO (Either PersistenceError TransactionGraph)
folder Either PersistenceError TransactionGraph
eitherGraph TransactionId
transId = case Either PersistenceError TransactionGraph
eitherGraph of
            Left PersistenceError
err -> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ PersistenceError -> Either PersistenceError TransactionGraph
forall a b. a -> Either a b
Left PersistenceError
err
            Right TransactionGraph
graph -> FilePath
-> TransactionId
-> Maybe ScriptSession
-> TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
readTransactionIfNecessary FilePath
dbdir TransactionId
transId Maybe ScriptSession
mScriptSession TransactionGraph
graph
      Either PersistenceError TransactionGraph
loadedGraph <- (Either PersistenceError TransactionGraph
 -> TransactionId -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> [TransactionId]
-> IO (Either PersistenceError TransactionGraph)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Either PersistenceError TransactionGraph
-> TransactionId -> IO (Either PersistenceError TransactionGraph)
folder (TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. b -> Either a b
Right TransactionGraph
graphIn) (((TransactionId, UTCTime, [TransactionId]) -> TransactionId)
-> [(TransactionId, UTCTime, [TransactionId])] -> [TransactionId]
forall a b. (a -> b) -> [a] -> [b]
map (\(TransactionId
tid,UTCTime
_,[TransactionId]
_) -> TransactionId
tid) [(TransactionId, UTCTime, [TransactionId])]
info)
      case Either PersistenceError TransactionGraph
loadedGraph of 
        Left PersistenceError
err -> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ PersistenceError -> Either PersistenceError TransactionGraph
forall a b. a -> Either a b
Left PersistenceError
err
        Right TransactionGraph
freshGraph -> do
          let maybeTransHeads :: [(HeadName, Either RelationalError Transaction)]
maybeTransHeads = [(HeadName
headName, TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
uuid TransactionGraph
freshGraph) | (HeadName
headName, TransactionId
uuid) <- [(HeadName, TransactionId)]
freshHeadsAssoc]
              freshHeads :: Map HeadName Transaction
freshHeads = [(HeadName, Transaction)] -> Map HeadName Transaction
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(HeadName
headName,Transaction
trans) | (HeadName
headName, Right Transaction
trans) <- [(HeadName, Either RelationalError Transaction)]
maybeTransHeads]
          Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. b -> Either a b
Right (TransactionGraph -> Either PersistenceError TransactionGraph)
-> TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. (a -> b) -> a -> b
$ Map HeadName Transaction -> Set Transaction -> TransactionGraph
TransactionGraph Map HeadName Transaction
freshHeads (TransactionGraph -> Set Transaction
transactionsForGraph TransactionGraph
freshGraph)
  
{-  
if the transaction with the TransactionId argument is not yet part of the graph, then read the transaction and add it - this does not update the heads
-}
readTransactionIfNecessary :: FilePath -> TransactionId -> Maybe ScriptSession -> TransactionGraph -> IO (Either PersistenceError TransactionGraph)  
readTransactionIfNecessary :: FilePath
-> TransactionId
-> Maybe ScriptSession
-> TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
readTransactionIfNecessary FilePath
dbdir TransactionId
transId Maybe ScriptSession
mScriptSession TransactionGraph
graphIn =
  if Either RelationalError Transaction -> Bool
forall a b. Either a b -> Bool
isRight (Either RelationalError Transaction -> Bool)
-> Either RelationalError Transaction -> Bool
forall a b. (a -> b) -> a -> b
$ TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
transId TransactionGraph
graphIn then
    --the transaction is already known and loaded- done
    Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. b -> Either a b
Right TransactionGraph
graphIn
    else do
    Either PersistenceError Transaction
trans <- FilePath
-> TransactionId
-> Maybe ScriptSession
-> IO (Either PersistenceError Transaction)
readTransaction FilePath
dbdir TransactionId
transId Maybe ScriptSession
mScriptSession
    case Either PersistenceError Transaction
trans of
      Left PersistenceError
err -> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ PersistenceError -> Either PersistenceError TransactionGraph
forall a b. a -> Either a b
Left PersistenceError
err
      Right Transaction
trans' -> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceError TransactionGraph
 -> IO (Either PersistenceError TransactionGraph))
-> Either PersistenceError TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
forall a b. (a -> b) -> a -> b
$ TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. b -> Either a b
Right (TransactionGraph -> Either PersistenceError TransactionGraph)
-> TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. (a -> b) -> a -> b
$ Map HeadName Transaction -> Set Transaction -> TransactionGraph
TransactionGraph (TransactionGraph -> Map HeadName Transaction
transactionHeadsForGraph TransactionGraph
graphIn) (Transaction -> Set Transaction -> Set Transaction
forall a. Ord a => a -> Set a -> Set a
S.insert Transaction
trans' (TransactionGraph -> Set Transaction
transactionsForGraph TransactionGraph
graphIn))
  
writeGraphTransactionIdFile :: DiskSync -> FilePath -> TransactionGraph -> IO LockFileHash
writeGraphTransactionIdFile :: DiskSync -> FilePath -> TransactionGraph -> IO LockFileHash
writeGraphTransactionIdFile DiskSync
sync FilePath
destDirectory (TransactionGraph Map HeadName Transaction
_ Set Transaction
transSet) = DiskSync -> FilePath -> HeadName -> IO ()
writeFileSync DiskSync
sync FilePath
graphFile HeadName
uuidInfo IO () -> IO LockFileHash -> IO LockFileHash
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LockFileHash -> IO LockFileHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockFileHash
digest
  where
    graphFile :: FilePath
graphFile = FilePath -> FilePath
transactionLogPath FilePath
destDirectory
    uuidInfo :: HeadName
uuidInfo = HeadName -> [HeadName] -> HeadName
T.intercalate HeadName
"\n" [HeadName]
graphLines
    digest :: LockFileHash
digest = LockFileHash -> LockFileHash
SHA256.hash (HeadName -> LockFileHash
encodeUtf8 HeadName
uuidInfo)
    graphLines :: [HeadName]
graphLines = Set HeadName -> [HeadName]
forall a. Set a -> [a]
S.toList (Set HeadName -> [HeadName]) -> Set HeadName -> [HeadName]
forall a b. (a -> b) -> a -> b
$ (Transaction -> HeadName) -> Set Transaction -> Set HeadName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Transaction -> HeadName
graphLine Set Transaction
transSet 
    epochTime :: Transaction -> Double
epochTime = POSIXTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (POSIXTime -> Double)
-> (Transaction -> POSIXTime) -> Transaction -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> (Transaction -> UTCTime) -> Transaction -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> UTCTime
timestamp :: Transaction -> Double
    graphLine :: Transaction -> HeadName
graphLine Transaction
trans = TransactionId -> HeadName
U.toText (Transaction -> TransactionId
transactionId Transaction
trans) 
                      HeadName -> HeadName -> HeadName
forall a. Semigroup a => a -> a -> a
<> HeadName
" " 
                      HeadName -> HeadName -> HeadName
forall a. Semigroup a => a -> a -> a
<> FilePath -> HeadName
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show (Transaction -> Double
epochTime Transaction
trans))
                      HeadName -> HeadName -> HeadName
forall a. Semigroup a => a -> a -> a
<> HeadName
" "
                      HeadName -> HeadName -> HeadName
forall a. Semigroup a => a -> a -> a
<> HeadName -> [HeadName] -> HeadName
T.intercalate HeadName
" " (Set HeadName -> [HeadName]
forall a. Set a -> [a]
S.toList ((TransactionId -> HeadName) -> Set TransactionId -> Set HeadName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map TransactionId -> HeadName
U.toText (Set TransactionId -> Set HeadName)
-> Set TransactionId -> Set HeadName
forall a b. (a -> b) -> a -> b
$ Transaction -> Set TransactionId
parentIds Transaction
trans))
    
readGraphTransactionIdFileDigest :: FilePath -> IO LockFileHash
readGraphTransactionIdFileDigest :: FilePath -> IO LockFileHash
readGraphTransactionIdFileDigest FilePath
dbdir = do
  let graphTransactionIdData :: IO HeadName
graphTransactionIdData = FilePath -> IO HeadName
readUTF8FileOrError (FilePath -> FilePath
transactionLogPath FilePath
dbdir)
  LockFileHash -> LockFileHash
SHA256.hash (LockFileHash -> LockFileHash)
-> (HeadName -> LockFileHash) -> HeadName -> LockFileHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeadName -> LockFileHash
encodeUtf8 (HeadName -> LockFileHash) -> IO HeadName -> IO LockFileHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO HeadName
graphTransactionIdData
    
readGraphTransactionIdFile :: FilePath -> IO (Either PersistenceError [(TransactionId, UTCTime, [TransactionId])])
readGraphTransactionIdFile :: FilePath
-> IO
     (Either
        PersistenceError [(TransactionId, UTCTime, [TransactionId])])
readGraphTransactionIdFile FilePath
dbdir = do
  --read in all transactions' uuids
  let grapher :: HeadName -> (TransactionId, UTCTime, [TransactionId])
grapher HeadName
line = let HeadName
tid:HeadName
epochText:[HeadName]
parentIds' = HeadName -> [HeadName]
T.words HeadName
line in
        (HeadName -> TransactionId
readUUID HeadName
tid, HeadName -> UTCTime
readEpoch HeadName
epochText, (HeadName -> TransactionId) -> [HeadName] -> [TransactionId]
forall a b. (a -> b) -> [a] -> [b]
map HeadName -> TransactionId
readUUID [HeadName]
parentIds')
      readUUID :: HeadName -> TransactionId
readUUID HeadName
uuidText = TransactionId -> Maybe TransactionId -> TransactionId
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> TransactionId
forall a. HasCallStack => FilePath -> a
error FilePath
"failed to read uuid") (HeadName -> Maybe TransactionId
U.fromText HeadName
uuidText)
      readEpoch :: HeadName -> UTCTime
readEpoch HeadName
t = POSIXTime -> UTCTime
posixSecondsToUTCTime (Double -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac ((FilePath -> Double)
-> ((Double, HeadName) -> Double)
-> Either FilePath (Double, HeadName)
-> Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> FilePath -> Double
forall a. HasCallStack => FilePath -> a
error FilePath
"failed to read epoch") (Double, HeadName) -> Double
forall a b. (a, b) -> a
fst (Reader Double
double HeadName
t)))
  [(TransactionId, UTCTime, [TransactionId])]
-> Either
     PersistenceError [(TransactionId, UTCTime, [TransactionId])]
forall a b. b -> Either a b
Right ([(TransactionId, UTCTime, [TransactionId])]
 -> Either
      PersistenceError [(TransactionId, UTCTime, [TransactionId])])
-> (HeadName -> [(TransactionId, UTCTime, [TransactionId])])
-> HeadName
-> Either
     PersistenceError [(TransactionId, UTCTime, [TransactionId])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadName -> (TransactionId, UTCTime, [TransactionId]))
-> [HeadName] -> [(TransactionId, UTCTime, [TransactionId])]
forall a b. (a -> b) -> [a] -> [b]
map HeadName -> (TransactionId, UTCTime, [TransactionId])
grapher ([HeadName] -> [(TransactionId, UTCTime, [TransactionId])])
-> (HeadName -> [HeadName])
-> HeadName
-> [(TransactionId, UTCTime, [TransactionId])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeadName -> [HeadName]
T.lines (HeadName
 -> Either
      PersistenceError [(TransactionId, UTCTime, [TransactionId])])
-> IO HeadName
-> IO
     (Either
        PersistenceError [(TransactionId, UTCTime, [TransactionId])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO HeadName
readUTF8FileOrError (FilePath -> FilePath
transactionLogPath FilePath
dbdir)

--rationale- reading essential database files must fail hard
readUTF8FileOrError :: FilePath -> IO T.Text
readUTF8FileOrError :: FilePath -> IO HeadName
readUTF8FileOrError FilePath
pathIn = do
  Either IOError LockFileHash
eFileBytes <- IO LockFileHash -> IO (Either IOError LockFileHash)
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> IO LockFileHash
BS.readFile FilePath
pathIn) :: IO (Either IOError BS.ByteString)
  case Either IOError LockFileHash
eFileBytes of 
    Left IOError
err -> FilePath -> IO HeadName
forall a. HasCallStack => FilePath -> a
error (IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
err)
    Right LockFileHash
fileBytes ->
      case LockFileHash -> Either UnicodeException HeadName
TE.decodeUtf8' LockFileHash
fileBytes of
        Left UnicodeException
err -> FilePath -> IO HeadName
forall a. HasCallStack => FilePath -> a
error (UnicodeException -> FilePath
forall a. Show a => a -> FilePath
show UnicodeException
err)
        Right HeadName
utf8Bytes -> HeadName -> IO HeadName
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadName
utf8Bytes