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.User
  30 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  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 fake_HyperdataUser 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 = defaultFolder
  57
  58 mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
  59    insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
  60     where
  61       hd = defaultFolder
  62
  63 mkNodeWithParent NodeFolderShared (Just i) uId _ =
  64    insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
  65     where
  66       hd = defaultFolder
  67
  68 mkNodeWithParent NodeFolderPublic (Just i) uId _ =
  69    insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
  70     where
  71       hd = defaultFolder
  72
  73 mkNodeWithParent NodeTeam (Just i) uId name =
  74    insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
  75     where
  76       hd = defaultFolder
  77 ------------------------------------------------------------------------
  78 mkNodeWithParent NodeCorpus (Just i) uId name =
  79    insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
  80     where
  81       hd = defaultCorpus
  82
  83 mkNodeWithParent NodeAnnuaire (Just i) uId name =
  84    insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
  85     where
  86       hd = defaultAnnuaire
  87
  88 mkNodeWithParent NodeList (Just i) uId name =
  89    insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
  90     where
  91       hd = defaultAnnuaire
  92
  93 mkNodeWithParent NodeGraph (Just i) uId name =
  94    insertNodesWithParentR (Just i) [node NodeGraph name hd Nothing uId]
  95     where
  96       hd = arbitraryGraph
  97
  98 mkNodeWithParent NodeDashboard (Just i) uId name =
  99    insertNodesWithParentR (Just i) [node NodeDashboard name hd Nothing uId]
 100     where
 101       hd = arbitraryDashboard
 102
 103
 104
 105 mkNodeWithParent NodeFrameWrite i u n =
 106   mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
 107
 108 mkNodeWithParent NodeFrameCalc i u n =
 109   mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
 110
 111 mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 112
 113
 114 -- | Sugar to create a node, get his NodeId and update his Hyperdata after
 115 mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err)
 116                                     => NodeType
 117                                     -> Maybe ParentId
 118                                     -> UserId
 119                                     -> Name
 120                                     -> Cmd err [NodeId]
 121 mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
 122   mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
 123
 124 mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
 125   mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
 126
 127 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 128
 129
 130 -- | Function not exposed
 131 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err)
 132                                     => NodeType
 133                                     -> Maybe ParentId
 134                                     -> UserId
 135                                     -> Name
 136                                     -> Cmd err [NodeId]
 137 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
 138   maybeNodeId <- insertNodesWithParentR (Just i) [node nt name defaultFolder Nothing uId]
 139   case maybeNodeId of
 140     []  -> nodeError (DoesNotExist i)
 141     [n] -> do
 142       config <- view hasConfig
 143       u <- case nt of
 144             NodeFrameWrite -> pure $ _gc_frame_write_url config
 145             NodeFrameCalc  -> pure $ _gc_frame_calc_url config
 146             _              -> nodeError NeedsConfiguration
 147       let
 148         s = _gc_secretkey config
 149         hd = HyperdataFrame u (sha $ s <> (cs $ show n))
 150       _ <- updateHyperdata n hd
 151       pure [n]
 152     (_:_:_)  -> nodeError MkNode
 153 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 154
 155
 156
 157