module Handler.CryptoIDDispatch
  ( getCryptoUUIDDispatchR
  , getCryptoFileNameDispatchR
  ) where

import Import

import qualified Data.Text as Text

import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))

import qualified Control.Monad.Catch as E (Handler(..))

import           Data.CaseInsensitive   (CI)
import qualified Data.CaseInsensitive as CI


class CryptoRoute ciphertext plaintext where
  cryptoIDRoute :: p plaintext -> ciphertext -> Handler (Route UniWorX)

instance CryptoRoute UUID SubmissionId where
  cryptoIDRoute _ (CryptoID -> cID) = do
    (smid :: SubmissionId) <- decrypt cID
    cID' <- encrypt smid
    (tid,ssh,csh,shn) <- runDB $ do
      shid <- submissionSheet <$> get404 smid
      Sheet{..}  <- get404 shid
      Course{..} <- get404 sheetCourse
      return (courseTerm, courseSchool, courseShorthand, sheetName)
    return $ CSubmissionR tid ssh csh shn cID' SubShowR

instance CryptoRoute (CI FilePath) SubmissionId where
  cryptoIDRoute _ ciphertext
    | Just cID <- fromPathPiece . Text.pack $ CI.original ciphertext = do
        smid <- decrypt cID
        (tid,ssh,csh,shn) <- runDB $ do
          shid <- submissionSheet <$> get404 smid
          Sheet{..}  <- get404 shid
          Course{..} <- get404 sheetCourse
          return (courseTerm, courseSchool, courseShorthand, sheetName)
        return $ CSubmissionR tid ssh csh shn cID SubShowR
    | otherwise = notFound

instance CryptoRoute UUID UserId where
  cryptoIDRoute _ (CryptoID -> cID) = do
    (_ :: UserId) <- decrypt cID
    return $ AdminUserR cID

class Dispatch ciphertext (x :: [*]) where
  dispatchID :: p x -> ciphertext -> Handler (Maybe (Route UniWorX))

instance Dispatch ciphertext '[] where
  dispatchID _ _ = return Nothing

instance (CryptoRoute ciphertext plaintext, Dispatch ciphertext ps) => Dispatch ciphertext (plaintext ': ps) where
  dispatchID _ ciphertext = (<|>) <$> dispatchHead <*> dispatchTail
    where
      dispatchHead = (Just <$> cryptoIDRoute (Proxy :: Proxy plaintext) ciphertext) `catches` [ E.Handler handleHCError, E.Handler handleCryptoID ]
        where
          handleHCError :: HandlerContents -> Handler (Maybe a)
          handleHCError (HCError NotFound) = return Nothing
          handleHCError e = throwM e
          handleCryptoID :: CryptoIDError -> Handler (Maybe a)
          handleCryptoID _ = return Nothing
      dispatchTail = dispatchID (Proxy :: Proxy ps) ciphertext
  

getCryptoUUIDDispatchR :: UUID -> Handler ()
getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
  where
    p :: Proxy '[ SubmissionId
                , UserId
                ]
    p = Proxy

getCryptoFileNameDispatchR :: CI FilePath -> Handler ()
getCryptoFileNameDispatchR path = dispatchID p path >>= maybe notFound (redirectWith found302)
  where
    p :: Proxy '[ SubmissionId ] 
    p = Proxy