subtree(users/wpcarro): docking briefcase at '24f5a642'

git-subtree-dir: users/wpcarro
git-subtree-mainline: 464bbcb15c
git-subtree-split: 24f5a642af
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789

users/wpcarro/assessments/tt/src/Auth.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module Auth where
+--------------------------------------------------------------------------------
+import Control.Monad.IO.Class (liftIO)
+import Web.Cookie
+import Servant
+
+import qualified Data.UUID as UUID
+import qualified Sessions as Sessions
+import qualified Accounts as Accounts
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+-- | Return the UUID from a Session cookie.
+uuidFromCookie :: T.SessionCookie -> Maybe T.SessionUUID
+uuidFromCookie (T.SessionCookie cookies) = do
+  auth <- lookup "auth" cookies
+  uuid <- UUID.fromASCIIBytes auth
+  pure $ T.SessionUUID uuid
+
+-- | Attempt to return the account associated with `cookie`.
+accountFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Account)
+accountFromCookie dbFile cookie =
+  case uuidFromCookie cookie of
+    Nothing -> pure Nothing
+    Just uuid -> do
+      mSession <- Sessions.get dbFile uuid
+      case mSession of
+        Nothing -> pure Nothing
+        Just T.StoredSession{..} -> do
+          mAccount <- Accounts.lookup dbFile storedSessionUsername
+          case mAccount of
+            Nothing -> pure Nothing
+            Just x -> pure (Just x)
+
+-- | Create a new session cookie.
+mkCookie :: T.SessionUUID -> SetCookie
+mkCookie (T.SessionUUID uuid) =
+  defaultSetCookie
+    { setCookieName = "auth"
+    , setCookieValue = UUID.toASCIIBytes uuid
+    }
+
+-- | Use this to clear out the session cookie.
+emptyCookie :: SetCookie
+emptyCookie =
+  defaultSetCookie
+    { setCookieName = "auth"
+    , setCookieValue = ""
+    }
+
+-- | Throw a 401 error if the `predicate` fails.
+assert :: FilePath -> T.SessionCookie -> (T.Account -> Bool) -> Handler a -> Handler a
+assert dbFile cookie predicate handler = do
+  mRole <- liftIO $ accountFromCookie dbFile cookie
+  case mRole of
+    Nothing -> throwError err401 { errBody = "Missing valid session cookie" }
+    Just account ->
+      if predicate account then
+        handler
+      else
+        throwError err401 { errBody = "You are not authorized to access this resource" }