Error modes.

core/commence-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               commence-core
-version:            0.1.0.0
+version:            0.2.0.0
 extra-source-files: CHANGELOG.md
 
 common common-extensions
@@ -82,6 +82,8 @@ library
                  , Commence.Multilogging 
                  , Commence.Util.Module 
                  , Commence.Runtime.Errors
+                 , Commence.Runtime.Errors.Mode
+                 , Commence.Runtime.Errors.Code
                  , Commence.Runtime.Storage 
                  , Commence.ACL
                  , Commence.ACL.Types 

core/src/Commence/Runtime/Errors.hs

@@ -32,33 +32,30 @@ instance IsRuntimeErr AuthErr where
 module Commence.Runtime.Errors
   ( RuntimeErr(..)
   , IsRuntimeErr(..)
-  , ErrCode(..)
   , asServantError
+  , defaultErrHtml
+  -- * Exceptional re-exports for backwards compatibility in dependant packages. 
+  , module Mode
+  , module Code
   ) where
 
-import           Commence.Logging
+import           Commence.Runtime.Errors.Code  as Code
+import           Commence.Runtime.Errors.Mode  as Mode
 import           Control.Lens                  as L
-import qualified Data.ByteString.Lazy          as BSL
-import qualified Data.String                -- Required from the handrolled IsString instance. 
+                                         hiding ( (.=) )
+import qualified Data.Aeson                    as Aeson
+import           Data.Aeson                     ( (.=)
+                                                , Value(String)
+                                                ) -- for convenience, where qualified imports are overkill.
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as TE
 import qualified GHC.Show                      as Show
 import           Network.HTTP.Types
 import qualified Network.HTTP.Types            as HTTP
 import           Servant.Server                 ( ServerError(..) )
-
-newtype ErrCode = ErrCode [Text]
-                deriving (Eq, Show, Monoid, Semigroup) via [Text]
-
-instance TextShow ErrCode where
-  showb = showb . showErrCode
-
--- | Reverse of the IsString instance (below)
-showErrCode (ErrCode envs) = T.toUpper . T.intercalate "." $ envs
-
--- | Take any string; split at @/@; and use it as the ErrCode.
-instance IsString ErrCode where
-  fromString = ErrCode . T.splitOn "." . T.toUpper . T.pack
+import qualified Text.Blaze.Html               as B
+import           Text.Blaze.Html.Renderer.Utf8  ( renderHtml )
+import qualified Text.Blaze.Html5              as H
 
 -- brittany-disable-next-binding 
 -- | A generalised error
@@ -73,7 +70,7 @@ deriving anyclass instance Exception RuntimeErr
 -- | TODO: add common properties of errors.
 class IsRuntimeErr e where
 
-  errCode :: e -> ErrCode
+  errCode :: e -> Code.ErrCode
 
   -- | Construct a `RuntimeErr` from an instance value
   knownErr :: e -> RuntimeErr
@@ -98,7 +95,20 @@ class IsRuntimeErr e where
 
   -- | Header information to supply for returning errors over HTTP.
   httpHeaders :: e -> [Header]
-  httpHeaders e = [("x-err-code", errCode e ^. coerced . L.to showErrCode . L.to TE.encodeUtf8)]
+  httpHeaders e = [("x-err-code", errCode e ^. coerced . L.to Code.showErrCode . L.to TE.encodeUtf8)]
+
+  -- | Error specific HTML markup generation. Uses the crude `defaultErrHtml` by default. 
+  htmlErr :: e -> B.Html
+  htmlErr = defaultErrHtml
+
+-- | Generate an HTML error: TODO improve the default implementation to have a proper design. 
+-- For errors with very custom designs, this method may be overriden. 
+defaultErrHtml :: forall e . IsRuntimeErr e => e -> B.Html
+defaultErrHtml e = H.body $ do
+  H.text "Sorry, we've encountered an error."
+  H.hr
+  maybe mempty addMessage (userMessage e)
+  where addMessage txt = H.text txt *> H.hr
 
 instance Show RuntimeErr where
   show = T.unpack . displayErr
