Add 0.0.0.6

Author: Jon Kristensen

src/Api.hs

@@ -10,6 +10,7 @@ import           Backend
 import           Control.Monad.Trans
 import           Control.Monad.Trans.Either
 import           Data.Traversable
+import qualified Data.Traversable as Traversable
 import           Data.Monoid
 import           Data.Text (Text)
 import qualified Data.Text as Text
@@ -97,6 +98,19 @@ serveGetUserInstancesAPI :: ConnectionPool
 serveGetUserInstancesAPI pool conf user =
   lift . runAPI pool conf $ getUserInstances user
 
+type GetUserInfoAPI = "user-info-by-token"
+                    :> Capture "token" B64Token
+                    :> Get '[JSON] ReturnUserInfo
+
+serveGetUserInfoAPI :: ConnectionPool
+                    -> Config
+                    -> Server GetUserInfoAPI
+serveGetUserInfoAPI pool conf token =  do
+  mbRUI <- lift . runAPI pool conf $ getUserInfo token
+  case mbRUI of
+   Nothing -> left err403
+   Just rui -> return rui
+
 type UserMirrorAPI = "showUser"
                    :> Header "X-User" Text
                    :> Get '[JSON] Text
@@ -111,6 +125,7 @@ apiPrx :: Proxy (    LoginAPI
                 :<|> PublicCheckTokenAPI
                 :<|> LogoutAPI
                 :<|> GetUserInstancesAPI
+                :<|> GetUserInfoAPI
                 :<|> UserMirrorAPI)
 apiPrx = Proxy
 
@@ -120,4 +135,5 @@ serveAPI pool conf = serve apiPrx $ serveLogin pool conf
                                :<|> servePublicCheckToken pool conf
                                :<|> serveLogout pool conf
                                :<|> serveGetUserInstancesAPI pool conf
+                               :<|> serveGetUserInfoAPI pool conf
                                :<|> serveUserMirror

src/AuthServiceTypes.hs

@@ -170,6 +170,16 @@ makeLensesWith camelCaseFields ''ReturnInstance
 deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "returnInstance"}
     ''ReturnInstance
 
+data ReturnUserInfo = ReturnUserInfo { returnUserInfoId :: !UserID
+                                     , returnUserInfoEmail :: !Email
+                                     , returnUserInfoName :: !Name
+                                     , returnUserInfoPhone :: !(Maybe Phone)
+                                     , returnUserInfoInstances :: ![ReturnInstance]
+                                     }
+
+deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "returnUserInfo"}
+           ''ReturnUserInfo
+makeLensesWith camelCaseFields ''ReturnUserInfo
 
 data Login = Login { loginUser     :: !Email
                    , loginPassword :: !Password

src/Backend.hs

@@ -17,6 +17,7 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Time.Clock
+import qualified Data.Traversable as Traversable
 import qualified Data.UUID.V4 as UUID
 import qualified Database.Esqueleto as E
 import           Database.Esqueleto hiding ((^.), from)
@@ -210,12 +211,32 @@ login Login{ loginUser = userEmail
         sendOTP twilioConf userEmail p otp
         return ()
 
+getUserByToken :: B64Token -> API (Maybe DB.User)
+getUserByToken tokenId = do
+  -- Delete expired tokens
+  now <- liftIO $ getCurrentTime
+  runDB $ P.deleteWhere [DB.TokenExpires P.<=. Just now]
+
+  user <- runDB . select . E.from $ \(user `InnerJoin` token) -> do
+    on (user E.^. DB.UserUuid ==. token E.^. DB.TokenUser)
+    where_ (token E.^. DB.TokenToken ==. val tokenId)
+    return user
+  return . fmap entityVal $ listToMaybe user
+
+getUserInfo :: B64Token -> API (Maybe ReturnUserInfo)
+getUserInfo token = do
+  mbUser <- getUserByToken token
+  Traversable.forM mbUser $ \user -> do
+    instances <- getUserInstances (user ^. DB.uuid)
+    return ReturnUserInfo { returnUserInfoId = user ^. DB.uuid
+                          , returnUserInfoEmail = user ^. email
+                          , returnUserInfoName = user ^. name
+                          , returnUserInfoPhone = user ^. phone
+                          , returnUserInfoInstances = instances
+                          }
 
 checkToken :: B64Token -> API (Maybe UserID)
-checkToken tokenId = do
-    now <- liftIO $ getCurrentTime
-    runDB $ P.deleteWhere [DB.TokenExpires P.<=. Just now]
-    fmap DB.tokenUser <$> (runDB $ P.get (DB.TokenKey tokenId))
+checkToken tokenId = fmap DB.userUuid <$> getUserByToken tokenId
 
 checkInstance  :: InstanceID -> UserID -> API (Maybe DB.UserInstance)
 checkInstance inst user = runDB $ P.get (DB.UserInstanceKey user inst)

web/nginx.conf.m4

@@ -91,6 +91,20 @@ http {
             alias /www/auth-service.js;
         }
 
+        location = /user-info {
+            set $token $cookie_token;
+            if ($token = '') {
+              set $token $http_x_token;
+            }
+            if ($token = '') {
+              return 403;
+            }
+            proxy_pass http://AUTH_SERVICE/user-info-by-token/$token/;
+            proxy_pass_request_body off;
+            proxy_set_header Content-Length "";
+            proxy_set_header X-Original-URI $request_uri;
+        }
+
         # Locations to redirect /auth.html
 
         location = /auth.html {