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