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
  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
  24 import Gargantext.Core.Types (Name)
  25 import Gargantext.Database.Admin.Types.Hyperdata
  26 import Gargantext.Database.Admin.Types.Hyperdata.Default
  27 import Gargantext.Database.Admin.Types.Node
  28 import Gargantext.Database.Query.Table.Node
  29 import Gargantext.Database.Query.Table.Node.Error
  30 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  31 import Gargantext.Prelude
  32 import Gargantext.Prelude.Crypto.Hash (hash)
  33 import Gargantext.Database.Prelude
  34 import Control.Lens (view)
  35 import Gargantext.Prelude.Config (GargConfig(..))
  36
  37 ------------------------------------------------------------------------
  38 -- | TODO mk all others nodes
  39 mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
  40                  => NodeType
  41                  -> Maybe ParentId
  42                  -> UserId
  43                  -> Name
  44                  -> Cmd err [NodeId]
  45 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
  46
  47 ------------------------------------------------------------------------
  48 -- | MkNode, insert and eventually configure Hyperdata
  49 mkNodeWithParent NodeUser Nothing uId name =
  50   insertNodesWithParentR Nothing [node NodeUser name defaultHyperdataUser Nothing uId]
  51
  52 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
  53 ------------------------------------------------------------------------
  54 mkNodeWithParent NodeFrameWrite i u n =
  55   mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
  56
  57 mkNodeWithParent NodeFrameCalc i u n =
  58   mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
  59
  60 mkNodeWithParent NodeFrameVisio i u n =
  61   mkNodeWithParent_ConfigureHyperdata NodeFrameVisio i u n
  62
  63 mkNodeWithParent NodeFrameNotebook i u n =
  64   mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook i u n
  65
  66
  67
  68 mkNodeWithParent nt (Just pId) uId name  = insertNode nt (Just name) Nothing pId uId
  69 -- mkNodeWithParent _ _ _ _ = errorWith "[G.D.A.Node.mkNodeWithParent] nees parent"
  70
  71
  72 -- | Sugar to create a node, get its NodeId and update its Hyperdata after
  73 mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
  74                                     => NodeType
  75                                     -> Maybe ParentId
  76                                     -> UserId
  77                                     -> Name
  78                                     -> Cmd err [NodeId]
  79 mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
  80   mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
  81
  82 mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
  83   mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
  84
  85 mkNodeWithParent_ConfigureHyperdata NodeFrameVisio (Just i) uId name =
  86   mkNodeWithParent_ConfigureHyperdata' NodeFrameVisio (Just i) uId name
  87
  88 mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name =
  89   insertNode NodeFrameNotebook  (Just "Notebook") (Just $ DefaultFrameCode $ HyperdataFrame "Notebook" name) i uId
  90
  91 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
  92
  93
  94 -- | Function not exposed
  95 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
  96                                     => NodeType
  97                                     -> Maybe ParentId
  98                                     -> UserId
  99                                     -> Name
 100                                     -> Cmd err [NodeId]
 101 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
 102   maybeNodeId <- case nt of
 103      NodeFrameWrite -> insertNode NodeFrameWrite (Just name)   Nothing i uId
 104      NodeFrameCalc  -> insertNode NodeFrameCalc  (Just name)   Nothing i uId
 105      NodeFrameVisio -> insertNode NodeFrameVisio (Just name)   Nothing i uId
 106      _              -> nodeError NeedsConfiguration
 107
 108   case maybeNodeId of
 109     []  -> nodeError (DoesNotExist i)
 110     [n] -> do
 111       cfg <- view hasConfig
 112       u <- case nt of
 113             NodeFrameWrite -> pure $ _gc_frame_write_url cfg
 114             NodeFrameCalc  -> pure $ _gc_frame_calc_url  cfg
 115             NodeFrameVisio -> pure $ _gc_frame_visio_url  cfg
 116             _              -> nodeError NeedsConfiguration
 117       let
 118         s = _gc_secretkey cfg
 119         hd = HyperdataFrame u (hash $ s <> (cs $ show n))
 120       _ <- updateHyperdata n hd
 121       pure [n]
 122     (_:_:_)  -> nodeError MkNode
 123 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 124