never executed always true always false
    1 {-|
    2 Module: Flaw.Oil.ClientRepo
    3 Description: Oil client repo.
    4 License: MIT
    5 -}
    6 
    7 {-# LANGUAGE PatternSynonyms, ViewPatterns #-}
    8 {-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
    9 
   10 module Flaw.Oil.ClientRepo
   11   ( ClientRepo()
   12   , openClientRepo
   13   , clientRepoRevision
   14   , clientRepoGetRevisionValue
   15   , clientRepoChange
   16   , clientRepoGetKeysPrefixed
   17   , ClientRepoPushState(..)
   18   , pushClientRepo
   19   , isClientRepoPushEmpty
   20   , ClientRepoPullInfo(..)
   21   , pullClientRepo
   22   , cleanupClientRepo
   23   , syncClientRepo
   24   ) where
   25 
   26 import Control.Exception
   27 import Control.Monad
   28 import qualified Data.ByteString as B
   29 import Data.Int
   30 import qualified Data.Text as T
   31 import Foreign.C.Types
   32 
   33 import Flaw.Book
   34 import Flaw.Data.Sqlite
   35 import Flaw.Exception
   36 import Flaw.Oil.Repo
   37 
   38 data ClientRepo = ClientRepo
   39   { clientRepoDb :: !SqliteDb
   40   , clientRepoStmtManifestGet            :: !SqliteStmt
   41   , clientRepoStmtManifestSet            :: !SqliteStmt
   42   , clientRepoStmtGetKeyItems            :: !SqliteStmt
   43   , clientRepoStmtGetKeyItemsByOneItemId :: !SqliteStmt
   44   , clientRepoStmtGetKeyServerItem       :: !SqliteStmt
   45   , clientRepoStmtGetKeyItemKey          :: !SqliteStmt
   46   , clientRepoStmtGetKeyItemRevValue     :: !SqliteStmt
   47   , clientRepoStmtAddKeyItem             :: !SqliteStmt
   48   , clientRepoStmtChangeKeyItemRev       :: !SqliteStmt
   49   , clientRepoStmtChangeKeyItemRevValue  :: !SqliteStmt
   50   , clientRepoStmtSelectKeysToPush       :: !SqliteStmt
   51   , clientRepoStmtGetPushLag             :: !SqliteStmt
   52   , clientRepoStmtMassChangeRev          :: !SqliteStmt
   53   , clientRepoStmtEnumerateKeysBegin     :: !SqliteStmt
   54   , clientRepoStmtEnumerateKeysBeginEnd  :: !SqliteStmt
   55   , clientRepoStmtAddChunk               :: !SqliteStmt
   56   , clientRepoStmtPreCutChunks           :: !SqliteStmt
   57   , clientRepoStmtCutChunks              :: !SqliteStmt
   58   , clientRepoStmtGetUpperRevision       :: !SqliteStmt
   59   }
   60 
   61 openClientRepo :: T.Text -> IO (ClientRepo, IO ())
   62 openClientRepo fileName = describeException "failed to open oil client repo" $ withSpecialBook $ \bk -> do
   63   -- open db
   64   db <- book bk $ openRepoDb fileName clientRepoVersion
   65 
   66   -- enable normal synchronous mode (db correctness is a concern, but durability is not for client repo)
   67   sqliteExec db $ T.pack "PRAGMA synchronous = NORMAL"
   68 
   69   -- ensure tables and indices exist
   70 
   71   -- manifest table
   72   sqliteExec db $ T.pack
   73     "CREATE TABLE IF NOT EXISTS manifest (\
   74     \key INTEGER PRIMARY KEY, \
   75     \value ANY NOT NULL)"
   76   -- items table
   77   sqliteExec db $ T.pack
   78     "CREATE TABLE IF NOT EXISTS items (\
   79     \id INTEGER PRIMARY KEY, \
   80     \value BLOB NOT NULL, \
   81     \key BLOB NOT NULL, \
   82     \rev INTEGER NOT NULL)"
   83   -- items_key_rev index
   84   sqliteExec db $ T.pack
   85     "CREATE UNIQUE INDEX IF NOT EXISTS items_key_rev ON items (key, rev)"
   86   -- items_rev_partial index
   87   sqliteExec db $ T.pack $
   88     "CREATE INDEX IF NOT EXISTS items_rev_partial ON items (rev) WHERE\
   89     \ rev = " ++ show (ItemRevClient :: Int) ++
   90     " OR rev = " ++ show (ItemRevTransient :: Int) ++
   91     " OR rev = " ++ show (ItemRevPostponed :: Int)
   92   -- chunks table
   93   sqliteExec db $ T.pack
   94     "CREATE TABLE IF NOT EXISTS chunks (\
   95     \prerev INTEGER PRIMARY KEY, \
   96     \postrev INTEGER NOT NULL)"
   97 
   98   -- create statements
   99   let createStmt str = book bk $ sqliteStmt db $ T.pack str
  100   stmtManifestGet            <- createStmt "SELECT value FROM manifest WHERE key = ?1"
  101   stmtManifestSet            <- createStmt "INSERT OR REPLACE INTO manifest (key, value) VALUES (?1, ?2)"
  102   stmtGetKeyItems            <- createStmt "SELECT id, rev FROM items WHERE key = ?1 AND rev < 0"
  103   stmtGetKeyItemsByOneItemId <- createStmt "SELECT id, rev FROM items WHERE key = (SELECT key FROM items WHERE id = ?1) AND rev < 0"
  104   stmtGetKeyServerItem       <- createStmt "SELECT id, rev FROM items WHERE key = ?1 AND rev > 0 ORDER BY rev DESC LIMIT 1"
  105   stmtGetKeyItemKey          <- createStmt "SELECT key FROM items WHERE id = ?1"
  106   stmtGetKeyItemRevValue     <- createStmt "SELECT rev, value FROM items WHERE id = ?1"
  107   stmtAddKeyItem             <- createStmt "INSERT OR REPLACE INTO items (key, value, rev) VALUES (?1, ?2, ?3)"
  108   stmtChangeKeyItemRev       <- createStmt "UPDATE OR REPLACE items SET rev = ?2 WHERE id = ?1"
  109   stmtChangeKeyItemRevValue  <- createStmt "UPDATE items SET rev = ?2, value = ?3 WHERE id = ?1"
  110   stmtSelectKeysToPush       <- createStmt $ "SELECT id, key, value FROM items WHERE rev = " ++ show (ItemRevClient :: Int) ++ " ORDER BY id LIMIT ?1"
  111   stmtGetPushLag             <- createStmt $ "SELECT COUNT(*) FROM items WHERE rev = " ++ show (ItemRevClient :: Int)
  112   stmtMassChangeRev          <- createStmt "UPDATE OR REPLACE items SET rev = ?2 WHERE rev = ?1"
  113   stmtEnumerateKeysBegin     <- createStmt "SELECT DISTINCT key FROM items WHERE key >= ?1 ORDER BY key"
  114   stmtEnumerateKeysBeginEnd  <- createStmt "SELECT DISTINCT key FROM items WHERE key >= ?1 AND key < ?2 ORDER BY key"
  115   stmtAddChunk               <- createStmt "INSERT INTO chunks (prerev, postrev) VALUES (?1, ?2)"
  116   stmtPreCutChunks           <- createStmt "SELECT MAX(postrev) FROM chunks WHERE prerev <= ?1"
  117   stmtCutChunks              <- createStmt "DELETE FROM chunks WHERE prerev <= ?1"
  118   stmtGetUpperRevision       <- createStmt "SELECT MIN(prerev) FROM chunks"
  119 
  120   return ClientRepo
  121     { clientRepoDb = db
  122     , clientRepoStmtManifestGet            = stmtManifestGet
  123     , clientRepoStmtManifestSet            = stmtManifestSet
  124     , clientRepoStmtGetKeyItems            = stmtGetKeyItems
  125     , clientRepoStmtGetKeyItemsByOneItemId = stmtGetKeyItemsByOneItemId
  126     , clientRepoStmtGetKeyServerItem       = stmtGetKeyServerItem
  127     , clientRepoStmtGetKeyItemKey          = stmtGetKeyItemKey
  128     , clientRepoStmtGetKeyItemRevValue     = stmtGetKeyItemRevValue
  129     , clientRepoStmtAddKeyItem             = stmtAddKeyItem
  130     , clientRepoStmtChangeKeyItemRev       = stmtChangeKeyItemRev
  131     , clientRepoStmtChangeKeyItemRevValue  = stmtChangeKeyItemRevValue
  132     , clientRepoStmtSelectKeysToPush       = stmtSelectKeysToPush
  133     , clientRepoStmtGetPushLag             = stmtGetPushLag
  134     , clientRepoStmtMassChangeRev          = stmtMassChangeRev
  135     , clientRepoStmtEnumerateKeysBegin     = stmtEnumerateKeysBegin
  136     , clientRepoStmtEnumerateKeysBeginEnd  = stmtEnumerateKeysBeginEnd
  137     , clientRepoStmtAddChunk               = stmtAddChunk
  138     , clientRepoStmtPreCutChunks           = stmtPreCutChunks
  139     , clientRepoStmtCutChunks              = stmtCutChunks
  140     , clientRepoStmtGetUpperRevision       = stmtGetUpperRevision
  141     }
  142 
  143 -- Item pseudo revs.
  144 -- Correct revisions (commited to server) are > 0.
  145 -- If it's < 0, it's a special pseudo-revision.
  146 -- Zero revision means no revision.
  147 -- client change based on 'server' in case of no conflict
  148 pattern ItemRevClient = -1
  149 -- client change based on 'server' which is in process of committing to server
  150 pattern ItemRevTransient = -2
  151 -- client change based on 'transient', waiting for results of commit of 'transient'
  152 pattern ItemRevPostponed = -3
  153 
  154 -- Manifest keys.
  155 pattern ManifestKeyGlobalRevision = 0
  156 
  157 type ItemId = Int64
  158 
  159 getManifestValue :: ClientRepo -> CInt -> Int64 -> IO Int64
  160 getManifestValue ClientRepo
  161   { clientRepoStmtManifestGet = stmtManifestGet
  162   } key defaultValue =
  163   sqliteQuery stmtManifestGet $ \query -> do
  164     sqliteBind query 1 key
  165     r <- sqliteStep query
  166     if r then sqliteColumn query 0
  167     else return defaultValue
  168 
  169 setManifestValue :: ClientRepo -> CInt -> Int64 -> IO ()
  170 setManifestValue ClientRepo
  171   { clientRepoStmtManifestSet = stmtManifestSet
  172   } key value =
  173   sqliteQuery stmtManifestSet $ \query -> do
  174     sqliteBind query 1 key
  175     sqliteBind query 2 value
  176     sqliteFinalStep query
  177 
  178 -- | Get global revision in client repo.
  179 -- Tries to increase global revision found in manifest, by using chunks, and then removes those chunks.
  180 clientRepoRevision :: ClientRepo -> IO Revision
  181 clientRepoRevision repo@ClientRepo
  182   { clientRepoStmtPreCutChunks = stmtPreCutChunks
  183   , clientRepoStmtCutChunks = stmtCutChunks
  184   } = do
  185   -- get global revision from manifest, and try to increase it using chunks
  186   let
  187     preCutChunks globalRevision = do
  188       preCutRevision <- sqliteQuery stmtPreCutChunks $ \query -> do
  189         sqliteBind query 1 globalRevision
  190         r <- sqliteStep query
  191         unless r $ throwIO $ DescribeFirstException "failed to get pre-cut revision"
  192         sqliteColumn query 0
  193       -- try again if it actually increased
  194       if preCutRevision > globalRevision then preCutChunks preCutRevision
  195       else return globalRevision
  196   firstGlobalRevision <- getManifestValue repo ManifestKeyGlobalRevision 0
  197   globalRevision <- preCutChunks firstGlobalRevision
  198   -- if global revision has actually incresed, remember it in manifest
  199   when (globalRevision > firstGlobalRevision) $ setManifestValue repo ManifestKeyGlobalRevision globalRevision
  200   -- remove chunks behind global revision
  201   sqliteQuery stmtCutChunks $ \query -> do
  202     sqliteBind query 1 globalRevision
  203     sqliteFinalStep query
  204   return globalRevision
  205 
  206 addKeyItem :: ClientRepo -> B.ByteString -> B.ByteString -> Revision -> IO ()
  207 addKeyItem ClientRepo
  208   { clientRepoStmtAddKeyItem = stmtAddKeyItem
  209   } key value revision = sqliteQuery stmtAddKeyItem $ \query -> do
  210   sqliteBind query 1 key
  211   sqliteBind query 2 value
  212   sqliteBind query 3 revision
  213   sqliteFinalStep query
  214 
  215 changeKeyItemRevision :: ClientRepo -> ItemId -> Revision -> IO ()
  216 changeKeyItemRevision ClientRepo
  217   { clientRepoStmtChangeKeyItemRev = stmtChangeKeyItemRev
  218   } itemId newRevision = sqliteQuery stmtChangeKeyItemRev $ \query -> do
  219   sqliteBind query 1 itemId
  220   sqliteBind query 2 newRevision
  221   sqliteFinalStep query
  222 
  223 getKeyItemRevisionValue :: ClientRepo -> ItemId -> IO (Revision, B.ByteString)
  224 getKeyItemRevisionValue ClientRepo
  225   { clientRepoStmtGetKeyItemRevValue = stmtGetKeyItemRevValue
  226   } itemId = sqliteQuery stmtGetKeyItemRevValue $ \query -> do
  227   sqliteBind query 1 itemId
  228   r <- sqliteStep query
  229   unless r $ throwIO $ DescribeFirstException "failed to get key item revision and value"
  230   revision <- sqliteColumn query 0
  231   value <- sqliteColumn query 1
  232   return (if revision > 0 then revision else 0, value)
  233 
  234 changeKeyItemRevisionValue :: ClientRepo -> ItemId -> Revision -> B.ByteString -> IO ()
  235 changeKeyItemRevisionValue ClientRepo
  236   { clientRepoStmtChangeKeyItemRevValue = stmtChangeKeyItemRevValue
  237   } itemId newRevision newValue = sqliteQuery stmtChangeKeyItemRevValue $ \query -> do
  238   sqliteBind query 1 itemId
  239   sqliteBind query 2 newRevision
  240   sqliteBind query 3 newValue
  241   sqliteFinalStep query
  242 
  243 -- | Collection of items with the same key.
  244 data KeyItems = KeyItems
  245   { keyItemsClientItemId :: {-# UNPACK #-} !ItemId
  246   , keyItemsTransientItemId :: {-# UNPACK #-} !ItemId
  247   , keyItemsPostponedItemId :: {-# UNPACK #-} !ItemId
  248   } deriving Show
  249 
  250 fillKeyItems :: SqliteQuery -> IO KeyItems
  251 fillKeyItems query = step KeyItems
  252   { keyItemsClientItemId = 0
  253   , keyItemsTransientItemId = 0
  254   , keyItemsPostponedItemId = 0
  255   } where
  256   step keyItems = do
  257     r <- sqliteStep query
  258     if r then do
  259       itemId <- sqliteColumn query 0
  260       itemRevision <- sqliteColumn query 1
  261       case itemRevision :: Revision of
  262         ItemRevClient -> step keyItems
  263           { keyItemsClientItemId = itemId
  264           }
  265         ItemRevTransient -> step keyItems
  266           { keyItemsTransientItemId = itemId
  267           }
  268         ItemRevPostponed -> step keyItems
  269           { keyItemsPostponedItemId = itemId
  270           }
  271         _ -> throwIO $ DescribeFirstException "wrong item status rev"
  272     else return keyItems
  273 
  274 getKeyItems :: ClientRepo -> B.ByteString -> IO KeyItems
  275 getKeyItems ClientRepo
  276   { clientRepoStmtGetKeyItems = stmtGetKeyItems
  277   } key = sqliteQuery stmtGetKeyItems $ \query -> do
  278   sqliteBind query 1 key
  279   fillKeyItems query
  280 
  281 getKeyItemsByOneItemId :: ClientRepo -> ItemId -> IO KeyItems
  282 getKeyItemsByOneItemId ClientRepo
  283   { clientRepoStmtGetKeyItemsByOneItemId = stmtGetKeyItemsByOneItemId
  284   } itemId = sqliteQuery stmtGetKeyItemsByOneItemId $ \query -> do
  285   sqliteBind query 1 itemId
  286   fillKeyItems query
  287 
  288 getKeyServerItem :: ClientRepo -> B.ByteString -> IO ItemId
  289 getKeyServerItem ClientRepo
  290   { clientRepoStmtGetKeyServerItem = stmtGetKeyServerItem
  291   } key = sqliteQuery stmtGetKeyServerItem $ \query -> do
  292   sqliteBind query 1 key
  293   r <- sqliteStep query
  294   if r then sqliteColumn query 0
  295   else return 0
  296 
  297 mapKeyRevisionItem :: ClientRepo -> B.ByteString -> a -> (ItemId -> IO a) -> IO a
  298 mapKeyRevisionItem repo key defaultResult f = do
  299   KeyItems
  300     { keyItemsClientItemId = clientItemId
  301     , keyItemsTransientItemId = transientItemId
  302     , keyItemsPostponedItemId = postponedItemId
  303     } <- getKeyItems repo key
  304   -- check key items in this particular order
  305   if postponedItemId > 0 then f postponedItemId
  306   else if transientItemId > 0 then f transientItemId
  307   else if clientItemId > 0 then f clientItemId
  308   else do
  309     -- check server item
  310     serverItemId <- getKeyServerItem repo key
  311     if serverItemId > 0 then f serverItemId
  312     else return defaultResult
  313 
  314 getKeyRevisionValue :: ClientRepo -> B.ByteString -> IO (Revision, B.ByteString)
  315 getKeyRevisionValue repo key = mapKeyRevisionItem repo key (0, B.empty) $ getKeyItemRevisionValue repo
  316 
  317 -- | Get revision and value by key.
  318 clientRepoGetRevisionValue :: ClientRepo -> B.ByteString -> IO (Revision, B.ByteString)
  319 clientRepoGetRevisionValue repo@ClientRepo
  320   { clientRepoDb = db
  321   } key = sqliteTransaction db $ \_commit -> getKeyRevisionValue repo key
  322 
  323 -- | Change value for given key.
  324 clientRepoChange :: ClientRepo -> B.ByteString -> B.ByteString -> IO ()
  325 clientRepoChange repo@ClientRepo
  326   { clientRepoDb = db
  327   } key value = sqliteTransaction db $ \commit -> do
  328   KeyItems
  329     { keyItemsClientItemId = clientItemId
  330     , keyItemsTransientItemId = transientItemId
  331     , keyItemsPostponedItemId = postponedItemId
  332     } <- getKeyItems repo key
  333   let
  334     (newRev, revItemId) =
  335       if transientItemId > 0 then (ItemRevPostponed, postponedItemId)
  336       else (ItemRevClient, clientItemId)
  337   if revItemId > 0 then changeKeyItemRevisionValue repo revItemId newRev value
  338   else addKeyItem repo key value newRev
  339   void $ getKeyItems repo key
  340   commit
  341 
  342 -- | Get all keys having the string given as a prefix.
  343 -- Empty-valued keys are returned too for removed values, for purpose of detecting changes.
  344 clientRepoGetKeysPrefixed :: ClientRepo -> B.ByteString -> IO [B.ByteString]
  345 clientRepoGetKeysPrefixed ClientRepo
  346   { clientRepoDb = db
  347   , clientRepoStmtEnumerateKeysBegin = stmtEnumerateKeysBegin
  348   , clientRepoStmtEnumerateKeysBeginEnd = stmtEnumerateKeysBeginEnd
  349   } keyPrefix = sqliteTransaction db $ \_commit -> case maybeUpperBound of
  350   Just upperBound -> sqliteQuery stmtEnumerateKeysBeginEnd $ \query -> do
  351     sqliteBind query 1 keyPrefix
  352     sqliteBind query 2 upperBound
  353     process query
  354   Nothing -> sqliteQuery stmtEnumerateKeysBegin $ \query -> do
  355     sqliteBind query 1 keyPrefix
  356     process query
  357   where
  358     keyPrefixLength = B.length keyPrefix
  359     -- get upper bound for a query
  360     -- essentially we need "prefix + 1", i.e. increment first byte from end which is < 0xFF
  361     -- and set to zero all bytes after it
  362     -- if the whole prefix looks like "0xFFFFFFFFFF..." then no upper bound is needed
  363     maybeUpperBound = let
  364       f i | i >= 0 = let b = keyPrefix `B.index` i in
  365         if b < 0xFF then Just $ B.take i keyPrefix <> B.singleton (b + 1) <> B.replicate (keyPrefixLength - i - 1) 0
  366         else f $ i - 1
  367       f _ = Nothing
  368       in f $ keyPrefixLength - 1
  369     process query = let
  370       step previousKeys = do
  371         r <- sqliteStep query
  372         if r then step =<< (: previousKeys) <$> sqliteColumn query 0
  373         else return previousKeys
  374       in reverse <$> step []
  375 
  376 -- | State of push, needed for pull.
  377 newtype ClientRepoPushState = ClientRepoPushState
  378   { clientRepoPushStateTransientIds :: [ItemId]
  379   }
  380 
  381 -- | Perform push.
  382 pushClientRepo :: ClientRepo -> Manifest -> IO (Push, ClientRepoPushState)
  383 pushClientRepo repo@ClientRepo
  384   { clientRepoDb = db
  385   , clientRepoStmtSelectKeysToPush = stmtSelectKeysToPush
  386   , clientRepoStmtGetUpperRevision = stmtGetUpperRevision
  387   } Manifest
  388   { manifestMaxPushItemsCount = maxPushItemsCount
  389   , manifestMaxPushValuesTotalSize = maxPushValuesTotalSize
  390   } = describeException "failed to push client repo" $ sqliteTransaction db $ \commit -> do
  391 
  392   -- get global revision
  393   clientRevision <- clientRepoRevision repo
  394 
  395   -- get upper revision
  396   clientUpperRevision <- sqliteQuery stmtGetUpperRevision $ \query -> do
  397     r <- sqliteStep query
  398     unless r $ throwIO $ DescribeFirstException "failed to get upper revision"
  399     sqliteColumn query 0
  400 
  401   -- select keys to push
  402   (reverse -> items, reverse -> transientIds) <- sqliteQuery stmtSelectKeysToPush $ \query -> do
  403     sqliteBind query 1 (fromIntegral maxPushItemsCount :: Int64)
  404     let
  405       step pushValuesTotalSize prevItems prevItemsIds = do
  406         -- get next row
  407         r <- sqliteStep query
  408         if r then do
  409           -- get value
  410           value <- sqliteColumn query 2
  411           -- check limits
  412           let
  413             newPushValuesTotalSize = pushValuesTotalSize + B.length value
  414           if newPushValuesTotalSize > maxPushValuesTotalSize then return ([], [])
  415           else do
  416             -- get key
  417             key <- sqliteColumn query 1
  418             -- get id of item
  419             itemId <- sqliteColumn query 0
  420             -- change status of item to 'transient'
  421             changeKeyItemRevision repo itemId ItemRevTransient
  422             -- get rest of the items and return
  423             step newPushValuesTotalSize ((key, value) : prevItems) (itemId : prevItemsIds)
  424         else return (prevItems, prevItemsIds)
  425       in step 0 [] []
  426 
  427   -- commit and return
  428   commit
  429 
  430   return (Push
  431     { pushClientRevision = clientRevision
  432     , pushClientUpperRevision = clientUpperRevision
  433     , pushItems = items
  434     }, ClientRepoPushState
  435     { clientRepoPushStateTransientIds = transientIds
  436     })
  437 
  438 isClientRepoPushEmpty :: ClientRepoPushState -> Bool
  439 isClientRepoPushEmpty ClientRepoPushState
  440   { clientRepoPushStateTransientIds = transientIds
  441   } = null transientIds
  442 
  443 data ClientRepoPullInfo = ClientRepoPullInfo
  444   { clientRepoPullRevision :: {-# UNPACK #-} !Revision
  445   , clientRepoPullLag :: {-# UNPACK #-} !Int64
  446   , clientRepoPullChanges :: [(Revision, B.ByteString, B.ByteString)]
  447   }
  448 
  449 -- | Perform pull, i.e. process answer from server, marking pushed changes and remembering outside changes.
  450 pullClientRepo :: ClientRepo -> Pull -> ClientRepoPushState -> IO ClientRepoPullInfo
  451 pullClientRepo repo@ClientRepo
  452   { clientRepoDb = db
  453   , clientRepoStmtAddChunk = stmtAddChunk
  454   } Pull
  455   { pullLag = lag
  456   , pullPrePushRevision = prePushRevision
  457   , pullPostPushRevision = postPushRevision
  458   , pullItems = itemsToPull
  459   , pullNewClientRevision = newClientRevision
  460   } ClientRepoPushState
  461   { clientRepoPushStateTransientIds = transientIds
  462   } = describeException "failed to pull client repo" $ sqliteTransaction db $ \commit -> do
  463 
  464   -- process commited keys
  465   forM_ (zip [(prePushRevision + 1)..] transientIds) $ \(revision, transientItemId) -> do
  466     -- get key items
  467     KeyItems
  468       { keyItemsPostponedItemId = postponedItemId
  469       } <- getKeyItemsByOneItemId repo transientItemId
  470 
  471     -- 'transient' becomes 'server'
  472     changeKeyItemRevision repo transientItemId revision
  473     -- 'postponed' becomes 'client'
  474     when (postponedItemId > 0) $ changeKeyItemRevision repo postponedItemId ItemRevClient
  475 
  476   -- add chunk if something has been committed
  477   when (prePushRevision < postPushRevision) $
  478     sqliteQuery stmtAddChunk $ \query -> do
  479       sqliteBind query 1 prePushRevision
  480       sqliteBind query 2 postPushRevision
  481       sqliteFinalStep query
  482 
  483   -- pull keys
  484   forM_ itemsToPull $ \(revision, key, value) -> do
  485     -- value always becomes 'server'
  486     -- see what we need to do
  487     serverItemId <- getKeyServerItem repo key
  488     if serverItemId > 0 then changeKeyItemRevisionValue repo serverItemId revision value
  489     else when (B.length value > 0) $ addKeyItem repo key value revision
  490 
  491   -- set new client revision
  492   setManifestValue repo ManifestKeyGlobalRevision newClientRevision
  493 
  494   -- commit and return
  495   commit
  496 
  497   return ClientRepoPullInfo
  498     { clientRepoPullRevision = newClientRevision
  499     , clientRepoPullLag = lag
  500     , clientRepoPullChanges = itemsToPull
  501     }
  502 
  503 -- | Perform cleanup after interrupted sync (i.e. after push, but without pull).
  504 -- It's harmless to do it without push.
  505 cleanupClientRepo :: ClientRepo -> IO ()
  506 cleanupClientRepo ClientRepo
  507   { clientRepoDb = db
  508   , clientRepoStmtMassChangeRev = stmtMassChangeStatus
  509   } = sqliteTransaction db $ \commit -> do
  510   -- change 'transient' items to 'client'
  511   sqliteQuery stmtMassChangeStatus $ \query -> do
  512     sqliteBind query 1 (ItemRevTransient :: Revision)
  513     sqliteBind query 2 (ItemRevClient :: Revision)
  514     sqliteFinalStep query
  515   -- change 'postponed' items to 'client' (possibly replacing former 'transient' items)
  516   sqliteQuery stmtMassChangeStatus $ \query -> do
  517     sqliteBind query 1 (ItemRevPostponed :: Revision)
  518     sqliteBind query 2 (ItemRevClient :: Revision)
  519     sqliteFinalStep query
  520   -- commit
  521   commit
  522 
  523 -- | Helper function to perform sync.
  524 syncClientRepo :: ClientRepo -> Manifest -> (Push -> IO Pull) -> IO ClientRepoPullInfo
  525 syncClientRepo repo manifest sync = flip onException (cleanupClientRepo repo) $ do
  526   -- perform push on client repo
  527   (push, pushState) <- pushClientRepo repo manifest
  528   pull <- sync push
  529   pullClientRepo repo pull pushState
  530 
  531 instance Repo ClientRepo where
  532   repoDb = clientRepoDb