module Handler.Sheet.PersonalisedFilesSpec where

import TestImport

import Utils.Files
import Handler.Sheet.PersonalisedFiles

import qualified Yesod.Persist as Yesod

import ModelSpec ()

import Data.Universe.Class

import Data.Conduit
import qualified Data.Conduit.Combinators as C
import Control.Lens.Extras
import Control.Monad.Trans.Maybe
  
import qualified Crypto.Hash as Crypto (hash)

import System.FilePath (dropDrive)

import Data.Time.Clock (diffUTCTime)
import Data.Char (chr)

import Database.Persist.Sql (transactionUndo)


instance Arbitrary (FileReferenceResidual PersonalisedSheetFile) where
  arbitrary = PersonalisedSheetFileResidual
    <$> arbitrary
    <*> arbitrary
    <*> elements [ sfType | sfType <- universeF, sfType /= SheetMarking ]

instance Arbitrary PersonalisedSheetFilesDownloadAnonymous where
  arbitrary = elements universeF


spec :: Spec
spec = withApp . describe "Personalised sheet file zip encoding" $ do
  it "roundtrips" . replicateM_ 10 . runHandler . Yesod.runDB $ do
    term <- liftIO $ generate arbitrary
    tid <- insert term
    school <- liftIO $ generate arbitrary
    ssh <- insert school
    course <- liftIO $ generate arbitrary <&> \c -> c { courseTerm = tid, courseSchool = ssh }
    cid <- insert course
    sheet <- liftIO $ generate arbitrary <&> \s -> s { sheetCourse = cid }
    shid <- insert sheet

    sheetFiles' <- liftIO . generate . listOf $ scale (`div` 2) arbitrary
    sheetFiles <- fmap catMaybes . forM sheetFiles' $ \(f', res') -> runMaybeT $ do
      let f = f' { fileTitle = filter (/= chr 0) $ fileTitle f' } -- PostgreSQL doesn't like to store NUL-bytes in text
      guard . not . null . dropDrive $ fileTitle f
      
      uid <-
        let userLoop = do
              user <- liftIO $ generate arbitrary
              lift (insertUnique user) >>= maybe userLoop return
         in userLoop
      let res = res' { personalisedSheetFileResidualSheet = shid, personalisedSheetFileResidualUser = uid }
      fRef <- lift (sinkFile f :: DB FileReference)
      now <- liftIO getCurrentTime
      void . lift . insert $ CourseParticipant cid (personalisedSheetFileResidualUser res) now Nothing Nothing CourseParticipantActive
      void . lift . insert $ _FileReference # (fRef, res)
      return (f, res)

    anonMode <- liftIO $ generate arbitrary

    let
      fpL :: Lens' (Either PersonalisedSheetFile File) FilePath
      fpL = lens (either personalisedSheetFileTitle fileTitle) $ \f' path -> case f' of
        Left pf -> Left pf { personalisedSheetFileTitle = path }
        Right f -> Right f { fileTitle = path }
      isDirectory = either (is _Nothing . personalisedSheetFileContent) (is _Nothing . fileContent)

    recoveredFiles <- runConduit $
         sourcePersonalisedSheetFiles cid (Just shid) Nothing anonMode
      .| resolvePersonalisedSheetFiles fpL isDirectory cid shid
      .| C.foldMap pure

    let
      checkFile :: Either (PersonalisedSheetFileUnresolved (Either PersonalisedSheetFile File)) (Either PersonalisedSheetFile File, FileReferenceResidual PersonalisedSheetFile)
                -> (File, FileReferenceResidual PersonalisedSheetFile)
                -> Bool
      checkFile (Left _) _
        = False
      checkFile (Right (recFile, recResidual)) (file, residual)
        =    recResidual == residual
          && case recFile of
               Right f -> file == f
               Left pf ->    dropDrive (fileTitle file) == dropDrive (personalisedSheetFileTitle pf)
                          && abs (fileModified file `diffUTCTime` personalisedSheetFileModified pf) < 1e-6 -- Precision is a PostgreSQL limitation
                          && fmap Crypto.hash (fileContent file) == personalisedSheetFileContent pf

      errors = go [] sheetFiles recoveredFiles
        where go acc xs [] = reverse acc ++ map Left xs
              go acc [] ys = reverse acc ++ map Right ys
              go acc xs (y:ys)
                | (xs', _ : xs'') <- break (checkFile y) xs
                = go acc (xs' ++ xs'') ys
                | is (_Left . _PSFUnresolved) y
                , fromMaybe False $ previews (_Left . _PSFUnresolved . _Right . _fileTitle) ("meta-informationen" `isInfixOf`) y -- DEBUG; remove once _PSFUnresolvedCollatable works
                = go acc xs ys
                | isn't (_Left . _PSFUnresolved) y
                , isn't _Right y
                = go acc xs ys
                | otherwise       = go (Right y : acc) xs ys

    unless (null errors) . liftIO $ 
      expectationFailure $ show recoveredFiles ++ " does not match " ++ show sheetFiles ++ ": " ++ show errors

    transactionUndo