module Handler.Course.Application.Files
  ( getCAFilesR
  , getCAppsFilesR
  ) where

import Import
import Handler.Utils

import System.FilePath (addExtension, (</>))

import qualified Data.Conduit.List as C

import qualified Database.Esqueleto as E

import qualified Data.CaseInsensitive as CI


getCAFilesR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler TypedContent
getCAFilesR tid ssh csh cID = do
  appId <- decrypt cID
  User{..} <- runDB $ do
    CourseApplication{..} <- get404 appId
    Course{..} <- get404 courseApplicationCourse
    let matches = and
          [ tid == courseTerm
          , ssh == courseSchool
          , csh == courseShorthand
          ]
    unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
    get404 courseApplicationUser

  archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseApplicationArchiveName tid ssh csh cID userDisplayName
  let
    fsSource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
      E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
      E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
      return file

  serveSomeFiles archiveName $ fsSource .| C.map entityVal


getCAppsFilesR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
getCAppsFilesR tid ssh csh = do
  runDB . existsBy404 $ TermSchoolCourseShort tid ssh csh
  MsgRenderer mr <- getMsgRenderer
  
  archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseAllApplicationsArchiveName tid ssh csh

  let
    fsSource :: Source DB File
    fsSource = do
      apps <- lift . E.select . E.from $ \((course `E.InnerJoin` courseApplication `E.InnerJoin` user) `E.LeftOuterJoin` allocation) -> do
        E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
        E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
        E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
        E.where_ $ course E.^. CourseTerm E.==. E.val tid
             E.&&. course E.^. CourseSchool E.==. E.val ssh
             E.&&. course E.^. CourseShorthand E.==. E.val csh
        return (allocation, user, courseApplication)
      apps' <- flip filterM apps $ \(_, _, Entity appId _) -> do
        cID <- cachedByBinary appId $ encrypt appId
        hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
      let
        applicationAllocs = setOf (folded . _1) apps'
        
        allocations = applicationAllocs ^.. folded . _Just . _entityVal . $(multifocusG 3) _allocationTerm _allocationSchool _allocationShorthand

        allEqualOn :: Eq x => Getter _ x -> Bool
        allEqualOn l = maybe True (\x -> allOf (folded . l) (== x) allocations) (allocations ^? _head . l)
        
        mkAllocationDir mbAlloc
          | not $ allEqualOn _1
          , Just Allocation{..} <- mbAlloc
          = (</>) $ unpack [st|#{CI.foldCase (termToText (unTermKey allocationTerm))}-#{CI.foldedCase (unSchoolKey allocationSchool)}-#{CI.foldedCase allocationShorthand}|]
          | not $ allEqualOn _2
          , Just Allocation{..} <- mbAlloc
          = (</>) $ unpack [st|#{CI.foldedCase (unSchoolKey allocationSchool)}-#{CI.foldedCase allocationShorthand}|]
          | not $ allEqualOn _3
          , Just Allocation{..} <- mbAlloc
          = (</>) . unpack $ CI.foldedCase allocationShorthand
          | Just Allocation{} <- mbAlloc
          , not $ all (is _Just) applicationAllocs
          = (</>) . unpack $ mr MsgCourseApplicationsAllocatedDirectory
          | Nothing <- mbAlloc
          , any (is _Just) applicationAllocs
          = (</>) . unpack $ mr MsgCourseApplicationsNotAllocatedDirectory
          | otherwise
          = id

      forM_ apps' $ \(mbAlloc, Entity _ User{..}, Entity appId CourseApplication{..}) -> do
        cID <- cachedByBinary appId $ encrypt appId :: _ CryptoFileNameCourseApplication
        let mkAppDir = mkAllocationDir (entityVal <$> mbAlloc) . (</>) (unpack [st|#{CI.foldedCase $ ciphertext cID}-#{CI.foldCase userSurname}|])
            dirFiles = C.map $ over _fileTitle mkAppDir . entityVal
            fileEntitySource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
              E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
              E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
              return file
        
        yield File
          { fileModified = courseApplicationTime
          , fileTitle = mkAppDir ""
          , fileContent = Nothing
          }

        fileEntitySource .| dirFiles


  serveSomeFiles archiveName fsSource