{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module Gargantext.API.Node.ShareURL where import Control.Lens (view, (#)) import Data.Text qualified as T import Data.Validity qualified as V import Gargantext.API.Prelude (IsGargServer) 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 (IsDBEnvExtra) 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, IsDBEnvExtra 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)