never executed always true always false
    1 {-|
    2 Module: Flaw.Oil.ServerRepo
    3 Description: Oil server repo.
    4 License: MIT
    5 -}
    6 
    7 module Flaw.Oil.ServerRepo
    8   ( ServerRepo()
    9   , openServerRepo
   10   , serverRepoMaxRevision
   11   , syncServerRepo
   12   ) where
   13 
   14 import Control.Exception
   15 import Control.Monad
   16 import qualified Data.ByteString as B
   17 import Data.Int
   18 import qualified Data.Text as T
   19 
   20 import Flaw.Book
   21 import Flaw.Data.Sqlite
   22 import Flaw.Exception
   23 import Flaw.Oil.Repo
   24 
   25 data ServerRepo = ServerRepo
   26   { serverRepoDb :: !SqliteDb
   27   , serverRepoStmtGetMaxRevision  :: !SqliteStmt
   28   , serverRepoStmtClearLatest     :: !SqliteStmt
   29   , serverRepoStmtWrite           :: !SqliteStmt
   30   , serverRepoStmtPull            :: !SqliteStmt
   31   , serverRepoStmtGetWeakRevision :: !SqliteStmt
   32   , serverRepoStmtPullTotalSize   :: !SqliteStmt
   33   }
   34 
   35 openServerRepo :: T.Text -> IO (ServerRepo, IO ())
   36 openServerRepo fileName = describeException "failed to open oil server repo" $ withSpecialBook $ \bk -> do
   37   -- open db
   38   db <- book bk $ openRepoDb fileName serverRepoVersion
   39 
   40   -- ensure tables and indices exist
   41 
   42   -- revs table
   43   sqliteExec db $ T.pack
   44     "CREATE TABLE IF NOT EXISTS revs (\
   45     \rev INTEGER PRIMARY KEY AUTOINCREMENT, \
   46     \date INTEGER NOT NULL, \
   47     \user INTEGER NOT NULL, \
   48     \latest INTEGER NOT NULL, \
   49     \key BLOB NOT NULL, \
   50     \value BLOB NOT NULL)"
   51   -- revs_rev__latest_1 index
   52   sqliteExec db $ T.pack
   53     "CREATE UNIQUE INDEX IF NOT EXISTS revs_rev__latest_1 ON revs (rev) WHERE latest = 1"
   54   -- revs_key__latest_1 index
   55   sqliteExec db $ T.pack
   56     "CREATE UNIQUE INDEX IF NOT EXISTS revs_key__latest_1 ON revs (key) WHERE latest = 1"
   57 
   58   -- create statements
   59   let
   60     createStmt str = book bk $ sqliteStmt db $ T.pack str
   61   stmtGetMaxRevision  <- createStmt "SELECT MAX(rev) FROM revs"
   62   stmtClearLatest     <- createStmt "UPDATE revs SET latest = 0 WHERE key = ?1 AND latest = 1"
   63   stmtWrite           <- createStmt "INSERT INTO revs (date, user, latest, key, value) VALUES (strftime('%s','now'), ?1, 1, ?2, ?3)"
   64   stmtPull            <- createStmt "SELECT rev, key, value FROM revs WHERE rev > ?1 AND rev <= ?2 AND latest = 1 ORDER BY rev LIMIT ?3"
   65   stmtGetWeakRevision <- createStmt "SELECT rev FROM revs WHERE rev > ?1 AND rev <= ?2 AND latest = 1 ORDER BY rev LIMIT 1"
   66   stmtPullTotalSize   <- createStmt "SELECT COUNT(rev) FROM revs WHERE rev > ?1 AND latest = 1"
   67 
   68   return ServerRepo
   69     { serverRepoDb = db
   70     , serverRepoStmtGetMaxRevision  = stmtGetMaxRevision
   71     , serverRepoStmtClearLatest     = stmtClearLatest
   72     , serverRepoStmtWrite           = stmtWrite
   73     , serverRepoStmtPull            = stmtPull
   74     , serverRepoStmtGetWeakRevision = stmtGetWeakRevision
   75     , serverRepoStmtPullTotalSize   = stmtPullTotalSize
   76     }
   77 
   78 serverRepoMaxRevision :: ServerRepo -> IO Int64
   79 serverRepoMaxRevision ServerRepo
   80   { serverRepoStmtGetMaxRevision = stmtGetMaxRevision
   81   } =
   82   sqliteQuery stmtGetMaxRevision $ \query -> do
   83     r <- sqliteStep query
   84     unless r $ throwIO $ DescribeFirstException "failed to get server repo max revision"
   85     sqliteColumn query 0
   86 
   87 -- | Sync operation.
   88 -- Push limits are not checked.
   89 syncServerRepo :: ServerRepo -> Manifest -> Push -> UserId -> IO Pull
   90 syncServerRepo repo@ServerRepo
   91   { serverRepoDb = db
   92   , serverRepoStmtClearLatest     = stmtClearLatest
   93   , serverRepoStmtWrite           = stmtWrite
   94   , serverRepoStmtPull            = stmtPull
   95   , serverRepoStmtGetWeakRevision = stmtGetWeakRevision
   96   , serverRepoStmtPullTotalSize   = stmtPullTotalSize
   97   } Manifest
   98   { manifestMaxPullItemsCount = maxPullItemsCount
   99   , manifestMaxPullValuesTotalSize = maxPullValuesTotalSize
  100   } Push
  101   { pushClientRevision = clientRevision
  102   , pushClientUpperRevision = clientUpperRevisionUncorrected
  103   , pushItems = itemsToPush
  104   } userId = describeException "failed to sync server repo" $ sqliteTransaction db $ \commit -> do
  105 
  106   -- get pre-push revision
  107   prePushRevision <- serverRepoMaxRevision repo
  108 
  109   -- get corrected client upper revision
  110   let
  111     clientUpperRevision = if clientUpperRevisionUncorrected == 0 || clientUpperRevisionUncorrected > prePushRevision
  112       then prePushRevision
  113       else clientUpperRevisionUncorrected
  114 
  115   -- determine pull lag
  116   lag <- sqliteQuery stmtPullTotalSize $ \query -> do
  117     sqliteBind query 1 clientRevision
  118     r <- sqliteStep query
  119     unless r $ throwIO $ DescribeFirstException "failed to determine total pull size"
  120     sqliteColumn query 0
  121 
  122   -- loop for push items
  123   forM_ itemsToPush $ \(key, value) -> do
  124     -- clear latest flag for that key
  125     sqliteQuery stmtClearLatest $ \query -> do
  126       sqliteBind query 1 key
  127       sqliteFinalStep query
  128     -- write key-value pair
  129     sqliteQuery stmtWrite $ \query -> do
  130       sqliteBind query 1 userId
  131       sqliteBind query 2 key
  132       sqliteBind query 3 value
  133       sqliteFinalStep query
  134 
  135   -- get post-push revision
  136   postPushRevision <- serverRepoMaxRevision repo
  137 
  138   -- perform pull
  139   (itemsToPull, lastKnownClientRevision) <- sqliteQuery stmtPull $ \query -> do
  140     sqliteBind query 1 clientRevision
  141     sqliteBind query 2 clientUpperRevision
  142     sqliteBind query 3 (fromIntegral maxPullItemsCount :: Int64)
  143 
  144     let
  145       step valuesTotalSize lastKnownClientRevision = do
  146         -- get next row
  147         r <- sqliteStep query
  148         -- if there's row
  149         if r then do
  150           -- get value
  151           value <- sqliteColumn query 2
  152           -- if we breach total values limit by adding this row, stop
  153           let
  154             newValuesTotalSize = valuesTotalSize + B.length value
  155           if newValuesTotalSize > maxPullValuesTotalSize then return ([], lastKnownClientRevision)
  156           else do
  157             -- get revision and key
  158             revision <- sqliteColumn query 0
  159             key <- sqliteColumn query 1
  160             -- get rest items and return
  161             (restItemsToPull, newLastKnownClientRevision) <- step newValuesTotalSize revision
  162             return ((revision, key, value) : restItemsToPull, newLastKnownClientRevision)
  163         else return ([], lastKnownClientRevision)
  164       in step 0 clientRevision
  165 
  166   -- get new client revision
  167   newClientRevision <- sqliteQuery stmtGetWeakRevision $ \query -> do
  168     sqliteBind query 1 lastKnownClientRevision
  169     sqliteBind query 2 clientUpperRevision
  170     r <- sqliteStep query
  171     if r then (+ (-1)) <$> sqliteColumn query 0
  172     else return clientUpperRevision
  173 
  174   -- commit transaction
  175   commit
  176 
  177   -- return answer
  178   return Pull
  179     { pullLag = lag
  180     , pullPrePushRevision = prePushRevision
  181     , pullPostPushRevision = postPushRevision
  182     , pullItems = itemsToPull
  183     , pullNewClientRevision = newClientRevision
  184     }
  185 
  186 instance Repo ServerRepo where
  187   repoDb = serverRepoDb