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