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
import Data.Tuple

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
7

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

transactionLogPath :: FilePath -> FilePath
transactionLogPath :: [Char] -> [Char]
transactionLogPath [Char]
dbdir = [Char]
dbdir [Char] -> [Char] -> [Char]
</> [Char]
transactionLogFileName

headsPath :: FilePath -> FilePath
headsPath :: [Char] -> [Char]
headsPath [Char]
dbdir = [Char]
dbdir [Char] -> [Char] -> [Char]
</> [Char]
"heads"

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

setupDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Either PersistenceError (LockFile, LockFileHash))
setupDatabaseDir :: DiskSync
-> [Char]
-> TransactionGraph
-> IO (Either PersistenceError (LockFile, LockFileHash))
setupDatabaseDir DiskSync
sync [Char]
dbdir TransactionGraph
bootstrapGraph = do
  Bool
dbdirExists <- [Char] -> IO Bool
doesDirectoryExist [Char]
dbdir
  Either PersistenceError ()
eWrongVersion <- [Char] -> IO (Either PersistenceError ())
checkForOtherVersions [Char]
dbdir
  case Either PersistenceError ()
eWrongVersion of
    Left PersistenceError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left PersistenceError
err)
    Right () -> do
      Bool
m36exists <- [Char] -> IO Bool
doesFileExist ([Char] -> [Char]
transactionLogPath [Char]
dbdir)  
      if Bool
dbdirExists Bool -> Bool -> Bool
&& Bool
m36exists then do
        --no directories to write, just 
        LockFile
locker <- [Char] -> IO LockFile
openLockFile ([Char] -> [Char]
lockFilePath [Char]
dbdir)
        LockFileHash
gDigest <- 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) ([Char] -> IO LockFileHash
readGraphTransactionIdFileDigest [Char]
dbdir)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (LockFile
locker, LockFileHash
gDigest))
      else if Bool -> Bool
not Bool
m36exists then 
        forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiskSync
-> [Char] -> TransactionGraph -> IO (LockFile, LockFileHash)
bootstrapDatabaseDir DiskSync
sync [Char]
dbdir TransactionGraph
bootstrapGraph
         else
           forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ([Char] -> PersistenceError
InvalidDirectoryError [Char]
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
-> [Char] -> TransactionGraph -> IO (LockFile, LockFileHash)
bootstrapDatabaseDir DiskSync
sync [Char]
dbdir TransactionGraph
bootstrapGraph = do
  [Char] -> IO ()
createDirectory [Char]
dbdir
  LockFile
locker <- [Char] -> IO LockFile
openLockFile ([Char] -> [Char]
lockFilePath [Char]
dbdir)
  let allTransIds :: [TransactionId]
allTransIds = forall a b. (a -> b) -> [a] -> [b]
map Transaction -> TransactionId
transactionId (forall a. Set a -> [a]
S.toList (TransactionGraph -> Set Transaction
transactionsForGraph TransactionGraph
bootstrapGraph))
  Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False ([Char] -> [Char]
ProjectM36.TransactionGraph.Persist.objectFilesPath [Char]
dbdir)
  LockFileHash
digest  <- 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
-> [Char] -> [TransactionId] -> TransactionGraph -> IO LockFileHash
transactionGraphPersist DiskSync
sync [Char]
dbdir [TransactionId]
allTransIds TransactionGraph
bootstrapGraph)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (LockFile
locker, LockFileHash
digest)

objectFilesPath :: FilePath -> FilePath
objectFilesPath :: [Char] -> [Char]
objectFilesPath [Char]
dbdir = [Char]
dbdir [Char] -> [Char] -> [Char]
</> [Char]
"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
-> [Char] -> [TransactionId] -> TransactionGraph -> IO LockFileHash
transactionGraphPersist DiskSync
sync [Char]
destDirectory [TransactionId]
transIds TransactionGraph
graph = do
  DiskSync -> [TransactionId] -> [Char] -> TransactionGraph -> IO ()
transactionsPersist DiskSync
sync [TransactionId]
transIds [Char]
destDirectory TransactionGraph
graph
  --write graph file
  LockFileHash
newDigest <- DiskSync -> [Char] -> TransactionGraph -> IO LockFileHash
writeGraphTransactionIdFile DiskSync
sync [Char]
destDirectory TransactionGraph
graph
  --write heads file
  DiskSync -> [Char] -> TransactionGraph -> IO ()
transactionGraphHeadsPersist DiskSync
sync [Char]
destDirectory TransactionGraph
graph
  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] -> [Char] -> TransactionGraph -> IO ()
transactionsPersist DiskSync
sync [TransactionId]
transIds [Char]
destDirectory TransactionGraph
graphIn = 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 -> forall a. HasCallStack => [Char] -> a
error ([Char]
"writeTransaction: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show RelationalError
err)
            Right Transaction