@@ -127,17 +137,34 @@ instance IsRuntimeErr RuntimeErr where
       T.unwords ["RuntimeException", show e, T.pack $ displayException e]
 
 -- | Map out a known error to a `ServerError` (from Servant)
-asServantError :: IsRuntimeErr e => e -> ServerError
-asServantError e = ServerError
+asServantError :: IsRuntimeErr e => Mode.ErrMode -> e -> ServerError
+asServantError mode e = ServerError
   { errReasonPhrase = T.unpack . TE.decodeUtf8 $ statusMessage
-  , errHeaders      = httpHeaders e
+  , errHeaders      = httpHeaders e <> Mode.modeContentType mode
   , ..
   }
  where
   Status errHTTPCode statusMessage = httpStatus e
-  errBody =
-    maybe "No known reason." (BSL.fromStrict . TE.encodeUtf8) $ userMessage e
+  -- depending on the mode, we'd like to output the right respose body.
+  -- this in combination of the call to `Mode.modeContentType` above will ensure we're outputting the correct response type. 
+  errBody                          = case mode of
+    Mode.JsonErr -> Aeson.encode . knownErr $ e
+    Mode.HtmlErr -> renderHtml $ htmlErr e
 
 instance MonadError RuntimeErr (Either RuntimeErr) where
   throwError = Left
   catchError op' handler = either handler Right op'
+
+instance Aeson.ToJSON RuntimeErr where
+  toJSON = \case
+    KnownErr e -> Aeson.object
+      [ "errorCode" .= errCode e
+      , "userMessage" .= userMessage e
+      , "errorType" .= String "KNOWN_ERR" -- indicates that we know how to handle this error, and it is a user-defined error. 
+      ]
+
+    RuntimeException ex -> Aeson.object
+      [ "errorType" .= String "RUNTIME_EXCEPTION"
+      , "exception" .= String (show ex)
+      ]
+

core/src/Commence/Runtime/Errors/Code.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Commence.Runtime.Errors.Code
+  ( ErrCode(..)
+  , showErrCode
+  ) where
+
+import           Commence.Logging
+import qualified Data.Aeson                    as Aeson
+import qualified Data.String                                   -- Required from the handrolled IsString instance. 
+import qualified Data.Text                     as T
+import qualified Text.Blaze.Html5              as H
+
+newtype ErrCode = ErrCode [Text]
+                deriving (Eq, Show, Monoid, Semigroup) via [Text]
+
+instance TextShow ErrCode where
+  showb = showb . showErrCode
+
+-- | Reverse of the IsString instance (below)
+showErrCode (ErrCode envs) = T.toUpper . T.intercalate "." $ envs
+
+-- | Take any string; split at @/@; and use it as the ErrCode.
+instance IsString ErrCode where
+  fromString = ErrCode . T.splitOn "." . T.toUpper . T.pack
+
+instance Aeson.ToJSON ErrCode where
+  toJSON = Aeson.String . showErrCode
+  {-# INLINE toJSON #-}
+
+instance H.ToMarkup ErrCode where
+  toMarkup = H.text . showErrCode
+  {-# INLINE toMarkup #-}

core/src/Commence/Runtime/Errors/Mode.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Commence.Runtime.Errors.Mode
+  ( ErrMode(..)
+  , modeContentType
+  ) where
+
+import           Network.HTTP.Types.Header
+
+{- | An error mode indicates how we'd like to have a failure.
+
+In some cases, we'd like to respond with JSON values in case of errors: eg. in a REST API response. Whereas for hosted HTML
+interfaces, we'd like to respond with HTML. 
+-}
+data ErrMode = JsonErr | HtmlErr
+             deriving (Eq, Show)
+
+-- | Get the content-type header value 
+modeContentType :: ErrMode -> [Header]
+modeContentType = pure . (hContentType, ) . \case
+  JsonErr -> "application/json"
+  HtmlErr -> "text/html"

interactive-state/commence-interactive-state.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               commence-interactive-state
-version:            0.1.0.0
+version:            0.2.0.0
 
 common common-extensions
   default-language: Haskell2010