{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}

-- | spawns a few processes that serve the que.run website
--
-- : exe que-website
--
-- : dep async
-- : dep config-ini
-- : dep process
-- : dep protolude
-- : dep req
module Run.Que.Website
  ( main
  )
where

import qualified Control.Concurrent.Async      as Async
import           Com.Simatime.Alpha
import qualified Data.ByteString.Char8         as BS
import qualified Data.Ini.Config               as Config
import qualified Data.Text                     as Text
import           Data.Text.Encoding             ( encodeUtf8 )
import qualified Data.Text.IO                  as Text
import           Network.HTTP.Req
import qualified System.Directory              as Directory
import           System.Environment            as Environment
import qualified System.Exit                   as Exit
import           System.FilePath                ( (</>) )
import qualified System.Process                as Process

main :: IO ()
main = do
  (src, ns) <- Environment.getArgs >>= \case
    [src]     -> return (src, "_") -- default to _ ns which is special
    [src, ns] -> return (src, Text.pack ns)
    _         -> Exit.die "usage: que-website <srcdir> [namespace]"
  mKey <- getKey ns
  putText $ "serving " <> Text.pack src <> " at " <> ns
  run mKey ns $ Sources { index      = src </> "index.md"
                        , client     = src </> "client.py"
                        , quescripts = src </> "quescripts.md"
                        , style      = src </> "style.css"
                        , apidocs    = src </> "apidocs.md"
                        , tutorial   = src </> "tutorial.md"
                        }

getKey :: Namespace -> IO (Maybe Key)
getKey ns = do
  home <- Directory.getHomeDirectory
  let file = home </> ".config" </> "que.conf"
  exists <- (Directory.doesFileExist file)
  unless exists <| panic <| "not found: " <> Text.pack file
  conf <- Text.readFile file
  print (home </> ".config" </> "que.conf")
  auth ns
    |> Config.parseIniFile conf
    |> either errorParsingConf identity
    |> return

errorParsingConf :: error
errorParsingConf = panic "could not parse ~/.config/que.conf"

data Sources = Sources
  { index :: FilePath
  , quescripts :: FilePath
  , client :: FilePath
  , style :: FilePath
  , tutorial :: FilePath
  , apidocs :: FilePath
  }

type Namespace = Text
type Key = Text

auth :: Namespace -> Config.IniParser (Maybe Key)
auth "pub" = pure Nothing
auth ns    = Config.sectionMb ns <| Config.field "key"

run :: Maybe Key -> Text -> Sources -> IO ()
run key ns Sources {..} = Async.runConcurrently actions >> return ()
 where
  actions = traverse
    Async.Concurrently
    [ forever <| toHtml index >>= serve key ns "index"
    , forever <| toHtml quescripts >>= serve key ns "quescripts"
    , forever <| BS.readFile client >>= serve key ns "client"
    , forever <| toHtml tutorial >>= serve key ns "tutorial"
    , forever <| toHtml apidocs >>= serve key ns "apidocs"
    ]
  toHtml :: FilePath -> IO ByteString
  toHtml md =
    BS.pack
      <$> Process.readProcess
            "pandoc"
            [ "--include-in-header"
            , style
            , "-i"
            , md
            , "--from"
            , "markdown"
            , "--to"
            , "html"
            ]
            []

serve :: Maybe Key -> Namespace -> Text -> ByteString -> IO ()
serve Nothing "pub" path content = runReq defaultHttpConfig $ do
  _ <- req POST
           (http "que.run" /: "pub" /: path)
           (ReqBodyBs content)
           ignoreResponse
           mempty
  liftIO $ return ()
serve Nothing    p  _    _       = panic <| "no auth key provided for ns: " <> p
serve (Just key) ns path content = runReq defaultHttpConfig $ do
  let options =
        header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound
  _ <- req POST
           (http "que.run" /: ns /: path)
           (ReqBodyBs content)
           ignoreResponse
           options
  liftIO $ return ()