--
-- MinIO Haskell SDK, (C) 2018 MinIO, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--

module Network.Minio.JsonParser
  ( parseErrResponseJSON,
  )
where

import Data.Aeson
  ( FromJSON,
    eitherDecode,
    parseJSON,
    withObject,
    (.:),
  )
import qualified Data.Text as T
import Lib.Prelude
import Network.Minio.Errors

data AdminErrJSON = AdminErrJSON
  { AdminErrJSON -> Text
aeCode :: Text,
    AdminErrJSON -> Text
aeMessage :: Text
  }
  deriving stock (AdminErrJSON -> AdminErrJSON -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdminErrJSON -> AdminErrJSON -> Bool
$c/= :: AdminErrJSON -> AdminErrJSON -> Bool
== :: AdminErrJSON -> AdminErrJSON -> Bool
$c== :: AdminErrJSON -> AdminErrJSON -> Bool
Eq, Int -> AdminErrJSON -> ShowS
[AdminErrJSON] -> ShowS
AdminErrJSON -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdminErrJSON] -> ShowS
$cshowList :: [AdminErrJSON] -> ShowS
show :: AdminErrJSON -> String
$cshow :: AdminErrJSON -> String
showsPrec :: Int -> AdminErrJSON -> ShowS
$cshowsPrec :: Int -> AdminErrJSON -> ShowS
Show)

instance FromJSON AdminErrJSON where
  parseJSON :: Value -> Parser AdminErrJSON
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AdminErrJSON" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> AdminErrJSON
AdminErrJSON
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Code"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Message"

parseErrResponseJSON :: (MonadIO m) => LByteString -> m ServiceErr
parseErrResponseJSON :: forall (m :: * -> *). MonadIO m => LByteString -> m ServiceErr
parseErrResponseJSON LByteString
jsondata =
  case forall a. FromJSON a => LByteString -> Either String a
eitherDecode LByteString
jsondata of
    Right AdminErrJSON
aErr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> ServiceErr
toServiceErr (AdminErrJSON -> Text
aeCode AdminErrJSON
aErr) (AdminErrJSON -> Text
aeMessage AdminErrJSON
aErr)
    Left String
err -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> MErrV
MErrVJsonParse forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err