module Audit
  ( module Audit.Types
  , AuditException(..)
  , audit, audit'
  , AuditRemoteException(..)
  , getRemote
  ) where


import Import.NoModel
import Model
import Database.Persist.Sql
import Audit.Types

import Utils.Lens
import qualified Network.Wai as Wai
import qualified Network.Socket as Wai

import qualified Net.IP as IP

{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}


data AuditRemoteException
  = ARUnsupportedSocketKind
  deriving (Show, Generic, Typeable)
instance Exception AuditRemoteException


getRemote :: (MonadHandler m, MonadThrow m) => m IP
getRemote = do
  wai <- waiRequest
  case Wai.remoteHost wai of
    Wai.SockAddrInet _ hAddr -> let (b1, b2, b3, b4) = Wai.hostAddressToTuple hAddr in return $ IP.ipv4 b1 b2 b3 b4
    Wai.SockAddrInet6 _ _ hAddr _ -> let (w1, w2, w3, w4, w5, w6, w7, w8) = Wai.hostAddress6ToTuple hAddr in return $ IP.ipv6 w1 w2 w3 w4 w5 w6 w7 w8
    _other -> throwM ARUnsupportedSocketKind


data AuditException
  = AuditRemoteException AuditRemoteException
  | AuditUserNotFound UserId
  deriving (Show, Generic, Typeable)
instance Exception AuditException


audit :: ( AuthId (HandlerSite m) ~ Key User
         , AuthEntity (HandlerSite m) ~ User
         , IsSqlBackend (YesodPersistBackend (HandlerSite m))
         , SqlBackendCanWrite (YesodPersistBackend (HandlerSite m))
         , HasInstanceID (HandlerSite m) InstanceId
         , YesodAuthPersist (HandlerSite m)
         , MonadHandler m
         , MonadCatch m
         )
      => Transaction -- ^ Transaction to record
      -> [UserId] -- ^ Affected users
      -> 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
audit (toJSON -> transactionLogInfo) affected = do
  uid <- liftHandlerT maybeAuthId

  transactionLogTime <- liftIO getCurrentTime
  transactionLogInstance <- getsYesod $ view instanceID
  transactionLogInitiator <- for uid $ \uid' -> maybe (throwM $ AuditUserNotFound uid') (return . userIdent) =<< get uid'
  transactionLogRemote <- handle (throwM . AuditRemoteException) $ Just <$> getRemote

  tlId <- insert TransactionLog{..}

  affectedUsers <- forM affected $ \uid' -> maybe (throwM $ AuditUserNotFound uid') (return . userIdent) =<< get uid'
  insertMany_ $ map (TransactionLogAffected tlId) affectedUsers

audit' :: ( AuthId (HandlerSite m) ~ Key User
          , AuthEntity (HandlerSite m) ~ User
          , IsSqlBackend (YesodPersistBackend (HandlerSite m))
          , SqlBackendCanWrite (YesodPersistBackend (HandlerSite m))
          , HasInstanceID (HandlerSite m) InstanceId
          , YesodAuthPersist (HandlerSite m)
          , MonadHandler m
          , MonadCatch m
          )
       => Transaction -- ^ Transaction to record
       -> ReaderT (YesodPersistBackend (HandlerSite m)) m ()
-- ^ Special case of `audit` for when there are no affected users
audit' = flip audit []