{-# LANGUAGE BlockArguments  #-}
{-# LANGUAGE RecordWildCards #-}
-- | mostly the monad the service runs in
module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds, runLogging, getTzseries, serveDirectoryFileServer) where

import           Config                              (LoggingConfig (..),
                                                      ServerConfig (..))
import           Control.Exception                   (handle, try)
import           Control.Monad.Extra                 (void, whenJust)
import           Control.Monad.IO.Class              (MonadIO (liftIO))
import           Control.Monad.Logger                (Loc, LogLevel (..),
                                                      LogSource, LogStr,
                                                      LoggingT (..),
                                                      defaultOutput, fromLogStr,
                                                      runStderrLoggingT)
import           Control.Monad.Reader                (ReaderT (..))
import qualified Data.Aeson                          as A
import           Data.ByteString                     (ByteString)
import qualified Data.ByteString                     as C8
import           Data.Text                           (Text)
import qualified Data.Text                           as T
import           Data.Text.Encoding                  (decodeUtf8Lenient)
import           Data.Time                           (Day, UTCTime (..),
                                                      diffUTCTime,
                                                      getCurrentTime,
                                                      nominalDiffTimeToSeconds)
import           Data.Time.LocalTime.TimeZone.Olson  (getTimeZoneSeriesFromOlsonFile)
import           Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries)
import           Fmt                                 ((+|), (|+))
import           GHC.IO                              (unsafePerformIO)
import           GHC.IO.Exception                    (IOException (IOError))
import           GTFS                                (Seconds (..))
import           Prometheus                          (MonadMonitor (doIO))
import qualified Servant
import           Servant                             (Handler, ServerError,
                                                      ServerT, err404, errBody,
                                                      errHeaders, throwError)
import           System.IO                           (stderr)
import           System.OsPath                       (OsPath, decodeFS,
                                                      decodeUtf, encodeUtf,
                                                      (</>))
import           System.Process.Extra                (callProcess)

type ServiceM  = LoggingT (ReaderT LoggingConfig Handler)
type Service api = ServerT api ServiceM

runService :: LoggingConfig -> ServiceM a -> Handler a
runService conf m = runReaderT (runLogging conf m) conf

instance MonadMonitor ServiceM where
  doIO = liftIO

runLogging :: MonadIO m => LoggingConfig -> LoggingT m a -> m a
runLogging LoggingConfig{..} logging = runLoggingT logging printLogMsg
  where printLogMsg loc source level msg = do
          -- this is what runStderrLoggingT does
          defaultOutput stderr loc source level msg

          whenJust loggingConfigNtfyToken \token -> handle ntfyFailed do
            callProcess "ntfy"
              [ "send"
              , "--token=" <> T.unpack token
              , "--title="+|loggingConfigHostname|+"/"+|"tracktrain"
              , "--priority="+|show (ntfyPriority level)|+""
              , T.unpack loggingConfigNtfyTopic
              , T.unpack (decodeUtf8Lenient (fromLogStr msg)) ]

        ntfyFailed (e :: IOError) =
          putStrLn ("calling ntfy failed:"+|show e|+".")
        ntfyPriority level = case level of
          LevelDebug   -> 2
          LevelInfo    -> 3
          LevelWarn    -> 4
          LevelError   -> 5
          LevelOther _ -> 0


sendErrorMsg :: Text -> ServiceM a
sendErrorMsg msg = throwError err404
  { errBody = A.encode $ A.object ["error" A..= (404 :: Int), "msg" A..= msg] }

secondsNow :: MonadIO m => Day -> m Seconds
secondsNow runningDay = do
  now <- liftIO getCurrentTime
  pure $ utcToSeconds now runningDay

-- | convert utc time to seconds on a day, with wrap-around
-- for trains that cross midnight.
utcToSeconds :: UTCTime -> Day -> Seconds
utcToSeconds time day =
  Seconds $ round $ nominalDiffTimeToSeconds $ diffUTCTime time (UTCTime day 0)

getTzseries :: ServerConfig -> Text -> IO TimeZoneSeries
getTzseries settings tzname = do
  suffix <- encodeUtf (T.unpack tzname)
  -- TODO: submit a patch to timezone-olson making it accept OsPath
  legacyPath <- decodeFS (serverConfigZoneinfoPath settings </> suffix)
  getTimeZoneSeriesFromOlsonFile legacyPath

-- TODO: patch servant / wai to use OsPath?
serveDirectoryFileServer :: OsPath -> ServerT Servant.Raw m
serveDirectoryFileServer =
  Servant.serveDirectoryFileServer . unsafePerformIO . decodeUtf