{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}

module Handler.Submission where

import Import

import Handler.Utils

import Network.Mime

import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.CaseInsensitive as CI

import qualified Data.UUID.Cryptographic as UUID
import qualified CryptoID.Base32 as Base32

import qualified Database.Esqueleto as E

import qualified Data.Conduit.List as Conduit

import System.FilePath


getSubmissionListR :: Handler Html
getSubmissionListR = do
  entityList <- runDB $ selectList [] []
  cIDKey <- getsYesod appCryptoIDKey
  let
    cryptEntity :: Entity Submission -> Handler (CryptoUUIDSubmission, Submission)
    cryptEntity (Entity key val) = (, val) <$> UUID.encrypt cIDKey key
  submissionList <- mapM cryptEntity entityList
  defaultLayout $(widgetFile "submission-list")

getSubmissionDownloadSingleR :: CryptoUUIDSubmission -> FilePath -> Handler TypedContent
getSubmissionDownloadSingleR cID path = do
  cIDKey <- getsYesod appCryptoIDKey
  submissionID <- UUID.decrypt cIDKey cID
  cID' <- Base32.encrypt cIDKey submissionID

  runDB $ do
    isRating <- maybe False (== submissionID) <$> isRatingFile path
    case isRating of
      True  -> do
        file <- (ratingFile cID' =<<) <$> getRating submissionID
        maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
      False -> do
        results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOn [E.don $ f E.^. FileTitle] $ do
          E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
          E.where_ (sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID)
          E.where_ (f E.^. FileTitle E.==. E.val path)
          E.where_ . E.not_ . E.isNothing $ f E.^. FileContent
          return f

        let fileName = Text.pack $ takeFileName path
        case results of
          [Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName) (toContent c)
          _ -> notFound

getSubmissionDownloadArchiveR :: FilePath -> Handler TypedContent
getSubmissionDownloadArchiveR path = do
  let (baseName, ext) = splitExtension path
      cID :: CryptoFileNameSubmission
      cID = CryptoID . CI.mk $ Text.pack baseName
  unless (ext == ".zip") notFound
  cIDKey <- getsYesod appCryptoIDKey
  submissionID <- Base32.decrypt cIDKey cID
  cUUID <- UUID.encrypt cIDKey submissionID
  runDB $ do
    rating <- getRating submissionID
    case rating of
      Nothing -> notFound
      Just rating' -> do
        sqlBackend <- ask
        let fileEntitySource = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
              E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
              return f
            fileEntitySource' :: Source (ResourceT IO) File
            fileEntitySource' = runReaderC sqlBackend fileEntitySource =$= Conduit.map entityVal >> maybe (return ()) yield (ratingFile cID rating')
            info = ZipInfo { zipComment = Text.encodeUtf8 . tshow $ ciphertext (cUUID :: CryptoUUIDSubmission) }
        return . TypedContent "application/zip" . toContent $ fileEntitySource' =$= produceZip info

getSubmissionR, postSubmissionR :: CryptoUUIDSubmission -> Handler Html
getSubmissionR = postSubmissionR
postSubmissionR cID = do
  cIDKey <- getsYesod appCryptoIDKey
  submissionID <- UUID.decrypt cIDKey cID
  (submission, files) <- runDB $ do
    submission <- get404 (submissionID :: Key Submission)
    files <- E.select . E.distinct . E.from $ \(sf `E.InnerJoin` f) -> do
      E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
      return (f, sf)
    return $ (submission, files)

  let
    rating@(Rating'{..}) = Rating'
      { ratingPoints = submissionRatingPoints submission
      , ratingComment = submissionRatingComment submission
      , ratingTime = submissionRatingTime submission
      }

  cID' <- Base32.encrypt cIDKey submissionID
  let
    archiveBaseName = Text.unpack . CI.foldedCase $ ciphertext (cID' :: CryptoFileNameSubmission)
    archiveName = archiveBaseName <.> "zip"

  defaultLayout $(widgetFile "submission")