diff options
| -rw-r--r-- | src/API.hs | 5 | ||||
| -rw-r--r-- | src/App.hs | 28 |
2 files changed, 30 insertions, 3 deletions
diff --git a/src/API.hs b/src/API.hs index 134d278426d6..9ae618cd3029 100644 --- a/src/API.hs +++ b/src/API.hs @@ -37,3 +37,8 @@ type API = -- trips: List :<|> "trips" :> Get '[JSON] [T.Trip] + + -- Miscellaneous + :<|> "login" + :> ReqBody '[JSON] T.AccountCredentials + :> Post '[JSON] (Maybe T.Session) diff --git a/src/App.hs b/src/App.hs index e9c528ec4eac..f8b81ed98672 100644 --- a/src/App.hs +++ b/src/App.hs @@ -1,18 +1,22 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} -------------------------------------------------------------------------------- module App where -------------------------------------------------------------------------------- +import Control.Exception (throwIO) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (runStderrLoggingT) import Data.Function ((&)) import Data.String.Conversions (cs) import Data.Text (Text) import Database.SQLite.Simple import Network.Wai.Handler.Warp as Warp import Servant - import API + +import qualified Crypto.KDF.BCrypt as BC +import qualified Data.Text.Encoding as TE import qualified Types as T -------------------------------------------------------------------------------- @@ -23,14 +27,15 @@ server dbFile = createAccountH :<|> createTripH :<|> deleteTripH :<|> listTripsH + :<|> loginH where createAccountH newUser = liftIO $ createAccount newUser deleteAccountH username = liftIO $ deleteAccount username listAccountsH = liftIO $ listAccounts - createTripH trip = liftIO $ createTrip trip deleteTripH tripPK = liftIO $ deleteTrip tripPK listTripsH = liftIO $ listTrips + loginH creds = liftIO $ login creds -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s createAccount :: T.CreateAccountRequest -> IO NoContent @@ -73,6 +78,23 @@ server dbFile = createAccountH (tripPK & T.tripPKFields) pure NoContent + -- TODO(wpcarro): Create and store a session token + login :: T.AccountCredentials -> IO (Maybe T.Session) + login (T.AccountCredentials username password) = + withConnection dbFile $ \conn -> do + res <- query conn "SELECT * FROM Accounts WHERE username = ?" + (Only username) + case res of + [T.Account{T.accountUsername,T.accountPassword,T.accountRole}] -> + if T.passwordsMatch password accountPassword then + pure $ Just (T.Session accountUsername accountRole) + else + -- TODO(wpcarro): Catch and return errors over HTTP + throwIO $ err401 { errBody = "Your credentials are invalid" } + + -- In this branch, the user didn't supply a known username. + _ -> throwIO $ err401 { errBody = "Your credentials are invalid" } + mkApp :: FilePath -> IO Application mkApp dbFile = do pure $ serve (Proxy @ API) $ server dbFile |