{-# LANGUAGE OverloadedStrings #-}

module LnUrl.Utils (
    Base16 (..),
    Base64 (..),
    JsonURI (..),
    (.=?),
) where

import Data.Aeson (
    FromJSON,
    ToJSON,
    Value,
    parseJSON,
    toJSON,
    withText,
    (.=),
 )
import Data.ByteString (ByteString)
import Data.ByteString.Base16 (decodeBase16, encodeBase16)
import Data.ByteString.Base64 (decodeBase64, encodeBase64)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import Network.URI (URI, parseURI)

newtype Base16 = Base16 {Base16 -> ByteString
getBase16 :: ByteString}
    deriving (Base16 -> Base16 -> Bool
(Base16 -> Base16 -> Bool)
-> (Base16 -> Base16 -> Bool) -> Eq Base16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base16 -> Base16 -> Bool
$c/= :: Base16 -> Base16 -> Bool
== :: Base16 -> Base16 -> Bool
$c== :: Base16 -> Base16 -> Bool
Eq, Int -> Base16 -> ShowS
[Base16] -> ShowS
Base16 -> String
(Int -> Base16 -> ShowS)
-> (Base16 -> String) -> ([Base16] -> ShowS) -> Show Base16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base16] -> ShowS
$cshowList :: [Base16] -> ShowS
show :: Base16 -> String
$cshow :: Base16 -> String
showsPrec :: Int -> Base16 -> ShowS
$cshowsPrec :: Int -> Base16 -> ShowS
Show)

instance FromJSON Base16 where
    parseJSON :: Value -> Parser Base16
parseJSON =
        String -> (Text -> Parser Base16) -> Value -> Parser Base16
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Base16" ((Text -> Parser Base16) -> Value -> Parser Base16)
-> (Text -> Parser Base16) -> Value -> Parser Base16
forall a b. (a -> b) -> a -> b
$
            (Text -> Parser Base16)
-> (ByteString -> Parser Base16)
-> Either Text ByteString
-> Parser Base16
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Base16
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Base16)
-> (Text -> String) -> Text -> Parser Base16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (Base16 -> Parser Base16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base16 -> Parser Base16)
-> (ByteString -> Base16) -> ByteString -> Parser Base16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16
Base16)
                (Either Text ByteString -> Parser Base16)
-> (Text -> Either Text ByteString) -> Text -> Parser Base16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase16
                (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToJSON Base16 where
    toJSON :: Base16 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Base16 -> Text) -> Base16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase16 (ByteString -> Text) -> (Base16 -> ByteString) -> Base16 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 -> ByteString
getBase16

newtype Base64 = Base64 {Base64 -> ByteString
getBase64 :: ByteString}
    deriving (Base64 -> Base64 -> Bool
(Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool) -> Eq Base64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64 -> Base64 -> Bool
$c/= :: Base64 -> Base64 -> Bool
== :: Base64 -> Base64 -> Bool
$c== :: Base64 -> Base64 -> Bool
Eq, Int -> Base64 -> ShowS
[Base64] -> ShowS
Base64 -> String
(Int -> Base64 -> ShowS)
-> (Base64 -> String) -> ([Base64] -> ShowS) -> Show Base64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base64] -> ShowS
$cshowList :: [Base64] -> ShowS
show :: Base64 -> String
$cshow :: Base64 -> String
showsPrec :: Int -> Base64 -> ShowS
$cshowsPrec :: Int -> Base64 -> ShowS
Show)

instance FromJSON Base64 where
    parseJSON :: Value -> Parser Base64
parseJSON =
        String -> (Text -> Parser Base64) -> Value -> Parser Base64
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Base64" ((Text -> Parser Base64) -> Value -> Parser Base64)
-> (Text -> Parser Base64) -> Value -> Parser Base64
forall a b. (a -> b) -> a -> b
$
            (Text -> Parser Base64)
-> (ByteString -> Parser Base64)
-> Either Text ByteString
-> Parser Base64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Base64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Base64)
-> (Text -> String) -> Text -> Parser Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (Base64 -> Parser Base64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64 -> Parser Base64)
-> (ByteString -> Base64) -> ByteString -> Parser Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64
Base64)
                (Either Text ByteString -> Parser Base64)
-> (Text -> Either Text ByteString) -> Text -> Parser Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase64
                (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToJSON Base64 where
    toJSON :: Base64 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Base64 -> Text) -> Base64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase64 (ByteString -> Text) -> (Base64 -> ByteString) -> Base64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
getBase64

newtype JsonURI = JsonURI {JsonURI -> URI
getJsonURI :: URI}
    deriving (JsonURI -> JsonURI -> Bool
(JsonURI -> JsonURI -> Bool)
-> (JsonURI -> JsonURI -> Bool) -> Eq JsonURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonURI -> JsonURI -> Bool
$c/= :: JsonURI -> JsonURI -> Bool
== :: JsonURI -> JsonURI -> Bool
$c== :: JsonURI -> JsonURI -> Bool
Eq, Int -> JsonURI -> ShowS
[JsonURI] -> ShowS
JsonURI -> String
(Int -> JsonURI -> ShowS)
-> (JsonURI -> String) -> ([JsonURI] -> ShowS) -> Show JsonURI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonURI] -> ShowS
$cshowList :: [JsonURI] -> ShowS
show :: JsonURI -> String
$cshow :: JsonURI -> String
showsPrec :: Int -> JsonURI -> ShowS
$cshowsPrec :: Int -> JsonURI -> ShowS
Show)

instance FromJSON JsonURI where
    parseJSON :: Value -> Parser JsonURI
parseJSON = String -> (Text -> Parser JsonURI) -> Value -> Parser JsonURI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"JsonURI" ((Text -> Parser JsonURI) -> Value -> Parser JsonURI)
-> (Text -> Parser JsonURI) -> Value -> Parser JsonURI
forall a b. (a -> b) -> a -> b
$ Parser JsonURI
-> (URI -> Parser JsonURI) -> Maybe URI -> Parser JsonURI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser JsonURI
forall a. Parser a
noParse (JsonURI -> Parser JsonURI
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonURI -> Parser JsonURI)
-> (URI -> JsonURI) -> URI -> Parser JsonURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> JsonURI
JsonURI) (Maybe URI -> Parser JsonURI)
-> (Text -> Maybe URI) -> Text -> Parser JsonURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseURI (String -> Maybe URI) -> (Text -> String) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
      where
        noParse :: Parser a
noParse = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse URI"

instance ToJSON JsonURI where
    toJSON :: JsonURI -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (JsonURI -> String) -> JsonURI -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (JsonURI -> URI) -> JsonURI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonURI -> URI
getJsonURI

(.=?) :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value)
Text
k .=? :: Text -> Maybe a -> Maybe (Text, Value)
.=? Maybe a
mv = (Text
k Text -> a -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (a -> (Text, Value)) -> Maybe a -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mv