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 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..1aa349b 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 = @@ -204,21 +207,18 @@ 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') -data Model uid gid c = Model - { id :: Maybe (Id (Model uid gid c)), +-- | 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, - -- | 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,48 +230,37 @@ 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 - ( Typeable uid, - Typeable gid, + ( Typeable gid, FromField uid, FromField gid, 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 instance - ( Typeable uid, - Typeable gid, - ToField uid, + ( ToField uid, 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 ] @@ -279,22 +268,16 @@ instance {- ORMOLU_DISABLE -} instance ( FromJSON uid, - FromJSON gid, FromJSONKey gid, Ord gid ) => - FromJSON (Model uid gid Oid) + FromJSON (Model uid gid) 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") - <*> fmap (Oid . fromIntegral @Word64) (o .: "contents") - <*> o .: "version" - <*> o .: "card" <*> o .: "permissions" <*> o .:? "user" where @@ -307,21 +290,104 @@ instance instance ( ToJSON uid, - 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 ] + +-- | 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 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 + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +instance + ( FromField uid, + FromField gid + ) => + FromRow (ModelVersion uid gid Oid) + where + -- 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 + <*> field + <*> field + <*> field + <*> field + +instance + ( ToField uid, + ToField 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 @"card" & Aeson & toField, + mv ^. the @"contents" & toField, + mv ^. the @"version" & toField + ] + +{- ORMOLU_DISABLE -} +instance + ( FromJSON uid, + FromJSON 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 version serialized as JSON always refers + -- to one that exists in the DB already) + <$> fmap Just (o .: "id") + <*> o .: "model" + <*> o .: "card" + <*> fmap (Oid . fromIntegral @Word64) (o .: "contents") + <*> o .: "version" +{- ORMOLU_ENABLE -} + +instance + ( ToJSON uid, + ToJSON 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