{-# 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

-- | Typeclass used to pull Rollbar 'Settings' out of a given 'Monad'.
class HasSettings m where
  getSettings :: m Settings

-- | General settings required to interact with Rollbar API.
data Settings = Settings
  { Settings -> Token
settingsToken :: Token
    -- ^ Rollbar API authentication token.
  , Settings -> Environment
settingsEnvironment :: Environment
    -- ^ Environment to which the revision was deployed.
  , Settings -> Maybe Revision
settingsRevision :: Maybe Revision
    -- ^ Git SHA of revision being deployed.
  , 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

-- | Reads 'Settings' from a YAML file.
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

-- | Environment to which the revision was deployed.
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)

-- | Git SHA of revision being deployed.
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)

-- | Similar to 'getRevisionMaybe', but it throws a 'RevisionNotFound' if the
-- 'Revision' is not found.
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

-- | Gets the 'Revision' from 'Settings' (if the value is present), otherwise
-- gets the 'Revision' from @git@ (if the executable is present) directly
-- by running the following command @git rev-parse HEAD@, if none of them are
-- present (neither the value nor the executable) returns 'Nothing'.
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

-- | Represents a list of 'Request' modifiers that are combined by
-- 'getRequestModifier' into a single function.
data RequestModifiers = RequestModifiers
  { RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersExcludeHeaders :: Maybe (NonEmpty Text)
    -- ^ A list of 'Request' header names to be excluded.
  , RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersExcludeParams :: Maybe (NonEmpty Text)
    -- ^ A list of 'Request' param names to be excluded.
  , RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersIncludeHeaders :: Maybe (NonEmpty Text)
    -- ^ A list of 'Request' header names to be included.
  , RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersIncludeParams :: Maybe (NonEmpty Text)
    -- ^ A list of 'Request' params names to be included.
  } 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

-- | Returns an empty 'RequestModifiers', the function produced by
-- 'getRequestModifier' given this values is equivalent to 'id'.
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