diff options
| author | Kjetil Orbekk <kjetil.orbekk@gmail.com> | 2015-10-13 20:51:34 -0400 |
|---|---|---|
| committer | Kjetil Orbekk <kjetil.orbekk@gmail.com> | 2015-10-13 20:51:34 -0400 |
| commit | 225d5d135c95d611d4edddac4a3fb3d4d3c5c4b6 (patch) | |
| tree | b73e5d41f976b688bc0cef9d21435db967e06271 | |
| parent | 1276bc232e1f1adfafe264130c91658052be8190 (diff) | |
Working authentication for /test.
| -rw-r--r-- | photos.cabal | 1 | ||||
| -rw-r--r-- | 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) |