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")
  90                                 (Just $ DefaultFrameCode $ HyperdataFrame { _hf_base = "Codebook"
  91                                                                           , _hf_frame_id = name }) i uId
  92
  93 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
  94
  95
  96 -- | Function not exposed
  97 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
  98                                     => NodeType
  99                                     -> Maybe ParentId
 100                                     -> UserId
 101                                     -> Name
 102                                     -> Cmd err [NodeId]
 103 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
 104   maybeNodeId <- case nt of
 105      NodeFrameWrite -> insertNode NodeFrameWrite (Just name)   Nothing i uId
 106      NodeFrameCalc  -> insertNode NodeFrameCalc  (Just name)   Nothing i uId
 107      NodeFrameVisio -> insertNode NodeFrameVisio (Just name)   Nothing i uId
 108      _              -> nodeError NeedsConfiguration
 109
 110   case maybeNodeId of
 111     []  -> nodeError (DoesNotExist i)
 112     [n] -> do
 113       cfg <- view hasConfig
 114       u <- case nt of
 115             NodeFrameWrite -> pure $ _gc_frame_write_url cfg
 116             NodeFrameCalc  -> pure $ _gc_frame_calc_url  cfg
 117             NodeFrameVisio -> pure $ _gc_frame_visio_url  cfg
 118             _              -> nodeError NeedsConfiguration
 119       let
 120         s = _gc_secretkey cfg
 121         hd = HyperdataFrame u (hash $ s <> (cs $ show n))
 122       _ <- updateHyperdata n hd
 123       pure [n]
 124     (_:_:_)  -> nodeError MkNode
 125 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 126