From 0ec736ddebfa9866328bb03a1e0bcedfc5b061ed Mon Sep 17 00:00:00 2001
From: Drew Hess <src@drewhess.com>
Date: Wed, 7 Jun 2023 13:35:33 +0100
Subject: [PATCH] fix: work around an OpenAPI 3.0 spec issue regarding nullable
 results

This fixes an issue where the OpenAPI schema check failed when
`setSelection` returns `Nothing`. This should never happen in theory
and is just a quirk of our typechecker implementation, but our OpenAPI
adapter can't properly handle this scenario, and the OpenAPI 3.0 spec
isn't clear how to do so, either.

To work around this, we add a wrapped version of `setSelection` that
converts `Nothing` results to an API error.

Signed-off-by: Drew Hess <src@drewhess.com>
---
 primer-service/src/Primer/Servant/OpenAPI.hs |  2 +-
 primer-service/src/Primer/Server.hs          |  3 ++-
 primer/src/Primer/API.hs                     | 19 +++++++++++++++++++
 3 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/primer-service/src/Primer/Servant/OpenAPI.hs b/primer-service/src/Primer/Servant/OpenAPI.hs
index 18d2a6145..c45ea1ad2 100644
--- a/primer-service/src/Primer/Servant/OpenAPI.hs
+++ b/primer-service/src/Primer/Servant/OpenAPI.hs
@@ -104,7 +104,7 @@ data SessionAPI mode = SessionAPI
           :> Summary "Set the current selection, and obtain the type of the selected node"
           :> OperationId "setSelection"
           :> ReqBody '[JSON] Selection
-          :> Post '[JSON] (Maybe TypeOrKind)
+          :> Post '[JSON] TypeOrKind
   , createDefinition ::
       mode
         :- "def"
diff --git a/primer-service/src/Primer/Server.hs b/primer-service/src/Primer/Server.hs
index 0eba54bcc..b2c3309e5 100644
--- a/primer-service/src/Primer/Server.hs
+++ b/primer-service/src/Primer/Server.hs
@@ -180,7 +180,7 @@ openAPISessionServer sid =
     , OpenAPI.getProgram = API.getProgram' sid
     , OpenAPI.getSessionName = API.getSessionName sid
     , OpenAPI.setSessionName = renameSession sid
-    , OpenAPI.setSelection = API.setSelection sid
+    , OpenAPI.setSelection = API.setSelection' sid
     , OpenAPI.createDefinition = createDefinition sid
     , OpenAPI.typeDef = openAPITypeDefServer sid
     , OpenAPI.actions = openAPIActionServer sid
@@ -427,5 +427,6 @@ serve ss q v port origins logger = do
         UndoError pe -> err500{errBody = "Undo failed: " <> show pe}
         RedoError pe -> err500{errBody = "Redo failed: " <> show pe}
         SetSelectionError sel pe -> err400{errBody = "Error while setting selection (" <> show sel <> "): " <> show pe}
+        SetSelectionNothing sel -> err400{errBody = "Error while setting selection (" <> show sel <> "): setSelection returned Nothing"}
       where
         encode = LT.encodeUtf8 . LT.fromStrict
diff --git a/primer/src/Primer/API.hs b/primer/src/Primer/API.hs
index ad6d9e361..427f95a3e 100644
--- a/primer/src/Primer/API.hs
+++ b/primer/src/Primer/API.hs
@@ -72,6 +72,7 @@ module Primer.API (
   Name (..),
   TypeOrKind (..),
   setSelection,
+  setSelection',
 ) where
 
 import Foreword
@@ -272,6 +273,7 @@ data PrimerErr
   | UndoError ProgError
   | RedoError ProgError
   | SetSelectionError Selection ProgError
+  | SetSelectionNothing Selection
   deriving stock (Show)
 
 instance Exception PrimerErr
@@ -1246,3 +1248,20 @@ setSelection = curry $ logAPI (noError SetSelection) $ \(sid, sel) ->
     viewTypeKind = Kind . fromMaybe trivialTree . viewTypeKind'
     viewTypeKind' :: TypeMeta -> Maybe Tree
     viewTypeKind' = preview $ _type % _Just % to viewTreeKind
+
+-- | Strip 'Maybe' off of 'setSelection''s return type.
+--
+-- For technical reasons owing to our typechecker's design,
+-- 'setSelection' returns a 'Maybe TypeOrKind', but that curently
+-- causes problems with our OpenAPI adapter due to the OpenAPI 3.0
+-- specification not properly supporting nullable results. To work
+-- around this, we strip 'setSelection''s return type down to
+-- 'TypeOrKind' in normal operation, and throw an error otherwise. In
+-- practice, this error should never occur (though 'setSelection' may
+-- of course fail for other reasons; e.g., the client attempts to
+-- select invalid ID).
+--
+-- When we can update to OpenAPI 3.1, or our adapter otherwise adds
+-- support for nullable results, we may drop this method.
+setSelection' :: (MonadIO m, MonadThrow m, MonadAPILog l m) => SessionId -> Selection -> PrimerM m TypeOrKind
+setSelection' sid sel = setSelection sid sel >>= maybe (throwM $ SetSelectionNothing sel) pure