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