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 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 mkNodeWithParent n (Just i) uId name =
 105    insertNodesWithParentR (Just i) [node NodeDashboard name (hasDefaultData n) Nothing uId]
 106
 107 -- mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 108
 109
 110 -- | Sugar to create a node, get his NodeId and update his Hyperdata after
 111 mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err)
 112                                     => NodeType
 113                                     -> Maybe ParentId
 114                                     -> UserId
 115                                     -> Name
 116                                     -> Cmd err [NodeId]
 117 mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
 118   mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
 119
 120 mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
 121   mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
 122
 123 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 124
 125
 126 -- | Function not exposed
 127 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err)
 128                                     => NodeType
 129                                     -> Maybe ParentId
 130                                     -> UserId
 131                                     -> Name
 132                                     -> Cmd err [NodeId]
 133 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
 134   maybeNodeId <- insertNodesWithParentR (Just i) [node nt name defaultFolder Nothing uId]
 135   case maybeNodeId of
 136     []  -> nodeError (DoesNotExist i)
 137     [n] -> do
 138       config <- view hasConfig
 139       u <- case nt of
 140             NodeFrameWrite -> pure $ _gc_frame_write_url config
 141             NodeFrameCalc  -> pure $ _gc_frame_calc_url config
 142             _              -> nodeError NeedsConfiguration
 143       let
 144         s = _gc_secretkey config
 145         hd = HyperdataFrame u (sha $ s <> (cs $ show n))
 146       _ <- updateHyperdata n hd
 147       pure [n]
 148     (_:_:_)  -> nodeError MkNode
 149 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 150
 151
 152
 153