{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module LnUrl (
    Response (..),
    AckResponse (..),
    NodeId,
) where

import Data.Aeson (
    FromJSON,
    ToJSON,
    object,
    parseJSON,
    toJSON,
    withObject,
    (.:),
    (.:?),
    (.=),
 )
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Text as Text

data AckResponse
    = AckSuccess
    | AckError Text
    deriving (AckResponse -> AckResponse -> Bool
(AckResponse -> AckResponse -> Bool)
-> (AckResponse -> AckResponse -> Bool) -> Eq AckResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AckResponse -> AckResponse -> Bool
$c/= :: AckResponse -> AckResponse -> Bool
== :: AckResponse -> AckResponse -> Bool
$c== :: AckResponse -> AckResponse -> Bool
Eq, Int -> AckResponse -> ShowS
[AckResponse] -> ShowS
AckResponse -> String
(Int -> AckResponse -> ShowS)
-> (AckResponse -> String)
-> ([AckResponse] -> ShowS)
-> Show AckResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AckResponse] -> ShowS
$cshowList :: [AckResponse] -> ShowS
show :: AckResponse -> String
$cshow :: AckResponse -> String
showsPrec :: Int -> AckResponse -> ShowS
$cshowsPrec :: Int -> AckResponse -> ShowS
Show)

instance FromJSON AckResponse where
    parseJSON :: Value -> Parser AckResponse
parseJSON = String
-> (Object -> Parser AckResponse) -> Value -> Parser AckResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AckResponse" ((Object -> Parser AckResponse) -> Value -> Parser AckResponse)
-> (Object -> Parser AckResponse) -> Value -> Parser AckResponse
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Object
obj Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"status" Parser String
-> (String -> Parser AckResponse) -> Parser AckResponse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            String
"OK" -> AckResponse -> Parser AckResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure AckResponse
AckSuccess
            String
"ERROR" -> Text -> AckResponse
AckError (Text -> AckResponse) -> Parser Text -> Parser AckResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reason"
            String
other -> String -> Parser AckResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AckResponse) -> String -> Parser AckResponse
forall a b. (a -> b) -> a -> b
$ String
"Unknown status: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
other

instance ToJSON AckResponse where
    toJSON :: AckResponse -> Value
toJSON = \case
        AckResponse
AckSuccess ->
            [Pair] -> Value
object [Text
"status" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"OK" :: Text)]
        AckError Text
msg ->
            [Pair] -> Value
object
                [ Text
"status" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"ERROR" :: Text)
                , Text
"reason" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
msg
                ]

type NodeId = ByteString

data Response a = Success a | ErrorResponse Text
    deriving (Response a -> Response a -> Bool
(Response a -> Response a -> Bool)
-> (Response a -> Response a -> Bool) -> Eq (Response a)
forall a. Eq a => Response a -> Response a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response a -> Response a -> Bool
$c/= :: forall a. Eq a => Response a -> Response a -> Bool
== :: Response a -> Response a -> Bool
$c== :: forall a. Eq a => Response a -> Response a -> Bool
Eq, Int -> Response a -> ShowS
[Response a] -> ShowS
Response a -> String
(Int -> Response a -> ShowS)
-> (Response a -> String)
-> ([Response a] -> ShowS)
-> Show (Response a)
forall a. Show a => Int -> Response a -> ShowS
forall a. Show a => [Response a] -> ShowS
forall a. Show a => Response a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response a] -> ShowS
$cshowList :: forall a. Show a => [Response a] -> ShowS
show :: Response a -> String
$cshow :: forall a. Show a => Response a -> String
showsPrec :: Int -> Response a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Response a -> ShowS
Show)

instance FromJSON a => FromJSON (Response a) where
    parseJSON :: Value -> Parser (Response a)
parseJSON Value
v = String
-> (Object -> Parser (Response a)) -> Value -> Parser (Response a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResponseContainer" Object -> Parser (Response a)
forall a. FromJSON a => Object -> Parser (Response a)
inspect Value
v
      where
        inspect :: Object -> Parser (Response a)
inspect Object
obj =
            Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"status" Parser (Maybe Text)
-> (Maybe Text -> Parser (Response a)) -> Parser (Response a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Text
"ERROR" -> Text -> Response a
forall a. Text -> Response a
ErrorResponse (Text -> Response a) -> Parser Text -> Parser (Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reason"
                Just Text
other -> String -> Parser (Response a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Response a)) -> String -> Parser (Response a)
forall a b. (a -> b) -> a -> b
$ String
"Unknown status: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
other
                Maybe Text
Nothing -> a -> Response a
forall a. a -> Response a
Success (a -> Response a) -> Parser a -> Parser (Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON a => ToJSON (Response a) where
    toJSON :: Response a -> Value
toJSON = \case
        Success a
x -> a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x
        ErrorResponse Text
reason ->
            [Pair] -> Value
object
                [ Text
"status" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"ERROR" :: Text)
                , Text
"reason" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
reason
                ]