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


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

import qualified Data.Text.Encoding as Text

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, HasAppSettings (HandlerSite m)) => m IP
getRemote = do
  ipFromHeader <- getsYesod $ view _appIpFromHeader
  wai <- waiRequest

  if
    | ipFromHeader
    , Just ip <- byHeader wai
      -> return ip
    | otherwise
      -> byRemoteHost wai
  
  where
    byHeader wai = listToMaybe $ do
      (h, v) <- Wai.requestHeaders wai
      guard $ h `elem` ["x-real-ip", "x-forwarded-for"]
      v' <- either (const mzero) return $ Text.decodeUtf8' v
      maybeToList $ IP.decode v'
    
    byRemoteHost wai = 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
  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
         , HasAppSettings (HandlerSite m)
         )
      => Transaction -- ^ Transaction to record
      -> 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) = do

  transactionLogTime <- liftIO getCurrentTime
  transactionLogInstance <- getsYesod $ view instanceID
  transactionLogInitiator <- liftHandlerT maybeAuthId
  transactionLogRemote <- handle (throwM . AuditRemoteException) $ Just <$> getRemote

  insert_ TransactionLog{..}