refactor(qualification): update db migration code

models/lms.model

@@ -60,21 +60,18 @@ QualificationUser
   validUntil        Day                           -- addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil
   lastRefresh       Day                           -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
   firstHeld         Day                           -- first time the qualification was earned, should never change
-  -- blockedDue        QualificationBlocked Maybe    -- TODO: refactor own table isJust means that the qualification is currently revoked
   scheduleRenewal   Bool  default=true            -- if false, no automatic renewal is scheduled and the qualification expires
   lastNotified      UTCTime default=now()         -- last notficiation about being invalid
-  -- temporärer Entzug vorsehen -- SAP Schnittstelle muss dann angepasst werden
-  -- Begründungsfeld vorsehen
+  -- Reasons and temporary revocations are implemented through QualificationUserBlock
+  -- TODO: adjust SAP interface to transmit end dates
   UniqueQualificationUser qualification user
   deriving Generic
 
 QualificationUserBlock
   qualificationUser QualificationUserId OnDeleteCascade OnUpdateCascade
   unblock           Bool
-  from              UTCTime
-  -- until             Day Maybe -- if Nothing then the block holds indefinitely
-  reason            Text
-  -- company        --   to be encoded in reason
+  from              UTCTime  
+  reason            Text  
   blocker           UserId Maybe
   deriving Eq Ord Read Show Generic
 

src/Model/Migration.hs

@@ -13,7 +13,7 @@ module Model.Migration
 import Import.NoModel hiding (Max(..), Last(..))
 import Model
 import Foundation.Type
-import Model.Migration.Definitions
+import Model.Migration.Definitions                 -- SEE HERE: this module contains the actual migration code
 import qualified Model.Migration.Types as Legacy
 import qualified Data.Map as Map
 

src/Model/Migration/Definitions.hs

@@ -858,8 +858,15 @@ customMigrations = mapF $ \case
   Migration20230524QualificationUserBlock -> 
     unlessM (tableExists "qualification_user_block") $ do
       [executeQQ|
-        CREATE TABLE "qualification_user_block" ("id" SERIAL8 PRIMARY KEY UNIQUE, "qualification_user" bigint NOT NULL, "from" date NOT NULL, "until" date, "reason" character varying NOT NULL)
-        CONSTRAINT qualification_user_fkey FOREIGN KEY (qualification_user) REFERENCES qualification_user(id)
+        CREATE TABLE "qualification_user_block" 
+          ( "id" SERIAL8 PRIMARY KEY UNIQUE
+          , "qualification_user" bigint NOT NULL
+          , "from" timestamp with time zone NOT NULL
+          , "reason" character varying NOT NULL
+          , "blocker" bigint 
+          , CONSTRAINT qualification_user_block_qualification_user_fkey FOREIGN KEY (qualification_user) REFERENCES qualification_user(id) ON DELETE CASCADE
+          , CONSTRAINT qualification_user_block_blocker_fkey FOREIGN KEY (blocker) REFERENCES user(id)
+          )
       |]
 
       let getBlocks = [queryQQ|SELECT "id", "blocked_due" FROM "qualification_user" WHERE "blocked_due" IS NOT NULL|]