Add tracking for external links

wizard-public/src/WizardLib/Public/Database/DAO/ExternalLink/ExternalLinkUsageDAO.hs

@@ -0,0 +1,19 @@
+module WizardLib.Public.Database.DAO.ExternalLink.ExternalLinkUsageDAO where
+
+import GHC.Int
+
+import Shared.Common.Database.DAO.Common
+import Shared.Common.Model.Context.AppContext
+import WizardLib.Public.Database.Mapping.ExternalLink.ExternalLinkUsage ()
+import WizardLib.Public.Model.ExternalLink.ExternalLinkUsage
+
+entityName = "external_link_usage"
+
+findExternalLinkUsages :: AppContextC s sc m => m [ExternalLinkUsage]
+findExternalLinkUsages = createFindEntitiesFn entityName
+
+insertExternalLinkUsage :: AppContextC s sc m => ExternalLinkUsage -> m Int64
+insertExternalLinkUsage = createInsertFn entityName
+
+deleteExternalLinkUsages :: AppContextC s sc m => m Int64
+deleteExternalLinkUsages = createDeleteEntitiesFn entityName

wizard-public/src/WizardLib/Public/Database/Mapping/ExternalLink/ExternalLinkUsage.hs

@@ -0,0 +1,9 @@
+module WizardLib.Public.Database.Mapping.ExternalLink.ExternalLinkUsage where
+
+import Database.PostgreSQL.Simple
+
+import WizardLib.Public.Model.ExternalLink.ExternalLinkUsage
+
+instance ToRow ExternalLinkUsage
+
+instance FromRow ExternalLinkUsage

wizard-public/src/WizardLib/Public/Database/Migration/Development/ExternalLink/ExternalLinkMigration.hs

@@ -0,0 +1,12 @@
+module WizardLib.Public.Database.Migration.Development.ExternalLink.ExternalLinkMigration where
+
+import Shared.Common.Constant.Component
+import Shared.Common.Model.Context.AppContext
+import Shared.Common.Util.Logger
+import WizardLib.Public.Database.DAO.ExternalLink.ExternalLinkUsageDAO
+
+runMigration :: AppContextC s sc m => m ()
+runMigration = do
+  logInfo _CMP_MIGRATION "(ExternalLink/ExternalLink) started"
+  deleteExternalLinkUsages
+  logInfo _CMP_MIGRATION "(ExternalLink/ExternalLink) ended"

wizard-public/src/WizardLib/Public/Database/Migration/Development/ExternalLink/ExternalLinkSchemaMigration.hs

@@ -0,0 +1,31 @@
+module WizardLib.Public.Database.Migration.Development.ExternalLink.ExternalLinkSchemaMigration where
+
+import Database.PostgreSQL.Simple
+import GHC.Int
+
+import Shared.Common.Database.DAO.Common
+import Shared.Common.Model.Context.AppContext
+import Shared.Common.Util.Logger
+
+dropTables :: AppContextC s sc m => m Int64
+dropTables = do
+  logInfo _CMP_MIGRATION "(Table/ExternalLink) drop tables"
+  let sql = "DROP TABLE IF EXISTS external_link_usage CASCADE;"
+  let action conn = execute_ conn sql
+  runDB action
+
+createTables :: AppContextC s sc m => m Int64
+createTables = do
+  logInfo _CMP_MIGRATION "(Table/ExternalLink) create table"
+  let sql =
+        "CREATE TABLE external_link_usage \
+        \( \
+        \    uuid        uuid        NOT NULL, \
+        \    url         varchar     NOT NULL, \
+        \    tenant_uuid uuid        NOT NULL, \
+        \    created_at  timestamptz NOT NULL, \
+        \    CONSTRAINT external_link_usage_pk PRIMARY KEY (uuid, tenant_uuid), \
+        \    CONSTRAINT external_link_usage_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) \
+        \);"
+  let action conn = execute_ conn sql
+  runDB action

wizard-public/src/WizardLib/Public/Model/ExternalLink/ExternalLinkUsage.hs

@@ -0,0 +1,13 @@
+module WizardLib.Public.Model.ExternalLink.ExternalLinkUsage where
+
+import Data.Time
+import qualified Data.UUID as U
+import GHC.Generics
+
+data ExternalLinkUsage = ExternalLinkUsage
+  { uuid :: U.UUID
+  , url :: String
+  , tenantUuid :: U.UUID
+  , createdAt :: UTCTime
+  }
+  deriving (Show, Eq, Generic)

