module Patrol.Type.Dsn where

import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Catch
import qualified Data.ByteString as ByteString
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.URI as Uri
import qualified Numeric.Natural as Natural
import qualified Patrol.Constant as Constant
import qualified Patrol.Exception.Problem as Problem
import qualified Text.Read as Read

data Dsn = Dsn
  { Dsn -> Text
protocol :: Text.Text,
    Dsn -> Text
publicKey :: Text.Text,
    Dsn -> Text
secretKey :: Text.Text,
    Dsn -> Text
host :: Text.Text,
    Dsn -> Maybe Natural
port :: Maybe Natural.Natural,
    Dsn -> Text
path :: Text.Text,
    Dsn -> Text
projectId :: Text.Text
  }
  deriving (Dsn -> Dsn -> Bool
(Dsn -> Dsn -> Bool) -> (Dsn -> Dsn -> Bool) -> Eq Dsn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dsn -> Dsn -> Bool
== :: Dsn -> Dsn -> Bool
$c/= :: Dsn -> Dsn -> Bool
/= :: Dsn -> Dsn -> Bool
Eq, Int -> Dsn -> ShowS
[Dsn] -> ShowS
Dsn -> String
(Int -> Dsn -> ShowS)
-> (Dsn -> String) -> ([Dsn] -> ShowS) -> Show Dsn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dsn -> ShowS
showsPrec :: Int -> Dsn -> ShowS
$cshow :: Dsn -> String
show :: Dsn -> String
$cshowList :: [Dsn] -> ShowS
showList :: [Dsn] -> ShowS
Show)

fromUri :: (Catch.MonadThrow m) => Uri.URI -> m Dsn
fromUri :: forall (m :: * -> *). MonadThrow m => URI -> m Dsn
fromUri URI
uri = do
  Text
theProtocol <- m Text -> (Text -> m Text) -> Maybe Text -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Problem -> m Text
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> m Text) -> Problem -> m Text
forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"invalid scheme") Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m Text)
-> (String -> Maybe Text) -> String -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
Text.stripSuffix (Char -> Text
Text.singleton Char
':') (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> m Text) -> String -> m Text
forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriScheme URI
uri
  URIAuth
uriAuth <- m URIAuth -> (URIAuth -> m URIAuth) -> Maybe URIAuth -> m URIAuth
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Problem -> m URIAuth
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> m URIAuth) -> Problem -> m URIAuth
forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"missing authority") URIAuth -> m URIAuth
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe URIAuth -> m URIAuth) -> Maybe URIAuth -> m URIAuth
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
Uri.uriAuthority URI
uri
  Text
userInfo <- m Text -> (Text -> m Text) -> Maybe Text -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Problem -> m Text
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> m Text) -> Problem -> m Text
forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"invalid user information") Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m Text)
-> (String -> Maybe Text) -> String -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
Text.stripSuffix (Char -> Text
Text.singleton Char
'@') (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> m Text) -> String -> m Text
forall a b. (a -> b) -> a -> b
$ URIAuth -> String
Uri.uriUserInfo URIAuth
uriAuth
  let (Text
thePublicKey, Text
theSecretKey) = (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
Text.drop Int
1) ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Text.breakOn (Char -> Text
Text.singleton Char
':') Text
userInfo
      theHost :: Text
theHost = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URIAuth -> String
Uri.uriRegName URIAuth
uriAuth
  Maybe Natural
