{-# LANGUAGE NoImplicitPrelude
           , DataKinds
           , KindSignatures
           , TypeFamilies
           , FlexibleInstances
           , TypeOperators
           , RankNTypes
           , PolyKinds
           , RecordWildCards
           , MultiParamTypeClasses
           , ScopedTypeVariables
           , ViewPatterns
  #-}

module Handler.CryptoIDDispatch
  ( getCryptoUUIDDispatchR
  ) where

import Import hiding (Proxy)

import Data.Proxy

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

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


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

instance CryptoRoute UUID SubmissionId where
  cryptoIDRoute _ (CryptoID -> cID) = do
    (_ :: SubmissionId) <- decrypt cID
    
    return $ SubmissionR 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
                ]
    p = Proxy