-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Admin.Avs
  ( getAdminAvsR
  , postAdminAvsR
  ) where

import Import
import qualified Control.Monad.State.Class as State
-- import Data.Aeson (encode)
import qualified Data.Text as Text
import qualified Data.Set  as Set

import Handler.Utils
import Handler.Utils.Avs

import Utils.Avs

-- Button needed only here
data ButtonAvsTest = BtnCheckLicences
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAvsTest
instance Finite ButtonAvsTest

nullaryPathPiece ''ButtonAvsTest camelToPathPiece

instance Button UniWorX ButtonAvsTest where
  btnLabel    BtnCheckLicences = "Check all licences" -- could be msg
  btnClasses  BtnCheckLicences = [BCIsButton, BCPrimary]
-- END Button


avsCardNoField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m AvsCardNo
avsCardNoField = convertField AvsCardNo avsCardNo textField

makeAvsPersonForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson
makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html ->
  flip (renderAForm FormStandard) html $ AvsQueryPerson
    <$> aopt avsCardNoField (fslI MsgAvsCardNo)             (avsPersonQueryCardNo              <$> tmpl)
    <*> aopt textField      (fslI MsgAvsVersionNo)          (avsPersonQueryVersionNo           <$> tmpl)
    <*> aopt textField      (fslI MsgAvsFirstName)          (avsPersonQueryFirstName           <$> tmpl)
    <*> aopt textField      (fslI MsgAvsLastName)           (avsPersonQueryLastName            <$> tmpl)
    <*> aopt textField      (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo  <$> tmpl)
    

validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler ()
validateAvsQueryPerson = do
  AvsQueryPerson{..} <- State.get
  guardValidation MsgAvsQueryEmpty $
    is _Just avsPersonQueryCardNo             ||
    is _Just avsPersonQueryFirstName          ||
    is _Just avsPersonQueryLastName           ||
    is _Just avsPersonQueryInternalPersonalNo ||
    is _Just avsPersonQueryVersionNo

makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html ->
  flip (renderAForm FormStandard) html $
     parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl)
  where
    parseAvsIds :: Text -> AvsQueryStatus
    parseAvsIds txt = AvsQueryStatus $ Set.fromList ids
      where
        nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt
        ids = catMaybes $ readMay <$> nonemptys
    unparseAvsIds :: AvsQueryStatus -> Text
    unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids

validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler ()
validateAvsQueryStatus = do
  AvsQueryStatus ids <- State.get
  guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids)


avsLicenceOptions :: OptionList AvsLicence
avsLicenceOptions = mkOptionList
  [ Option
    { optionDisplay       = Text.singleton $ licence2char l
    , optionInternalValue = l
    , optionExternalValue = toJsonText l
    }
  | l <- universeF
  ]

getAdminAvsR,  postAdminAvsR :: Handler Html
getAdminAvsR = postAdminAvsR
postAdminAvsR = do
  mAvsQuery <- getsYesod $ view _appAvsQuery
  case mAvsQuery of
    Nothing -> return mempty
    Just AvsQuery{..} -> do
      ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing

      let procFormPerson fr = do
            addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
            res <- avsQueryPerson fr
            case res of
              Left  err -> return . Just $ tshow err
              Right jsn -> return . Just $ tshow jsn
      mbPerson <- formResultMaybe presult procFormPerson

      ((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
      let procFormStatus fr = do
            addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
            res <- avsQueryStatus fr
            case res of
              Left err -> return . Just $ tshow err
              Right jsn -> return . Just $ tshow jsn
      mbStatus <- formResultMaybe sresult procFormStatus

      ((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html ->
        flip (renderAForm FormStandard) html $ areq textField (fslI MsgAvsCardNo) Nothing
      let procFormCrUsr fr = do
            addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
            res <- try $ upsertAvsUser fr
            case res of
              (Right (Just uid)) -> do
                uuid :: CryptoUUIDUser <- encrypt uid
                return $ Just [whamlet|<h2>Success:</h2> <a href=@{ForProfileR uuid}>User created or updated.|]
              (Right Nothing) ->
                return $ Just [whamlet|<h2>Warning:</h2> No user found.|]
              (Left e) -> do
                let msg = tshow (e :: SomeException)
                return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
      mbCrUser <- formResultMaybe crUsrRes procFormCrUsr

      ((getLicRes, getLicWgt), getLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicence $ \html ->
        flip (renderAForm FormStandard) html $ areq intField (fslI MsgAvsPersonId) Nothing
      let procFormGetLic fr = do
            addMessage Info $ text2Html $ "Query: " <> tshow (toJSON (AvsPersonId fr))
            res <- try $ getLicenceByAvsId $ AvsPersonId fr
            case res of
              (Right (Just lic)) ->
                return $ Just [whamlet|<h2>Success:</h2> Licence #{tshow lic}|]
              (Right Nothing) ->
                return $ Just [whamlet|<h2>Warning:</h2> User not found.|]
              (Left e) -> do
                let msg = tshow (e :: SomeException)
                return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
      mbGetLic <- formResultMaybe getLicRes procFormGetLic

      ((setLicRes, setLicWgt), setLicEnctype) <- runFormPost $ identifyForm FIDAvsSetLicence $ \html ->
        flip (renderAForm FormStandard) html $ (,) <$> areq intField (fslI MsgAvsPersonId) Nothing
                                                   <*> areq (selectField $ return avsLicenceOptions) (fslI MsgAvsLicence) (Just AvsLicenceVorfeld)
      let procFormSetLic (aid, lic) = do
            res <- try $ setLicenceAvs (AvsPersonId aid) lic
            case res of
              (Right True) ->
                return $ Just [whamlet|<h2>Success:</h2> Licence #{tshow (licence2char lic)} set for #{tshow aid}.|]
              (Right False) ->
                return $ Just [whamlet|<h2>Error:</h2> Licence could not be set for #{tshow aid}.|]
              (Left e) -> do
                let msg = tshow (e :: SomeException)
                return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
      mbSetLic <- formResultMaybe setLicRes procFormSetLic


      ((qryLicRes, qryLicWgt), qryLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicenceDiffs (buttonForm :: Form ButtonAvsTest)
      let procFormQryLic BtnCheckLicences = do
            res <- try checkLicences
            case res of
              (Right True) ->
                return $ Just [whamlet|<h2>Success:</h2> Licences sychronized.|]
              (Right False) ->
                return $ Just [whamlet|<h2>Error:</h2> Licences could not be synchronized, see error log.|]
              (Left e) -> do
                let msg = tshow (e :: SomeException)
                return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
      mbQryLic <- formResultMaybe qryLicRes procFormQryLic

      actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
      siteLayoutMsg MsgMenuAvs $ do
        setTitleI MsgMenuAvs
        let wrapFormHere fw fe = wrapForm fw def { formAction = Just $ SomeRoute actionUrl, formEncoding = fe }
            personForm = wrapFormHere pwidget  penctype
            statusForm = wrapFormHere swidget  senctype
            crUsrForm  = wrapFormHere crUsrWgt crUsrEnctype
            getLicForm = wrapFormHere getLicWgt getLicEnctype
            setLicForm = wrapFormHere setLicWgt setLicEnctype
            qryLicForm = wrapForm     qryLicWgt def { formAction = Just $ SomeRoute actionUrl, formEncoding = qryLicEnctype, formSubmit = FormNoSubmit }
        -- TODO: use i18nWidgetFile instead if this is to become permanent
        $(widgetFile "avs")