-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Admin.Test
  ( getAdminTestR
  , postAdminTestR
  , getAdminTestPdfR
  ) where

import Import
import Utils.Print

import Handler.Utils
import Jobs

import Data.Ratio ((%))
import Data.Char (isDigit)
import qualified Data.Text as Text
-- import qualified Data.Text.IO as Text
import qualified Data.ByteString.Lazy as LBS

import qualified Data.Set as Set
import qualified Data.Map as Map

-- just to test i18nHamlet
import Text.Hamlet
-- import Handler.Utils.I18n

import Handler.Admin.Test.Download (testDownload)
import qualified Database.Esqueleto.Experimental as E (selectOne, unValue)
import qualified Database.Esqueleto.PostgreSQL as E  (now_)
import qualified Database.Esqueleto.Utils as E (psqlVersion_)

{-# ANN module ("HLint: ignore Functor law" :: String) #-}

-- BEGIN - Buttons needed only here
data ButtonCreate = CreateMath | CreateInf | CrashApp -- Dummy for Example
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic)
instance Universe ButtonCreate
instance Finite ButtonCreate

nullaryPathPiece ''ButtonCreate camelToPathPiece

instance Button UniWorX ButtonCreate where
  btnLabel CreateMath = [whamlet|Ma<i>thema</i>tik|]
  btnLabel CreateInf  = "Informatik"
  btnLabel CrashApp   = "Crash Application"

  btnClasses CreateMath = [BCIsButton, BCInfo]
  btnClasses CreateInf  = [BCIsButton, BCPrimary]
  btnClasses CrashApp   = [BCIsButton, BCDanger]
-- END Button needed only here

emailTestForm :: AForm (HandlerFor UniWorX) (Email, MailContext)
emailTestForm = (,)
            <$> areq emailField (fslI MsgMailTestFormEmail) Nothing
            <*> ( MailContext
                  <$> (Languages <$> areq (reorderField appLanguagesOpts) (fslI MsgMailTestFormLanguages) Nothing)
                  <*> (toMailDateTimeFormat
                        <$> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) Nothing
                        <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) Nothing
                        <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) Nothing
                      )
                  <*> pure def
                )
  where
    toMailDateTimeFormat dt d t = \case
      SelFormatDateTime -> dt
      SelFormatDate -> d
      SelFormatTime -> t

makeDemoForm :: Int -> Form (Int,Bool,Double)
makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do
    (result, widget) <- flip (renderAForm FormStandard) html $ (,,)
        <$> areq (minIntFieldI n ("Zahl" :: Text)) (fromString $ "Ganzzahl > " ++ show n) Nothing
        <*  aformSection MsgFormBehaviour
        <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
        <*> areq doubleField "Fliesskommazahl" Nothing
        -- NO LONGER DESIRED IN AFORMS:
        -- <*  submitButton
    return $ case result of
      FormSuccess fsres
        | errorMsgs <- validateResult fsres
        , not $ null errorMsgs -> (FormFailure errorMsgs, widget)
      _otherwise -> (result, widget)
  where
    validateResult :: (Int,Bool,Double) -> [Text]
    validateResult (i,True,d) | fromIntegral i >= d = [tshow d <> " ist nicht größer als " <> tshow i, "Zweite Fehlermeldung", "Dritte Fehlermeldung"]
    validateResult _other = []


getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden!
getAdminTestR = postAdminTestR
postAdminTestR = do
  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonCreate)
  let btnForm = wrapForm btnWdgt def
        { formAction = Just $ SomeRoute AdminTestR
        , formEncoding = btnEnctype
        , formSubmit = FormNoSubmit
        }
  case btnResult of
    (FormSuccess CreateInf)  -> addMessage Info "Informatik-Knopf gedrückt"
    (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt"
    (FormSuccess CrashApp)   -> addMessage Error "Crash Button Ratio 0 betätigt" >> error ("Crash Button" <> show (1 % 0))
    FormMissing -> return ()
    _other -> addMessage Warning "KEIN Knopf erkannt"

  ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm ("email" :: Text) $ renderAForm FormStandard emailTestForm
  formResultModal emailResult AdminTestR $ \(email, ls) -> do
    mapWriterT runDBJobs $ do
      lift . queueDBJob $ JobSendTestEmail email ls
      tell . pure $ Message Success [shamlet|Email-test gestartet|] (Just IconEmail)
    addMessage Warning [shamlet|Inkorrekt ausgegebener Alert|] -- For testing alert handling when short circuiting; for proper (not fallback-solution) handling always use `tell` within `formResultModal`

  let emailWidget' = wrapForm emailWidget def
        { formAction = Just . SomeRoute $ AdminTestR
        , formEncoding = emailEnctype
        , formAttrs = [asyncSubmitAttr] -- equivalent to [("uw-async-form", "")]
        }

  now <- liftIO getCurrentTime
  $logInfoS "TEST" $ "Admin Test Page was retrieved at " <> tshow now <> "." -- to ensure that we can read the right log.

  let demoFormAction (_i,_b,_d) = addMessage Info "All ok."
  ((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7
  formResult demoResult demoFormAction
  let showDemoResult = [whamlet|
          $maybe (i,b,d) <- formResult' demoResult
            Received values:
              <ul>
                <li>#{show i}
                <li>#{show b}
                <li>#{show d}
          $nothing
            No form values received, due to #
            $# Using formResult' above means that we usually to not distinguish the following two cases here, sind formResult does this already:
            $case demoResult
              $of FormSuccess _
                $# Already dealt with above, to showecase usage of formResult' as normally done.
                success, which should not happen here.
              $of FormMissing
                Form data missing, probably empty.
              $of FormFailure msgs
                <ul>
                  $forall m <- msgs
                    <li>#{m}
        |]
  let testTooltipMsg = toWidget [whamlet| So sehen aktuell Tooltips via iconTooltip aus. |] :: WidgetFor UniWorX ()

  msgInfoTooltip    <- messageI Info ("Info-Tooltip via messageI" :: Text)
  msgSuccessTooltip <- messageI Success ("Success-Tooltip via messageI" :: Text)
  msgWarningTooltip <- messageI Warning ("Warning-Tooltip via messageI" :: Text)
  msgErrorTooltip   <- messageI Error ("Error-Tooltip via messageI" :: Text)

  msgNonDefaultIconTooltip <- messageIconI Info IconEmail ("Info-Tooltip mit lustigem Icon" :: Text)

  {- The following demonstrates the use of @massInput@.

     @massInput@ takes as arguments:
       - A configuration struct describing how the Widget should behave (how is the space of sub-forms structured, how many dimensions does it have, which additions/deletions are permitted, what data do they need to operate and what should their effect on the overall shape be?)
       - Information on how the resulting field fits into the form as a whole (@FieldSettings@ and whether the @massInput@ should be marked required)
       - An initial value to pre-fill the field with

     @massInput@ then returns an @MForm@ structured for easy downstream consumption of the result
   -}
  let
    -- We define the fields of the configuration struct @MassInput@:

    -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
    --
    -- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required)
    mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
              -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
              -> ListLength -- ^ Previous shape of massinput
              -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
              -> FieldView UniWorX -- ^ Submit-Button for this add-widget
              -> Maybe (Form (Map ListPosition Int -> FormResult (Map ListPosition Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cells and data needed to initialize cells
    mkAddForm 0 0 liveliness nudge submitBtn = guardOn (allowAdd 0 0 liveliness) $ \csrf -> do
      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
          addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data
      return (addRes'', toWidget csrf >> fvWidget addView >> fvWidget submitBtn)
    mkAddForm _pos _dim _ _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"

    -- | Make a single massInput-Cell
    --
    -- This /needs/ to use @nudge@ and deterministic field naming (this allows for correct value-shifting when cells are deleted)
    mkCellForm :: ListPosition -- ^ Position of this cell
               -> Int -- ^ Data needed to initialize the cell (see return of @mkAddForm@)
               -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
               -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
               -> Form Int
    mkCellForm _pos cData initial nudge csrf = do -- Extremely simple cell
      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ initial <|> Just cData
      return (intRes, toWidget csrf >> fvWidget intView)
    -- | How does the shape (`ListLength`) change if a certain cell is deleted?
    deleteCell :: Map ListPosition Int -- ^ Current shape, including initialisation data
               -> ListPosition -- ^ Coordinate to delete
               -> MaybeT (MForm (HandlerFor UniWorX)) (Map ListPosition ListPosition) -- ^ Monadically compute a set of new positions and their associated old positions
    deleteCell = miDeleteList
    -- | Make a decision on whether an add widget should be allowed to further cells, given the current @liveliness@ (i.e. before performing the addition)
    allowAdd :: ListPosition -> Natural -> ListLength -> Bool
    allowAdd _ _ l = l < 7 -- Limit list length; much more complicated checks are possible (this could in principle be monadic, but @massInput@ is probably already complicated enough to cover just current (2019-03) usecases)
    -- | Where to send the user when they click a shape-changing button, given the id of the Wrapper of the `massInput`-`Widget`
    buttonAction :: PathPiece p => p -> Maybe (SomeRoute UniWorX)
    buttonAction frag = Just . SomeRoute $ AdminTestR :#: frag

  -- The actual call to @massInput@ is comparatively simple:

  ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing

  ((i18nResult, fvWidget -> i18nWidget), i18nEnc) <- runFormPost . identifyForm ("i18n-stored-markup" :: Text) $ i18nField htmlField True (\_ -> Nothing) ("i18n-stored-markup" :: Text) "" True Nothing

  testDownloadWidget <- testDownload

  testHamlet1 <- withUrlRenderer $(hamletFile "templates/i18n/test/en-eu.hamlet")
  --let testHamlet2 = $(i18nHamletFile "test")
  let testHamlet2 = testHamlet1
      btnModalText = [whamlet|<button type="button" class=#{unwords $ map toPathPiece [BCIsButton, BCDanger]}>
                                Button-Modal
                     |]

      mkCryptoFilnameUser :: UserId -> Handler CryptoFileNameUser
      mkCryptoFilnameUser = encrypt
      mkCryptoUUIDUser :: UserId -> Handler CryptoUUIDUser
      mkCryptoUUIDUser = encrypt
  usrCryptoFileName <- maybeM (return "no-user_id") (fmap toPathPiece . mkCryptoFilnameUser) maybeAuthId
  usrCryptoUUID     <- maybeM (return "no-user_id") (fmap toPathPiece . mkCryptoUUIDUser)    maybeAuthId

  UniWorX{ appSettings' = AppSettings{..} } <- getYesod

  psqlVersion <- runDBRead $ E.selectOne $ return E.psqlVersion_
  dbTime      <- runDBRead $ E.selectOne $ return E.now_

  let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
  siteLayout locallyDefinedPageHeading $ do
  -- defaultLayout $ do
    setTitle "Uni2work Admin Testpage"

    $(i18nWidgetFile "admin-test")

    [whamlet|
      <h2>User CryptoId and CryptoFileName
      <dl>
        <dt>CryptoUUIDUser
        <dd>#{usrCryptoUUID}
        <dt>CryptoFileNameUser
        <dd>#{usrCryptoFileName}
    |]

    [whamlet|<h2>Formular Demonstration|]
    wrapForm formWidget FormSettings
      { formMethod   = POST
      , formAction   = Just . SomeRoute $ AdminTestR :#: FIDAdminDemo
      , formEncoding = formEnctype
      , formAttrs    = []
      , formSubmit   = FormSubmit
      , formAnchor   = Just FIDAdminDemo
      }
    showDemoResult

    miIdent <- newIdent
    let miForm' = wrapForm miForm FormSettings
          { formMethod   = POST
          , formAction   = Just . SomeRoute $ AdminTestR :#: miIdent
          , formEncoding = miEnc
          , formAttrs    = []
          , formSubmit   = FormSubmit
          , formAnchor   = Just miIdent
          }
    [whamlet|
      <h2>Mass-Input
      ^{miForm'}
      $case miResult
        $of FormMissing
        $of FormFailure errs
          <ul>
            $forall err <- errs
              <li>#{err}
        $of FormSuccess res
          <p style="white-space:pre-wrap; font-family:var(--font-monospace);">
            #{tshow res}
    |]

    i18nIdent <- newIdent
    let i18nForm' = wrapForm i18nWidget FormSettings
          { formMethod   = POST
          , formAction   = Just . SomeRoute $ AdminTestR :#: i18nIdent
          , formEncoding = i18nEnc
          , formAttrs    = []
          , formSubmit   = FormSubmit
          , formAnchor   = Just i18nIdent
          }
    [whamlet|
      <h2>I18n-Form
      ^{i18nForm'}
      $case i18nResult
        $of FormMissing
        $of FormFailure errs
          <ul>
            $forall err <- errs
              <li>#{err}
        $of FormSuccess res
          <pre .json>
            #{toYAML res}
    |]

    [whamlet|
       <section>
         <h2>_{MsgTestDownload}
         ^{testDownloadWidget}
    |]

    [whamlet|
      <section>
        <h2>Test i18nHamlet 1
        #{testHamlet1}
      <section>
        <h2>Test i18nHamlet 2
        #{testHamlet2}
    |]
    i18n $ MsgPrintDebugForStupid "DebugForStupid"

    [whamlet|
      <section>
        <h2> Some Active App Settings
        <dl .deflist>
          <dt .deflist__dt>        appJobCronInterval
          <dd .deflist__dd>#{tshow appJobCronInterval}
          <dt .deflist__dt>        appSynchroniseLdapUsersWithin
          <dd .deflist__dd>#{tshow appSynchroniseLdapUsersWithin}
          <dt .deflist__dt>        appSynchroniseAvsUsersWithin
          <dd .deflist__dd>#{tshow appSynchroniseAvsUsersWithin}
    |]

    [whamlet|
      <section>
        <h2> PostgreSQL Information
        <dl .deflist>
          $maybe pver <- psqlVersion
            <dt .deflist__dt>DB Version
            <dd .deflist__dd>#{E.unValue pver}
          $maybe ptme <- dbTime
            <dt .deflist__dt>DB Time
            <dd .deflist__dd>#{tshow (E.unValue ptme)}
    |]



getAdminTestPdfR :: Handler TypedContent
getAdminTestPdfR = do
  usr  <- requireAuth -- to determine language and recipient for test
  qual <- fromMaybeM
            (addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR)
            (runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand])
  encRecipient :: CryptoUUIDUser <- encrypt $ usr ^. _entityKey
  now <- liftIO getCurrentTime
  let nowaday = utctDay now
      letter  = LetterRenewQualification
        { lmsLogin      = LmsIdent "abcdefgh"
        , lmsPin        = "12345678"
        , qualHolderID  = usr ^. _entityKey
        , qualHolderDN  = usr ^. _userDisplayName
        , qualHolderSN  = usr ^. _userSurname
        , qualExpiry    = succ nowaday
        , qualId        = qual ^. _entityKey
        , qualName      = qual ^. _qualificationName      . _CI
        , qualShort     = qual ^. _qualificationShorthand . _CI
        , qualSchool    = qual ^. _qualificationSchool
        , qualDuration  = qual ^. _qualificationValidDuration
        , qualRenewAuto = qual ^. _qualificationElearningRenews
        , qualELimit    = qual ^. _qualificationElearningLimit
        , isReminder    = False
        }
  apcIdent <- letterApcIdent letter encRecipient now
  renderLetterPDF usr letter apcIdent Nothing >>= \case
    Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
    Right pdf -> do
      liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
      encryptPDF "tomatenmarmelade" pdf >>= \case
        Left err      -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
        Right encPdf  -> do
          liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
          sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now