{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

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

import Import
import Handler.Utils

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 -> do
      E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
      return courseApplicationFile

  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 :: ConduitT () CourseApplicationFile DB ()
    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
        lift . 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}|])
            fileEntitySource = E.selectSource . E.from $ \courseApplicationFile -> do
              E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
              return courseApplicationFile

        yield $ _FileReference # ( FileReference
                                   { fileReferenceModified = courseApplicationTime
                                   , fileReferenceTitle = mkAppDir ""
                                   , fileReferenceContent = Nothing
                                   }
                                 , CourseApplicationFileResidual appId
                                 )

        fileEntitySource .| C.map (view _entityVal) .| C.map (over (_FileReference . _1 . _fileReferenceTitle) mkAppDir)


  serveSomeFiles archiveName fsSource
