module Feed.V1.Server (mkServer) where

import Relude hiding (runReader)
import Relude.Extra.Tuple (fmapToSnd)

import Api.V1.Types
import Data.Cache (newCache)
import Data.List (isSuffixOf)
import Feed.V1.Core (App)
import Feed.V1.Section (feedSectionCached)
import Feed.V1.Spec (FeedApi, feedApi)
import Feed.V1.Topic (feedTopicCached)
import Polysemy (embedToFinal, raiseUnder, runFinal)
import Polysemy.Embed (runEmbedded)
import Polysemy.Error (runError)
import Network.HTTP.Client qualified as Http
import Polysemy.Reader (runReader)
import Servant.API ((:<|>) ((:<|>)))
import Servant.Client.Streaming
import Servant.Polysemy.Client (runServantClientWith)
import Servant.Server
import System.Clock

defProxy :: Http.Proxy
defProxy = Http.Proxy "127.0.0.1" 4444

server :: ServerT FeedApi App
server = feedTopicCached . GetTopic :<|> feedSectionCached

mkServer :: IO (Server FeedApi)
mkServer = do
  let cacheVarName = "4R_FEED_CACHE"
  secMbRaw <- lookupEnv cacheVarName
  sec <- case readEither `fmapToSnd` secMbRaw of
    Nothing -> pure 3600
    Just (_, Right ok) -> pure ok
    Just (secRaw, Left e) -> fail $ "Failed to parse " <> cacheVarName <> "=" <> secRaw <> ": " <> toString e
  cache <- newCache $ Just TimeSpec{nsec = 0, sec}

  baseUrl <- lookupEnv "4RUM_BASE_URL" >>= maybe (pure (BaseUrl Http "4rum.i2p" 80 "")) parseBaseUrl
  clientEnv <- do
    manager' <-
      liftIO $
        Http.newManager $
          Http.defaultManagerSettings
            & if ".i2p" `isSuffixOf` baseUrl.baseUrlHost
              then Http.managerSetProxy $ Http.proxyEnvironmentNamed "I2P_HTTP_PROXY" $ Just defProxy
              else id
    pure $ mkClientEnv manager' baseUrl

  let interpreter :: App a -> Handler a
      interpreter =
        runReader cache
          >>> raiseUnder
          >>> runServantClientWith clientEnv
          >>> runError
          >>> (>>= either (error . (show :: ClientError -> Text)) pure)
          >>> raiseUnder
          >>> runEmbedded (liftIO @Handler)
          >>> embedToFinal @Handler
          >>> runFinal
  pure $ hoistServer feedApi interpreter server