module Network.OAuth2.Experiment.Utils where

import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS8
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Lazy qualified as TL
import URI.ByteString (URI, serializeURIRef')

tlToBS :: TL.Text -> ByteString
tlToBS :: Text -> ByteString
tlToBS = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict

bs8ToLazyText :: BS8.ByteString -> TL.Text
bs8ToLazyText :: ByteString -> Text
bs8ToLazyText = String -> Text
TL.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS8.unpack

unionMapsToQueryParams :: [Map TL.Text TL.Text] -> [(ByteString, ByteString)]
unionMapsToQueryParams :: [Map Text Text] -> [(ByteString, ByteString)]
unionMapsToQueryParams =
  ((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString)
-> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> ByteString
tlToBS Text -> ByteString
tlToBS)
    ([(Text, Text)] -> [(ByteString, ByteString)])
-> ([Map Text Text] -> [(Text, Text)])
-> [Map Text Text]
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList
    (Map Text Text -> [(Text, Text)])
-> ([Map Text Text] -> Map Text Text)
-> [Map Text Text]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions

uriToText :: URI -> T.Text
uriToText :: URI -> Text
uriToText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef'