{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module LnUrl.Channel (
proceed,
cancel,
NodeId,
SuccessResponse (..),
Response (..),
AckResponse (..),
) where
import Data.Aeson (
FromJSON,
ToJSON,
object,
parseJSON,
toJSON,
withObject,
(.:),
(.=),
)
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import LnUrl (AckResponse (..), NodeId, Response (..))
import LnUrl.Utils (Base16 (..), JsonURI (..), getBase16)
import Network.URI (URI)
import Network.URI.Utils (addQueryParams)
data SuccessResponse = SuccessResponse
{
SuccessResponse -> ByteString
remoteNode :: ByteString
,
SuccessResponse -> URI
callback :: URI
,
SuccessResponse -> ByteString
k1 :: ByteString
}
deriving (SuccessResponse -> SuccessResponse -> Bool
(SuccessResponse -> SuccessResponse -> Bool)
-> (SuccessResponse -> SuccessResponse -> Bool)
-> Eq SuccessResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuccessResponse -> SuccessResponse -> Bool
$c/= :: SuccessResponse -> SuccessResponse -> Bool
== :: SuccessResponse -> SuccessResponse -> Bool
$c== :: SuccessResponse -> SuccessResponse -> Bool
Eq, Int -> SuccessResponse -> ShowS
[SuccessResponse] -> ShowS
SuccessResponse -> String
(Int -> SuccessResponse -> ShowS)
-> (SuccessResponse -> String)
-> ([SuccessResponse] -> ShowS)
-> Show SuccessResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuccessResponse] -> ShowS
$cshowList :: [SuccessResponse] -> ShowS
show :: SuccessResponse -> String
$cshow :: SuccessResponse -> String
showsPrec :: Int -> SuccessResponse -> ShowS
$cshowsPrec :: Int -> SuccessResponse -> ShowS
Show)
instance FromJSON SuccessResponse where
parseJSON :: Value -> Parser SuccessResponse
parseJSON = String
-> (Object -> Parser SuccessResponse)
-> Value
-> Parser SuccessResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SuccessResponse" ((Object -> Parser SuccessResponse)
-> Value -> Parser SuccessResponse)
-> (Object -> Parser SuccessResponse)
-> Value
-> Parser SuccessResponse
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
Object
obj Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tag" Parser String
-> (String -> Parser SuccessResponse) -> Parser SuccessResponse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
String
"channelRequest" ->
ByteString -> URI -> ByteString -> SuccessResponse
SuccessResponse
(ByteString -> URI -> ByteString -> SuccessResponse)
-> Parser ByteString
-> Parser (URI -> ByteString -> SuccessResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Parser Text -> Parser ByteString
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
"uri")
Parser (URI -> ByteString -> SuccessResponse)
-> Parser URI -> Parser (ByteString -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (JsonURI -> URI
getJsonURI (JsonURI -> URI) -> Parser JsonURI -> Parser URI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser JsonURI
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"callback")
Parser (ByteString -> SuccessResponse)
-> Parser ByteString -> Parser SuccessResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base16 -> ByteString
getBase16 (Base16 -> ByteString) -> Parser Base16 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Base16
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"k1")
String
tag -> String -> Parser SuccessResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SuccessResponse)
-> String -> Parser SuccessResponse
forall a b. (a -> b) -> a -> b
$ String
"Unknown tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tag
instance ToJSON SuccessResponse where
toJSON :: SuccessResponse -> Value
toJSON SuccessResponse
success =
[Pair] -> Value
object
[ Text
"uri" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (SuccessResponse -> ByteString) -> SuccessResponse -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> ByteString
remoteNode) SuccessResponse
success
, Text
"callback" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (URI -> String
forall a. Show a => a -> String
show (URI -> String)
-> (SuccessResponse -> URI) -> SuccessResponse -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> URI
callback) SuccessResponse
success
, Text
"k1" Text -> Base16 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Base16
Base16 (SuccessResponse -> ByteString
k1 SuccessResponse
success)
]
proceed :: SuccessResponse -> NodeId -> Bool -> URI
proceed :: SuccessResponse -> ByteString -> Bool -> URI
proceed SuccessResponse
payload ByteString
theRemoteNode Bool
isPrivate =
URI -> Query -> URI
addQueryParams
(SuccessResponse -> URI
callback SuccessResponse
payload)
[ (ByteString
"k1", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SuccessResponse -> ByteString
k1 SuccessResponse
payload)
, (ByteString
"remoteid", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
theRemoteNode)
, (ByteString
"private", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool ByteString
"0" ByteString
"1" Bool
isPrivate)
]
cancel :: SuccessResponse -> NodeId -> URI
cancel :: SuccessResponse -> ByteString -> URI
cancel SuccessResponse
payload ByteString
theRemoteNode =
URI -> Query -> URI
addQueryParams
(SuccessResponse -> URI
callback SuccessResponse
payload)
[ (ByteString
"k1", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SuccessResponse -> ByteString
k1 SuccessResponse
payload)
, (ByteString
"remoteid", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
theRemoteNode)
, (ByteString
"cancel", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1")
]