chore(log): add interface usage table

models/audit.model

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -9,4 +9,16 @@ TransactionLog
   initiator UserId Maybe -- User associated with performing this action
   remote IP Maybe -- Remote party that triggered this action via HTTP
   info Value -- JSON-encoded `Transaction`
+  deriving Eq Read Show Generic
+
+InterfaceLog
+  time UTCTime
+  instance InstanceId
+  initiator UserId Maybe -- User associated with performing this interface access
+  remote IP Maybe -- Remote party that triggered this action via HTTP
+  interface Text
+  subtype   Text
+  info      Text
+  write     Bool  -- True implies a write to FRADrive
+  UniqueInterfaceSubtypeWrite interface subtype write
   deriving Eq Read Show Generic

routes

@@ -283,7 +283,7 @@
 /lms/#SchoolId/#QualificationShorthand/learners             LmsLearnersR	          GET
 /lms/#SchoolId/#QualificationShorthand/learners/direct      LmsLearnersDirectR	    GET       !token -- LMS
 /lms/#SchoolId/#QualificationShorthand/report               LmsReportR              GET POST
-/lms/#SchoolId/#QualificationShorthand/report/upload        LmsReportUploadR        GET POST  !development
+/lms/#SchoolId/#QualificationShorthand/report/upload        LmsReportUploadR        GET POST
 /lms/#SchoolId/#QualificationShorthand/report/direct        LmsReportDirectR            POST  !token -- LMS
 -- other lms routes
 /lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent      LmsIdentR               GET       -- redirect to LmsR with filter-parameter

src/Audit.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2023 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -8,6 +8,7 @@ module Audit
   , audit
   , AuditRemoteException(..)
   , getRemote
+  , logInterface
   ) where
 
 
@@ -112,3 +113,38 @@ audit transaction@(toJSON -> transactionLogInfo) = do
   insert_ TransactionLog{..}
 
   $logInfoS "Audit" $ Text.filter (/= '\n') $ tshow (transaction, transactionLogInitiator, transactionLogRemote) <> " - " <> pack (prettyCallStack callStack)
+
+
+logInterface :: ( AuthId (HandlerSite m) ~ Key User 
+         , IsSqlBackend (YesodPersistBackend (HandlerSite m))
+         , SqlBackendCanWrite (YesodPersistBackend (HandlerSite m))
+         , HasInstanceID (HandlerSite m) InstanceId
+         , YesodAuthPersist (HandlerSite m)
+         , MonadHandler m
+         , MonadCatch m
+         , HasAppSettings (HandlerSite m)
+         , HasCallStack
+         )
+      => Text -- ^ Interface that is used
+      -> Text -- ^ Subtype of the interface, if any      
+      -> Text -- ^ Any additional information
+      -> ReaderT (YesodPersistBackend (HandlerSite m)) m ()
+-- ^ Log a transaction using information available from `HandlerT`:
+--
+--   - `transactionLogTime` is now
+--   - `transactionLogInitiator` is currently logged in user (or none)
+--   - `transactionLogRemote` is determined from current HTTP-Request
+logInterface interfaceLogInterface interfaceLogSubtype interfaceLogInfo = do
+  interfaceLogTime <- liftIO getCurrentTime
+  interfaceLogInstance <- getsYesod $ view instanceID
+  interfaceLogInitiator <- liftHandler maybeAuthId
+  interfaceLogRemote <- handle (throwM . AuditRemoteException) $ Just <$> getRemote
+  interfaceLogWrite <- (methodGet /=) . Wai.requestMethod . reqWaiRequest <$> getRequest
+  putMany [InterfaceLog{..}]
+  audit TransactionInterface
+          { transactionInterfaceName    = interfaceLogInterface
+          , transactionInterfaceSubtype = interfaceLogSubtype
+          , transactionInterfaceInfo    = interfaceLogInfo
+          , transactionInterfaceWrite   = interfaceLogWrite
+          }
+  

src/Audit/Types.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,,Steffen Jost <s.jost@fraport.de>
+-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -234,6 +234,12 @@ data Transaction
     , transactionQualification                :: QualificationId
     , transactionQualificationScheduleRenewal :: Maybe Bool           -- TRUE=will be notified upon expiry, FALSE=won't be notified; always JUST, for compatibility with TransactionQualificationUserEdit
     }
+  | TransactionInterface
+    { transactionInterfaceName                :: Text
+    , transactionInterfaceSubtype             :: Text
+    , transactionInterfaceInfo                :: Text
+    , transactionInterfaceWrite               :: Bool                 -- True implies a write to FRADrive
+    }
   deriving (Eq, Ord, Read, Show, Generic)
 
 deriveJSON defaultOptions
@@ -243,4 +249,4 @@ deriveJSON defaultOptions
   , sumEncoding = TaggedObject "transaction" "data"
   } ''Transaction
 
-derivePersistFieldJSON ''Transaction
+derivePersistFieldJSON ''Transaction

src/Handler/SAP.hs

@@ -139,8 +139,10 @@ getQualificationSAPDirectR = do
       nr  = length qualUsers
       msg = "Qualification download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"  
   $logInfoS "SAP" msg
+  runDB $ logInterface "SAP" "" $ tshow $ length csvRendered
   addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
   csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered  
+  
 
 -- direct Download see:
 -- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod