diff options
Diffstat (limited to 'server/Main.hs')
| -rw-r--r-- | server/Main.hs | 20 | 
1 files changed, 7 insertions, 13 deletions
| diff --git a/server/Main.hs b/server/Main.hs index 8ea59d6..1a18c6a 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -10,14 +10,7 @@  -- | simple server offering linting "as a service"  module Main where -import           Universum                            (Container (length), IO, -                                                       MVar, Monad ((>>=)), -                                                       Num ((*)), Proxy (Proxy), -                                                       Text, atomically, forM_, -                                                       forever, map, newMVar, -                                                       print, putTextLn, -                                                       readMVar, view, void, -                                                       ($), (.)) +import           Universum  import           Control.Concurrent                   (threadDelay)  import           Control.Concurrent.Async             (async, link, waitEither_) @@ -49,10 +42,11 @@ import           Server                               (JobStatus, Org (..),                                                         ServerState, Sha1,                                                         emptyState, exneuland,                                                         interval, loadConfig, -                                                       orgs, port, unState, -                                                       verbose) +                                                       orgs, port, token, +                                                       unState, verbose)  import           Worker                               (Job (Job), linterThread) +import           Servant.API                          (Header)  import           Servant.Client                       (BaseUrl (BaseUrl),                                                         ClientM, Scheme (Http),                                                         client, mkClientEnv, @@ -60,7 +54,7 @@ import           Servant.Client                       (BaseUrl (BaseUrl),  type family PolyEndpoint method format payload where    PolyEndpoint Get format payload = Get format payload -  PolyEndpoint Post format payload = ReqBody format payload :> Post '[PlainText] Text +  PolyEndpoint Post format payload = Header "Auth" Text :> ReqBody format payload :> Post '[PlainText] Text  type MapServiceAPI method = @@ -92,7 +86,7 @@ server state = jsonAPI @JSON state  app :: MVar ServerState -> Application  app = serve (Proxy @Routes) . server -postNewMaps :: MapService -> ClientM Text +postNewMaps :: Maybe Text -> MapService -> ClientM Text  postNewMaps = client (Proxy @(MapServiceAPI Post))  main :: IO () @@ -123,7 +117,7 @@ main = do    updater <- async $ forever $ do      done <- readMVar state      res <- runClientM -           (postNewMaps (MapService done)) +           (postNewMaps (view token config) (MapService done))             (mkClientEnv manager' (view exneuland config))      print res      threadDelay (view interval config * 1000000) | 
