src/Gargantext/Database/Action/Node.hs

   1 {-|
   2 Module      : Gargantext.Database.Action.Node
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE ConstraintKinds        #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE TemplateHaskell        #-}
  18 {-# LANGUAGE TypeFamilies           #-}
  19
  20 module Gargantext.Database.Action.Node
  21   where
  22
  23 import Gargantext.Core.Types (Name)
  24 import Gargantext.Database.Admin.Types.Hyperdata
  25 import Gargantext.Database.Admin.Types.Node
  26 import Gargantext.Database.Prelude (Cmd)
  27 import Gargantext.Database.Query.Table.Node
  28 import Gargantext.Database.Query.Table.Node.Error
  29 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  30 import Gargantext.Viz.Graph (defaultHyperdataGraph)
  31 import Gargantext.Prelude
  32 import Gargantext.Prelude.Utils (sha)
  33 import Gargantext.Database.Prelude
  34 import Control.Lens (view)
  35 import Gargantext.Config (GargConfig(..))
  36
  37 ------------------------------------------------------------------------
  38 -- | TODO mk all others nodes
  39 mkNodeWithParent :: (HasNodeError err)
  40                  => NodeType
  41                  -> Maybe ParentId
  42                  -> UserId
  43                  -> Name
  44                  -> Cmd err [NodeId]
  45 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
  46
  47 ------------------------------------------------------------------------
  48 mkNodeWithParent NodeUser Nothing uId name =
  49   insertNodesWithParentR Nothing [node NodeUser name defaultHyperdataUser Nothing uId]
  50
  51 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
  52 ------------------------------------------------------------------------
  53 mkNodeWithParent NodeFolder (Just i) uId name =
  54    insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
  55     where
  56       hd = defaultHyperdataFolder
  57
  58 mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
  59    insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
  60     where
  61       hd = defaultHyperdataFolder
  62
  63 mkNodeWithParent NodeFolderShared (Just i) uId _ =
  64    insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
  65     where
  66       hd = defaultHyperdataFolder
  67
  68 mkNodeWithParent NodeFolderPublic (Just i) uId _ =
  69    insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
  70     where
  71       hd = defaultHyperdataFolder
  72
  73 mkNodeWithParent NodeTeam (Just i) uId name =
  74    insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
  75     where
  76       hd = defaultHyperdataFolder
  77 ------------------------------------------------------------------------
  78 mkNodeWithParent NodeCorpus (Just i) uId name =
  79    insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
  80     where
  81       hd = defaultHyperdataCorpus
  82
  83 mkNodeWithParent NodeAnnuaire (Just i) uId name =
  84    insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
  85     where
  86       hd = defaultHyperdataAnnuaire
  87
  88 mkNodeWithParent NodeList (Just i) uId name =
  89    insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
  90     where
  91       hd = defaultHyperdataAnnuaire
  92
  93 mkNodeWithParent NodeGraph (Just i) uId name =
  94    insertNodesWithParentR (Just i) [node NodeGraph name hd Nothing uId]
  95     where
  96       hd = defaultHyperdataGraph
  97
  98 mkNodeWithParent NodeFrameWrite i u n =
  99   mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
 100
 101 mkNodeWithParent NodeFrameCalc i u n =
 102   mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
 103
 104 {-
 105 mkNodeWithParent n (Just i) uId name =
 106    insertNodesWithParentR (Just i) [node NodeDashboard name (hasDefaultData n) Nothing uId]
 107 -}
 108
 109 mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 110
 111
 112 -- | Sugar to create a node, get his NodeId and update his Hyperdata after
 113 mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err)
 114                                     => NodeType
 115                                     -> Maybe ParentId
 116                                     -> UserId
 117                                     -> Name
 118                                     -> Cmd err [NodeId]
 119 mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
 120   mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
 121
 122 mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
 123   mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
 124
 125 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 126
 127
 128 -- | Function not exposed
 129 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err)
 130                                     => NodeType
 131                                     -> Maybe ParentId
 132                                     -> UserId
 133                                     -> Name
 134                                     -> Cmd err [NodeId]
 135 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
 136   maybeNodeId <- case nt of
 137      NodeFrameWrite -> insertNode NodeFrameWrite (Just name) Nothing i uId
 138      NodeFrameCalc  -> insertNode NodeFrameCalc  (Just name) Nothing i uId
 139      _              -> nodeError NeedsConfiguration
 140
 141   case maybeNodeId of
 142     []  -> nodeError (DoesNotExist i)
 143     [n] -> do
 144       config <- view hasConfig
 145       u <- case nt of
 146             NodeFrameWrite -> pure $ _gc_frame_write_url config
 147             NodeFrameCalc  -> pure $ _gc_frame_calc_url  config
 148             _              -> nodeError NeedsConfiguration
 149       let
 150         s = _gc_secretkey config
 151         hd = HyperdataFrame u (sha $ s <> (cs $ show n))
 152       _ <- updateHyperdata n hd
 153       pure [n]
 154     (_:_:_)  -> nodeError MkNode
 155 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 156