wizard-public/src/WizardLib/Public/Service/ExternalLink/ExternalLinkUsageService.hs

@@ -0,0 +1,22 @@
+module WizardLib.Public.Service.ExternalLink.ExternalLinkUsageService where
+
+import Control.Monad (void)
+import Control.Monad.Reader (asks, liftIO)
+import Data.Time
+import Prelude hiding (id)
+
+import Shared.Common.Database.DAO.Common
+import Shared.Common.Model.Context.AppContext
+import Shared.Common.Util.Logger
+import Shared.Common.Util.Uuid
+import WizardLib.Public.Database.DAO.ExternalLink.ExternalLinkUsageDAO
+import WizardLib.Public.Model.ExternalLink.ExternalLinkUsage
+
+createExternalLinkUsage :: AppContextC s sc m => String -> m ()
+createExternalLinkUsage url =
+  runInTransaction logInfoI logWarnI $ do
+    uuid <- liftIO generateUuid
+    tenantUuid <- asks (.tenantUuid')
+    now <- liftIO getCurrentTime
+    let externalLinkUsage = ExternalLinkUsage uuid url tenantUuid now
+    void $ insertExternalLinkUsage externalLinkUsage

wizard-server/src/Wizard/Api/Handler/Api.hs

@@ -17,6 +17,7 @@ import Wizard.Api.Handler.DocumentTemplateDraft.Asset.Api
 import Wizard.Api.Handler.DocumentTemplateDraft.File.Api
 import Wizard.Api.Handler.DocumentTemplateDraft.Folder.Api
 import Wizard.Api.Handler.Domain.Api
+import Wizard.Api.Handler.ExternalLink.Api
 import Wizard.Api.Handler.Feedback.Api
 import Wizard.Api.Handler.Info.Api
 import Wizard.Api.Handler.KnowledgeModel.Api
@@ -56,6 +57,7 @@ type ApplicationAPI =
     :<|> DocumentTemplateFileAPI
     :<|> DocumentAPI
     :<|> DomainAPI
+    :<|> ExternalLinkAPI
     :<|> FeedbackAPI
     :<|> InfoAPI
     :<|> KnowledgeModelAPI
@@ -98,6 +100,7 @@ applicationServer =
     :<|> documentTemplateFileServer
     :<|> documentServer
     :<|> domainServer
+    :<|> externalLinkServer
     :<|> feedbackServer
     :<|> infoServer
     :<|> knowledgeModelServer

wizard-server/src/Wizard/Api/Handler/ExternalLink/Api.hs

@@ -0,0 +1,17 @@
+module Wizard.Api.Handler.ExternalLink.Api where
+
+import Servant
+import Servant.Swagger.Tags
+
+import Wizard.Api.Handler.ExternalLink.List_GET
+import Wizard.Model.Context.BaseContext
+
+type ExternalLinkAPI =
+  Tags "ExternalLink"
+    :> List_GET
+
+externalLinkApi :: Proxy ExternalLinkAPI
+externalLinkApi = Proxy
+
+externalLinkServer :: ServerT ExternalLinkAPI BaseContextM
+externalLinkServer = list_GET

wizard-server/src/Wizard/Api/Handler/ExternalLink/List_GET.hs

@@ -0,0 +1,23 @@
+module Wizard.Api.Handler.ExternalLink.List_GET where
+
+import Servant
+
+import Shared.Common.Api.Handler.Common
+import Shared.Common.Model.Context.TransactionState
+import Shared.Common.Model.Error.Error
+import Wizard.Api.Handler.Common
+import Wizard.Model.Context.BaseContext
+import WizardLib.Public.Service.ExternalLink.ExternalLinkUsageService
+
+type List_GET =
+  Header "Host" String
+    :> "external-link"
+    :> QueryParam' '[Required] "url" String
+    :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent)
+
+list_GET :: Maybe String -> String -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent)
+list_GET mServerUrl url =
+  runInUnauthService mServerUrl Transactional $
+    addTraceUuidHeader =<< do
+      createExternalLinkUsage url
+      throwError $ FoundError url

wizard-server/src/Wizard/Database/Migration/Development/Migration.hs

