feat: let Rel8 handle the JSON encoding/decoding of Apps.

This makes our code a bit simpler. However, one major ramification of
this change is that if an `App` cannot be successfully decoded when
fetched from the database, this error condition will be dealt with by
throwing an out-of-band exception, which is how we handle errors
detected in the Rel8 or Hasql layers. Prior to this change, because
our code in `querySessionId` was doing the decoding, we could handle
decoding errors ourselves, and we would report these as a cryptic and
somewhat unhelpful error to the student in the UI, in-band.

In any case, this new way of handling errors as proper exceptions is
more consistent with how we handle other catastrophic errors. After
all, if a student's program can't be decoded when fetched from the
database, this probably means that something has gone horribly
wrong (a failed migration, data corruption, etc.), and should be
handled appropriately.

primer-rel8/primer-rel8.cabal

@@ -13,6 +13,7 @@ category:      Database
 library
   exposed-modules:
     Primer.Database.Rel8
+    Primer.Database.Rel8.OrphanInstances
     Primer.Database.Rel8.Rel8Db
     Primer.Database.Rel8.Schema
 

primer-rel8/src/Primer/Database/Rel8/OrphanInstances.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Primer.Database.Rel8.OrphanInstances (
+  -- * Orphan instances
+  -- $orphanInstances
+) where
+
+import Primer.App (App)
+import Rel8 (
+  DBType,
+  JSONEncoded (..),
+ )
+
+-- $orphanInstances
+--
+-- In order to keep the Primer core library free of a "Rel8"
+-- dependency, we need to define a few orphan instances.
+
+deriving via (JSONEncoded App) instance (DBType App)

primer-rel8/src/Primer/Database/Rel8/Rel8Db.hs

@@ -14,10 +14,6 @@ import Control.Monad.Fix (MonadFix)
 import Control.Monad.Trans (MonadTrans)
 import Control.Monad.Writer (MonadWriter)
 import Control.Monad.Zip (MonadZip)
-import qualified Data.Aeson as Aeson (
-  decode,
-  encode,
- )
 import Data.Functor.Contravariant ((>$<))
 import Data.UUID (UUID)
 import qualified Data.UUID as UUID (toText)
@@ -107,7 +103,7 @@ instance (MonadThrow m, MonadIO m) => MonadDb (Rel8DbT m) where
                     Schema.SessionRow
                       { Schema.uuid = s
                       , Schema.gitversion = v
-                      , Schema.app = Aeson.encode a
+                      , Schema.app = a
                       , Schema.name = fromSessionName n
                       }
                 ]
@@ -123,7 +119,7 @@ instance (MonadThrow m, MonadIO m) => MonadDb (Rel8DbT m) where
           , set = \_ row ->
               row
                 { Schema.gitversion = lit v
-                , Schema.app = lit (Aeson.encode a)
+                , Schema.app = lit a
                 }
           , updateWhere = \_ row -> Schema.uuid row ==. litExpr s
           , returning = NumberOfRowsAffected
@@ -174,26 +170,23 @@ instance (MonadThrow m, MonadIO m) => MonadDb (Rel8DbT m) where
     case result of
       [] -> return $ Left $ "No such session ID " <> UUID.toText sid
       (s : _) ->
-        case Aeson.decode (Schema.app s) of
-          Nothing -> pure $ Left $ "Failed to decode stored program for session ID " <> UUID.toText sid
-          Just decodedApp -> do
-            -- Note that we have 2 choices here if the session name
-            -- returned by the database is not a valid 'SessionName':
-            -- either we can return a failure, or we can convert it to
-            -- a valid 'SessionName', possibly including a helpful
-            -- message. This situation can only ever happen if we've
-            -- made a mistake (e.g., we've changed the rules on what's
-            -- a valid 'SessionName' and didn't run a migration), or
-            -- if someone has edited the database directly, without
-            -- going through the API. In either case, it would be bad
-            -- if a student can't load their session just because a
-            -- session name was invalid, so we opt for the "convert it
-            -- to a valid 'SessionName'" strategy. For now, we elide
-            -- the helpful message.
-            --
-            -- We should probably log an event when this occurs. See:
-            -- https://github.com/hackworthltd/primer/issues/179
-            pure $ Right (SessionData decodedApp (safeMkSessionName $ Schema.name s))
+        -- Note that we have 2 choices here if the session name
+        -- returned by the database is not a valid 'SessionName':
+        -- either we can return a failure, or we can convert it to
+        -- a valid 'SessionName', possibly including a helpful
+        -- message. This situation can only ever happen if we've
+        -- made a mistake (e.g., we've changed the rules on what's
+        -- a valid 'SessionName' and didn't run a migration), or
+        -- if someone has edited the database directly, without
+        -- going through the API. In either case, it would be bad
+        -- if a student can't load their session just because a
+        -- session name was invalid, so we opt for the "convert it
+        -- to a valid 'SessionName'" strategy. For now, we elide
+        -- the helpful message.
+        --
+        -- We should probably log an event when this occurs. See:
+        -- https://github.com/hackworthltd/primer/issues/179
+        pure $ Right (SessionData (Schema.app s) (safeMkSessionName $ Schema.name s))
 
 -- Helper to make dealing with "Hasql.Session" easier.
 --

primer-rel8/src/Primer/Database/Rel8/Schema.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -10,11 +11,12 @@ module Primer.Database.Rel8.Schema (
 
 import Foreword
 
-import Data.ByteString.Lazy as BL
 import Data.UUID (UUID)
+import Primer.App (App)
 import Primer.Database (
   Version,
  )
+import Primer.Database.Rel8.OrphanInstances ()
 import Rel8 (
   Column,
   Name,
@@ -34,9 +36,8 @@ data SessionRow f = SessionRow
   -- ^ Primer's git version. We would prefer that this were a git
   -- rev, but for technical reasons, it may also be a last-modified
   -- date.
-  , app :: Column f BL.ByteString
-  -- ^ The session's 'App'. Note that the 'App' is serialized to
-  -- JSON before being stored as a bytestring in the database.
+  , app :: Column f App
+  -- ^ The session's 'App'.
   , name :: Column f Text
   -- ^ The session's name.
   }