diff options
| author | stuebinm | 2022-02-16 19:38:08 +0100 |
|---|---|---|
| committer | stuebinm | 2022-03-19 19:26:32 +0100 |
| commit | cc52022f3b099287f0ac57eb514753202ef47db2 (patch) | |
| tree | 7109a45592378292157acdbdf65ec60d11cbaf23 /server/Server.hs | |
| parent | 8272b6f16b0125382eb44cabd819859f29528a31 (diff) | |
server: post map updates to exneuland's API
Diffstat (limited to 'server/Server.hs')
| -rw-r--r-- | server/Server.hs | 29 |
1 files changed, 21 insertions, 8 deletions
diff --git a/server/Server.hs b/server/Server.hs index bcb96a0..ef01b88 100644 --- a/server/Server.hs +++ b/server/Server.hs @@ -19,7 +19,7 @@ module Server ( loadConfig , Org(..) , Sha1 - , Config, tmpdir, port, verbose, orgs, interval + , Config, tmpdir, port, verbose, orgs, interval, exneuland , RemoteRef(..) , ServerState, emptyState, unState , JobStatus(..) @@ -29,6 +29,7 @@ module Server ( loadConfig import Universum import CheckDir (DirResult) +import Control.Arrow ((>>>)) import Control.Concurrent (modifyMVar_, withMVar) import Crypto.Hash.SHA1 (hash) import Data.Aeson (FromJSON, ToJSON, ToJSONKey (..), @@ -40,9 +41,14 @@ import qualified Data.Map as M import Lens.Micro.Platform (at, ix, makeLenses, traverseOf) import LintConfig (LintConfig') import Servant (FromHttpApiData) -import Toml (TomlCodec, prettyTomlDecodeErrors, - (.=)) +import Servant.Client (BaseUrl, + parseBaseUrl) +import Toml (BiMap (BiMap), TomlBiMap, + TomlBiMapError (ArbitraryError), + TomlCodec, + prettyTomlDecodeErrors, (.=)) import qualified Toml as T +import Data.Either.Extra (mapLeft) -- | a reference in a remote git repository data RemoteRef = RemoteRef @@ -103,13 +109,14 @@ instance ToJSONKey (Org True) where -- | the server's configuration data Config (loaded :: Bool) = Config - { _tmpdir :: FilePath + { _tmpdir :: FilePath -- ^ dir to clone git things in - , _port :: Int - , _verbose :: Bool - , _interval :: Int + , _port :: Int + , _verbose :: Bool + , _interval :: Int -- ^ port to bind to - , _orgs :: [Org loaded] + , _exneuland :: BaseUrl + , _orgs :: [Org loaded] } deriving Generic makeLenses ''Config @@ -130,6 +137,11 @@ orgCodec = Org <*> T.text "url" .= orgUrl <*> T.text "webdir" .= orgWebdir +-- why exactly does everything in tomland need to be invertable +urlBimap :: TomlBiMap BaseUrl String +urlBimap = BiMap + (Right . show) + (mapLeft (ArbitraryError . show) . parseBaseUrl) configCodec :: TomlCodec (Config False) configCodec = Config @@ -137,6 +149,7 @@ configCodec = Config <*> T.int "port" .= _port <*> T.bool "verbose" .= _verbose <*> T.int "interval" .= _interval + <*> T.match (urlBimap >>> T._String) "exneuland" .= _exneuland <*> T.list orgCodec "org" .= _orgs -- | a job status (of a specific uuid) |