From 3b4b8efc114d98db4379404f46fa93ae6c96f2b2 Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Thu, 14 Mar 2024 15:47:31 +0700 Subject: [PATCH 1/8] WIP: Separate `Model` and `ModelVersion` --- .../src/Inferno/ML/Server/Types.hs | 131 +++++++++++++----- 1 file changed, 100 insertions(+), 31 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index c967a8b..ed29e8c 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -206,19 +206,13 @@ instance -- | Row of the model table, parameterized by the user and group type as well -- as the contents of the model (normally this will be an 'Oid') -data Model uid gid c = Model - { id :: Maybe (Id (Model uid gid c)), +data Model uid gid = Model + { id :: Maybe (Id (Model uid gid)), name :: Text, - -- | The actual contents of the model - contents :: c, - version :: Version, - -- | Stored as JSON in the DB - card :: ModelCard, -- | Permissions for reading or updating the model, keyed by the group ID -- type -- - -- NOTE - -- This is stored as a @jsonb@ rather than as @hstore@. It could + -- NOTE: This is stored as a @jsonb@ rather than as @hstore@. It could -- currently be stored as an @hstore@, but later we might want to -- use a more complex type that we could not easily convert to\/from -- text (which is required to use @hstore@). So using @jsonb@ allows @@ -230,7 +224,7 @@ data Model uid gid c = Model } deriving stock (Show, Eq, Generic) -instance NFData (Model uid gid c) where +instance NFData (Model uid gid) where rnf = rwhnf instance @@ -241,17 +235,13 @@ instance FromJSONKey gid, Ord gid ) => - FromRow (Model uid gid Oid) + FromRow (Model uid gid) where - -- NOTE - -- Order of fields must align exactly with DB schema + -- NOTE: Order of fields must align exactly with DB schema fromRow = Model <$> field <*> field - <*> field - <*> field - <*> field <*> fmap getAeson field <*> field @@ -262,16 +252,12 @@ instance ToField gid, ToJSONKey gid ) => - ToRow (Model uid gid Oid) + ToRow (Model uid gid) where - -- NOTE - -- Order of fields must align exactly with DB schema + -- NOTE: Order of fields must align exactly with DB schema toRow m = [ toField Default, m ^. the @"name" & toField, - m ^. the @"contents" & toField, - m ^. the @"version" & toField, - m ^. the @"card" & toField, m ^. the @"permissions" & Aeson & toField, m ^. the @"user" & toField ] @@ -283,7 +269,7 @@ instance FromJSONKey gid, Ord gid ) => - FromJSON (Model uid gid Oid) + FromJSON (Model uid gid) where parseJSON = withObject "Model" $ \o -> Model @@ -292,9 +278,6 @@ instance -- in the DB already) <$> fmap Just (o .: "id") <*> (ensureNotNull =<< o .: "name") - <*> fmap (Oid . fromIntegral @Word64) (o .: "contents") - <*> o .: "version" - <*> o .: "card" <*> o .: "permissions" <*> o .:? "user" where @@ -310,18 +293,101 @@ instance ToJSON gid, ToJSONKey gid ) => - ToJSON (Model uid gid Oid) + ToJSON (Model uid gid) where toJSON m = object [ "id" .= view (the @"id") m, "name" .= view (the @"name") m, - "contents" .= view (the @"contents" . to unOid) m, - "version" .= view (the @"version") m, - "card" .= view (the @"card") m, "permissions" .= view (the @"permissions") m, "user" .= view (the @"user") m ] + +-- | TODO +data ModelVersion uid gid c = ModelVersion + { id :: Maybe (Id (ModelVersion uid gid c)), + -- | Foreign key of the @model@ table, which contains invariant metadata + -- related to the model, i.e. name, permissions, user + model :: Id (Model uid gid), + card :: ModelCard, + -- | The actual contents of the model version + contents :: c, + version :: Version + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +instance + ( Typeable uid, + Typeable gid, + FromField uid, + FromField gid + ) => + FromRow (ModelVersion uid gid Oid) + where + -- NOTE: Order of fields must align exactly with DB schema + fromRow = + ModelVersion + <$> field + <*> field + <*> field + <*> field + <*> field + +instance + ( Typeable uid, + Typeable gid, + ToField uid, + ToField gid, + ToJSONKey gid + ) => + ToRow (ModelVersion uid gid Oid) + where + -- NOTE: Order of fields must align exactly with DB schema + toRow mv = + [ toField Default, + mv ^. the @"model" & toField, + mv ^. the @"version" & toField, + mv ^. the @"contents" & toField, + mv ^. the @"card" & Aeson & toField + ] + +{- ORMOLU_DISABLE -} +instance + ( FromJSON uid, + FromJSON gid, + FromJSONKey gid, + Ord gid + ) => + FromJSON (ModelVersion uid gid Oid) + where + parseJSON = withObject "ModelVersion" $ \o -> + ModelVersion + -- Note that for a model serialized as JSON, the `id` must be present + -- (this assumes that a model serialized as JSON always refers to one + -- that exists in the DB already) + <$> fmap Just (o .: "id") + <*> o .: "model" + <*> o .: "version" + <*> fmap (Oid . fromIntegral @Word64) (o .: "contents") + <*> o .: "card" +{- ORMOLU_ENABLE -} + +instance + ( ToJSON uid, + ToJSON gid, + ToJSONKey gid + ) => + ToJSON (ModelVersion uid gid Oid) + where + toJSON mv = + object + [ "id" .= view (the @"id") mv, + "model" .= view (the @"model") mv, + "contents" .= view (the @"contents" . to unOid) mv, + "version" .= view (the @"version") mv, + "card" .= view (the @"card") mv + ] where unOid :: Oid -> Word32 unOid (Oid (CUInt x)) = x @@ -333,6 +399,7 @@ data ModelPermissions | -- | The model can be updated e.g. during training WriteModel deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) instance FromJSON ModelPermissions where parseJSON = withText "ModelPermissions" $ \case @@ -498,7 +565,9 @@ data InferenceParam uid gid p s = InferenceParam -- For existing inference params, this is the foreign key for the specific -- script in the 'InferenceScript' table script :: s, - model :: Id (Model uid gid Oid), + -- | This needs to be linked to a specific version of a model rather + -- than the @model@ table itself + model :: Id (ModelVersion uid gid Oid), inputs :: Vector (SingleOrMany p), outputs :: Vector (SingleOrMany p), user :: uid From 713aaf944aa87b3fac52806db2c0b02a9c13418e Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Fri, 15 Mar 2024 11:13:46 +0700 Subject: [PATCH 2/8] More docs --- .../src/Inferno/ML/Server/Types.hs | 22 ++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index ed29e8c..aeeb2bc 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -204,8 +204,11 @@ instance <$> fmap wrappedTo (field @VCObjectHashRow) <*> fmap getAeson field --- | Row of the model table, parameterized by the user and group type as well --- as the contents of the model (normally this will be an 'Oid') +-- | Row of the model table, parameterized by the user and group type. This +-- table contains metadata for models that should not change between different +-- versions, e.g. model name and permissions. A second table, 'ModelVersion', +-- contains the specific versions of each model (and the actual model contents), +-- along with other metadata that may change between versions data Model uid gid = Model { id :: Maybe (Id (Model uid gid)), name :: Text, @@ -303,14 +306,21 @@ instance "user" .= view (the @"user") m ] --- | TODO +-- | Represents rows of the model version tables; each row is linked to its +-- 'Model' parent and also contains the actual contents of the model. This +-- is parameterized by the user and group types as well as the type of the +-- content, which will normally be an 'Oid' (Postgres large object). Other +-- model metadata is contained here as well, e.g. the model card, as this +-- might change between versions data ModelVersion uid gid c = ModelVersion { id :: Maybe (Id (ModelVersion uid gid c)), -- | Foreign key of the @model@ table, which contains invariant metadata -- related to the model, i.e. name, permissions, user model :: Id (Model uid gid), card :: ModelCard, - -- | The actual contents of the model version + -- | The actual contents of version of the model. Normally this will be + -- an 'Oid' pointing to the serialized bytes of the model imported into + -- the PSQL large object table contents :: c, version :: Version } @@ -325,7 +335,9 @@ instance ) => FromRow (ModelVersion uid gid Oid) where - -- NOTE: Order of fields must align exactly with DB schema + -- NOTE: Order of fields must align exactly with DB schema. This instance + -- could just be `anyclass` derived but it's probably better to be as + -- explicit as possible fromRow = ModelVersion <$> field From 07a1d115d09fff6d7acfca91b3ab492ef0d5fa13 Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Fri, 15 Mar 2024 11:19:43 +0700 Subject: [PATCH 3/8] Remove some redundant constraints --- .../src/Inferno/ML/Server/Types.hs | 27 +++++-------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index aeeb2bc..b9b96bb 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -231,8 +231,7 @@ instance NFData (Model uid gid) where rnf = rwhnf instance - ( Typeable uid, - Typeable gid, + ( Typeable gid, FromField uid, FromField gid, FromJSONKey gid, @@ -249,9 +248,7 @@ instance <*> field instance - ( Typeable uid, - Typeable gid, - ToField uid, + ( ToField uid, ToField gid, ToJSONKey gid ) => @@ -268,7 +265,6 @@ instance {- ORMOLU_DISABLE -} instance ( FromJSON uid, - FromJSON gid, FromJSONKey gid, Ord gid ) => @@ -293,7 +289,6 @@ instance instance ( ToJSON uid, - ToJSON gid, ToJSONKey gid ) => ToJSON (Model uid gid) @@ -328,9 +323,7 @@ data ModelVersion uid gid c = ModelVersion deriving anyclass (NFData) instance - ( Typeable uid, - Typeable gid, - FromField uid, + ( FromField uid, FromField gid ) => FromRow (ModelVersion uid gid Oid) @@ -347,11 +340,8 @@ instance <*> field instance - ( Typeable uid, - Typeable gid, - ToField uid, - ToField gid, - ToJSONKey gid + ( ToField uid, + ToField gid ) => ToRow (ModelVersion uid gid Oid) where @@ -367,9 +357,7 @@ instance {- ORMOLU_DISABLE -} instance ( FromJSON uid, - FromJSON gid, - FromJSONKey gid, - Ord gid + FromJSON gid ) => FromJSON (ModelVersion uid gid Oid) where @@ -387,8 +375,7 @@ instance instance ( ToJSON uid, - ToJSON gid, - ToJSONKey gid + ToJSON gid ) => ToJSON (ModelVersion uid gid Oid) where From a950cb6d25d593bfad018bf91ce0d4847a59ecba Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Mon, 18 Mar 2024 13:39:45 +0700 Subject: [PATCH 4/8] Fix comment --- inferno-ml-server-types/src/Inferno/ML/Server/Types.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index b9b96bb..933e8c5 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -89,7 +89,10 @@ import System.Posix (EpochTime) import Text.Read (readMaybe) import URI.ByteString (Absolute, URIRef) import URI.ByteString.Aeson () -import Web.HttpApiData (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece)) +import Web.HttpApiData + ( FromHttpApiData (parseUrlPiece), + ToHttpApiData (toUrlPiece), + ) -- API type for `inferno-ml-server` type InfernoMlServerAPI uid gid p s = @@ -364,8 +367,8 @@ instance parseJSON = withObject "ModelVersion" $ \o -> ModelVersion -- Note that for a model serialized as JSON, the `id` must be present - -- (this assumes that a model serialized as JSON always refers to one - -- that exists in the DB already) + -- (this assumes that a model version serialized as JSON always refers + -- to one that exists in the DB already) <$> fmap Just (o .: "id") <*> o .: "model" <*> o .: "version" From 83be52195cf2d4ed4dec691d934c1841dbafff66 Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Thu, 21 Mar 2024 13:08:19 +0700 Subject: [PATCH 5/8] Version bump --- inferno-ml-server-types/CHANGELOG.md | 3 +++ inferno-ml-server-types/inferno-ml-server-types.cabal | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/inferno-ml-server-types/CHANGELOG.md b/inferno-ml-server-types/CHANGELOG.md index 2a75140..3cb6121 100644 --- a/inferno-ml-server-types/CHANGELOG.md +++ b/inferno-ml-server-types/CHANGELOG.md @@ -1,5 +1,8 @@ # Revision History for inferno-ml-server-types *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH) +## 0.1.0 +* Split `Model` and `ModelVersion` + ## 0.0.1 * Initial pre-release diff --git a/inferno-ml-server-types/inferno-ml-server-types.cabal b/inferno-ml-server-types/inferno-ml-server-types.cabal index 9dad133..2876175 100644 --- a/inferno-ml-server-types/inferno-ml-server-types.cabal +++ b/inferno-ml-server-types/inferno-ml-server-types.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: inferno-ml-server-types -version: 0.0.1 +version: 0.1.0 synopsis: Types for Inferno ML server description: Types for Inferno ML server homepage: https://github.com/plow-technologies/inferno.git#readme From 1bea5fa7b8c540f649fa9413c987f6b5aff39866 Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Thu, 21 Mar 2024 13:28:29 +0700 Subject: [PATCH 6/8] Allow `Model.id` to be null/missing --- inferno-ml-server-types/src/Inferno/ML/Server/Types.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index 933e8c5..4e88043 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -275,10 +275,8 @@ instance where parseJSON = withObject "Model" $ \o -> Model - -- Note that for a model serialized as JSON, the `id` must be present - -- (this assumes that a serialized model always refers to one that exists - -- in the DB already) - <$> fmap Just (o .: "id") + -- If a new model is being created, its ID will not be present + <$> o .:? "id" <*> (ensureNotNull =<< o .: "name") <*> o .: "permissions" <*> o .:? "user" From d2ad674633d59d1d09db09f22504946b1ddd824b Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Thu, 21 Mar 2024 14:08:45 +0700 Subject: [PATCH 7/8] Fix field order --- inferno-ml-server-types/src/Inferno/ML/Server/Types.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index 4e88043..4d85cb0 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -350,9 +350,9 @@ instance toRow mv = [ toField Default, mv ^. the @"model" & toField, - mv ^. the @"version" & toField, + mv ^. the @"card" & Aeson & toField, mv ^. the @"contents" & toField, - mv ^. the @"card" & Aeson & toField + mv ^. the @"version" & toField ] {- ORMOLU_DISABLE -} From cb4694568ac56b1ae67478f72f89de21f6b8bba5 Mon Sep 17 00:00:00 2001 From: Rory Tyler Hayford Date: Thu, 21 Mar 2024 14:23:43 +0700 Subject: [PATCH 8/8] Fix field order again --- inferno-ml-server-types/src/Inferno/ML/Server/Types.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs index 4d85cb0..1aa349b 100644 --- a/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs +++ b/inferno-ml-server-types/src/Inferno/ML/Server/Types.hs @@ -369,9 +369,9 @@ instance -- to one that exists in the DB already) <$> fmap Just (o .: "id") <*> o .: "model" - <*> o .: "version" - <*> fmap (Oid . fromIntegral @Word64) (o .: "contents") <*> o .: "card" + <*> fmap (Oid . fromIntegral @Word64) (o .: "contents") + <*> o .: "version" {- ORMOLU_ENABLE -} instance