datarekisteri/src/Client.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ViewPatterns #-}

{-# LANGUAGE NoImplicitPrelude #-}

import Relude hiding (get)

import Yesod
import Yesod.Auth
import Client.Types
import Client.Handlers
import Client.Auth ()
import Yesod.Static (static, Static)
import Options.Applicative
import Server (Config(..), runMigrations, checkSendmailPath, configOpts)
import System.Directory (createDirectoryIfMissing)

mkYesodDispatch "DataIdClient" resourcesDataIdClient

main :: IO ()
main = do
    yesodConfig' <- readConfig
    serverConfig' <- checkSendmailPath $ serverConfig yesodConfig'
    let config = yesodConfig' {serverConfig = serverConfig'}
    runMigrations (configDbUrl . serverConfig $ config)
    static <- getStaticDir "/tmp/data-id"
    warp (configPort . serverConfig $ config) $ DataIdClient static config

readConfig :: IO YesodConfig
readConfig = execParser $ info (configOpts' <**> helper)
    (fullDesc <> progDesc "Serve datarekisteri http client and graphql server"
    <> header "Client and server backend servers for datarekisteri")

configOpts' :: Parser YesodConfig
configOpts' = YesodConfig
    <$> configOpts
    <*> strOption (long "approot" <> short 'r' <> metavar "URL" <> value "http://localhost:3100" <> help "External URL of the server path /")
    -- TODO make port depend on the --port flag

getStaticDir :: FilePath -> IO Static
getStaticDir dir = createDirectoryIfMissing True dir >> static dir