{-# LANGUAGE TypeApplications #-}

module Data.Mergeful.ItemSpec
  ( spec
  ) where

import Test.Hspec
import Test.QuickCheck
import Test.Validity
import Test.Validity.Aeson

import Data.Mergeful.Item
import Data.Mergeful.Timed

import Data.GenValidity.Mergeful.Item ()

{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}

forAllSubsequent :: Testable prop => ((ServerTime, ServerTime) -> prop) -> Property
forAllSubsequent func =
  forAllValid $ \st ->
    forAllShrink (genValid `suchThat` (> st)) (filter (> st) . shrinkValid) $ \st' -> func (st, st')

spec :: Spec
spec = do
  genValidSpec @(ClientItem Int)
  jsonSpecOnValid @(ClientItem Int)
  genValidSpec @(ServerItem Int)
  jsonSpecOnValid @(ServerItem Int)
  genValidSpec @(ItemSyncRequest Int)
  jsonSpecOnValid @(ItemSyncRequest Int)
  genValidSpec @(ItemSyncResponse Int)
  jsonSpecOnValid @(ItemSyncResponse Int)
  describe "makeItemSyncRequest" $
    it "produces valid requests" $ producesValidsOnValids (makeItemSyncRequest @Int)
  describe "mergeItemSyncResponseRaw" $
    it "produces valid client stores" $ producesValidsOnValids2 (mergeItemSyncResponseRaw @Int)
  describe "mergeItemSyncResponseIgnoreProblems" $
    it "produces valid client stores" $
    producesValidsOnValids2 (mergeItemSyncResponseIgnoreProblems @Int)
  describe "processServerItemSync" $ do
    it "produces valid responses and stores" $ producesValidsOnValids2 (processServerItemSync @Int)
    it "makes no changes if the sync request reflects the state of the empty server" $ do
      let store1 = ServerEmpty
          req = ItemSyncRequestPoll
      let (resp, store2) = processServerItemSync @Int store1 req
      store2 `shouldBe` store1
      resp `shouldBe` ItemSyncResponseInSyncEmpty
    it "makes no changes if the sync request reflects the state of the full server" $
      forAllValid $ \i ->
        forAllValid $ \st -> do
          let store1 = ServerFull $ Timed i st
              req = ItemSyncRequestKnown st
          let (resp, store2) = processServerItemSync @Int store1 req
          store2 `shouldBe` store1
          resp `shouldBe` ItemSyncResponseInSyncFull
    describe "Client changes" $ do
      it "adds the item that the client tells the server to add" $
        forAllValid $ \i -> do
          let store1 = ServerEmpty
              req = ItemSyncRequestNew i
          let (resp, store2) = processServerItemSync @Int store1 req
          let time = initialServerTime
          store2 `shouldBe` ServerFull (Timed i time)
          resp `shouldBe` ItemSyncResponseClientAdded time
      it "changes the item that the client tells the server to change" $
        forAllValid $ \i ->
          forAllValid $ \j ->
            forAllValid $ \st -> do
              let store1 = ServerFull (Timed i st)
                  req = ItemSyncRequestKnownButChanged (Timed j st)
              let (resp, store2) = processServerItemSync @Int store1 req
              let time = incrementServerTime st
              store2 `shouldBe` ServerFull (Timed j time)
              resp `shouldBe` ItemSyncResponseClientChanged time
      it "deletes the item that the client tells the server to delete" $
        forAllValid $ \i ->
          forAllValid $ \st -> do
            let store1 = ServerFull (Timed i st)
                req = ItemSyncRequestDeletedLocally st
            let (resp, store2) = processServerItemSync @Int store1 req
            store2 `shouldBe` ServerEmpty
            resp `shouldBe` ItemSyncResponseClientDeleted
    describe "Server changes" $ do
      it "tells the client that there is a new item at the server side" $
        forAllValid $ \i ->
          forAllValid $ \st -> do
            let store1 = ServerFull (Timed i st)
                req = ItemSyncRequestPoll
            let (resp, store2) = processServerItemSync @Int store1 req
            store2 `shouldBe` store1
            resp `shouldBe` ItemSyncResponseServerAdded (Timed i st)
      it "tells the client that there is a modified item at the server side" $
        forAllValid $ \i ->
          forAllSubsequent $ \(st, st') -> do
            let store1 = ServerFull (Timed i st')
                req = ItemSyncRequestKnown st
            let (resp, store2) = processServerItemSync @Int store1 req
            store2 `shouldBe` store1
            resp `shouldBe` ItemSyncResponseServerChanged (Timed i st')
      it "tells the client that there is a deleted item at the server side" $
        forAllValid $ \st -> do
          let store1 = ServerEmpty
              req = ItemSyncRequestKnown st
          let (resp, store2) = processServerItemSync @Int store1 req
          store2 `shouldBe` store1
          resp `shouldBe` ItemSyncResponseServerDeleted
    describe "Conflicts" $ do
      it "notices a conflict if the client and server are trying to sync different items" $
        forAllValid $ \i ->
          forAllValid $ \j ->
            forAllSubsequent $ \(st, st') -> do
              let store1 = ServerFull (Timed i st')
                  req = ItemSyncRequestKnownButChanged (Timed j st)
              let (resp, store2) = processServerItemSync @Int store1 req
              store2 `shouldBe` store1
              resp `shouldBe` ItemSyncResponseConflict (Timed i st')
      it
        "notices a server-deleted-conflict if the client has a deleted item and server has a modified item" $
        forAllValid $ \i ->
          forAllSubsequent $ \(st, st') -> do
            let store1 = ServerFull (Timed i st')
                req = ItemSyncRequestDeletedLocally st
            let (resp, store2) = processServerItemSync @Int store1 req
            store2 `shouldBe` store1
            resp `shouldBe` ItemSyncResponseConflictClientDeleted (Timed i st')
      it
        "notices a server-deleted-conflict if the client has a modified item and server has no item" $
        forAllValid $ \i ->
          forAllValid $ \st -> do
            let store1 = ServerEmpty
                req = ItemSyncRequestKnownButChanged (Timed i st)
            let (resp, store2) = processServerItemSync @Int store1 req
            store2 `shouldBe` store1
            resp `shouldBe` ItemSyncResponseConflictServerDeleted
  describe "syncing" $ do
    it "it always possible to add an item from scratch" $
      forAllValid $ \i -> do
        let cstore1 = ClientAdded (i :: Int)
        let sstore1 = ServerEmpty
        let req1 = makeItemSyncRequest cstore1
            (resp1, sstore2) = processServerItemSync sstore1 req1
            cstore2 = mergeItemSyncResponseIgnoreProblems cstore1 resp1
        let time = initialServerTime
        resp1 `shouldBe` ItemSyncResponseClientAdded time
        sstore2 `shouldBe` ServerFull (Timed i time)
        cstore2 `shouldBe` ClientItemSynced (Timed i time)
    it "succesfully syncs an addition across to a second client" $
      forAllValid $ \i -> do
        let cAstore1 = ClientAdded i
        -- Client B is empty
        let cBstore1 = ClientEmpty
        -- The server is empty
        let sstore1 = ServerEmpty
        -- Client A makes sync request 1
        let req1 = makeItemSyncRequest cAstore1
        -- The server processes sync request 1
        let (resp1, sstore2) = processServerItemSync @Int sstore1 req1
        let time = initialServerTime
        resp1 `shouldBe` ItemSyncResponseClientAdded time
        sstore2 `shouldBe` ServerFull (Timed i time)
        -- Client A merges the response
        let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp1
        cAstore2 `shouldBe` ClientItemSynced (Timed i time)
        -- Client B makes sync request 2
        let req2 = makeItemSyncRequest cBstore1
        -- The server processes sync request 2
        let (resp2, sstore3) = processServerItemSync sstore2 req2
        resp2 `shouldBe` ItemSyncResponseServerAdded (Timed i time)
        sstore3 `shouldBe` ServerFull (Timed i time)
        -- Client B merges the response
        let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp2
        cBstore2 `shouldBe` ClientItemSynced (Timed i time)
        -- Client A and Client B now have the same store
        cAstore2 `shouldBe` cBstore2
    it "succesfully syncs a modification across to a second client" $
      forAllValid $ \time1 ->
        forAllValid $ \i ->
          forAllValid $ \j -> do
            let cAstore1 = ClientItemSynced (Timed i time1)
            -- Client B had synced that same item, but has since modified it
            let cBstore1 = ClientItemSyncedButChanged (Timed j time1)
            -- The server is has the item that both clients had before
            let sstore1 = ServerFull (Timed i time1)
            -- Client B makes sync request 1
            let req1 = makeItemSyncRequest cBstore1
            -- The server processes sync request 1
            let (resp1, sstore2) = processServerItemSync @Int sstore1 req1
            let time2 = incrementServerTime time1
            resp1 `shouldBe` ItemSyncResponseClientChanged time2
            sstore2 `shouldBe` ServerFull (Timed j time2)
            -- Client B merges the response
            let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp1
            cBstore2 `shouldBe` ClientItemSynced (Timed j time2)
            -- Client A makes sync request 2
            let req2 = makeItemSyncRequest cAstore1
            -- The server processes sync request 2
            let (resp2, sstore3) = processServerItemSync sstore2 req2
            resp2 `shouldBe` ItemSyncResponseServerChanged (Timed j time2)
            sstore3 `shouldBe` ServerFull (Timed j time2)
            -- Client A merges the response
            let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp2
            cAstore2 `shouldBe` ClientItemSynced (Timed j time2)
            -- Client A and Client B now have the same store
            cAstore2 `shouldBe` cBstore2
    it "succesfully syncs a deletion across to a second client" $
      forAllValid $ \time1 ->
        forAllValid $ \i -> do
          let cAstore1 = ClientItemSynced (Timed i time1)
          -- Client B had synced that same item, but has since deleted it
          let cBstore1 = ClientDeleted time1
          -- The server still has the undeleted item
          let sstore1 = ServerFull (Timed i time1)
          -- Client B makes sync request 1
          let req1 = makeItemSyncRequest cBstore1
          -- The server processes sync request 1
          let (resp1, sstore2) = processServerItemSync @Int sstore1 req1
          resp1 `shouldBe` ItemSyncResponseClientDeleted
          sstore2 `shouldBe` ServerEmpty
          -- Client B merges the response
          let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp1
          cBstore2 `shouldBe` ClientEmpty
          -- Client A makes sync request 2
          let req2 = makeItemSyncRequest cAstore1
          -- The server processes sync request 2
          let (resp2, sstore3) = processServerItemSync sstore2 req2
          resp2 `shouldBe` ItemSyncResponseServerDeleted
          sstore3 `shouldBe` ServerEmpty
          -- Client A merges the response
          let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp2
          cAstore2 `shouldBe` ClientEmpty
          -- Client A and Client B now have the same store
          cAstore2 `shouldBe` cBstore2
    it "does not run into a conflict if two clients both try to sync a deletion" $
      forAllValid $ \time1 ->
        forAllValid $ \i -> do
          let cAstore1 = ClientDeleted time1
          -- Both client a and client b delete an item.
          let cBstore1 = ClientDeleted time1
          -- The server still has the undeleted item
          let sstore1 = ServerFull (Timed i time1)
          -- Client A makes sync request 1
          let req1 = makeItemSyncRequest cAstore1
          -- The server processes sync request 1
          let (resp1, sstore2) = processServerItemSync @Int sstore1 req1
          resp1 `shouldBe` ItemSyncResponseClientDeleted
          sstore2 `shouldBe` ServerEmpty
          -- Client A merges the response
          let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp1
          cAstore2 `shouldBe` ClientEmpty
          -- Client B makes sync request 2
          let req2 = makeItemSyncRequest cBstore1
          -- The server processes sync request 2
          let (resp2, sstore3) = processServerItemSync sstore2 req2
          resp2 `shouldBe` ItemSyncResponseClientDeleted
          sstore3 `shouldBe` ServerEmpty
          -- Client B merges the response
          let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp2
          cBstore2 `shouldBe` ClientEmpty
          -- Client A and Client B now have the same store
          cAstore2 `shouldBe` cBstore2
    it "is idempotent with one client" $
      forAllValid $ \cstore1 ->
        forAllValid $ \sstore1 -> do
          let req1 = makeItemSyncRequest (cstore1 :: ClientItem Int)
              (resp1, sstore2) = processServerItemSync sstore1 req1
              cstore2 = mergeItemSyncResponseIgnoreProblems cstore1 resp1
              req2 = makeItemSyncRequest cstore2
              (resp2, sstore3) = processServerItemSync sstore2 req2
              cstore3 = mergeItemSyncResponseIgnoreProblems cstore2 resp2
          cstore2 `shouldBe` cstore3
          sstore2 `shouldBe` sstore3