code.delx.au - offlineimap/blob - testsrc/TestConnection.hs

   1 {-
   2 Copyright (C) 2002-2008 John Goerzen <jgoerzen@complete.org>
   3
   4 This program is free software; you can redistribute it and/or modify
   5 it under the terms of the GNU General Public License as published by
   6 the Free Software Foundation; either version 2 of the License, or
   7 (at your option) any later version.
   8
   9 This program is distributed in the hope that it will be useful,
  10 but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 GNU General Public License for more details.
  13
  14 You should have received a copy of the GNU General Public License
  15 along with this program; if not, write to the Free Software
  16 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 -}
  18 module TestConnection where
  19 import Data.Maybe(catMaybes)
  20 import Data.Syncable
  21 import qualified Data.Map as Map
  22 import Data.List
  23 import qualified Test.HUnit as HU
  24 import Test.HUnit.Utils
  25 import Data.Word
  26 import Test.QuickCheck
  27 import TestInfrastructure
  28
  29 prop_empty :: Bool
  30 prop_empty =
  31     syncBiDir (emptymap::Map.Map Int ()) emptymap emptymap == ([], []) -- ([DeleteItem 5], [], [])
  32
  33 prop_delAllFromChild :: SyncCollection Int () -> Result
  34 prop_delAllFromChild inp =
  35     let (resMaster, resChild) = syncBiDir emptymap inp inp
  36         expectedResChild = sort . map DeleteItem . Map.keys $ inp
  37         in ([], expectedResChild) @=?
  38            (resMaster, sort resChild)
  39
  40 prop_delAllFromMaster :: SyncCollection Int () -> Result
  41 prop_delAllFromMaster inp =
  42     let (resMaster, resChild) = syncBiDir inp emptymap inp
  43         expectedResMaster = sort . map DeleteItem . Map.keys $ inp
  44         in (expectedResMaster, []) @=?
  45            (sort resMaster, resChild)
  46
  47 prop_addFromMaster :: SyncCollection Int Word8 -> Result
  48 prop_addFromMaster inp =
  49     let (resMaster, resChild) = syncBiDir inp emptymap emptymap
  50         expectedResChild = sort . map (\(k, v) -> CopyItem k v) . Map.toList $ inp
  51         in ([], expectedResChild) @=?
  52            (resMaster, sort resChild)
  53
  54 -- FIXME: prop_addFromChild
  55
  56 prop_allChangesToChild :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
  57 prop_allChangesToChild master child =
  58     let (resMaster, resChild) = syncBiDir master child child
  59         expectedResChild = sort $
  60             (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ child) ++
  61             (map DeleteItem . Map.keys . Map.difference child $ master) ++
  62             (map (pairToFunc SetContent) changeList)
  63         changeList = foldl changefunc [] (Map.toList child)
  64         changefunc accum (k, v) =
  65             case Map.lookup k master of
  66               Nothing -> accum
  67               Just x -> if x /= v
  68                         then (k, x) : accum
  69                         else accum
  70         in ([], expectedResChild) @=?
  71            (sort resMaster, sort resChild)
  72
  73 prop_allChangesToMaster :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
  74 prop_allChangesToMaster master child =
  75     let (resMaster, resChild) = syncBiDir master child master
  76         expectedResMaster = sort $
  77             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ master) ++
  78             (map DeleteItem . Map.keys . Map.difference master $ child) ++
  79             (map (pairToFunc SetContent) changeList)
  80         changeList = foldl changefunc [] (Map.toList child)
  81         changefunc accum (k, v) =
  82             case Map.lookup k master of
  83               Nothing -> accum
  84               Just x -> if x /= v
  85                         then (k, v) : accum
  86                         else accum
  87         in (expectedResMaster, []) @=?
  88            (sort resMaster, resChild)
  89
  90 -- FIXME: test findModified
  91
  92 prop_allChanges :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
  93 prop_allChanges master child lastchild =
  94     let (resMaster, resChild) = syncBiDir master child lastchild
  95
  96         masterMods = catMaybes . map procKV $ (Map.toList master)
  97             where procKV (k, m) =
  98                       case (Map.lookup k child, Map.lookup k lastchild) of
  99                         (Just c, Just lc) ->
 100                             if c == lc -- child didn't change
 101                                then Nothing
 102                                else if c == m -- child and master changed
 103                                     then Nothing
 104                                     else Just (k, c) -- child changed, master didn't
 105                         (Nothing, Just lc) -> Nothing -- deleted on child
 106                         (Just c, Nothing) -> -- New on both c and m
 107                             if c == m        -- Added the same
 108                                then Nothing
 109                                else Just (k, c) -- Added but differ
 110                         (Nothing, Nothing) -> Nothing -- New to master only
 111
 112         childMods = catMaybes . map procKV $ (Map.toList child)
 113             where procKV (k, c) =
 114                       case (Map.lookup k master, Map.lookup k lastchild) of
 115                         (Just m, Just lc) ->
 116                             if lc == c
 117                                then if c == m
 118                                        then Nothing
 119                                        else Just (k, m)
 120                                else Nothing
 121                         (Nothing, Just lc) ->        -- deleted; nothing to see here
 122                                               Nothing
 123                         (Just m, Nothing) -> -- New on both; child takes precedence
 124                            Nothing
 125                         (Nothing, Nothing) -> Nothing -- New to child only
 126
 127         expectedResMaster = sort $
 128             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
 129                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
 130             (map (pairToFunc SetContent) masterMods)
 131
 132         expectedResChild = sort $
 133             (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
 134                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
 135             (map (pairToFunc SetContent) childMods)
 136
 137     in (expectedResMaster, expectedResChild) @=?
 138        (sort resMaster, sort resChild)
 139
 140 {- | Basic validation that unaryApplyChanges works -}
 141 prop_unaryApplyChanges :: SyncCollection Int Word8 -> [(Bool, Int, Word8)] -> Result
 142 prop_unaryApplyChanges collection randcommands =
 143     let -- We use nubBy to make sure we don't get input that has reference
 144         -- to the same key more than once.  We then convert True/False to
 145         -- commands.
 146         commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
 147         toCommand (True, x, v) = CopyItem x v
 148         toCommand (False, x, _) = DeleteItem x
 149
 150         addedItems = catMaybes . map (\x -> case x of CopyItem y v -> Just (y, v); _ -> Nothing) $ commands
 151         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
 152
 153         collection' = foldl (flip Map.delete) collection deletedKeys
 154         expectedCollection =
 155             Map.union collection' (Map.fromList addedItems)
 156         in (sort . Map.keys $ expectedCollection) @=?
 157            (sort . Map.keys $ unaryApplyChanges collection commands)
 158
 159 {- | Should validate both that unaryApplyChanges works, and that it is
 160 an identify -}
 161 prop_unaryApplyChangesId :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 162 prop_unaryApplyChangesId master child =
 163     let (resMaster, resChild) = syncBiDir master child child
 164         newMaster = unaryApplyChanges master resMaster
 165         newChild = unaryApplyChanges child resChild
 166         newMasterKeys = sort . Map.keys $ newMaster
 167         newChildKeys = sort . Map.keys $ newChild
 168         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
 169            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 170
 171 prop_unaryApplyChanges3 :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 172 prop_unaryApplyChanges3 master child lastChild =
 173     let (resMaster, resChild) = syncBiDir master child lastChild
 174         newMaster = unaryApplyChanges master resMaster
 175         newChild = unaryApplyChanges child resChild
 176     in newMaster @=? newChild
 177
 178 prop_diffCollection :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 179 prop_diffCollection coll1 coll2 =
 180     let commands = diffCollection coll1 coll2
 181         newcoll2 = unaryApplyChanges coll1 commands
 182         in coll2 @=? newcoll2
 183
 184 q :: Testable a => String -> a -> HU.Test
 185 q = qccheck (defaultConfig {configMaxTest = 250})
 186
 187 allt = [q "Empty" prop_empty,
 188         q "Del all from child" prop_delAllFromChild,
 189         q "Del all from master" prop_delAllFromMaster,
 190         q "Add from master" prop_addFromMaster,
 191         q "All changes to child" prop_allChangesToChild,
 192         q "All changes to master" prop_allChangesToMaster,
 193         q "All changes" prop_allChanges,
 194         q "unaryApplyChanges" prop_unaryApplyChanges,
 195         q "unaryApplyChangesId" prop_unaryApplyChangesId,
 196         q "unaryApplyChanges3" prop_unaryApplyChanges3,
 197         q "diffCollection" prop_diffCollection
 198        ]