{-# 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