{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Rollbar.Client.Settings
( HasSettings(..)
, Settings(..)
, readSettings
, Token(..)
, Environment(..)
, Revision(..)
, getRevision
, getRevisionMaybe
, RequestModifiers(..)
, defaultRequestModifiers
) where
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Control.Exception (Exception, throwIO)
import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Aeson
import Data.ByteString (ByteString)
import Data.List.NonEmpty
import Data.Text (Text)
import Data.Yaml.Config (loadYamlSettings, requireEnv)
import System.Directory (findExecutable)
import System.Process
class HasSettings m where
getSettings :: m Settings
data Settings = Settings
{ Settings -> Token
settingsToken :: Token
, Settings -> Environment
settingsEnvironment :: Environment
, Settings -> Maybe Revision
settingsRevision :: Maybe Revision
, Settings -> RequestModifiers
settingsRequestModifiers :: RequestModifiers
} deriving (Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
/= :: Settings -> Settings -> Bool
Eq, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show)
instance FromJSON Settings where
parseJSON :: Value -> Parser Settings
parseJSON = String -> (Object -> Parser Settings) -> Value -> Parser Settings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Settings" ((Object -> Parser Settings) -> Value -> Parser Settings)
-> (Object -> Parser Settings) -> Value -> Parser Settings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Token
-> Environment -> Maybe Revision -> RequestModifiers -> Settings
Settings (Token
-> Environment -> Maybe Revision -> RequestModifiers -> Settings)
-> Parser Token
-> Parser
(Environment -> Maybe Revision -> RequestModifiers -> Settings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Token
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
Parser
(Environment -> Maybe Revision -> RequestModifiers -> Settings)
-> Parser Environment
-> Parser (Maybe Revision -> RequestModifiers -> Settings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Environment
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"environment"
Parser (Maybe Revision -> RequestModifiers -> Settings)
-> Parser (Maybe Revision) -> Parser (RequestModifiers -> Settings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Maybe Revision))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"revision" Parser (Maybe (Maybe Revision))
-> Maybe Revision -> Parser (Maybe Revision)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Revision
forall a. Maybe a
Nothing
Parser (RequestModifiers -> Settings)
-> Parser RequestModifiers -> Parser Settings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe RequestModifiers)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_modifiers" Parser (Maybe RequestModifiers)
-> RequestModifiers -> Parser RequestModifiers
forall a. Parser (Maybe a) -> a -> Parser a
.!= RequestModifiers
defaultRequestModifiers
readSettings :: MonadIO m => FilePath -> m Settings
readSettings :: forall (m :: * -> *). MonadIO m => String -> m Settings
readSettings String
path = IO Settings -> m Settings
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Settings -> m Settings) -> IO Settings -> m Settings
forall a b. (a -> b) -> a -> b
$ [String] -> [Value] -> EnvUsage -> IO Settings
forall settings.
FromJSON settings =>
[String] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings [String
path] [] EnvUsage
requireEnv
newtype Token = Token ByteString
deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)
instance FromJSON Token where
parseJSON :: Value -> Parser Token
parseJSON = String -> (Text -> Parser Token) -> Value -> Parser Token
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Token" ((Text -> Parser Token) -> Value -> Parser Token)
-> (Text -> Parser Token) -> Value -> Parser Token
forall a b. (a -> b) -> a -> b
$ Token -> Parser Token
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Parser Token) -> (Text -> Token) -> Text -> Parser Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Token
Token (ByteString -> Token) -> (Text -> ByteString) -> Text -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
newtype Environment = Environment Text
deriving (Environment -> Environment -> Bool
(Environment -> Environment -> Bool)
-> (Environment -> Environment -> Bool) -> Eq Environment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
/= :: Environment -> Environment -> Bool
Eq, Maybe Environment
Value -> Parser [Environment]
Value -> Parser Environment
(Value -> Parser Environment)
-> (Value -> Parser [Environment])
-> Maybe Environment
-> FromJSON Environment
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Environment
parseJSON :: Value -> Parser Environment
$cparseJSONList :: Value -> Parser [Environment]
parseJSONList :: Value -> Parser [Environment]
$comittedField :: Maybe Environment
omittedField :: Maybe Environment
FromJSON, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Environment -> ShowS
showsPrec :: Int -> Environment -> ShowS
$cshow :: Environment -> String
show :: Environment -> String
$cshowList :: [Environment] -> ShowS
showList :: [Environment] -> ShowS
Show, [Environment] -> Value
[Environment] -> Encoding
Environment -> Bool
Environment -> Value
Environment -> Encoding
(Environment -> Value)
-> (Environment -> Encoding)
-> ([Environment] -> Value)
-> ([Environment] -> Encoding)
-> (Environment -> Bool)
-> ToJSON Environment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Environment -> Value
toJSON :: Environment -> Value
$ctoEncoding :: Environment -> Encoding
toEncoding :: Environment -> Encoding
$ctoJSONList :: [Environment] -> Value
toJSONList :: [Environment] -> Value
$ctoEncodingList :: [Environment] -> Encoding
toEncodingList :: [Environment] -> Encoding
$comitField :: Environment -> Bool
omitField :: Environment -> Bool
ToJSON)
newtype Revision = Revision Text
deriving (Revision -> Revision -> Bool
(Revision -> Revision -> Bool)
-> (Revision -> Revision -> Bool) -> Eq Revision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Revision -> Revision -> Bool
== :: Revision -> Revision -> Bool
$c/= :: Revision -> Revision -> Bool
/= :: Revision -> Revision -> Bool
Eq, Maybe Revision
Value -> Parser [Revision]
Value -> Parser Revision
(Value -> Parser Revision)
-> (Value -> Parser [Revision])
-> Maybe Revision
-> FromJSON Revision
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Revision
parseJSON :: Value -> Parser Revision
$cparseJSONList :: Value -> Parser [Revision]
parseJSONList :: Value -> Parser [Revision]
$comittedField :: Maybe Revision
omittedField :: Maybe Revision
FromJSON, Int -> Revision -> ShowS
[Revision] -> ShowS
Revision -> String
(Int -> Revision -> ShowS)
-> (Revision -> String) -> ([Revision] -> ShowS) -> Show Revision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Revision -> ShowS
showsPrec :: Int -> Revision -> ShowS
$cshow :: Revision -> String
show :: Revision -> String
$cshowList :: [Revision] -> ShowS
showList :: [Revision] -> ShowS
Show, [Revision] -> Value
[Revision] -> Encoding
Revision -> Bool
Revision -> Value
Revision -> Encoding
(Revision -> Value)
-> (Revision -> Encoding)
-> ([Revision] -> Value)
-> ([Revision] -> Encoding)
-> (Revision -> Bool)
-> ToJSON Revision
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Revision -> Value
toJSON :: Revision -> Value
$ctoEncoding :: Revision -> Encoding
toEncoding :: Revision -> Encoding
$ctoJSONList :: [Revision] -> Value
toJSONList :: [Revision] -> Value
$ctoEncodingList :: [Revision] -> Encoding
toEncodingList :: [Revision] -> Encoding
$comitField :: Revision -> Bool
omitField :: Revision -> Bool
ToJSON)
getRevision
:: (HasSettings m, MonadIO m)
=> m Revision
getRevision :: forall (m :: * -> *). (HasSettings m, MonadIO m) => m Revision
getRevision = do
Maybe Revision
mrevision <- m (Maybe Revision)
forall (m :: * -> *).
(HasSettings m, MonadIO m) =>
m (Maybe Revision)
getRevisionMaybe
case Maybe Revision
mrevision of
Maybe Revision
Nothing -> IO Revision -> m Revision
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Revision -> m Revision) -> IO Revision -> m Revision
forall a b. (a -> b) -> a -> b
$ RollbarError -> IO Revision
forall e a. Exception e => e -> IO a
throwIO RollbarError
RevisionNotFound
Just Revision
revision -> Revision -> m Revision
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Revision
revision
getRevisionMaybe
:: (HasSettings m, MonadIO m)
=> m (Maybe Revision)
getRevisionMaybe :: forall (m :: * -> *).
(HasSettings m, MonadIO m) =>
m (Maybe Revision)
getRevisionMaybe = do
Maybe Revision
mrevision <- Settings -> Maybe Revision
settingsRevision (Settings -> Maybe Revision) -> m Settings -> m (Maybe Revision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Settings
forall (m :: * -> *). HasSettings m => m Settings
getSettings
case Maybe Revision
mrevision of
Maybe Revision
Nothing -> do
Maybe String
mgitPath <- IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable String
"git"
Maybe String -> (String -> m Revision) -> m (Maybe Revision)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
mgitPath ((String -> m Revision) -> m (Maybe Revision))
-> (String -> m Revision) -> m (Maybe Revision)
forall a b. (a -> b) -> a -> b
$ \String
gitPath ->
String -> Revision
mkRevision (String -> Revision) -> m String -> m Revision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> String -> IO String
readProcess String
gitPath [String
"rev-parse", String
"HEAD"] String
"")
Just Revision
revision -> Maybe Revision -> m (Maybe Revision)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Revision -> m (Maybe Revision))
-> Maybe Revision -> m (Maybe Revision)
forall a b. (a -> b) -> a -> b
$ Revision -> Maybe Revision
forall a. a -> Maybe a
Just Revision
revision
where
mkRevision :: String -> Revision
mkRevision = Text -> Revision
Revision (Text -> Revision) -> (String -> Text) -> String -> Revision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
data RequestModifiers = RequestModifiers
{ :: Maybe (NonEmpty Text)
, RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersExcludeParams :: Maybe (NonEmpty Text)
, :: Maybe (NonEmpty Text)
, RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersIncludeParams :: Maybe (NonEmpty Text)
} deriving (RequestModifiers -> RequestModifiers -> Bool
(RequestModifiers -> RequestModifiers -> Bool)
-> (RequestModifiers -> RequestModifiers -> Bool)
-> Eq RequestModifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestModifiers -> RequestModifiers -> Bool
== :: RequestModifiers -> RequestModifiers -> Bool
$c/= :: RequestModifiers -> RequestModifiers -> Bool
/= :: RequestModifiers -> RequestModifiers -> Bool
Eq, Int -> RequestModifiers -> ShowS
[RequestModifiers] -> ShowS
RequestModifiers -> String
(Int -> RequestModifiers -> ShowS)
-> (RequestModifiers -> String)
-> ([RequestModifiers] -> ShowS)
-> Show RequestModifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestModifiers -> ShowS
showsPrec :: Int -> RequestModifiers -> ShowS
$cshow :: RequestModifiers -> String
show :: RequestModifiers -> String
$cshowList :: [RequestModifiers] -> ShowS
showList :: [RequestModifiers] -> ShowS
Show)
instance FromJSON RequestModifiers where
parseJSON :: Value -> Parser RequestModifiers
parseJSON = String
-> (Object -> Parser RequestModifiers)
-> Value
-> Parser RequestModifiers
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RequestModifiers" ((Object -> Parser RequestModifiers)
-> Value -> Parser RequestModifiers)
-> (Object -> Parser RequestModifiers)
-> Value
-> Parser RequestModifiers
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> RequestModifiers
RequestModifiers (Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> RequestModifiers)
-> Parser (Maybe (NonEmpty Text))
-> Parser
(Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> RequestModifiers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Maybe (NonEmpty Text)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclude_headers" Parser (Maybe (Maybe (NonEmpty Text)))
-> Maybe (NonEmpty Text) -> Parser (Maybe (NonEmpty Text))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
Parser
(Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> RequestModifiers)
-> Parser (Maybe (NonEmpty Text))
-> Parser
(Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text) -> RequestModifiers)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Maybe (NonEmpty Text)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclude_params" Parser (Maybe (Maybe (NonEmpty Text)))
-> Maybe (NonEmpty Text) -> Parser (Maybe (NonEmpty Text))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
Parser
(Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text) -> RequestModifiers)
-> Parser (Maybe (NonEmpty Text))
-> Parser (Maybe (NonEmpty Text) -> RequestModifiers)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Maybe (NonEmpty Text)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"include_headers" Parser (Maybe (Maybe (NonEmpty Text)))
-> Maybe (NonEmpty Text) -> Parser (Maybe (NonEmpty Text))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
Parser (Maybe (NonEmpty Text) -> RequestModifiers)
-> Parser (Maybe (NonEmpty Text)) -> Parser RequestModifiers
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Maybe (NonEmpty Text)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"include_params" Parser (Maybe (Maybe (NonEmpty Text)))
-> Maybe (NonEmpty Text) -> Parser (Maybe (NonEmpty Text))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
defaultRequestModifiers :: RequestModifiers
defaultRequestModifiers :: RequestModifiers
defaultRequestModifiers = RequestModifiers
{ requestModifiersExcludeHeaders :: Maybe (NonEmpty Text)
requestModifiersExcludeHeaders = Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
, requestModifiersExcludeParams :: Maybe (NonEmpty Text)
requestModifiersExcludeParams = Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
, requestModifiersIncludeHeaders :: Maybe (NonEmpty Text)
requestModifiersIncludeHeaders = Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
, requestModifiersIncludeParams :: Maybe (NonEmpty Text)
requestModifiersIncludeParams = Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
}
data RollbarError = RevisionNotFound
deriving (RollbarError -> RollbarError -> Bool
(RollbarError -> RollbarError -> Bool)
-> (RollbarError -> RollbarError -> Bool) -> Eq RollbarError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RollbarError -> RollbarError -> Bool
== :: RollbarError -> RollbarError -> Bool
$c/= :: RollbarError -> RollbarError -> Bool
/= :: RollbarError -> RollbarError -> Bool
Eq, Int -> RollbarError -> ShowS
[RollbarError] -> ShowS
RollbarError -> String
(Int -> RollbarError -> ShowS)
-> (RollbarError -> String)
-> ([RollbarError] -> ShowS)
-> Show RollbarError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RollbarError -> ShowS
showsPrec :: Int -> RollbarError -> ShowS
$cshow :: RollbarError -> String
show :: RollbarError -> String
$cshowList :: [RollbarError] -> ShowS
showList :: [RollbarError] -> ShowS
Show)
instance Exception RollbarError