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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dsn -> Dsn -> Bool
$c/= :: Dsn -> Dsn -> Bool
== :: Dsn -> Dsn -> Bool
$c== :: Dsn -> Dsn -> Bool
Eq, Int -> Dsn -> ShowS
[Dsn] -> ShowS
Dsn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dsn] -> ShowS
$cshowList :: [Dsn] -> ShowS
show :: Dsn -> String
$cshow :: Dsn -> String
showsPrec :: Int -> Dsn -> ShowS
$cshowsPrec :: Int -> 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"invalid scheme") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
Text.stripSuffix (Char -> Text
Text.singleton Char
':') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriScheme URI
uri
  URIAuth
uriAuth <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"missing authority") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
Uri.uriAuthority URI
uri
  Text
userInfo <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"invalid user information") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
Text.stripSuffix (Char -> Text
Text.singleton Char
'@') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ URIAuth -> String
Uri.uriUserInfo URIAuth
uriAuth
  let (Text
thePublicKey, Text
theSecretKey) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
Text.drop Int
1) forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
Text.breakOn (Char -> Text
Text.singleton Char
':') Text
userInfo
      theHost :: Text
theHost = String -> Text
Text.pack 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
':') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ URIAuth -> String
Uri.uriPort URIAuth
uriAuth of
    Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Text
text -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"invalid port") (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Read.readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text
  let (Text
thePath, Text
theProjectId) = Text -> Text -> (Text, Text)
Text.breakOnEnd (Char -> Text
Text.singleton Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriPath URI
uri
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriQuery URI
uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"unexpected query"
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ URI -> String
Uri.uriFragment URI
uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM forall a b. (a -> b) -> a -> b
$ String -> Problem
Problem.Problem String
"unexpected fragment"
  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 = forall a. Monoid a => [a] -> a
mconcat [Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Dsn -> Text
protocol Dsn
dsn, String
":"],
      uriAuthority :: Maybe URIAuth
Uri.uriAuthority =
        forall a. a -> Maybe a
Just
          Uri.URIAuth
            { uriUserInfo :: String
Uri.uriUserInfo =
                forall a. Monoid a => [a] -> a
mconcat
                  [ Text -> String
Text.unpack 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 -> forall a. Monoid a => [a] -> a
mconcat [String
":", Text -> String
Text.unpack Text
x],
                    String
"@"
                  ],
              uriRegName :: String
Uri.uriRegName = Text -> String
Text.unpack 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 -> forall a. Monoid a => [a] -> a
mconcat [String
":", forall a. Show a => a -> String
show Natural
x]
            },
      uriPath :: String
Uri.uriPath =
        forall a. Monoid a => [a] -> a
mconcat
          [ Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Dsn -> Text
path Dsn
dsn,
            Text -> String
Text.unpack 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
Text.pack String
"Sentry " forall a. Semigroup a => a -> a -> a
<>)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
',')
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
      (\(String
k, Text
v) -> if Text -> Bool
Text.null Text
v then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (String -> Text
Text.pack String
k forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
'=' 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)
      ]