trans -> DiskSync -> [Char] -> Transaction -> IO ()
writeTransaction DiskSync
sync [Char]
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 -> [Char] -> TransactionGraph -> IO ()
transactionGraphHeadsPersist DiskSync
sync [Char]
dbdir TransactionGraph
graph = do
  let headFileStr :: (HeadName, Transaction) -> T.Text
      headFileStr :: (Text, Transaction) -> Text
headFileStr (Text
headName, Transaction
trans) =  Text
headName forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> TransactionId -> Text
U.toText (Transaction -> TransactionId
transactionId Transaction
trans)
  forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[Char] -> [Char] -> ([Char] -> m a) -> m a
withTempDirectory [Char]
dbdir [Char]
".heads.tmp" forall a b. (a -> b) -> a -> b
$ \[Char]
tempHeadsDir -> do
    let tempHeadsPath :: [Char]
tempHeadsPath = [Char]
tempHeadsDir [Char] -> [Char] -> [Char]
</> [Char]
"heads"
        headsStrLines :: [Text]
headsStrLines = forall a b. (a -> b) -> [a] -> [b]
map (Text, Transaction) -> Text
headFileStr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList (TransactionGraph -> TransactionHeads
transactionHeadsForGraph TransactionGraph
graph)
    DiskSync -> [Char] -> Text -> IO ()
writeFileSync DiskSync
sync [Char]
tempHeadsPath forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
headsStrLines
    DiskSync -> [Char] -> [Char] -> IO ()
renameSync DiskSync
sync [Char]
tempHeadsPath ([Char] -> [Char]
headsPath [Char]
dbdir)

transactionGraphHeadsLoad :: FilePath -> IO [(HeadName,TransactionId)]
transactionGraphHeadsLoad :: [Char] -> IO [(Text, TransactionId)]
transactionGraphHeadsLoad [Char]
dbdir = do
  [Char]
headsData <- [Char] -> IO [Char]
readFile ([Char] -> [Char]
headsPath [Char]
dbdir)
  let headsAssocs :: [([Char], [Char])]
headsAssocs = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ([Char], [Char])
twowords ([Char] -> [[Char]]
lines [Char]
headsData)
  forall (m :: * -> *) a. Monad m => a -> m a
return [([Char] -> Text
T.pack [Char]
headName, TransactionId
uuid) | ([Char]
headName, Just TransactionId
uuid) <- forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Char] -> Maybe TransactionId
U.fromString) [([Char], [Char])]
headsAssocs]

data Pos = One | Two

twowords :: String -> (String, String)
twowords :: [Char] -> ([Char], [Char])
twowords [Char]
s = forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> (Pos, ([Char], [Char])) -> (Pos, ([Char], [Char]))
twowordfolder (Pos
One, ([Char]
"",[Char]
"")) [Char]
s
  where
    twowordfolder :: Char -> (Pos, ([Char], [Char])) -> (Pos, ([Char], [Char]))
twowordfolder Char
' ' (Pos
One, ([Char], [Char])
acc) = (Pos
Two,([Char], [Char])
acc)
    twowordfolder Char
c (Pos
One, ([Char]
a, [Char]
b)) =  (Pos
One, (Char
cforall a. a -> [a] -> [a]
:[Char]
a, [Char]
b))
    twowordfolder Char
c (Pos
Two, ([Char]
a, [Char]
b)) = (Pos
Two, ([Char]
a, Char
cforall a. a -> [a] -> [a]
:[Char]
b))
  
{-  
load any transactions which are not already part of the incoming transaction graph
-}

transactionGraphLoad :: FilePath -> TransactionGraph -> Maybe ScriptSession -> IO (Either PersistenceError TransactionGraph)
transactionGraphLoad :: [Char]
-> TransactionGraph
-> Maybe ScriptSession
-> IO (Either PersistenceError TransactionGraph)
transactionGraphLoad [Char]
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 <- [Char]
-> IO
     (Either
        PersistenceError [(TransactionId, UTCTime, [TransactionId])])
readGraphTransactionIdFile [Char]
dbdir
  [(Text, TransactionId)]
freshHeadsAssoc <- [Char] -> IO [(Text, TransactionId)]
transactionGraphHeadsLoad [Char]
dbdir
  case Either PersistenceError [(TransactionId, UTCTime, [TransactionId])]
uuidInfo of
    Left PersistenceError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PersistenceError
err
            Right TransactionGraph
graph -> [Char]
-> TransactionId
-> Maybe ScriptSession
-> TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
readTransactionIfNecessary [Char]
dbdir TransactionId
transId Maybe ScriptSession
mScriptSession TransactionGraph
graph
      Either PersistenceError TransactionGraph
