Update API schema to make better use of graphql
This commit is contained in:
parent
dfbdb0cf99
commit
cd3e45a045
|
@ -193,9 +193,6 @@ instance MonadDB APIM where
|
|||
dbGetUser = Sql.dbGetUser
|
||||
dbGetUserByEmail = Sql.dbGetUserByEmail
|
||||
dbGetUsers = Sql.dbGetUsers
|
||||
dbGetUserTokens = Sql.dbGetUserTokens
|
||||
dbGetUserKeys = Sql.dbGetUserKeys
|
||||
dbGetUserPrimaryKey = Sql.dbGetUserPrimaryKey
|
||||
dbGetApplications = Sql.dbGetApplications
|
||||
dbGetEmailVerificationSecret = Sql.dbGetEmailVerificationSecret
|
||||
dbGetTokenBySecret = Sql.dbGetTokenBySecret
|
||||
|
|
|
@ -93,8 +93,8 @@ updateArgsToData UpdateArgs {..} user = do
|
|||
verificationSecret <- genVerificationSecret
|
||||
pure UpdateData {..}
|
||||
|
||||
updateUser :: (MonadRandom m, MonadDB m, MonadEmail m, MonadError GQLError m, MonadTime m) =>
|
||||
UserID -> UpdateArgs -> m (User m)
|
||||
updateUser :: (MonadRandom m, MonadDB m, MonadEmail m,
|
||||
MonadError GQLError m, MonadTime m, MonadPermissions m) => UserID -> UpdateArgs -> m (User m)
|
||||
updateUser user args = do
|
||||
updateData@(UpdateData {..}) <- updateArgsToData args user
|
||||
updatedUser <- dbUpdateUser updateData >>= liftDBEither
|
||||
|
@ -152,18 +152,7 @@ resolveQuery = Query
|
|||
{ users = requirePermission Members ReadOnly >> map dbUserToUser <$> dbGetUsers
|
||||
, user = \(Arg id) -> targetUser id >>= \user -> requirePermission (Profile user) ReadOnly >>
|
||||
(Just . dbUserToUser <$> (dbGetUser user >>= liftDBEither)) `catchError` const (pure Nothing)
|
||||
, tokens = \(Arg id) -> targetUser id >>= \user -> do
|
||||
requirePermission (Tokens user) ReadOnly
|
||||
map dbTokenToToken <$> (dbGetUserTokens user >>= liftDBEither)
|
||||
, applications = requirePermission Applications ReadOnly >> map dbUserToUser <$> dbGetApplications
|
||||
, keys = \(Arg id) -> targetUser id >>= \user -> do
|
||||
requirePermission (Profile user) ReadOnly
|
||||
map dbPGPKeyToPGPKey <$> (dbGetUserKeys user >>= liftDBEither)
|
||||
--, key = \(Arg id) -> resolve (pure id)
|
||||
-- TODO is this actually useful
|
||||
, primaryKey = \(Arg id) -> targetUser id >>= \user -> do
|
||||
requirePermission (Profile user) ReadOnly
|
||||
fmap dbPGPKeyToPGPKey <$> (dbGetUserPrimaryKey user >>= liftDBEither)
|
||||
, permissions = currentPermissions
|
||||
}
|
||||
|
||||
|
@ -234,11 +223,13 @@ data User m = User
|
|||
, permissions :: m Text
|
||||
, isMember :: m Bool
|
||||
, application :: m Text
|
||||
, tokens :: m [Token m]
|
||||
, keys :: m [PGPKey m]
|
||||
, primaryKey :: m (Maybe (PGPKey m))
|
||||
} deriving (Generic, GQLType)
|
||||
|
||||
data PGPKey m = PGPKey
|
||||
{ id :: m KeyID
|
||||
, user :: m (User m)
|
||||
, pgpKeyData :: m Base64
|
||||
, expires :: m (Maybe Time)
|
||||
, uploaded :: m Time
|
||||
|
@ -247,7 +238,6 @@ data PGPKey m = PGPKey
|
|||
|
||||
data Token m = Token
|
||||
{ id :: m TokenID
|
||||
, user :: m (User m)
|
||||
, name :: m (Maybe Text)
|
||||
, tokenData :: m Text
|
||||
, comment :: m Text
|
||||
|
@ -260,11 +250,7 @@ data Query m = Query
|
|||
{ users :: m [User m]
|
||||
, user :: Arg "id" (Maybe UserID) -> m (Maybe (User m))
|
||||
, applications :: m [User m]
|
||||
, tokens :: Arg "user" (Maybe UserID) -> m [Token m]
|
||||
, keys :: Arg "user" (Maybe UserID) -> m [PGPKey m]
|
||||
, permissions :: m Text
|
||||
--, key :: Arg "id" KeyID -> m (PGPKey m)
|
||||
, primaryKey :: Arg "user" (Maybe UserID) -> m (Maybe (PGPKey m))
|
||||
} deriving (Generic, GQLType)
|
||||
|
||||
data Mutation m = Mutation
|
||||
|
@ -278,7 +264,7 @@ data Mutation m = Mutation
|
|||
, reject :: Arg "user" UserID -> m Unit
|
||||
} deriving (Generic, GQLType)
|
||||
|
||||
dbUserToUser :: Monad m => DBUser m -> User m
|
||||
dbUserToUser :: (MonadPermissions m, MonadError GQLError m) => DBUser m -> User m
|
||||
dbUserToUser DBUser {..} = User
|
||||
{ id = dbUserId
|
||||
, email = dbUserEmail
|
||||
|
@ -293,12 +279,14 @@ dbUserToUser DBUser {..} = User
|
|||
, permissions = dbUserPermissions
|
||||
, isMember = isJust <$> dbUserAccepted
|
||||
, application = dbUserApplication
|
||||
, tokens = dbUserId >>= flip requirePermission ReadOnly . Tokens >> map dbTokenToToken <$> dbUserTokens
|
||||
, keys = map dbPGPKeyToPGPKey <$> dbUserKeys
|
||||
, primaryKey = fmap dbPGPKeyToPGPKey <$> dbUserPrimaryKey
|
||||
}
|
||||
|
||||
dbPGPKeyToPGPKey :: Monad m => DBPGPKey m -> PGPKey m
|
||||
dbPGPKeyToPGPKey DBPGPKey {..} = PGPKey
|
||||
{ id = dbPGPKeyId
|
||||
, user = dbUserToUser <$> dbPGPKeyUser
|
||||
, pgpKeyData = dbPGPKeyData
|
||||
, expires = dbPGPKeyExpires
|
||||
, uploaded = dbPGPKeyUploaded
|
||||
|
@ -308,7 +296,6 @@ dbPGPKeyToPGPKey DBPGPKey {..} = PGPKey
|
|||
dbTokenToToken :: Monad m => DBToken m -> Token m
|
||||
dbTokenToToken DBToken {..} = Token
|
||||
{ id = dbTokenId
|
||||
, user = dbUserToUser <$> dbTokenUser
|
||||
, name = dbTokenName
|
||||
, tokenData = dbTokenData
|
||||
, comment = dbTokenComment
|
||||
|
|
|
@ -175,6 +175,9 @@ sqlUserToDBUser userID SqlUser {..} =
|
|||
, dbUserAccepted = pure sqlUserAccepted
|
||||
, dbUserPermissions = pure sqlUserPermissions
|
||||
, dbUserPasswordHash = pure sqlUserPasswordCrypt
|
||||
, dbUserTokens = fmap (map entityToDBToken) $ runQuery $ Sql.getUserTokens userID
|
||||
, dbUserKeys = fmap (map entityToDBKey) $ runQuery $ Sql.getKeys userID
|
||||
, dbUserPrimaryKey = fmap (fmap entityToDBKey) $ runQuery $ Sql.getPrimaryKey userID
|
||||
}
|
||||
|
||||
entityToDBToken :: MonadSql m => Entity SqlToken -> DBToken m
|
||||
|
@ -201,10 +204,6 @@ entityToDBKey (Entity keyKey sqlKey) = sqlKeyToDBKey (toID keyKey) sqlKey
|
|||
sqlKeyToDBKey :: MonadSql m => KeyID -> SqlKey -> DBPGPKey m
|
||||
sqlKeyToDBKey keyID SqlKey {..} = DBPGPKey
|
||||
{ dbPGPKeyId = pure keyID
|
||||
, dbPGPKeyUser =
|
||||
let userID = toID sqlKeyUid
|
||||
in fmap (sqlUserToDBUser userID . fromMaybe (error "Inconsistent DB at sqlKeyToDBKey!")) $
|
||||
runQuery $ Sql.getUser userID
|
||||
, dbPGPKeyData = pure $ base64Encode sqlKeyData
|
||||
, dbPGPKeyExpires = pure sqlKeyExpires
|
||||
, dbPGPKeyUploaded = pure sqlKeyUploaded
|
||||
|
|
|
@ -124,11 +124,13 @@ data DBUser m = DBUser
|
|||
, dbUserPermissions :: m Text
|
||||
, dbUserApplication :: m Text
|
||||
, dbUserPasswordHash :: m PasswordHash
|
||||
, dbUserTokens :: m [DBToken m]
|
||||
, dbUserKeys :: m [DBPGPKey m]
|
||||
, dbUserPrimaryKey :: m (Maybe (DBPGPKey m))
|
||||
}
|
||||
|
||||
data DBPGPKey m = DBPGPKey
|
||||
{ dbPGPKeyId :: m KeyID
|
||||
, dbPGPKeyUser :: m (DBUser m)
|
||||
, dbPGPKeyData :: m Base64
|
||||
, dbPGPKeyExpires :: m (Maybe Time)
|
||||
, dbPGPKeyUploaded :: m Time
|
||||
|
@ -165,9 +167,6 @@ class Monad m => MonadDB m where
|
|||
dbGetUser :: UserID -> m (DBEither (DBUser m))
|
||||
dbGetUserByEmail :: Email -> m (DBEither (DBUser m)) -- XXX should this be Maybe instead
|
||||
dbGetUsers :: m [DBUser m]
|
||||
dbGetUserTokens :: UserID -> m (DBEither [DBToken m])
|
||||
dbGetUserKeys :: UserID -> m (DBEither [DBPGPKey m])
|
||||
dbGetUserPrimaryKey :: UserID -> m (DBEither (Maybe (DBPGPKey m)))
|
||||
dbGetApplications :: m [DBUser m]
|
||||
dbGetTokenBySecret :: Text -> m (DBEither (DBToken m))
|
||||
dbGetEmailVerificationSecret :: UserID -> m (DBEither (Maybe Text))
|
||||
|
@ -196,9 +195,6 @@ instance (MonadDB m, LiftOperation o) => MonadDB (Resolver o () m) where
|
|||
dbGetUser = fmap (fmap liftUser) . lift . dbGetUser
|
||||
dbGetUserByEmail = fmap (fmap liftUser) . lift . dbGetUserByEmail
|
||||
dbGetUsers = fmap (map liftUser) $ lift $ dbGetUsers
|
||||
dbGetUserTokens = fmap (fmap (map liftToken)) . lift . dbGetUserTokens
|
||||
dbGetUserKeys = fmap (fmap (map liftKey)) . lift . dbGetUserKeys
|
||||
dbGetUserPrimaryKey = fmap (fmap (fmap liftKey)) . lift . dbGetUserPrimaryKey
|
||||
dbGetApplications = fmap (map liftUser) $ lift $ dbGetApplications
|
||||
dbGetEmailVerificationSecret = lift . dbGetEmailVerificationSecret
|
||||
dbGetTokenBySecret = fmap (fmap liftToken) . lift . dbGetTokenBySecret
|
||||
|
@ -222,7 +218,7 @@ instance (MonadRandom m, LiftOperation o) => MonadRandom (Resolver o () m) where
|
|||
instance (MonadTime m, LiftOperation o) => MonadTime (Resolver o () m) where
|
||||
currentTime = lift currentTime
|
||||
|
||||
liftUser :: (MonadTrans t, Monad m) => DBUser m -> DBUser (t m)
|
||||
liftUser :: (MonadTrans t, Monad m, Monad (t m)) => DBUser m -> DBUser (t m)
|
||||
liftUser DBUser {..} = DBUser
|
||||
{ dbUserId = lift dbUserId
|
||||
, dbUserEmail = lift dbUserEmail
|
||||
|
@ -237,6 +233,9 @@ liftUser DBUser {..} = DBUser
|
|||
, dbUserPermissions = lift dbUserPermissions
|
||||
, dbUserApplication = lift dbUserApplication
|
||||
, dbUserPasswordHash = lift dbUserPasswordHash
|
||||
, dbUserTokens = map liftToken <$> lift dbUserTokens
|
||||
, dbUserKeys = map liftKey <$> lift dbUserKeys
|
||||
, dbUserPrimaryKey = fmap liftKey <$> lift dbUserPrimaryKey
|
||||
}
|
||||
|
||||
liftToken :: (MonadTrans t, Monad m, Monad (t m)) => DBToken m -> DBToken (t m)
|
||||
|
@ -254,7 +253,6 @@ liftToken DBToken {..} = DBToken
|
|||
liftKey :: (MonadTrans t, Monad m, Monad (t m)) => DBPGPKey m -> DBPGPKey (t m)
|
||||
liftKey DBPGPKey {..} = DBPGPKey
|
||||
{ dbPGPKeyId = lift dbPGPKeyId
|
||||
, dbPGPKeyUser = fmap liftUser $ lift dbPGPKeyUser
|
||||
, dbPGPKeyData = lift dbPGPKeyData
|
||||
, dbPGPKeyExpires = lift dbPGPKeyExpires
|
||||
, dbPGPKeyUploaded = lift dbPGPKeyUploaded
|
||||
|
|
|
@ -21,7 +21,6 @@ enum Unit {
|
|||
|
||||
type PGPKey {
|
||||
id: KeyID!
|
||||
user: User!
|
||||
pgpKeyData: Base64!
|
||||
expires: Time
|
||||
uploaded: Time!
|
||||
|
@ -30,7 +29,6 @@ type PGPKey {
|
|||
|
||||
type Token {
|
||||
id: TokenID!
|
||||
user: User!
|
||||
name: String
|
||||
tokenData: String!
|
||||
comment: String!
|
||||
|
@ -53,16 +51,16 @@ type User {
|
|||
permissions: String!
|
||||
isMember: Boolean!
|
||||
application: String!
|
||||
tokens: [Token!]!
|
||||
keys: [PGPKey!]!
|
||||
primaryKey: PGPKey
|
||||
}
|
||||
|
||||
type Query {
|
||||
users: [User!]!
|
||||
user(id: UserID): User
|
||||
applications: [User!]!
|
||||
tokens(user: UserID): [Token!]!
|
||||
keys(user: UserID): [PGPKey!]!
|
||||
permissions: String!
|
||||
primaryKey(user: UserID): PGPKey
|
||||
}
|
||||
|
||||
type Mutation {
|
||||
|
|
Loading…
Reference in New Issue