content: {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  -- This file is part of the Wire Server implementation.
  --
  -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
  --
  -- This program is free software: you can redistribute it and/or modify it under
  -- the terms of the GNU Affero General Public License as published by the Free
  -- Software Foundation, either version 3 of the License, or (at your option) any
  -- later version.
  --
  -- This program is distributed in the hope that it will be useful, but WITHOUT
  -- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  -- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
  -- details.
  --
  -- You should have received a copy of the GNU Affero General Public License along
  -- with this program. If not, see <https://www.gnu.org/licenses/>.
  
  module Network.Wai.Utilities.Error
    ( Error (..),
      ErrorData (..),
      mkError,
      (!>>),
      isBadRequest,
    )
  where
  
  import Control.Error
  import Data.Aeson hiding (Error)
  import Data.Aeson.Types (Pair)
  import Data.Domain
  import Imports
  import Network.HTTP.Types
  
  data Error = Error
    { code :: !Status,
      label :: !LText,
      message :: !LText,
      errorData :: Maybe ErrorData,
      innerError :: Maybe Error
    }
    deriving (Eq, Show, Typeable)
  
  isBadRequest :: Error -> Bool
  isBadRequest e = code e == badRequest400
  
  mkError :: Status -> LText -> LText -> Error
  mkError c l m = Error c l m Nothing Nothing
  
  instance Exception Error
  
  data ErrorData = FederationErrorData
    { federrDomain :: !Domain,
      federrPath :: !Text
    }
    deriving (Eq, Show, Typeable)
  
  instance ToJSON ErrorData where
    toJSON (FederationErrorData d p) =
      object $
        [ "type" .= ("federation" :: Text),
          "domain" .= d,
          "path" .= p
        ]
  
  instance FromJSON ErrorData where
    parseJSON = withObject "ErrorData" $ \o ->
      FederationErrorData
        <$> o .: "domain"
        <*> o .: "path"
  
  instance ToJSON Error where
    toJSON (Error c l m md inner) =
      object $
        [ "code" .= statusCode c,
          "label" .= l,
          "message" .= m
        ]
          ++ maybe [] dataFields md
          ++ ["inner" .= e | e <- toList inner]
      where
        dataFields :: ErrorData -> [Pair]
        dataFields d = ["data" .= d]
  
  instance FromJSON Error where
    parseJSON = withObject "Error" $ \o ->
      Error
        <$> (toEnum <$> o .: "code")
        <*> o .: "label"
        <*> o .: "message"
        <*> o .:? "data"
        <*> o .:? "inner"
  
  -- FIXME: This should not live here.
  infixl 5 !>>
  
  (!>>) :: (Monad m) => ExceptT a m r -> (a -> b) -> ExceptT b m r
  (!>>) = flip fmapLT
  