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) ]