{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} module Gargantext.API.Node.ShareURL where import Control.Lens import Data.Text qualified as T import Data.Validity qualified as V import Gargantext.API.Prelude import Gargantext.API.Routes.Named.Share qualified as Named import Gargantext.Core.Config (GargConfig, gc_frontend_config, HasConfig(hasConfig)) import Gargantext.Core.Config.Types (fc_appPort, fc_url) import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError) import Gargantext.Database.Prelude (CmdCommon) import Gargantext.Prelude import Network.URI (parseURI) import Prelude (String) import Servant.Server.Generic (AsServerT) shareURL :: IsGargServer env err m => Named.ShareURL (AsServerT m) shareURL = Named.ShareURL getUrl getUrl :: (IsGargServer env err m, CmdCommon env) => Maybe NodeType -> Maybe NodeId -> m Named.ShareLink getUrl nt id = do -- TODO add check that the node is able to be shared (in a shared folder) gc <- view hasConfig case get_url nt id gc of Left err -> throwError $ _ValidationError # (V.check False err) Right shareLink -> pure shareLink get_url :: Maybe NodeType -> Maybe NodeId -> GargConfig -> Either String Named.ShareLink get_url nt id gc = do let urlHost = T.unpack $ gc ^. gc_frontend_config . fc_url let urlPort = gc ^. gc_frontend_config . fc_appPort t <- maybe (Left "Invalid node Type") Right nt i <- maybe (Left "Invalid node ID") Right id -- Include the port the server is running on if this is -- localhost, so that share URLs would work out of the box. let !rawURL | "localhost" `isInfixOf` urlHost = urlHost <> ":" <> show urlPort <> "/#/share/" <> show t <> "/" <> show (unNodeId i) | otherwise = urlHost <> "/#/share/" <> show t <> "/" <> show (unNodeId i) maybe (Left $ "Couldn't construct a valid share URL from '" <> rawURL <> "'") (Right . Named.ShareLink) (parseURI rawURL)