From 225d5d135c95d611d4edddac4a3fb3d4d3c5c4b6 Mon Sep 17 00:00:00 2001
From: Kjetil Orbekk <kjetil.orbekk@gmail.com>
Date: Tue, 13 Oct 2015 20:51:34 -0400
Subject: Working authentication for /test.

---
 photos.cabal |  1 +
 src/Main.hs  | 19 +++++++++++++++----
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/photos.cabal b/photos.cabal
index 5bc02bc..a043f6f 100644
--- a/photos.cabal
+++ b/photos.cabal
@@ -32,6 +32,7 @@ executable photos
     , mtl
     , servant
     , servant-server
+    , split
     , transformers
     , wai
     , wai-extra
diff --git a/src/Main.hs b/src/Main.hs
index d4c7fd4..187a9a6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -19,6 +20,7 @@ import Network.Wai.Middleware.RequestLogger
 import Servant
 import System.Exit
 import System.IO.Unsafe (unsafePerformIO)
+import Data.List.Split
 
 import qualified Authentication
 import Data
@@ -44,11 +46,13 @@ instance ToJSON RenameError
 type PhotoApi =
        "albums" :> Get '[JSON] [Album]
   :<|> "rename" :> ReqBody '[JSON] RenameRequest :> Post '[JSON] (Either RenameError ())
-  :<|> "test"   :> Header "X-Token" String :> Get '[JSON] ()
+  :<|> "test"   :> Header "X-Token" String :> Get '[JSON] String
 -- Introduce request header containing auth information.
 
+type Token = String
+
 isAuthenticated = Authentication.isAuthenticated users cache
-    where users = ["kjetil.orbekk@gmail.com"]
+    where users = splitOn "," flags_allowed_users
           cache = unsafePerformIO (newMVar [])
 
 config = Config
@@ -56,6 +60,12 @@ config = Config
   , photosPath = flags_photos_path
   }
 
+whenAuthenticated :: Maybe Token -> EitherT ServantErr IO a -> EitherT ServantErr IO a
+whenAuthenticated (Just token) action = liftIO (isAuthenticated token) >>= \case
+  True -> action
+  False -> left err503 { errBody = "Not authenticated" }
+whenAuthenticated Nothing _ = left err503 { errBody = "Missing token" }
+
 server :: Server PhotoApi
 server = albums
     :<|> rename
@@ -66,8 +76,8 @@ server = albums
         rename (RenameRequest from to) = liftIO $
           runEitherT (renameAlbum config from to)
 
-        test (Just token) = liftIO (putStrLn $ "Is authenticated" ++ token)
-        test _ = left err503 { errBody = "Not authenticated" }
+        test = (`whenAuthenticated` test')
+        test' = return "Yay"
 
 photoApi :: Proxy PhotoApi
 photoApi = Proxy
@@ -82,6 +92,7 @@ settings = setHost "*6" . setPort 8081 $ defaultSettings
 main :: IO ()
 main = do
   $initHFlags "photos"
+  print $ splitOn "," flags_allowed_users
   when (flags_pending_path == "") (die "--pending_path must be specified")
   when (flags_photos_path == "") (die "--photos_path must be specified")
   putStrLn $ "Starting server on port: " ++ (show port)
-- 
cgit v1.2.3