[inferno-ml-server-types] Split Model and ModelVersion

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

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

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,71 +230,54 @@ 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
     ]
 
 {- 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