loadedGraph <- 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 (forall a b. b -> Either a b
Right TransactionGraph
graphIn) (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PersistenceError
err
        Right TransactionGraph
freshGraph -> do
          let maybeTransHeads :: [(Text, Either RelationalError Transaction)]
maybeTransHeads = [(Text
headName, TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
uuid TransactionGraph
freshGraph) | (Text
headName, TransactionId
uuid) <- [(Text, TransactionId)]
freshHeadsAssoc]
              freshHeads :: TransactionHeads
freshHeads = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
headName,Transaction
trans) | (Text
headName, Right Transaction
trans) <- [(Text, Either RelationalError Transaction)]
maybeTransHeads]
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ TransactionHeads -> Set Transaction -> TransactionGraph
TransactionGraph TransactionHeads
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 :: [Char]
-> TransactionId
-> Maybe ScriptSession
-> TransactionGraph
-> IO (Either PersistenceError TransactionGraph)
readTransactionIfNecessary [Char]
dbdir TransactionId
transId Maybe ScriptSession
mScriptSession TransactionGraph
graphIn =
  if forall a b. Either a b -> Bool
isRight 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right TransactionGraph
graphIn
    else do
    Either PersistenceError Transaction
trans <- [Char]
-> TransactionId
-> Maybe ScriptSession
-> IO (Either PersistenceError Transaction)
readTransaction [Char]
dbdir TransactionId
transId Maybe ScriptSession
mScriptSession
    case Either PersistenceError Transaction
trans of
      Left PersistenceError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PersistenceError
err
      Right Transaction
trans' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ TransactionHeads -> Set Transaction -> TransactionGraph
TransactionGraph (TransactionGraph -> TransactionHeads
transactionHeadsForGraph TransactionGraph
graphIn) (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 -> [Char] -> TransactionGraph -> IO LockFileHash
writeGraphTransactionIdFile DiskSync
sync [Char]
destDirectory (TransactionGraph TransactionHeads
_ Set Transaction
transSet) = DiskSync -> [Char] -> Text -> IO ()
writeFileSync DiskSync
sync [Char]
graphFile Text
uuidInfo forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure LockFileHash
digest
  where
    graphFile :: [Char]
graphFile = [Char] -> [Char]
transactionLogPath [Char]
destDirectory
    uuidInfo :: Text
uuidInfo = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
graphLines
    digest :: LockFileHash
digest = LockFileHash -> LockFileHash
SHA256.hash (Text -> LockFileHash
encodeUtf8 Text
uuidInfo)
    graphLines :: [Text]
graphLines = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Transaction -> Text
graphLine Set Transaction
transSet 
    epochTime :: Transaction -> Double
epochTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> UTCTime
timestamp :: Transaction -> Double
    graphLine :: Transaction -> Text
graphLine Transaction
trans = TransactionId -> Text
U.toText (Transaction -> TransactionId
transactionId Transaction
trans) 
                      forall a. Semigroup a => a -> a -> a
<> Text
" " 
                      forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Transaction -> Double
epochTime Transaction
trans))
                      forall a. Semigroup a => a -> a -> a
<> Text
" "
                      forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " (forall a. Set a -> [a]
S.toList (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map TransactionId -> Text
U.toText forall a b. (a -> b) -> a -> b
$ Transaction -> Set TransactionId
parentIds Transaction
trans))
    
readGraphTransactionIdFileDigest :: FilePath -> IO LockFileHash
readGraphTransactionIdFileDigest :: [Char] -> IO LockFileHash
readGraphTransactionIdFileDigest [Char]
dbdir = do
  let graphTransactionIdData :: IO Text
graphTransactionIdData = [Char] -> IO Text
readUTF8FileOrError ([Char] -> [Char]
transactionLogPath [Char]
dbdir)
  LockFileHash -> LockFileHash
SHA256.hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LockFileHash
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
graphTransactionIdData
    
readGraphTransactionIdFile :: FilePath -> IO (Either PersistenceError [(TransactionId, UTCTime, [TransactionId])])
readGraphTransactionIdFile :: [Char]
-> IO
     (Either
        PersistenceError [(TransactionId, UTCTime, [TransactionId])])
readGraphTransactionIdFile [Char]
dbdir = do
  --read in all transactions' uuids
  let grapher :: Text -> (TransactionId, UTCTime, [TransactionId])
grapher Text
line = let (Text
tid,Text
epochText,[Text]
parentIds') = case Text -> [Text]
T.words Text
line of
                           Text
x:Text
y:[Text]
zs -> (Text
x,Text
y,[Text]
zs)
                           [Text]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"failed to parse transaction id file"
                           in
        (Text -> TransactionId
readUUID Text
tid, Text -> UTCTime
readEpoch Text
epochText, forall a b. (a -> b) -> [a] -> [b]
map Text -> TransactionId
readUUID [Text]
parentIds')
      readUUID :: Text -> TransactionId
readUUID Text
uuidText = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"failed to read uuid") (Text -> Maybe TransactionId
U.fromText Text
uuidText)
      readEpoch :: Text -> UTCTime
readEpoch Text
t = POSIXTime -> UTCTime
posixSecondsToUTCTime (forall a b. (Real a, Fractional b) => a -> b
realToFrac (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error [Char]
"failed to read epoch") forall a b. (a, b) -> a
fst (Reader Double
double Text
t)))
  forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> (TransactionId, UTCTime, [TransactionId])
grapher forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
readUTF8FileOrError ([Char] -> [Char]
transactionLogPath [Char]
dbdir)

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