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 NodeFrameNotebook i u n =
  61   mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook i u n
  62
  63
  64
  65 mkNodeWithParent nt (Just pId) uId name  = insertNode nt (Just name) Nothing pId uId
  66 -- mkNodeWithParent _ _ _ _ = errorWith "[G.D.A.Node.mkNodeWithParent] nees parent"
  67
  68
  69 -- | Sugar to create a node, get its NodeId and update its Hyperdata after
  70 mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
  71                                     => NodeType
  72                                     -> Maybe ParentId
  73                                     -> UserId
  74                                     -> Name
  75                                     -> Cmd err [NodeId]
  76 mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
  77   mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
  78
  79 mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
  80   mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
  81
  82 mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name =
  83   insertNode NodeFrameNotebook  (Just "Notebook") (Just $ DefaultFrameCode $ HyperdataFrame "Notebook" name) i uId
  84
  85 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
  86
  87
  88 -- | Function not exposed
  89 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
  90                                     => NodeType
  91                                     -> Maybe ParentId
  92                                     -> UserId
  93                                     -> Name
  94                                     -> Cmd err [NodeId]
  95 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
  96   maybeNodeId <- case nt of
  97      NodeFrameWrite -> insertNode NodeFrameWrite (Just name)   Nothing i uId
  98      NodeFrameCalc  -> insertNode NodeFrameCalc  (Just name)   Nothing i uId
  99      _              -> nodeError NeedsConfiguration
 100
 101   case maybeNodeId of
 102     []  -> nodeError (DoesNotExist i)
 103     [n] -> do
 104       cfg <- view hasConfig
 105       u <- case nt of
 106             NodeFrameWrite -> pure $ _gc_frame_write_url cfg
 107             NodeFrameCalc  -> pure $ _gc_frame_calc_url  cfg
 108             _              -> nodeError NeedsConfiguration
 109       let
 110         s = _gc_secretkey cfg
 111         hd = HyperdataFrame u (hash $ s <> (cs $ show n))
 112       _ <- updateHyperdata n hd
 113       pure [n]
 114     (_:_:_)  -> nodeError MkNode
 115 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 116