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