@@ -46,6 +46,8 @@ import qualified Wizard.Database.Migration.Development.Tenant.TenantSchemaMigrat
 import qualified Wizard.Database.Migration.Development.User.UserMigration as User
 import qualified Wizard.Database.Migration.Development.User.UserSchemaMigration as User
 import Wizard.Model.Context.ContextMappers
+import qualified WizardLib.Public.Database.Migration.Development.ExternalLink.ExternalLinkMigration as ExternalLink
+import qualified WizardLib.Public.Database.Migration.Development.ExternalLink.ExternalLinkSchemaMigration as ExternalLink
 
 runMigration = runAppContextWithBaseContext $ do
   logInfo _CMP_MIGRATION "started"
@@ -54,6 +56,7 @@ runMigration = runAppContextWithBaseContext $ do
   Package.dropFunctions
   Common.dropFunctions
   -- 2. Drop schema
+  ExternalLink.dropTables
   KnowledgeModel.dropTables
   Component.dropTables
   TemporaryFile.dropTables
@@ -100,6 +103,7 @@ runMigration = runAppContextWithBaseContext $ do
   TemporaryFile.createTables
   Component.createTables
   KnowledgeModel.createTables
+  ExternalLink.createTables
   -- 4. Create DB functions
   Common.createFunctions
   Package.createFunctions
@@ -126,5 +130,6 @@ runMigration = runAppContextWithBaseContext $ do
   Registry.runMigration
   Locale.runMigration
   Component.runMigration
+  ExternalLink.runMigration
   logInfo _CMP_MIGRATION "ended"
   return Nothing

wizard-server/src/Wizard/Database/Migration/Production/Migration_0053_qtnEventsRefactoring/Migration.hs

@@ -21,6 +21,7 @@ migrate dbPool = do
   testEventCount dbPool
   testValueCount dbPool
   removeEventsColumnFromQuestionnaire dbPool
+  createExternalLinkTable dbPool
 
 regenerateQuestionnaireEventUuid dbPool = do
   let sql =
@@ -320,3 +321,18 @@ removeEventsColumnFromQuestionnaire dbPool = do
   let action conn = execute_ conn sql
   liftIO $ withResource dbPool action
   return Nothing
+
+createExternalLinkTable dbPool = do
+  let sql =
+        "CREATE TABLE external_link_usage \
+        \( \
+        \    uuid        uuid        NOT NULL, \
+        \    url         varchar     NOT NULL, \
+        \    tenant_uuid uuid        NOT NULL, \
+        \    created_at  timestamptz NOT NULL, \
+        \    CONSTRAINT external_link_usage_pk PRIMARY KEY (uuid, tenant_uuid), \
+        \    CONSTRAINT external_link_usage_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) \
+        \);"
+  let action conn = execute_ conn sql
+  liftIO $ withResource dbPool action
+  return Nothing

wizard-server/test/Spec.hs

@@ -35,6 +35,7 @@ import Wizard.Specs.API.DocumentTemplateDraft.Asset.APISpec
 import Wizard.Specs.API.DocumentTemplateDraft.File.APISpec
 import Wizard.Specs.API.DocumentTemplateDraft.Folder.APISpec
 import Wizard.Specs.API.Domain.APISpec
+import Wizard.Specs.API.ExternalLink.APISpec
 import Wizard.Specs.API.Feedback.APISpec
 import Wizard.Specs.API.Info.APISpec
 import Wizard.Specs.API.KnowledgeModel.APISpec
@@ -199,6 +200,7 @@ main =
               documentTemplateDraftAssetAPI baseContext appContext
               documentTemplateDraftFileAPI baseContext appContext
               domainAPI baseContext appContext
+              externalLinkAPI baseContext appContext
               feedbackAPI baseContext appContext
               infoAPI baseContext appContext
               knowledgeModelAPI baseContext appContext

wizard-server/test/Wizard/Specs/API/ExternalLink/APISpec.hs

@@ -0,0 +1,12 @@
+module Wizard.Specs.API.ExternalLink.APISpec where
+
+import Test.Hspec
+import Test.Hspec.Wai hiding (shouldRespondWith)
+
+import Wizard.Specs.API.Common
+import Wizard.Specs.API.ExternalLink.List_GET
+
+externalLinkAPI baseContext appContext =
+  with (startWebApp baseContext appContext) $
+    describe "EXTERNAL LINK API Spec" $ do
+      list_GET appContext

