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.Viz.Graph (defaultHyperdataGraph)
  32 import Gargantext.Prelude
  33 import Gargantext.Prelude.Utils (sha)
  34 import Gargantext.Database.Prelude
  35 import Control.Lens (view)
  36 import Gargantext.Config (GargConfig(..))
  37
  38 ------------------------------------------------------------------------
  39 -- | TODO mk all others nodes
  40 mkNodeWithParent :: (HasNodeError err)
  41                  => NodeType
  42                  -> Maybe ParentId
  43                  -> UserId
  44                  -> Name
  45                  -> Cmd err [NodeId]
  46 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
  47
  48 ------------------------------------------------------------------------
  49 mkNodeWithParent NodeUser Nothing uId name =
  50   insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
  51
  52 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
  53 ------------------------------------------------------------------------
  54 mkNodeWithParent NodeFolder (Just i) uId name =
  55    insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
  56     where
  57       hd = defaultHyperdataFolder
  58
  59 mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
  60    insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
  61     where
  62       hd = defaultHyperdataFolder
  63
  64 mkNodeWithParent NodeFolderShared (Just i) uId _ =
  65    insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
  66     where
  67       hd = defaultHyperdataFolder
  68
  69 mkNodeWithParent NodeFolderPublic (Just i) uId _ =
  70    insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
  71     where
  72       hd = defaultHyperdataFolder
  73
  74 mkNodeWithParent NodeTeam (Just i) uId name =
  75    insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
  76     where
  77       hd = defaultHyperdataFolder
  78 ------------------------------------------------------------------------
  79 mkNodeWithParent NodeCorpus (Just i) uId name =
  80    insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
  81     where
  82       hd = defaultHyperdataCorpus
  83
  84 mkNodeWithParent NodeAnnuaire (Just i) uId name =
  85    insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
  86     where
  87       hd = defaultHyperdataAnnuaire
  88
  89 mkNodeWithParent NodeList (Just i) uId name =
  90    insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
  91     where
  92       hd = defaultHyperdataAnnuaire
  93
  94 mkNodeWithParent NodeGraph (Just i) uId name =
  95    insertNodesWithParentR (Just i) [node NodeGraph name hd Nothing uId]
  96     where
  97       hd = defaultHyperdataGraph
  98
  99 mkNodeWithParent NodeFrameWrite i u n =
 100   mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
 101
 102 mkNodeWithParent NodeFrameCalc i u n =
 103   mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
 104
 105 {-
 106 mkNodeWithParent n (Just i) uId name =
 107    insertNodesWithParentR (Just i) [node NodeDashboard name (hasDefaultData n) Nothing uId]
 108 -}
 109
 110 mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 111
 112
 113 -- | Sugar to create a node, get his NodeId and update his Hyperdata after
 114 mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err)
 115                                     => NodeType
 116                                     -> Maybe ParentId
 117                                     -> UserId
 118                                     -> Name
 119                                     -> Cmd err [NodeId]
 120 mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
 121   mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
 122
 123 mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
 124   mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
 125
 126 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 127
 128
 129 -- | Function not exposed
 130 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err)
 131                                     => NodeType
 132                                     -> Maybe ParentId
 133                                     -> UserId
 134                                     -> Name
 135                                     -> Cmd err [NodeId]
 136 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
 137   maybeNodeId <- insertNodesWithParentR (Just i) [node nt name defaultFolder Nothing uId]
 138   case maybeNodeId of
 139     []  -> nodeError (DoesNotExist i)
 140     [n] -> do
 141       config <- view hasConfig
 142       u <- case nt of
 143             NodeFrameWrite -> pure $ _gc_frame_write_url config
 144             NodeFrameCalc  -> pure $ _gc_frame_calc_url config
 145             _              -> nodeError NeedsConfiguration
 146       let
 147         s = _gc_secretkey config
 148         hd = HyperdataFrame u (sha $ s <> (cs $ show n))
 149       _ <- updateHyperdata n hd
 150       pure [n]
 151     (_:_:_)  -> nodeError MkNode
 152 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 153