about summary refs log tree commit diff
path: root/src/App.hs
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2020-07-29T13·14+0100
committerWilliam Carroll <wpcarro@gmail.com>2020-07-29T13·14+0100
commitc4a090e55803864c21e8c40432ca17772247ca8e (patch)
tree3085b8e1f323830ad0b62bbae93fb27b24729046 /src/App.hs
parent9f70cb2c612212e218b5df75c9afba08f51d3acb (diff)
Support reading / writing cookies in API
Update my API type and handler types to reflect which handlers read and write
cookies.

TODO:
- Actually read from and write to Set-Cookie header
- Returning `pure NoContent` breaks my types, so I'm returning `undefined` now
Diffstat (limited to 'src/App.hs')
-rw-r--r--src/App.hs62
1 files changed, 36 insertions, 26 deletions
diff --git a/src/App.hs b/src/App.hs
index 209e2f209231..783b4402f078 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -14,6 +15,7 @@ import Network.Wai.Handler.Warp as Warp
 import Servant
 import API
 import Utils
+import Web.Cookie
 
 import qualified Crypto.KDF.BCrypt as BC
 import qualified Data.Text.Encoding as TE
@@ -32,14 +34,16 @@ server dbFile = createAccountH
            :<|> deleteTripH
            :<|> listTripsH
            :<|> loginH
+           :<|> logoutH
   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
+    createAccountH newUser         = liftIO $ createAccount newUser
+    deleteAccountH cookie username = liftIO $ deleteAccount cookie username
+    listAccountsH cookie           = liftIO $ listAccounts cookie
+    createTripH cookie trip        = liftIO $ createTrip cookie trip
+    deleteTripH cookie tripPK      = liftIO $ deleteTrip cookie tripPK
+    listTripsH                     = liftIO $ listTrips
+    loginH creds                   = liftIO $ login creds
+    logoutH cookie                 = liftIO $ logout cookie
 
     -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
     createAccount :: T.CreateAccountRequest -> IO NoContent
@@ -51,30 +55,30 @@ server dbFile = createAccountH
         (T.createAccountRequestRole request)
       pure NoContent
 
-    deleteAccount :: Text -> IO NoContent
-    deleteAccount username = do
+    deleteAccount :: T.SessionCookie -> Text -> IO NoContent
+    deleteAccount cookie username = do
       Accounts.delete dbFile (T.Username username)
       pure NoContent
 
-    listAccounts :: IO [T.User]
-    listAccounts = Accounts.list dbFile
+    listAccounts :: T.SessionCookie -> IO [T.User]
+    listAccounts cookie = Accounts.list dbFile
 
-    createTrip :: T.Trip -> IO NoContent
-    createTrip trip = do
+    createTrip :: T.SessionCookie -> T.Trip -> IO NoContent
+    createTrip cookie 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
+    deleteTrip :: T.SessionCookie -> T.TripPK -> IO NoContent
+    deleteTrip cookie tripPK = do
       Trips.delete dbFile tripPK
       pure NoContent
 
-    -- TODO(wpcarro): Create and store a session token
-    login :: T.AccountCredentials -> IO NoContent
+    listTrips :: IO [T.Trip]
+    listTrips = Trips.list dbFile
+
+    login :: T.AccountCredentials
+          -> IO (Headers '[Header "Set-Cookie" SetCookie] NoContent)
     login (T.AccountCredentials username password) = do
       mAccount <- Accounts.lookup dbFile username
       case mAccount of
@@ -85,25 +89,31 @@ server dbFile = createAccountH
               if T.passwordsMatch password accountPassword then do
                 session <- Sessions.findOrCreate dbFile account
                 -- set cookie
-                pure NoContent
+                undefined
               else do
                 LoginAttempts.increment dbFile username
-                throwIO $ err401 { errBody = "Your credentials are invalid" }
+                throwIO err401 { errBody = "Your credentials are invalid" }
             Just attempts ->
               if attempts > 3 then
                 -- TODO(wpcarro): Prefer 429 error code
-                throwIO $ err401 { errBody = "Too many failed login attempts" }
+                throwIO err401 { errBody = "Too many failed login attempts" }
               else if T.passwordsMatch password accountPassword then do
                 session <- Sessions.findOrCreate dbFile account
                 -- set cookie
-                pure NoContent
+                undefined
               else do
                 LoginAttempts.increment dbFile username
                 -- TODO(wpcarro): Catch and return errors over HTTP
-                throwIO $ err401 { errBody = "Your credentials are invalid" }
+                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" }
+        Nothing -> throwIO err401 { errBody = "Your credentials are invalid" }
+
+    logout :: T.SessionCookie
+           -> IO (Headers '[Header "Set-Cookie" SetCookie] NoContent)
+    logout cookie = undefined
+      -- pull off SessionUUID from the request headers
+      -- delete the SessionUUID from the Sessions table.
 
 mkApp :: FilePath -> IO Application
 mkApp dbFile = do