wizard-server/test/Wizard/Specs/API/ExternalLink/List_GET.hs

@@ -0,0 +1,55 @@
+module Wizard.Specs.API.ExternalLink.List_GET (
+  list_GET,
+) where
+
+import Data.Aeson (encode)
+import Network.HTTP.Types
+import Network.Wai (Application)
+import Test.Hspec
+import Test.Hspec.Wai hiding (shouldRespondWith)
+import Test.Hspec.Wai.Matcher
+
+import Shared.Common.Api.Resource.Error.ErrorJM ()
+import Shared.Common.Model.Error.Error
+import Wizard.Model.Context.AppContext
+import WizardLib.Public.Database.DAO.ExternalLink.ExternalLinkUsageDAO
+
+import SharedTest.Specs.API.Common
+import Wizard.Specs.API.Common
+
+-- ------------------------------------------------------------------------
+-- GET /wizard-api/external-link?url=http://example.com/my-link
+-- ------------------------------------------------------------------------
+list_GET :: AppContext -> SpecWith ((), Application)
+list_GET appContext = describe "GET /wizard-api/external-link?url=http://example.com/my-link" $ test_302 appContext
+
+-- ----------------------------------------------------
+-- ----------------------------------------------------
+-- ----------------------------------------------------
+reqMethod = methodGet
+
+reqUrl = "/wizard-api/external-link?url=http://example.com/my-link"
+
+reqHeaders = []
+
+reqBody = ""
+
+-- ----------------------------------------------------
+-- ----------------------------------------------------
+-- ----------------------------------------------------
+test_302 appContext =
+  it "HTTP 302 FOUND" $
+    -- GIVEN: Prepare expectation
+    do
+      let expStatus = 302
+      let expHeaders = resCtHeader : resCorsHeaders
+      let expDto = FoundError "http://example.com/my-link"
+      let expBody = encode expDto
+      -- WHEN: Call API
+      response <- request reqMethod reqUrl reqHeaders reqBody
+      -- THEN: Compare response with expectation
+      let responseMatcher =
+            ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody}
+      response `shouldRespondWith` responseMatcher
+      -- THEN: Compare DB with expectation
+      assertCountInDB findExternalLinkUsages appContext 1

wizard-server/test/Wizard/TestMigration.hs

@@ -64,9 +64,11 @@ import Wizard.Model.Cache.ServerCache
 import WizardLib.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO
 import WizardLib.KnowledgeModel.Database.DAO.Package.PackageDAO
 import WizardLib.KnowledgeModel.Database.Migration.Development.Package.Data.Packages
+import WizardLib.Public.Database.DAO.ExternalLink.ExternalLinkUsageDAO
 import WizardLib.Public.Database.DAO.User.UserGroupDAO
 import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO
 import WizardLib.Public.Database.DAO.User.UserTokenDAO
+import qualified WizardLib.Public.Database.Migration.Development.ExternalLink.ExternalLinkSchemaMigration as ExternalLink
 
 import Wizard.Specs.Common
 
@@ -76,6 +78,7 @@ buildSchema appContext = do
   runInContext Package.dropFunctions appContext
   runInContext Common.dropFunctions appContext
   putStrLn "DB: dropping schema"
+  runInContext ExternalLink.dropTables appContext
   runInContext KnowledgeModel.dropTables appContext
   runInContext Component.dropTables appContext
   runInContext Locale.dropTables appContext
@@ -122,6 +125,7 @@ buildSchema appContext = do
   runInContext Locale.createTables appContext
   runInContext Component.createTables appContext
   runInContext KnowledgeModel.createTables appContext
+  runInContext ExternalLink.createTables appContext
   putStrLn "DB: Creating DB functions"
   runInContext Common.createFunctions appContext
   runInContext Package.createFunctions appContext
@@ -131,6 +135,7 @@ buildSchema appContext = do
   runInContext LocaleMigration.runS3Migration appContext
 
 resetDB appContext = do
+  runInContext deleteExternalLinkUsages appContext
   runInContext deleteKnowledgeModelCaches appContext
   runInContext deleteLocales appContext
   runInContext deleteRegistryOrganizations appContext