packages feed

rollbar-hs (empty) → 0.1.0.0

raw patch · 25 files changed

+1664/−0 lines, 25 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, bytestring, case-insensitive, containers, hostname, hspec, hspec-golden-aeson, http-client, http-conduit, http-types, lens, lens-aeson, network, rollbar-hs, text, time, unordered-containers, uuid

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Hardy Jones (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Hardy Jones nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# rollbar-hs
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rollbar-hs.cabal view
@@ -0,0 +1,90 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: c372135c80536d8928405a9e3c5ddfabd7fa0e93e03252e6a8e780f4efa018ae++name:           rollbar-hs+version:        0.1.0.0+synopsis:       Core Rollbar data types and APIs.+category:       Web+homepage:       https://github.com/joneshf/rollbar-hs#readme+bug-reports:    https://github.com/joneshf/rollbar-hs/issues+author:         Hardy Jones+maintainer:     jones3.hardy@gmail.com+copyright:      2018 Hardy Jones+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/joneshf/rollbar-hs++library+  hs-source-dirs:+      src+  build-depends:+      aeson >=1.0 && <1.3+    , base >=4.9 && <5+    , bytestring >=0.10 && <0.11+    , case-insensitive >=1.2 && <1.3+    , hostname >=1.0 && <1.1+    , http-client >=0.5 && <0.6+    , http-conduit >=2.2 && <2.4+    , http-types >=0.9 && <0.13+    , network >=2.6 && <2.7+    , text >=1.2 && <1.3+    , time >=1.6 && <1.9+    , unordered-containers >=0.2 && <0.3+    , uuid >=1.3 && <1.4+  exposed-modules:+      Rollbar.AccessToken+      Rollbar.API+      Rollbar.Item+      Rollbar.Item.Body+      Rollbar.Item.CodeVersion+      Rollbar.Item.Data+      Rollbar.Item.Environment+      Rollbar.Item.Hardcoded+      Rollbar.Item.Internal.Notifier+      Rollbar.Item.Internal.Platform+      Rollbar.Item.Level+      Rollbar.Item.MissingHeaders+      Rollbar.Item.Person+      Rollbar.Item.Request+      Rollbar.Item.Server+  other-modules:+      Paths_rollbar_hs+  default-language: Haskell2010++test-suite doc-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test+  build-depends:+      QuickCheck >=2.9+    , aeson >=1.0+    , base >=4.9+    , bytestring >=0.10+    , case-insensitive >=1.2+    , containers >=0.5+    , hspec >=2.4+    , hspec-golden-aeson >=0.2+    , lens >=4.15+    , lens-aeson >=1.0+    , rollbar-hs+    , text >=1.2+  other-modules:+      Rollbar.Golden+      Rollbar.Item.Data.Test+      Rollbar.Item.MissingHeaders.Test+      Rollbar.Item.Request.Test+      Rollbar.QuickCheck+      Paths_rollbar_hs+  default-language: Haskell2010
+ src/Rollbar/API.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.API+    Description : Codifies Rollbar's API+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Provides functions for communicating with Rollbar through the public API.++    See Rollbar's <https://rollbar.com/docs/api/ API> for more details.+-}+module Rollbar.API+    ( -- * Helpful functions+      -- | These functions are probably what you want most of the time.+      itemsPOST+    , itemsPOST'+    , itemsPOSTRaw+    , itemsPOSTRaw'+    , makeRequest+    -- * Response data types+    , ItemsPOSTResponse(..)+    , ItemsPOSTErrorMessage(..)+    , ItemsPOSTSuccessResult(..)+    -- * Impure functions+    -- | Use with caution.+    , itemsPOSTWithException+    ) where++import Control.Monad.IO.Class (MonadIO)++import Data.Aeson.Types+    ( FromJSON(parseJSON)+    , SumEncoding(UntaggedValue)+    , ToJSON+    , defaultOptions+    , fieldLabelModifier+    , genericParseJSON+    , sumEncoding+    )+import Data.Text  (Text)++import GHC.Generics (Generic)++import Network.HTTP.Client+    ( Manager+    , Request(host, method, path, port, secure)+    , Response+    , defaultRequest+    , setRequestIgnoreStatus+    )+import Network.HTTP.Simple+    ( JSONException+    , httpJSON+    , httpJSONEither+    , setRequestBodyJSON+    , setRequestManager+    )++import Rollbar.Item (Item, RemoveHeaders, UUID4)++-- | The response received from sending an 'Rollbar.Item.Item' to Rollbar.+data ItemsPOSTResponse+    = ItemsPOSTSuccess+        { err_ItemsPOSTSuccess    :: Int+        -- ^ This `err` field is always 0.+        , result_ItemsPOSTSuccess :: ItemsPOSTSuccessResult+        -- ^ The part you probably care about.+        }+    | ItemsPOSTError+        { err_ItemsPOSTError     :: Int+        -- ^ This `err` field is always 1.+        , message_ItemsPOSTError :: Text+        -- ^ A human-readable message describing the error.+        }+    deriving (Eq, Generic, Show)++instance FromJSON ItemsPOSTResponse where+    parseJSON = genericParseJSON defaultOptions+        { fieldLabelModifier = takeWhile (/= '_')+        , sumEncoding = UntaggedValue+        }++-- | The successful response from sending an 'Rollbar.Item.Item' to Rollbar.+newtype ItemsPOSTSuccessResult+    = ItemsPOSTSuccessResult+        { uuid :: UUID4+        -- ^ 'Rollbar.Item.UUID4' of the item.+        --   Matches sent 'Rollbar.Item.UUID4' or generated by Rollbar if missing.+        }+    deriving (Eq, FromJSON, Generic, Show)++-- | The human readable error message from sending an 'Rollbar.Item.Item' to Rollbar.+newtype ItemsPOSTErrorMessage+    = ItemsPOSTErrorMessage Text+    deriving (Eq, FromJSON, Generic, Show)++-- | Sends an 'Rollbar.Item.Item' off to Rollbar.+--+--   Creates a new 'Network.HTTP.Client.Manager' to send off the request.+itemsPOST+    :: (MonadIO f, RemoveHeaders b, ToJSON a)+    => Item a b+    -> f (Response (Either JSONException ItemsPOSTResponse))+itemsPOST = itemsPOSTRaw++-- | Sends an 'Rollbar.Item.Item' off to Rollbar.+itemsPOST'+    :: (MonadIO f, RemoveHeaders b, ToJSON a)+    => Manager+    -> Item a b+    -> f (Response (Either JSONException ItemsPOSTResponse))+itemsPOST' = itemsPOSTRaw'++-- | Sends an 'Rollbar.Item.Item' off to Rollbar.+--+--   Creates a new 'Network.HTTP.Client.Manager' to send off the request.+--   Makes no claims about what you get back.+itemsPOSTRaw+    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)+    => Item a b+    -> f (Response (Either JSONException c))+itemsPOSTRaw = httpJSONEither . makeRequest++-- | Sends an 'Rollbar.Item.Item' off to Rollbar.+--+--   Makes no claims about what you get back.+itemsPOSTRaw'+    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)+    => Manager+    -> Item a b+    -> f (Response (Either JSONException c))+itemsPOSTRaw' manager = httpJSONEither . setRequestManager manager . makeRequest++-- | Sends an 'Rollbar.Item.Item' off to Rollbar.+--+--   Creates a new 'Network.HTTP.Client.Manager' to send off the request.+--   Makes no claims about what you get back.+--   Throws a 'Network.HTTP.Simple.JSONException' if it cannot parse the response.+--+--   Yes, this name is annoying, so are exceptions.+itemsPOSTWithException+    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)+    => Item a b+    -> f (Response c)+itemsPOSTWithException = httpJSON . makeRequest++-- | Converts an item into a request ready to send to Rollbar.+--+--   If you need a different scheme for sending items,+--   you'll probably want to use this along with a function like 'Network.HTTP.Client.httpLbs'+--   or 'Network.HTTP.Simple.httpLbs'.+--+--   If you want the JSON back and already have a 'Network.HTTP.Client.Manager',+--   you can use this function with 'Network.HTTP.Simple.setRequestManager'.+--   Then send off the request with something like 'Network.HTTP.Simple.httpJSONEither'.+makeRequest :: (RemoveHeaders headers, ToJSON a) => Item a headers -> Request+makeRequest payload =+    setRequestBodyJSON payload+        . setRequestIgnoreStatus+        $ defaultRequest+            { host = "api.rollbar.com"+            , method = "POST"+            , path = "api/1/item/"+            , port = 443+            , secure = True+            }
+ src/Rollbar/AccessToken.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+    Module      : Rollbar.AccessToken+    Description : The access token for a project on Rollbar.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.AccessToken+    ( AccessToken(..)+    ) where++import Data.Aeson  (FromJSON, ToJSON)+import Data.String (IsString)++import qualified Data.Text as T++-- | Should have the scope "post_server_item".+newtype AccessToken+    = AccessToken T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)
+ src/Rollbar/Item.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++{-|+    Module      : Rollbar.Item+    Description : Datatype for reporting to Rollbar+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Provides a data type that subsumes most of what Rollbar expects for "item"s.++    See Rollbar's <https://rollbar.com/docs/api/items_post/#data-format Data Format>+    for more details.+-}++module Rollbar.Item+    ( -- * Data helpers+      -- |  These functions are probably what you want to use most of the time.+      --+      --    They create a 'Data' with lots of data prefilled.+      --    You can then override what you need with record updates.+      debug+    , info+    , warning+    , error+    , critical+    -- * Item+    , Item(..)+    -- * Item data+    , module Rollbar.AccessToken+    , AccessToken(..)++    , module Rollbar.Item.Data+    , Data(..)+    , Context(..)+    , Fingerprint(..)+    , Framework(..)+    , Title(..)+    , UUID4(..)++    -- * Required data+    , module Rollbar.Item.Body+    , Body(..)+    , MessageBody(..)++    , module Rollbar.Item.Environment+    , Environment(..)++    , module Rollbar.Item.Level+    , Level(..)++    -- * Optional data+    , module Rollbar.Item.CodeVersion+    , CodeVersion(..)++    , module Rollbar.Item.Hardcoded+    , Hardcoded(..)++    , module Rollbar.Item.MissingHeaders+    , MissingHeaders(..)++    , module Rollbar.Item.Person+    , Person(..)+    , Email(..)+    , Id(..)+    , Username(..)++    , module Rollbar.Item.Request+    , Get(..)+    , IP(..)+    , Method(..)+    , MissingHeaders(..)+    , QueryString(..)+    , RawBody(..)+    , URL(..)++    , module Rollbar.Item.Server+    , Server(..)+    , Branch(..)+    , Root(..)+    ) where++import Data.Aeson+    ( FromJSON+    , KeyValue+    , ToJSON+    , Value(Object)+    , object+    , pairs+    , parseJSON+    , toEncoding+    , toJSON+    , (.:)+    , (.=)+    )+import Data.Aeson.Types (typeMismatch)+import Data.Maybe       (fromMaybe)++import GHC.Generics (Generic)++import Prelude hiding (error)++import Rollbar.AccessToken+import Rollbar.Item.Body+import Rollbar.Item.CodeVersion+import Rollbar.Item.Data+import Rollbar.Item.Environment+import Rollbar.Item.Hardcoded+import Rollbar.Item.Level+import Rollbar.Item.MissingHeaders+import Rollbar.Item.Person+import Rollbar.Item.Request+import Rollbar.Item.Server++import Rollbar.Item.Internal.Notifier+import Rollbar.Item.Internal.Platform++import System.Info (os)++import qualified Data.Text                    as T+import qualified Paths_rollbar_hs++-- | Creates 'Data' with the level set to 'Debug'.+debug+    :: Environment+    -> Maybe MessageBody+    -> payload+    -> Data payload ("Authorization" ': headers)+debug environment messageBody payload =+    Data+        { body = Message (fromMaybe "" messageBody) payload+        , codeVersion = Nothing+        , context = Nothing+        , custom = Nothing+        , environment = environment+        , fingerprint = Nothing+        , framework = Nothing+        , language = Hardcoded+        , level = Debug+        , notifier = Notifier Hardcoded Paths_rollbar_hs.version+        , person = Nothing+        , platform = Platform $ T.pack os+        , request = Nothing+        , server = Nothing+        , timestamp = Nothing+        , title = Nothing+        , uuid = Nothing+        }++-- | Creates 'Data' with the level set to 'Info'.+info+    :: Environment+    -> Maybe MessageBody+    -> payload+    -> Data payload ("Authorization" ': headers)+info environment messageBody payload =+    (debug environment messageBody payload) { level = Info }++-- | Creates 'Data' with the level set to 'Warning'.+warning+    :: Environment+    -> Maybe MessageBody+    -> payload+    -> Data payload ("Authorization" ': headers)+warning environment messageBody payload =+    (debug environment messageBody payload) { level = Warning }++-- | Creates 'Data' with the level set to 'Error'.+error+    :: Environment+    -> Maybe MessageBody+    -> payload+    -> Data payload ("Authorization" ': headers)+error environment messageBody payload =+    (debug environment messageBody payload) { level = Error }++-- | Creates 'Data' with the level set to 'Critical'.+critical+    :: Environment+    -> Maybe MessageBody+    -> payload+    -> Data payload ("Authorization" ': headers)+critical environment messageBody payload =+    (debug environment messageBody payload) { level = Critical }++-- | The thing we actually give to Rollbar.+data Item a headers+    = Item+        { accessToken :: AccessToken+        -- ^ Should have a scope "post_server_item".+        , itemData    :: Data a headers+        }+    deriving (Eq, Generic, Show)++itemKVs+    :: (KeyValue kv, RemoveHeaders headers, ToJSON v)+    => Item v headers+    -> [kv]+itemKVs Item{accessToken, itemData} =+    [ "access_token" .= accessToken+    , "data" .= itemData+    ]++instance FromJSON a => FromJSON (Item a headers) where+    parseJSON (Object o) = Item <$> o .: "access_token" <*> o .: "data"+    parseJSON v          = typeMismatch "Item a headers" v++instance (RemoveHeaders headers, ToJSON a) => ToJSON (Item a headers) where+    toJSON = object . itemKVs+    toEncoding = pairs . mconcat . itemKVs
+ src/Rollbar/Item/Body.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Body+    Description : The meat of the Rollbar item+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Use this for providing the majority of your specific data to Rollbar.+-}++module Rollbar.Item.Body+    ( Body(..)+    , MessageBody(..)+    ) where++import Data.Aeson+    ( FromJSON+    , KeyValue+    , ToJSON+    , Value(Object)+    , object+    , pairs+    , parseJSON+    , toEncoding+    , toJSON+    , (.:)+    , (.=)+    )+import Data.Aeson.Encoding (pair)+import Data.Aeson.Types    (typeMismatch)+import Data.String         (IsString)++import GHC.Generics (Generic)++import qualified Data.Text as T++-- | This is the actual data that you want to give to Rollbar.+--  Most of the rest of Rollbar is metadata.+data Body arbitrary+    -- | No stack trace, just a message and some arbitrary data.+    = Message+        { messageBody :: MessageBody+        -- ^ The primary message text.+        , messageData :: arbitrary+        -- ^ Any arbitrary data you want to send with this message.+        }+    deriving (Eq, Generic, Show)++bodyKVs :: (KeyValue kv, ToJSON v) => Body v -> [kv]+bodyKVs Message{messageBody, messageData} =+    [ "body" .= messageBody+    , "data" .= messageData+    ]++instance FromJSON arbitrary => FromJSON (Body arbitrary) where+    parseJSON (Object o') = do+        o <- o' .: "message"+        Message <$> o .: "body" <*> o .: "data"+    parseJSON v = typeMismatch "Body arbitrary" v++instance ToJSON arbitrary => ToJSON (Body arbitrary) where+    toJSON x = object ["message" .= object (bodyKVs x)]+    toEncoding = pairs . pair "message" . pairs . mconcat . bodyKVs++-- | The primary message text to send to Rollbar.+newtype MessageBody+    = MessageBody T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)
+ src/Rollbar/Item/CodeVersion.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.CodeVersion+    Description : Metadata for describing versions of software+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.CodeVersion+    ( CodeVersion(..)+    ) where++import Data.Aeson       (FromJSON, ToJSON, parseJSON, toEncoding, toJSON)+import Data.Aeson.Types (typeMismatch)++import GHC.Generics (Generic)++import qualified Data.Aeson as A+import qualified Data.Text  as T++-- | Rollbar supports different ways to say what version the code is.+data CodeVersion+    -- | Good ole SemVer.+    --  It's 'T.Text' because who knows if you actually got it right...+    = SemVer T.Text+    -- | Plain integers.+    | Number Int+    -- | Should be a Git SHA.+    | SHA T.Text+    deriving (Eq, Generic, Show)++prettyCodeVersion :: CodeVersion -> T.Text+prettyCodeVersion (SemVer s) = s+prettyCodeVersion (Number n) = T.pack . show $ n+prettyCodeVersion (SHA h)    = h++instance FromJSON CodeVersion where+    parseJSON (A.String s) = case T.splitOn "." s of+        [_major, _minor, _patch] -> pure $ SemVer s+        _                        -> pure $ SHA s+    parseJSON (A.Number n) = pure $ Number $ floor n+    parseJSON v = typeMismatch "CodeVersion" v++instance ToJSON CodeVersion where+    toJSON = toJSON . prettyCodeVersion+    toEncoding = toEncoding . prettyCodeVersion
+ src/Rollbar/Item/Data.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Data+    Description : Metadata about the item being reported+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    The majority of this module is metadata that is reported for each item.+-}++module Rollbar.Item.Data+    ( Data(..)+    , Context(..)+    , Fingerprint(..)+    , Framework(..)+    , Title(..)+    , UUID4(..)++    , RemoveHeaders+    ) where++import Data.Aeson+    ( FromJSON+    , ToJSON+    , Value(String)+    , defaultOptions+    , genericParseJSON+    , genericToEncoding+    , genericToJSON+    , parseJSON+    , toEncoding+    , toJSON+    )+import Data.Aeson.Types+    (Options, fieldLabelModifier, omitNothingFields, typeMismatch)+import Data.String      (IsString)+import Data.Time        (UTCTime)+import Data.UUID        (UUID, fromText, toText)++import GHC.Generics (Generic)++import Rollbar.Item.Body        (Body)+import Rollbar.Item.CodeVersion (CodeVersion)+import Rollbar.Item.Environment (Environment)+import Rollbar.Item.Hardcoded   (Hardcoded)+import Rollbar.Item.Level       (Level)+import Rollbar.Item.Person      (Person)+import Rollbar.Item.Request     (RemoveHeaders, Request)+import Rollbar.Item.Server      (Server)++import Rollbar.Item.Internal.Notifier (Notifier)+import Rollbar.Item.Internal.Platform (Platform)++import qualified Data.HashMap.Lazy as HM+import qualified Data.Text         as T++-- | The main payload of an item.+--  Most of this is metadata.+--+--  N.B. While it's entirely possible for you to create one of these yourself,+--  it's usually easier to use helpers like 'info' and 'error'.+data Data body headers+    = Data+        { body        :: Body body+        , codeVersion :: Maybe CodeVersion+        , context     :: Maybe Context+        , custom      :: Maybe (HM.HashMap T.Text Value)+        , environment :: Environment+        , fingerprint :: Maybe Fingerprint+        , framework   :: Maybe Framework+        , language    :: Hardcoded "haskell"+        , level       :: Level+        , notifier    :: Notifier+        -- ^ Metadata about this package. You probably shouldn't create this yourself.+        , person      :: Maybe Person+        , platform    :: Platform+        -- ^ Metadata about this package. You probably shouldn't create this yourself.+        , request     :: Maybe (Request headers)+        , server      :: Maybe Server+        , timestamp   :: Maybe UTCTime+        , title       :: Maybe Title+        , uuid        :: Maybe UUID4+        }+    deriving (Eq, Generic, Show)++instance FromJSON body => FromJSON (Data body headers) where+    parseJSON = genericParseJSON options++instance (RemoveHeaders headers, ToJSON body) => ToJSON (Data body headers) where+    toJSON = genericToJSON options+    toEncoding = genericToEncoding options++options :: Options+options = defaultOptions+    { fieldLabelModifier = codeVersionModifier+    , omitNothingFields = True+    }++codeVersionModifier :: (Eq s, IsString s) => s -> s+codeVersionModifier = \case+    "codeVersion" -> "code_version"+    str -> str++-- | The framework that is using this package.+--  E.g. "scotty", "servant", "yesod"+newtype Framework+    = Framework T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | The place in the code where this item came from.+newtype Context+    = Context T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | How to group the item.+newtype Fingerprint+    = Fingerprint T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | The title of the item.+newtype Title+    = Title T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | A unique identifier for each item.+newtype UUID4+    = UUID4 UUID+    deriving (Eq, Generic, Show)++instance FromJSON UUID4 where+    parseJSON v@(String s) =+        maybe (typeMismatch "UUID4" v) (pure . UUID4) $ fromText s+    parseJSON v = typeMismatch "UUID4" v++instance ToJSON UUID4 where+    toJSON (UUID4 u) = toJSON (toText u)+    toEncoding (UUID4 u) = toEncoding (toText u)
+ src/Rollbar/Item/Environment.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+    Module      : Rollbar.Item.Environment+    Description : The environment from which this package is running.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Environment+    ( Environment(..)+    ) where++import Data.Aeson  (FromJSON, ToJSON)+import Data.String (IsString)++import qualified Data.Text as T++-- | Should be something meaningful to your program.+--  E.g. "development", "production", "staging"+newtype Environment+    = Environment T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)
+ src/Rollbar/Item/Hardcoded.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-|+    Module      : Rollbar.Item.Hardcoded+    Description : Provides a way to hard code a value in JSOn+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Probably this could live outside the package...+-}++module Rollbar.Item.Hardcoded+    ( Hardcoded(..)+    ) where++import Data.Aeson+    (FromJSON, ToJSON, Value(String), parseJSON, toEncoding, toJSON)+import Data.Aeson.Types (typeMismatch)+import Data.Text        (pack)++import GHC.Generics (Generic)+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)++-- | This is basically 'Data.Proxy' with the variable restricted to 'Symbol'.+--  It's mostly useful so a value can be insert into a JSON blob easily.+data Hardcoded (symbol :: Symbol)+    = Hardcoded+    deriving (Eq, Generic, Show)++instance KnownSymbol symbol => ToJSON (Hardcoded symbol) where+    toJSON = toJSON . symbolVal+    toEncoding = toEncoding . symbolVal++instance KnownSymbol symbol => FromJSON (Hardcoded symbol) where+    parseJSON (String str)+        | str == pack (symbolVal (Hardcoded :: Hardcoded symbol)) = pure Hardcoded+    parseJSON v = typeMismatch "Hardcoded symbol" v
+ src/Rollbar/Item/Internal/Notifier.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Internal.Notifier+    Description : Metadata about this actual package+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Mostly, you shouldn't have to worry about this.+-}++module Rollbar.Item.Internal.Notifier+    ( Notifier(..)+    ) where++import Data.Aeson+    (FromJSON, ToJSON, defaultOptions, genericToEncoding, toEncoding)+import Data.Version (Version)++import GHC.Generics (Generic)++import Rollbar.Item.Hardcoded (Hardcoded)++-- | Metadata describing this package.+data Notifier+    = Notifier+        { name    :: Hardcoded "wai-middleware-rollbar"+        -- ^ The name of this package+        , version :: Version+        -- ^ The version of this package+        }+    deriving (Eq, Generic, Show)++instance FromJSON Notifier+instance ToJSON Notifier where+    toEncoding = genericToEncoding defaultOptions
+ src/Rollbar/Item/Internal/Platform.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+    Module      : Rollbar.Item.Internal.Platform+    Description : Metadata describing the platform this package is running on.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Mostly, you shouldn't have to worry about this.+-}++module Rollbar.Item.Internal.Platform+    ( Platform(..)+    ) where++import Data.Aeson  (FromJSON, ToJSON)+import Data.String (IsString)++import qualified Data.Text as T++-- | Should be something meaningful to rollbar, like "linux".+newtype Platform+    = Platform T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)
+ src/Rollbar/Item/Level.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveGeneric #-}++{-|+    Module      : Rollbar.Item.Level+    Description : The severity of the item.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Level+    ( Level(..)+    ) where++import Data.Aeson+    ( FromJSON+    , ToJSON+    , defaultOptions+    , genericParseJSON+    , genericToEncoding+    , genericToJSON+    , parseJSON+    , toEncoding+    , toJSON+    )+import Data.Aeson.Types (Options, constructorTagModifier)+import Data.Char        (toLower)++import GHC.Generics (Generic)++-- | Corresponds to the levels Rollbar allows in order of severity.+data Level+    = Debug+    | Info+    | Warning+    | Error+    | Critical+    deriving (Bounded, Enum, Eq, Generic, Ord, Show)++instance FromJSON Level where+    parseJSON = genericParseJSON options++instance ToJSON Level where+    toJSON = genericToJSON options+    toEncoding = genericToEncoding options++options :: Options+options = defaultOptions+    { constructorTagModifier = fmap toLower+    }
+ src/Rollbar/Item/MissingHeaders.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++{-|+    Module      : Rollbar.Item.MissingHeaders+    Description : Headers with some missing from the JSON instance.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.MissingHeaders+    ( MissingHeaders(..)+    , RemoveHeaders+    ) where++import Data.Aeson+    (FromJSON, KeyValue, ToJSON, object, parseJSON, toJSON, (.=))+import Data.Bifunctor       (bimap)+import Data.CaseInsensitive (mk, original)+import Data.Maybe           (catMaybes)+import Data.Proxy           (Proxy(Proxy))++import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)++import Network.HTTP.Types (Header, RequestHeaders)++import qualified Data.ByteString       as BS+import qualified Data.ByteString.Char8 as BSC8+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as TE++-- | The request headers with some missing+--+--  This is useful for removing sensitive information+--  like the `Authorization` header.+newtype MissingHeaders (headers :: [Symbol])+    = MissingHeaders RequestHeaders+    deriving (Eq, Show)++-- | Remove the headers given from the underlying request headers.+class RemoveHeaders (headers :: [Symbol]) where+    removeHeaders :: MissingHeaders headers -> RequestHeaders++instance RemoveHeaders '[] where+    removeHeaders (MissingHeaders rhs) = rhs++instance (KnownSymbol header, RemoveHeaders headers)+    => RemoveHeaders (header ': headers) where+    removeHeaders (MissingHeaders rhs) =+        removeHeaders (MissingHeaders $ filter go rhs :: MissingHeaders headers)+        where+        go (rh, _) =+            rh /= (mk . BSC8.pack $ symbolVal (Proxy :: Proxy header))++instance FromJSON (MissingHeaders headers) where+    parseJSON v = MissingHeaders . fmap (bimap (mk . BS.pack) BS.pack) <$> parseJSON v++instance RemoveHeaders headers => ToJSON (MissingHeaders headers) where+    toJSON = object . catMaybes . requestHeadersKVs . removeHeaders++requestHeadersKVs :: forall kv. KeyValue kv => RequestHeaders -> [Maybe kv]+requestHeadersKVs = fmap go+    where+    go :: Header -> Maybe kv+    go (key', val') = do+        key <- myDecodeUtf8 $ original key'+        val <- myDecodeUtf8 val'+        pure (key .= val)++myDecodeUtf8 :: BS.ByteString -> Maybe T.Text+myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'
+ src/Rollbar/Item/Person.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Person+    Description : The user this item affects.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Person+    ( Person(..)+    , Id(..)+    , Username(..)+    , Email(..)+    ) where++import Data.Aeson+    ( FromJSON+    , ToJSON+    , defaultOptions+    , genericToEncoding+    , genericToJSON+    , toEncoding+    , toJSON+    )+import Data.Aeson.Types (omitNothingFields)+import Data.String      (IsString)++import GHC.Generics (Generic)++import qualified Data.Text as T++-- | The affected user.+--+--  The 'Email' and 'Username' associated with the latest 'Id'+--  will overwrite any previous.+data Person+    = Person+        { id       :: Id+        , username :: Maybe Username+        , email    :: Maybe Email+        }+    deriving (Eq, Generic, Show)++instance FromJSON Person+instance ToJSON Person where+    toJSON = genericToJSON defaultOptions { omitNothingFields = True }+    toEncoding = genericToEncoding defaultOptions { omitNothingFields = True }++-- | The user's identifier. This uniquely identifies a 'Person' to Rollbar.+newtype Id+    = Id T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | The user's name.+newtype Username+    = Username T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | The user's email.+newtype Email+    = Email T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)
+ src/Rollbar/Item/Request.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-|+    Module      : Rollbar.Item.Request+    Description : Data about the request sent to the server.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Request+    ( Request(..)+    , Get(..)+    , IP(..)+    , Method(..)+    , MissingHeaders(..)+    , QueryString(..)+    , RawBody(..)+    , URL(..)+    , RemoveHeaders+    ) where++import Data.Aeson+    ( FromJSON+    , KeyValue+    , ToJSON+    , Value(Object, String)+    , object+    , pairs+    , parseJSON+    , toEncoding+    , toJSON+    , (.:)+    , (.=)+    )+import Data.Aeson.Types (typeMismatch)+import Data.Bifunctor   (bimap)+import Data.Maybe       (catMaybes, fromMaybe)+import Data.String      (IsString)++import GHC.Generics (Generic)++import Network.HTTP.Types (Query)+import Network.Socket     (SockAddr(SockAddrInet), tupleToHostAddress)++import Rollbar.Item.MissingHeaders++import Text.Read (readMaybe)++import qualified Data.ByteString    as BS+import qualified Data.Text          as T+import qualified Data.Text.Encoding as TE++-- | Data sent to the server+data Request headers+    = Request+        { rawBody     :: RawBody+        , get         :: Get+        -- ^ Query parameters+        , headers     :: MissingHeaders headers+        , method      :: Method+        , queryString :: QueryString+        -- ^ The entire query string+        , url         :: URL+        , userIP      :: IP+        -- ^ The client's IP address+        }+    deriving (Eq, Generic, Show)++-- | The raw request body as a 'BS.ByteString'.+newtype RawBody+    = RawBody BS.ByteString+    deriving (Eq, Generic, IsString, Show)++instance FromJSON RawBody where+    parseJSON v = RawBody . BS.pack <$> parseJSON v++instance ToJSON RawBody where+    toJSON (RawBody body) = toJSON (myDecodeUtf8 body)+    toEncoding (RawBody body) = toEncoding (myDecodeUtf8 body)++-- | The query string parameters as a more useful data structure.+newtype Get+    = Get Query+    deriving (Eq, Generic, Show)++instance FromJSON Get where+    parseJSON v = Get . fmap (bimap BS.pack (fmap BS.pack)) <$> parseJSON v++instance ToJSON Get where+    toJSON (Get q) = object . catMaybes . queryKVs $ q+    toEncoding (Get q) = pairs . mconcat . catMaybes . queryKVs $ q++queryKVs :: forall kv. (KeyValue kv) => Query -> [Maybe kv]+queryKVs = fmap go+    where+    go :: (BS.ByteString, Maybe BS.ByteString) -> Maybe kv+    go (key', val') = do+        key <- myDecodeUtf8 key'+        let val = val' >>= myDecodeUtf8+        pure (key .= val)++-- | The HTTP Verb+newtype Method+    = Method BS.ByteString+    deriving (Eq, Generic, Show)++instance FromJSON Method where+    parseJSON v = Method . BS.pack <$> parseJSON v++instance ToJSON Method where+    toJSON (Method q) = toJSON (myDecodeUtf8 q)+    toEncoding (Method q) = toEncoding (myDecodeUtf8 q)++-- | The raw querystring.+newtype QueryString+    = QueryString BS.ByteString+    deriving (Eq, Generic, Show)++instance FromJSON QueryString where+    parseJSON v = QueryString . BS.pack <$> parseJSON v++instance ToJSON QueryString where+    toJSON (QueryString q) = toJSON (myDecodeUtf8' q)+    toEncoding (QueryString q) = toEncoding (myDecodeUtf8' q)++-- | The IP address of the client.+newtype IP+    = IP SockAddr+    deriving (Eq, Generic, Show)++instance FromJSON IP where+    parseJSON v@(String s) = case T.splitOn "." s of+        [a', b', c', d] -> case T.splitOn ":" d of+            [e', f'] -> maybe (typeMismatch "IP" v) pure $ do+                [a, b, c, e] <- traverse (readMaybe . T.unpack) [a', b', c', e']+                f <- (readMaybe . T.unpack) f'+                pure . IP . SockAddrInet f $ tupleToHostAddress (a, b, c, e)+            _ -> typeMismatch "IP" v+        _ -> typeMismatch "IP" v+    parseJSON v = typeMismatch "IP" v++instance ToJSON IP where+    toJSON (IP ip) = toJSON (show ip)+    toEncoding (IP ip) = toEncoding (show ip)++requestKVs :: (KeyValue kv, RemoveHeaders headers) => Request headers -> [kv]+requestKVs Request{get, headers, method, queryString, rawBody, url, userIP} =+    [ "body" .= rawBody+    , "GET" .= get+    , "headers" .= headers+    , "method" .= method+    , "query_string" .= queryString+    , "url" .= url+    , "user_ip" .= userIP+    ]++instance FromJSON (Request headers) where+    parseJSON (Object o) =+        Request+            <$> o .: "body"+            <*> o .: "GET"+            <*> o .: "headers"+            <*> o .: "method"+            <*> o .: "query_string"+            <*> o .: "url"+            <*> o .: "user_ip"+    parseJSON v = typeMismatch "Request headers" v++instance (RemoveHeaders headers) => ToJSON (Request headers) where+    toJSON = object . requestKVs+    toEncoding = pairs . mconcat . requestKVs++-- | The URL as a slightly more useful structure.+newtype URL+    = URL (Maybe BS.ByteString, [T.Text])+    deriving (Eq, Generic, Show)++prettyURL :: URL -> T.Text+prettyURL (URL (host, parts)) =+    T.intercalate "/" (fromMaybe "" (host >>= myDecodeUtf8) : parts)++instance FromJSON URL where+    parseJSON (String s) = case T.splitOn "/" s of+        host:parts | "http" `T.isPrefixOf` host -> pure $ URL (Just $ TE.encodeUtf8 host, parts)+        parts -> pure $ URL (Nothing, parts)+    parseJSON v       = typeMismatch "URL" v++instance ToJSON URL where+    toJSON = toJSON . prettyURL+    toEncoding = toEncoding . prettyURL++myDecodeUtf8 :: BS.ByteString -> Maybe T.Text+myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'++myDecodeUtf8' :: BS.ByteString -> T.Text+myDecodeUtf8' = fromMaybe "" . myDecodeUtf8
+ src/Rollbar/Item/Server.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Server+    Description : Metadata about the server this package is running on.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Server+    ( Server(..)+    , Root(..)+    , Branch(..)+    ) where++import Data.Aeson+    ( FromJSON+    , KeyValue+    , ToJSON+    , Value(Object)+    , object+    , pairs+    , parseJSON+    , toEncoding+    , toJSON+    , (.:)+    , (.=)+    )+import Data.Aeson.Types (typeMismatch)+import Data.Maybe       (catMaybes)+import Data.String      (IsString)++import GHC.Generics (Generic)++import Network.HostName (HostName)++import Rollbar.Item.CodeVersion (CodeVersion)++import qualified Data.Text as T++-- | Information about the server using this package.+data Server+    = Server+        { host              :: Maybe HostName+        -- ^ The hostname of the server.+        , root              :: Maybe Root+        -- ^ The root directory the server is running in.+        , branch            :: Maybe Branch+        -- ^ The checked out branch the server is running on.+        , serverCodeVersion :: Maybe CodeVersion+        -- ^ The version of the server.+        }+    deriving (Eq, Generic, Show)++serverKVs :: KeyValue kv => Server -> [Maybe kv]+serverKVs Server{branch, host, root, serverCodeVersion} =+    [ ("host" .=) <$> host+    , ("root" .=) <$> root+    , ("branch" .=) <$> branch+    , ("code_version" .=) <$> serverCodeVersion+    ]++instance FromJSON Server where+    parseJSON (Object o) =+        Server+            <$> o .: "host"+            <*> o .: "root"+            <*> o .: "branch"+            <*> o .: "code_version"+    parseJSON v = typeMismatch "Server" v++instance ToJSON Server where+    toJSON = object . catMaybes . serverKVs+    toEncoding = pairs . mconcat . catMaybes . serverKVs++-- | The root directory.+newtype Root+    = Root T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)++-- | The git branch the server is running on.+newtype Branch+    = Branch T.Text+    deriving (Eq, FromJSON, IsString, Show, ToJSON)
+ test/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Rollbar.Golden+import qualified Rollbar.Item.Data.Test+import qualified Rollbar.Item.MissingHeaders.Test+import qualified Rollbar.Item.Request.Test++main :: IO ()+main = do+    Rollbar.Golden.main+    Rollbar.Item.Data.Test.props+    Rollbar.Item.MissingHeaders.Test.props+    Rollbar.Item.Request.Test.props
+ test/Rollbar/Golden.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DataKinds #-}+module Rollbar.Golden where++import Data.Proxy (Proxy(Proxy))++import Rollbar.Item       (Item)+import Rollbar.QuickCheck ()++import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)+import Test.Hspec              (hspec)++main :: IO ()+main =+  hspec $ roundtripAndGoldenSpecs (Proxy :: Proxy (Item () '["Authorization"]))
+ test/Rollbar/Item/Data/Test.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+module Rollbar.Item.Data.Test where++import Control.Lens ((^@..))++import Data.Aeson      (encode, toJSON)+import Data.Aeson.Lens (key, members)+import Data.Text       (Text)++import Rollbar.Item+import Rollbar.QuickCheck ()++import Test.QuickCheck (conjoin, quickCheck)++props :: IO ()+props =+    quickCheck $ conjoin+        [ prop_valueDataBodyHasRequiredKey+        , prop_encodingDataBodyHasRequiredKey+        ]++prop_valueDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool+prop_valueDataBodyHasRequiredKey x =+    length ms == 1 && fst (head ms) `elem` requiredBodyKeys+    where+    ms = toJSON x ^@.. key "body" . members++prop_encodingDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool+prop_encodingDataBodyHasRequiredKey x =+    length ms == 1 && fst (head ms) `elem` requiredBodyKeys+    where+    ms = encode x ^@.. key "body" . members++requiredBodyKeys :: [Text]+requiredBodyKeys = ["trace", "trace_chain", "message", "crash_report"]
+ test/Rollbar/Item/MissingHeaders/Test.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+module Rollbar.Item.MissingHeaders.Test where++import Control.Lens ((&), (^@..))++import Data.Aeson      (encode, toJSON)+import Data.Aeson.Lens (members)++import Prelude hiding (error)++import Rollbar.Item.MissingHeaders (MissingHeaders(..))+import Rollbar.QuickCheck          ()++import Test.QuickCheck (conjoin, quickCheck)++import Data.Set as S++props :: IO ()+props = do+    quickCheck $ conjoin+        [ prop_valueAuthorizationIsRemoved+        , prop_encodingAuthorizationIsRemoved+        ]++    quickCheck $ conjoin+        [ prop_valueX_AccessTokenIsRemoved+        , prop_encodingX_AccessTokenIsRemoved+        ]++    quickCheck $ conjoin+        [ prop_valueAllHeadersAreRemoved+        , prop_encodingAllHeadersAreRemoved+        ]++prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool+prop_valueAuthorizationIsRemoved hs =+    "Authorization" `S.notMember` actual+    where+    actual = toJSON hs ^@.. members & fmap fst & S.fromList++prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool+prop_encodingAuthorizationIsRemoved hs =+    "Authorization" `S.notMember` actual+    where+    actual = encode hs ^@.. members & fmap fst & S.fromList++prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool+prop_valueX_AccessTokenIsRemoved hs =+    "X-AccessToken" `S.notMember` actual+    where+    actual = toJSON hs ^@.. members & fmap fst & S.fromList++prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool+prop_encodingX_AccessTokenIsRemoved hs =+    "X-AccessToken" `S.notMember` actual+    where+    actual = encode hs ^@.. members & fmap fst & S.fromList++prop_valueAllHeadersAreRemoved+    :: MissingHeaders+        '["Authorization", "this is made up", "Server", "X-AccessToken"]+    -> Bool+prop_valueAllHeadersAreRemoved hs =+    "Authorization" `S.notMember` actual+        && "this is made up" `S.notMember` actual+        && "Server" `S.notMember` actual+        && "X-AccessToken" `S.notMember` actual+    where+    actual = toJSON hs ^@.. members & fmap fst & S.fromList++prop_encodingAllHeadersAreRemoved+    :: MissingHeaders+        '["Authorization", "this is made up", "Server", "X-AccessToken"]+    -> Bool+prop_encodingAllHeadersAreRemoved hs =+    "Authorization" `S.notMember` actual+        && "this is made up" `S.notMember` actual+        && "Server" `S.notMember` actual+        && "X-AccessToken" `S.notMember` actual+    where+    actual = encode hs ^@.. members & fmap fst & S.fromList
+ test/Rollbar/Item/Request/Test.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+module Rollbar.Item.Request.Test where++import Control.Lens ((&), (^@..))++import Data.Aeson           (encode, toJSON)+import Data.Aeson.Lens      (members)+import Data.CaseInsensitive (original)++import Prelude hiding (error)++import Rollbar.Item.Request (MissingHeaders(..))+import Rollbar.QuickCheck   ()++import Test.QuickCheck (conjoin, quickCheck)++import Data.Set           as S+import Data.Text.Encoding as TE++props :: IO ()+props =+    quickCheck $ conjoin+        [ prop_valueHeadersArentWrapped+        , prop_encodingHeadersArentWrapped+        ]++prop_valueHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool+prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) =+    actual `S.isSubsetOf` expected+    where+    actual = toJSON hs ^@.. members & fmap fst & S.fromList+    expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs++prop_encodingHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool+prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) =+    actual `S.isSubsetOf` expected+    where+    actual = encode hs ^@.. members & fmap fst & S.fromList+    expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs
+ test/Rollbar/QuickCheck.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+module Rollbar.QuickCheck where++import Data.Bifunctor       (bimap)+import Data.CaseInsensitive (mk)+import Data.Proxy           (Proxy(Proxy))++import GHC.TypeLits (KnownSymbol, symbolVal)++import Prelude hiding (error)++import Rollbar.Item++import Test.QuickCheck+import Test.QuickCheck.Modifiers (getASCIIString)++import qualified Data.ByteString.Char8 as BSC8+import qualified Data.Text             as T++instance Arbitrary a => Arbitrary (Item a '["Authorization"]) where+    arbitrary = Item <$> arbitrary <*> arbitrary++instance Arbitrary AccessToken where+    arbitrary = AccessToken . T.pack . getASCIIString <$> arbitrary++instance Arbitrary a => Arbitrary (Data a '["Authorization"]) where+    arbitrary = do+        env <- Environment . T.pack . getASCIIString <$> arbitrary+        message <- fmap (MessageBody . T.pack . getASCIIString) <$> arbitrary+        payload <- arbitrary+        elements $ (\f -> f env message payload) <$> datas++datas :: [Environment -> Maybe MessageBody -> a -> Data a '["Authorization"]]+datas = [debug, info, warning, error, critical]++instance Arbitrary (MissingHeaders '[]) where+    arbitrary = do+        xs <- arbitrary+        let hs = bimap (mk . BSC8.pack) BSC8.pack <$> xs+        pure . MissingHeaders $ hs++instance (KnownSymbol header, Arbitrary (MissingHeaders headers))+    => Arbitrary (MissingHeaders (header ': headers)) where+    arbitrary = do+        MissingHeaders hs <- arbitrary :: Gen (MissingHeaders headers)+        let name = mk . BSC8.pack $ symbolVal (Proxy :: Proxy header)+        value <- BSC8.pack <$> arbitrary+        pure . MissingHeaders $ (name, value) : hs