maybePort <- case Text -> Text -> Maybe Text
Text.stripPrefix (Char -> Text
Text.singleton Char
':') (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ URIAuth -> String
Uri.uriPort URIAuth
uriAuth of
    Maybe Text
Nothing -> Maybe Natural -> m (Maybe Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Natural
forall a. Maybe a
Nothing
    Just Text
text -> m (Maybe Natural)
-> (Natural -> m (Maybe Natural))
-> Maybe Natural
-> m (Maybe Natural)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Problem -> m (Maybe Natural)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> m (Maybe Natural)) -> Problem -> m (Maybe Natural)
forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"invalid port") (Maybe Natural -> m (Maybe Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Natural -> m (Maybe Natural))
-> (Natural -> Maybe Natural) -> Natural -> m (Maybe Natural)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural
forall a. a -> Maybe a
Just) (Maybe Natural -> m (Maybe Natural))
-> (String -> Maybe Natural) -> String -> m (Maybe Natural)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Natural
forall a. Read a => String -> Maybe a
Read.readMaybe (String -> m (Maybe Natural)) -> String -> m (Maybe Natural)
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text
  let (Text
thePath, Text
theProjectId) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Text.breakOnEnd (Char -> Text
Text.singleton Char
'/') (Text -> (Text, Text))
-> (String -> Text) -> String -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> (Text, Text)) -> String -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriPath URI
uri
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriQuery URI
uri) (m () -> m ()) -> (Problem -> m ()) -> Problem -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Problem -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> m ()) -> Problem -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"unexpected query"
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriFragment URI
uri) (m () -> m ()) -> (Problem -> m ()) -> Problem -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Problem -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> m ()) -> Problem -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"unexpected fragment"
  Dsn -> m Dsn
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Dsn
      { protocol :: Text
protocol = Text
theProtocol,
        publicKey :: Text
publicKey = Text
thePublicKey,
        secretKey :: Text
secretKey = Text
theSecretKey,
        host :: Text
host = Text
theHost,
        port :: Maybe Natural
port = Maybe Natural
maybePort,
        path :: Text
path = Text
thePath,
        projectId :: Text
projectId = Text
theProjectId
      }

intoUri :: Dsn -> Uri.URI
intoUri :: Dsn -> URI
intoUri Dsn
dsn =
  Uri.URI
    { uriScheme :: String
Uri.uriScheme = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Dsn -> Text
protocol Dsn
dsn, String
":"],
      uriAuthority :: Maybe URIAuth
Uri.uriAuthority =
        URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just
          Uri.URIAuth
            { uriUserInfo :: String
Uri.uriUserInfo =
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                  [ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Dsn -> Text
publicKey Dsn
dsn,
                    case Dsn -> Text
secretKey Dsn
dsn of
                      Text
x
                        | Text -> Bool
Text.null Text
x -> String
""
                        | Bool
otherwise -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
":", Text -> String
Text.unpack Text
x],
                    String
"@"
                  ],
              uriRegName :: String
Uri.uriRegName = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Dsn -> Text
host Dsn
dsn,
              uriPort :: String
Uri.uriPort = case Dsn -> Maybe Natural
port Dsn
dsn of
                Maybe Natural
Nothing -> String
""
                Just Natural
x -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
":", Natural -> String
forall a. Show a => a -> String
show Natural
x]
            },
      uriPath :: String
Uri.uriPath =
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Dsn -> Text
path Dsn
dsn,
            Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Dsn -> Text
projectId Dsn
dsn
          ],
      uriQuery :: String
Uri.uriQuery = String
"",
      uriFragment :: String
Uri.uriFragment = String
""
    }

intoAuthorization :: Dsn -> ByteString.ByteString
intoAuthorization :: Dsn -> ByteString
intoAuthorization Dsn
dsn =
  Text -> ByteString
Text.encodeUtf8
    (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
Text.pack String
"Sentry " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
    (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
',')
    ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((String, Text) -> Maybe Text) -> [(String, Text)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
      (\(String
k, Text
v) -> if Text -> Bool
Text.null Text
v then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Text.pack String
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
'=' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v))
      [ (String
"sentry_version", Text
Constant.sentryVersion),
        (String
"sentry_client", Text
Constant.userAgent),
        (String
"sentry_key", Dsn -> Text
publicKey Dsn
dsn),
        (String
"sentry_secret", Dsn -> Text
secretKey Dsn
dsn)
      ]