blob: 786820f097a382542fd46ae204a6ebeb8af6aca2 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
--------------------------------------------------------------------------------
module App where
--------------------------------------------------------------------------------
import Control.Exception (throwIO)
import Control.Monad.IO.Class (liftIO)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Network.Wai.Handler.Warp as Warp
import Servant
import API
import Utils
import qualified Crypto.KDF.BCrypt as BC
import qualified Data.Text.Encoding as TE
import qualified Types as T
import qualified Accounts as Accounts
import qualified Trips as Trips
import qualified Sessions as Sessions
--------------------------------------------------------------------------------
server :: FilePath -> Server API
server dbFile = createAccountH
:<|> deleteAccountH
:<|> listAccountsH
:<|> 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
createAccount request = do
Accounts.create dbFile
(T.createAccountRequestUsername request)
(T.createAccountRequestPassword request)
(T.createAccountRequestEmail request)
(T.createAccountRequestRole request)
pure NoContent
deleteAccount :: Text -> IO NoContent
deleteAccount username = do
Accounts.delete dbFile (T.Username username)
pure NoContent
listAccounts :: IO [T.User]
listAccounts = Accounts.list dbFile
createTrip :: T.Trip -> IO NoContent
createTrip trip = do
Trips.create dbFile trip
pure NoContent
listTrips :: IO [T.Trip]
listTrips = Trips.list dbFile
-- TODO(wpcarro): Validate incoming data like startDate.
deleteTrip :: T.TripPK -> IO NoContent
deleteTrip tripPK = do
Trips.delete dbFile tripPK
pure NoContent
-- TODO(wpcarro): Create and store a session token
login :: T.AccountCredentials -> IO NoContent
login (T.AccountCredentials username password) = do
mAccount <- Accounts.lookup dbFile username
case mAccount of
Just account ->
if T.passwordsMatch password (T.accountPassword account) then do
session <- Sessions.findOrCreate dbFile account
-- set cookie
pure NoContent
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.
Nothing -> throwIO $ err401 { errBody = "Your credentials are invalid" }
mkApp :: FilePath -> IO Application
mkApp dbFile = do
pure $ serve (Proxy @ API) $ server dbFile
run :: FilePath -> IO ()
run sqliteFile =
Warp.run 3000 =<< mkApp sqliteFile
|
