{--| Prelude module for our API specs, with utility functions to get us started quickly. -}

module Test.API.Prelude
  ( newCorpusForUser
  , newPrivateFolderForUser
  , newPublicFolderForUser
  , newShareFolderForUser
  , newFolderForUser
  , addFolderForUser
  , getRootPublicFolderIdForUser
  , getRootPrivateFolderIdForUser
  , getRootShareFolderIdForUser
  , newTeamWithOwner
  , myUserNodeId
  , checkEither
  , shouldFailWith

  -- User fixtures
  , alice
  , bob
  ) where

import Data.Aeson qualified as JSON
import Data.Text qualified as T
import Gargantext.API.Errors
import Gargantext.Core.Types.Individu
import Gargantext.Core.Types (NodeId, NodeType(..), ParentId)
import Gargantext.Core.Worker.Env ()  -- instance HasNodeError
import Gargantext.Database.Action.User
import Gargantext.Database.Admin.Types.Hyperdata.Corpus
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (insertNode, mk, getUserRootPublicNode, getUserRootPrivateNode, getUserRootShareNode)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.User (getUserByName)
import Gargantext.Database.Query.Tree.Root
import Gargantext.Database.Schema.Node (_node_id)
import Gargantext.Prelude hiding (get)
import Prelude (fail)
import Servant.Client.Core
import Test.Database.Types
import Test.Tasty.HUnit (Assertion, (@?=))

checkEither :: (Show a, Monad m) => m (Either a b) -> m b
checkEither = fmap (either (\x -> panicTrace $ "checkEither:" <> T.pack (show x)) identity)

newCorpusForUser :: TestEnv -> T.Text -> IO NodeId
newCorpusForUser env uname = runTestMonad env $ runDBTx $ do
  uid      <- getUserId (UserName uname)
  parentId <- getRootId (UserName uname)
  let corpusName = "Test_Corpus"
  xs <- mk (Just corpusName) (Nothing :: Maybe HyperdataCorpus) parentId uid
  case xs of
    [corpusId] -> pure corpusId
    _          -> panicTrace $ "impossible: " <> show xs

-- | Creates a new folder for the input user, nested under the given 'ParentId', if given.
newFolderForUser' :: HasNodeError err
                  => User
                  -> T.Text
                  -> ParentId
                  -> DBUpdate err NodeId
newFolderForUser' ur folderName parentId = do
  uid      <- getUserId ur
  insertNode NodeFolder (Just folderName) Nothing parentId uid

addFolderForUser :: TestEnv
                 -> User
                 -> T.Text
                 -> ParentId
                 -> IO NodeId
addFolderForUser env ur folderName parentId = runTestMonad env $ runDBTx $ do
  newFolderForUser' ur folderName parentId

newFolderForUser :: TestEnv -> User -> T.Text -> IO NodeId
newFolderForUser env uname folderName = runTestMonad env $ runDBTx $ do
  parentId <- getRootId uname
  newFolderForUser' uname folderName parentId

-- | Generate a 'Node' where we can append more data into, a bit reminiscent to the
-- \"Private\" root node we use in the real Gargantext.
newPrivateFolderForUser :: TestEnv -> User -> IO NodeId
newPrivateFolderForUser env ur = newFolder env ur NodeFolderPrivate

newPublicFolderForUser :: TestEnv -> User -> IO NodeId
newPublicFolderForUser env ur = newFolder env ur NodeFolderPublic

newShareFolderForUser :: TestEnv -> User -> IO NodeId
newShareFolderForUser env ur = newFolder env ur NodeFolderShared

newFolder :: TestEnv -> User -> NodeType -> IO NodeId
newFolder env ur nt = runTestMonad env $ runDBTx $ do
  let nodeName = show nt
  uid      <- getUserId ur
  parentId <- getRootId ur
  insertNode nt (Just nodeName) Nothing parentId uid

getRootPublicFolderIdForUser :: TestEnv -> User -> IO NodeId
getRootPublicFolderIdForUser env uname = runTestMonad env $ runDBQuery $ do
  _node_id <$> (getUserId uname >>= getUserRootPublicNode)

getRootPrivateFolderIdForUser :: TestEnv -> User -> IO NodeId
getRootPrivateFolderIdForUser env uname = runTestMonad env $ runDBQuery $ do
  _node_id <$> (getUserId uname >>= getUserRootPrivateNode)

getRootShareFolderIdForUser :: TestEnv -> User -> IO NodeId
getRootShareFolderIdForUser env uname = runTestMonad env $ runDBQuery $
  getRootShareFolderIdForUserTx uname

getRootShareFolderIdForUserTx :: User -> DBQuery BackendInternalError x NodeId
getRootShareFolderIdForUserTx uname = do
  _node_id <$> (getUserId uname >>= getUserRootShareNode)

newTeamWithOwner :: TestEnv -> User -> T.Text -> IO NodeId
newTeamWithOwner env uname teamName = runTestMonad env $ runDBTx $ do
  uid      <- getUserId uname
  parentId <- getRootShareFolderIdForUserTx uname
  insertNode NodeTeam (Just teamName) Nothing parentId uid

myUserNodeId :: TestEnv -> T.Text -> IO NodeId
myUserNodeId env uname = runTestMonad env $ do
  _node_id <$> runDBQuery (getUserByName uname)

shouldFailWith :: Show a => Either ClientError a -> BackendErrorCode -> Assertion
action `shouldFailWith` backendError = case action of
  Right{} -> fail "Expected action to fail, but it didn't."
  Left fr@(FailureResponse _req res)
    | Right FrontendError{..} <- JSON.eitherDecode (responseBody res)
    -> fe_type @?= backendError
    | otherwise
    -> fail $ "FailureResponse didn't have FrontendError: " <> show fr
  _xs -> fail $ "Unexpected ClientError: " <> show _xs

alice :: User
alice = UserName "alice"

bob :: User
bob = UserName "bob"
