{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c== :: Settings -> Settings -> Bool
Eq, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show)
instance FromJSON Settings where
parseJSON :: Value -> Parser Settings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Settings" forall a b. (a -> b) -> a -> b
$ \Object
o ->
Token
-> Environment -> Maybe Revision -> RequestModifiers -> Settings
Settings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"environment"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"revision" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_modifiers" 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall settings.
FromJSON settings =>
[String] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings [String
path] [] EnvUsage
requireEnv
newtype Token = Token ByteString
deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)
instance FromJSON Token where
parseJSON :: Value -> Parser Token
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Token" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Token
Token forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
newtype Environment = Environment Text
deriving (Environment -> Environment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, Value -> Parser [Environment]
Value -> Parser Environment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Environment]
$cparseJSONList :: Value -> Parser [Environment]
parseJSON :: Value -> Parser Environment
$cparseJSON :: Value -> Parser Environment
FromJSON, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, [Environment] -> Encoding
[Environment] -> Value
Environment -> Encoding
Environment -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Environment] -> Encoding
$ctoEncodingList :: [Environment] -> Encoding
toJSONList :: [Environment] -> Value
$ctoJSONList :: [Environment] -> Value
toEncoding :: Environment -> Encoding
$ctoEncoding :: Environment -> Encoding
toJSON :: Environment -> Value
$ctoJSON :: Environment -> Value
ToJSON)
newtype Revision = Revision Text
deriving (Revision -> Revision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Revision -> Revision -> Bool
$c/= :: Revision -> Revision -> Bool
== :: Revision -> Revision -> Bool
$c== :: Revision -> Revision -> Bool
Eq, Value -> Parser [Revision]
Value -> Parser Revision
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Revision]
$cparseJSONList :: Value -> Parser [Revision]
parseJSON :: Value -> Parser Revision
$cparseJSON :: Value -> Parser Revision
FromJSON, Int -> Revision -> ShowS
[Revision] -> ShowS
Revision -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Revision] -> ShowS
$cshowList :: [Revision] -> ShowS
show :: Revision -> String
$cshow :: Revision -> String
showsPrec :: Int -> Revision -> ShowS
$cshowsPrec :: Int -> Revision -> ShowS
Show, [Revision] -> Encoding
[Revision] -> Value
Revision -> Encoding
Revision -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Revision] -> Encoding
$ctoEncodingList :: [Revision] -> Encoding
toJSONList :: [Revision] -> Value
$ctoJSONList :: [Revision] -> Value
toEncoding :: Revision -> Encoding
$ctoEncoding :: Revision -> Encoding
toJSON :: Revision -> Value
$ctoJSON :: Revision -> Value
ToJSON)
getRevision
:: (HasSettings m, MonadIO m)
=> m Revision
getRevision :: forall (m :: * -> *). (HasSettings m, MonadIO m) => m Revision
getRevision = do
Maybe Revision
mrevision <- forall (m :: * -> *).
(HasSettings m, MonadIO m) =>
m (Maybe Revision)
getRevisionMaybe
case Maybe Revision
mrevision of
Maybe Revision
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO RollbarError
RevisionNotFound
Just Revision
revision -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasSettings m => m Settings
getSettings
case Maybe Revision
mrevision of
Maybe Revision
Nothing -> do
Maybe String
mgitPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable String
"git"
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
mgitPath forall a b. (a -> b) -> a -> b
$ \String
gitPath ->
String -> Revision
mkRevision forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Revision
revision
where
mkRevision :: String -> Revision
mkRevision = Text -> Revision
Revision forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestModifiers -> RequestModifiers -> Bool
$c/= :: RequestModifiers -> RequestModifiers -> Bool
== :: RequestModifiers -> RequestModifiers -> Bool
$c== :: RequestModifiers -> RequestModifiers -> Bool
Eq, Int -> RequestModifiers -> ShowS
[RequestModifiers] -> ShowS
RequestModifiers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestModifiers] -> ShowS
$cshowList :: [RequestModifiers] -> ShowS
show :: RequestModifiers -> String
$cshow :: RequestModifiers -> String
showsPrec :: Int -> RequestModifiers -> ShowS
$cshowsPrec :: Int -> RequestModifiers -> ShowS
Show)
instance FromJSON RequestModifiers where
parseJSON :: Value -> Parser RequestModifiers
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RequestModifiers" forall a b. (a -> b) -> a -> b
$ \Object
o ->
Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> RequestModifiers
RequestModifiers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclude_headers" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclude_params" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"include_headers" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"include_params" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
defaultRequestModifiers :: RequestModifiers
defaultRequestModifiers :: RequestModifiers
defaultRequestModifiers = RequestModifiers
{ requestModifiersExcludeHeaders :: Maybe (NonEmpty Text)
requestModifiersExcludeHeaders = forall a. Maybe a
Nothing
, requestModifiersExcludeParams :: Maybe (NonEmpty Text)
requestModifiersExcludeParams = forall a. Maybe a
Nothing
, requestModifiersIncludeHeaders :: Maybe (NonEmpty Text)
requestModifiersIncludeHeaders = forall a. Maybe a
Nothing
, requestModifiersIncludeParams :: Maybe (NonEmpty Text)
requestModifiersIncludeParams = forall a. Maybe a
Nothing
}
data RollbarError = RevisionNotFound
deriving (RollbarError -> RollbarError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RollbarError -> RollbarError -> Bool
$c/= :: RollbarError -> RollbarError -> Bool
== :: RollbarError -> RollbarError -> Bool
$c== :: RollbarError -> RollbarError -> Bool
Eq, Int -> RollbarError -> ShowS
[RollbarError] -> ShowS
RollbarError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RollbarError] -> ShowS
$cshowList :: [RollbarError] -> ShowS
show :: RollbarError -> String
$cshow :: RollbarError -> String
showsPrec :: Int -> RollbarError -> ShowS
$cshowsPrec :: Int -> RollbarError -> ShowS
Show)
instance Exception RollbarError