From 7c73bf1d94b8a972ba64fb8210290de7e6ab2839 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 16 Feb 2022 20:28:46 +0100
Subject: server: exneuland wants a token, apparently

---
 server/Main.hs | 20 +++++++-------------
 1 file changed, 7 insertions(+), 13 deletions(-)

(limited to 'server/Main.hs')

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)
-- 
cgit v1.2.3