{-# LANGUAGE OverloadedStrings #-}
module LnUrl.Withdraw (
getCallbackURL,
Response (..),
SuccessResponse (..),
AckResponse (..),
) where
import Data.Aeson (
FromJSON,
ToJSON,
object,
parseJSON,
toJSON,
withObject,
(.:),
(.:?),
(.=),
)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word64)
import LnUrl (AckResponse (..), Response (..))
import LnUrl.Utils (JsonURI (..), (.=?))
import Network.URI (URI)
import Network.URI.Utils (addQueryParams, param)
data SuccessResponse = SuccessResponse
{ SuccessResponse -> URI
callback :: URI
, SuccessResponse -> Text
challenge :: Text
, SuccessResponse -> Text
defaultDescription :: Text
,
SuccessResponse -> Word64
minWithdrawable :: Word64
,
SuccessResponse -> Word64
maxWithdrawable :: Word64
,
SuccessResponse -> Maybe URI
balanceCheck :: Maybe URI
}
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 ->
URI
-> Text -> Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse
SuccessResponse
(URI
-> Text
-> Text
-> Word64
-> Word64
-> Maybe URI
-> SuccessResponse)
-> Parser URI
-> Parser
(Text -> Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Functor 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
(Text -> Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
-> Parser Text
-> Parser
(Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"k1"
Parser (Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
-> Parser Text
-> Parser (Word64 -> Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"defaultDescription"
Parser (Word64 -> Word64 -> Maybe URI -> SuccessResponse)
-> Parser Word64 -> Parser (Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"minWithdrawable"
Parser (Word64 -> Maybe URI -> SuccessResponse)
-> Parser Word64 -> Parser (Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"maxWithdrawable"
Parser (Maybe URI -> SuccessResponse)
-> Parser (Maybe URI) -> Parser SuccessResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((JsonURI -> URI) -> Maybe JsonURI -> Maybe URI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonURI -> URI
getJsonURI (Maybe JsonURI -> Maybe URI)
-> Parser (Maybe JsonURI) -> Parser (Maybe URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe JsonURI)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"balanceCheck")
instance ToJSON SuccessResponse where
toJSON :: SuccessResponse -> Value
toJSON SuccessResponse
response =
[Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ Text
"callback" Text -> JsonURI -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (URI -> JsonURI
JsonURI (URI -> JsonURI)
-> (SuccessResponse -> URI) -> SuccessResponse -> JsonURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> URI
callback) SuccessResponse
response
, Text
"k1" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Text
challenge SuccessResponse
response
, Text
"defaultDescription" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Text
defaultDescription SuccessResponse
response
, Text
"minWithdrawable" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Word64
minWithdrawable SuccessResponse
response
, Text
"maxWithdrawable" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Word64
maxWithdrawable SuccessResponse
response
]
[Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Text
"balanceCheck" Text -> Maybe JsonURI -> Maybe Pair
forall a. ToJSON a => Text -> Maybe a -> Maybe Pair
.=? (URI -> JsonURI
JsonURI (URI -> JsonURI) -> Maybe URI -> Maybe JsonURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuccessResponse -> Maybe URI
balanceCheck SuccessResponse
response)]
getCallbackURL ::
SuccessResponse ->
Text ->
Maybe URI ->
URI
getCallbackURL :: SuccessResponse -> Text -> Maybe URI -> URI
getCallbackURL SuccessResponse
response Text
thePaymentRequest Maybe URI
balanceNotifyURI =
URI -> Query -> URI
addQueryParams (SuccessResponse -> URI
callback SuccessResponse
response) (Query -> URI) -> Query -> URI
forall a b. (a -> b) -> a -> b
$
[Maybe QueryItem] -> Query
forall a. [Maybe a] -> [a]
catMaybes
[ QueryItem -> Maybe QueryItem
forall a. a -> Maybe a
Just (QueryItem -> Maybe QueryItem) -> QueryItem -> Maybe QueryItem
forall a b. (a -> b) -> a -> b
$ ByteString
-> (SuccessResponse -> ByteString) -> SuccessResponse -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"k1" (Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (SuccessResponse -> Text) -> SuccessResponse -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> Text
challenge) SuccessResponse
response
, QueryItem -> Maybe QueryItem
forall a. a -> Maybe a
Just (QueryItem -> Maybe QueryItem) -> QueryItem -> Maybe QueryItem
forall a b. (a -> b) -> a -> b
$ ByteString -> (Text -> ByteString) -> Text -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"pr" Text -> ByteString
encodeUtf8 Text
thePaymentRequest
, ByteString -> (URI -> ByteString) -> URI -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"balanceNotify" (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (URI -> Text) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show) (URI -> QueryItem) -> Maybe URI -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
balanceNotifyURI
]