module Conduit.Features.Articles.Errors where

import Conduit.DB.Core (DBError(..))
import Conduit.Errors (FeatureError(..), FeatureErrorMapper(..))
import Conduit.Features.Account.Errors (AccountError)
import Conduit.Features.Account.Errors qualified as Account
import Conduit.Utils ((.-))
import Conduit.Validation (ValErrs(..), inErrMsgObj)
import Network.HTTP.Types (status403, status404, status500)
import Network.HTTP.Types.Status (status422)
import Web.Scotty.Trans (ActionT, json, status)

data ArticleError
  = ResourceNotFoundEx -- General exception for simplicity's sake since spec doesn't need specific 404 error msgs
  | UserUnauthorizedEx
  | IllegalArticleDelEx
  | IllegalCommentDelEx
  | UniquenessEx Text
  | InvalidSlugEx
  | SomeDBEx DBError
  deriving (Int -> ArticleError -> ShowS
[ArticleError] -> ShowS
ArticleError -> String
(Int -> ArticleError -> ShowS)
-> (ArticleError -> String)
-> ([ArticleError] -> ShowS)
-> Show ArticleError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArticleError -> ShowS
showsPrec :: Int -> ArticleError -> ShowS
$cshow :: ArticleError -> String
show :: ArticleError -> String
$cshowList :: [ArticleError] -> ShowS
showList :: [ArticleError] -> ShowS
Show, ArticleError -> ArticleError -> Bool
(ArticleError -> ArticleError -> Bool)
-> (ArticleError -> ArticleError -> Bool) -> Eq ArticleError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArticleError -> ArticleError -> Bool
== :: ArticleError -> ArticleError -> Bool
$c/= :: ArticleError -> ArticleError -> Bool
/= :: ArticleError -> ArticleError -> Bool
Eq, ReadPrec [ArticleError]
ReadPrec ArticleError
Int -> ReadS ArticleError
ReadS [ArticleError]
(Int -> ReadS ArticleError)
-> ReadS [ArticleError]
-> ReadPrec ArticleError
-> ReadPrec [ArticleError]
-> Read ArticleError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ArticleError
readsPrec :: Int -> ReadS ArticleError
$creadList :: ReadS [ArticleError]
readList :: ReadS [ArticleError]
$creadPrec :: ReadPrec ArticleError
readPrec :: ReadPrec ArticleError
$creadListPrec :: ReadPrec [ArticleError]
readListPrec :: ReadPrec [ArticleError]
Read)

instance FeatureError ArticleError where
  handleFeatureError :: forall (m :: * -> *). MonadIO m => ArticleError -> ActionT m ()
handleFeatureError = ArticleError -> ActionT m ()
forall (m :: * -> *). MonadIO m => ArticleError -> ActionT m ()
handleFeatureError'
  handleDBError :: DBError -> ArticleError
handleDBError = DBError -> ArticleError
handleDBErr'

handleFeatureError' :: (MonadIO m) => ArticleError -> ActionT m ()
handleFeatureError' :: forall (m :: * -> *). MonadIO m => ArticleError -> ActionT m ()
handleFeatureError' ArticleError
ResourceNotFoundEx  = Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status404
handleFeatureError' ArticleError
InvalidSlugEx       = Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status404
handleFeatureError' ArticleError
UserUnauthorizedEx  = Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status403
handleFeatureError' ArticleError
IllegalArticleDelEx = Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status403 ActionT m () -> ActionT m () -> ActionT m ()
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InObj Text -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (forall obj. obj -> InObj obj
inErrMsgObj @Text Text
"You are not authorized to delete this article")
handleFeatureError' ArticleError
IllegalCommentDelEx = Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status403 ActionT m () -> ActionT m () -> ActionT m ()
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InObj Text -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (forall obj. obj -> InObj obj
inErrMsgObj @Text Text
"You are not authorized to delete this comment")
handleFeatureError' (UniquenessEx Text
e)    = Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status422 ActionT m () -> ActionT m () -> ActionT m ()
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ValErrs -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json ([(Text, Text)] -> ValErrs
ValErrs [(Text
e, Text
"must be unique")])
handleFeatureError' (SomeDBEx DBError
e)        = DBError -> ActionT m ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print DBError
e ActionT m () -> ActionT m () -> ActionT m ()
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500

handleDBErr' :: DBError -> ArticleError
handleDBErr' :: DBError -> ArticleError
handleDBErr' (AuthorizationError Text
e) = Text
e Text -> (Text -> ArticleError) -> ArticleError
forall a b. a -> (a -> b) -> b
& Text -> String
forall a. ToString a => a -> String
toString (Text -> String)
-> (String -> Maybe ArticleError) -> Text -> Maybe ArticleError
forall a b c. (a -> b) -> (b -> c) -> a -> c
.- String -> Maybe ArticleError
forall a. Read a => String -> Maybe a
readMaybe (Text -> Maybe ArticleError)
-> (Maybe ArticleError -> ArticleError) -> Text -> ArticleError
forall a b c. (a -> b) -> (b -> c) -> a -> c
.- ArticleError -> Maybe ArticleError -> ArticleError
forall a. a -> Maybe a -> a
fromMaybe (Text -> ArticleError
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> ArticleError) -> Text -> ArticleError
forall a b. (a -> b) -> a -> b
$ Text
"invalid authorization error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall b a. (Show a, IsString b) => a -> b
show Text
e)
handleDBErr' DBError
NotFoundError = ArticleError
ResourceNotFoundEx
handleDBErr' (UniquenessError Text
e) = Text -> ArticleError
UniquenessEx Text
e
handleDBErr' DBError
err = DBError -> ArticleError
SomeDBEx DBError
err

instance FeatureErrorMapper AccountError ArticleError where
  mapFeatureError :: AccountError -> ArticleError
  mapFeatureError :: AccountError -> ArticleError
mapFeatureError = AccountError -> ArticleError
accountErr2articleErr
  
accountErr2articleErr :: AccountError -> ArticleError
accountErr2articleErr :: AccountError -> ArticleError
accountErr2articleErr (Account.SomeDBEx DBError
err) = DBError -> ArticleError
SomeDBEx DBError
err
accountErr2articleErr AccountError
Account.UserNotFoundEx = ArticleError
ResourceNotFoundEx
accountErr2articleErr AccountError
_ = Text -> ArticleError
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"shouldn't need other maps; just fail-fast until I add proper logging lol"