master..fe63e98 · typeable/rollbar-hs

.circleci/config.yml+9−33

since splitsnapshots

unifiedsplit

@@ -1,40 +1,16 @@

1version: 2

2jobs:

3− ghc-8.2.2:

3+ build:

4 docker:

5− - image: nixorg/nix@sha256:96c3f56563a3b9549ac1da12ff7567c39cb6e648afd6a17d4a1a41f0596ad8f6

5+ - image: haskell:8.2.2

6 steps:

7 - checkout

8− - restore_cache:

9− keys:

10− - v2-nix-{{ checksum "package.yaml" }}

11− - v2-nix-

12− name: Restoring cache

13 - run:

8 - run:

14− name: Compile

9+ name: Setup

15− command: nix-shell --run 'make sdist test --jobs=2'

10+ command: stack setup

16− environment:

11+ - run:

17− CABAL_BUILD_FLAGS: --jobs=2

12+ name: Build

18− - save_cache:

13+ command: stack build --no-run-tests --test

19− key: v2-nix-{{ checksum "package.yaml" }}

20− name: Caching nix

21− paths:

22− - /nix

23− - dist

24−

25− for-github:

26− docker:

27− - image: alpine

28− steps:

29 - run:

14 - run:

30− name: Passed

15+ name: Test

31− command: echo passed

16+ command: stack test

32−

33−workflows:

34− version: 2

35− base:

36− jobs:

37− - for-github:

38− requires:

39− - ghc-8.2.2

40− - ghc-8.2.2

.gitignore+2−3

@@ -1,7 +1,6 @@

1### Project specific ###

2

3−.make

3+*.cabal

4−bin

5

4

6# Created by https://www.gitignore.io/api/vim,osx,linux,macos,emacs,windows,haskell,visualstudiocode

5# Created by https://www.gitignore.io/api/vim,osx,linux,macos,emacs,windows,haskell,visualstudiocode

7

6

@@ -185,4 +184,4 @@ $RECYCLE.BIN/

185*.lnk

184*.lnk

186

185

187

186

188−# End of https://www.gitignore.io/api/vim,osx,linux,macos,emacs,windows,haskell,visualstudiocode

187+# End of https://www.gitignore.io/api/vim,osx,linux,macos,emacs,windows,haskell,visualstudiocode

CHANGELOG.mddeleted−31

@@ -1,31 +0,0 @@

1−# Changelog

2−

3−## 0.3.1.0

4−

5−* [Drop some test dependencies](https://github.com/joneshf/rollbar-hs/pull/12)

6−* [Relax upper bound for `network` to 2.8](https://github.com/joneshf/rollbar-hs/pull/14)

7−

8−## 0.3.0.1

9−

10−* [Add a changelog](https://github.com/joneshf/rollbar-hs/pull/10)

11−

12−## 0.3.0.0

13−

14−* [Bump `aeson` upper bound](https://github.com/joneshf/rollbar-hs/pull/3)

15−

16−## 0.2.0.0

17−

18−* [Fix the type of `Notifier` `name`](https://github.com/joneshf/rollbar-hs/commit/11a3a2463cf44735237d062f15a349d8bfa7ffce)

19−

20−## 0.1.0.1

21−

22−* [Add synopsis](https://github.com/joneshf/rollbar-hs/commit/272c5764a9657f55e00e31c43a3d583362d823d5)

23−

24−## 0.1.0.0

25−

26−* Extract core rollbar to its own package

27−

28− This is almost entirely copy-pasted from [`wai-middleware-rollbar` version 0.8.4](https://hackage.haskell.org/package/wai-middleware-rollbar-0.8.4).

29−

30− The intent is to make the core data types available for other packages.

31− If this gets unweildy, move it right back.

Makefiledeleted−61

@@ -1,61 +0,0 @@

1−CABAL ?= cabal

2−CABAL_FLAGS ?=

3−CABAL_BUILD_FLAGS ?=

4−DIST ?= dist

5−GHCID ?= ghcid

6−GHCID_FLAGS ?= --ghc-options=-fno-code

7−HPACK ?= hpack

8−NIX_SHELL ?= nix-shell

9−NIX_SHELL_FLAGS ?=

10−PROJECT_NAME := rollbar-hs

11−

12−CABAL_FILE := $(PROJECT_NAME).cabal

13−CONFIGURE := $(DIST)/setup-config

14−DOC_TEST := $(DIST)/build/doc-test/doc-test

15−

16−.DEFAULT_GOAL := build

17−

18−$(CABAL_FILE): package.yaml

19− $(HPACK)

20−

21−$(CONFIGURE): $(CABAL_FILE)

22− $(CABAL) $(CABAL_FLAGS) configure --enable-tests

23−

24−.PHONY: build

25−build $(DOC_TEST): $(CONFIGURE) default.nix

26− $(CABAL) $(CABAL_FLAGS) build $(CABAL_BUILD_FLAGS)

27−

28−.PHONY: check

29−check: $(CABAL_FILE)

30− $(CABAL) $(CABAL_FLAGS) check

31−

32−.PHONY: clean

33−clean:

34− rm -f $(CABAL_FILE)

35− rm -fr $(DIST)

36−

37−default.nix: $(CABAL_FILE)

38− cabal2nix . > $@

39−

40−.PHONY: sdist

41−sdist: check

42− $(CABAL) $(CABAL_FLAGS) sdist

43−

44−.PHONY: shell

45−shell:

46− $(NIX_SHELL) --pure $(NIX_SHELL_FLAGS)

47−

48−.PHONY: test

49−test: test-doc-test

50−

51−.PHONY: test-doc-test

52−test-doc-test: $(DOC_TEST)

53− $<

54−

55−.PHONY: upload-hackage

56−upload-hackage: sdist

57− @ $(CABAL) $(CABAL_FLAGS) upload $(DIST)/$(PROJECT_NAME)-*.tar.gz

58−

59−.PHONY: watch

60−watch: $(CONFIGURE)

61− $(GHCID) --command "cabal repl lib:$(PROJECT_NAME) $(GHCID_FLAGS)"

README.md−2

@@ -1,3 +1 @@

1# rollbar-hs

2−

3−[![CircleCI](https://circleci.com/gh/joneshf/rollbar-hs.svg?style=svg)](https://circleci.com/gh/joneshf/rollbar-hs)

default.nixdeleted−21

@@ -1,21 +0,0 @@

1−{ mkDerivation, aeson, base, bytestring, case-insensitive, hostname

2−, hspec, hspec-golden-aeson, http-client, http-conduit, http-types

3−, network, QuickCheck, stdenv, text, time, unordered-containers

4−, uuid

5−}:

6−mkDerivation {

7− pname = "rollbar-hs";

8− version = "0.3.1.0";

9− src = ./.;

10− libraryHaskellDepends = [

11− aeson base bytestring case-insensitive hostname http-client

12− http-conduit http-types network text time unordered-containers uuid

13− ];

14− testHaskellDepends = [

15− aeson base bytestring case-insensitive hspec hspec-golden-aeson

16− QuickCheck text unordered-containers

17− ];

18− homepage = "https://github.com/joneshf/rollbar-hs#readme";

19− description = "Core Rollbar data types and APIs";

20− license = stdenv.lib.licenses.bsd3;

21−}

golden/Item () (': Symbol "Authorization" ('[] Symbol)).faulty.json+6−6

@@ -5,7 +5,7 @@

5 "data": {

6 "notifier": {

7 "name": "rollbar-hs",

8− "version": "0.3.1.0"

8+ "version": "0.2.0.0"

9 },

10 "platform": "linux",

11 "environment": "HB\u0010BuQ\u0017\u00064d*HE\u000b9\u0019\u001b*\u000e\u0013",

@@ -24,7 +24,7 @@

24 "data": {

25 "notifier": {

26 "name": "rollbar-hs",

27− "version": "0.3.1.0"

27+ "version": "0.2.0.0"

28 },

29 "platform": "linux",

30 "environment": "\u001dGesd@(b)ppm/Z",

@@ -43,7 +43,7 @@

43 "data": {

44 "notifier": {

45 "name": "rollbar-hs",

46− "version": "0.3.1.0"

46+ "version": "0.2.0.0"

47 },

48 "platform": "linux",

49 "environment": "/dt",

@@ -62,7 +62,7 @@

62 "data": {

63 "notifier": {

64 "name": "rollbar-hs",

65− "version": "0.3.1.0"

65+ "version": "0.2.0.0"

66 },

67 "platform": "linux",

68 "environment": "\u0003+(up!I",

@@ -81,7 +81,7 @@

81 "data": {

82 "notifier": {

83 "name": "rollbar-hs",

84− "version": "0.3.1.0"

84+ "version": "0.2.0.0"

85 },

86 "platform": "linux",

87 "environment": "V\u001csj\u001edR`T4?\u000eJ\u000cf",

@@ -97,4 +97,4 @@

97 "access_token": ".=#\n$\rD4 /1*c *O"

98 }

99 ]

100−}

100+}

golden/Item () (': Symbol "Authorization" ('[] Symbol)).json+5−5

@@ -5,7 +5,7 @@

5 "data": {

6 "notifier": {

7 "name": "rollbar-hs",

8− "version": "0.3.1.0"

8+ "version": "0.2.0.0"

9 },

10 "platform": "linux",

11 "environment": "HB\u0010BuQ\u0017\u00064d*HE\u000b9\u0019\u001b*\u000e\u0013",

@@ -24,7 +24,7 @@

24 "data": {

25 "notifier": {

26 "name": "rollbar-hs",

27− "version": "0.3.1.0"

27+ "version": "0.2.0.0"

28 },

29 "platform": "linux",

30 "environment": "\u001dGesd@(b)ppm/Z",

@@ -43,7 +43,7 @@

43 "data": {

44 "notifier": {

45 "name": "rollbar-hs",

46− "version": "0.3.1.0"

46+ "version": "0.2.0.0"

47 },

48 "platform": "linux",

49 "environment": "/dt",

@@ -62,7 +62,7 @@

62 "data": {

63 "notifier": {

64 "name": "rollbar-hs",

65− "version": "0.3.1.0"

65+ "version": "0.2.0.0"

66 },

67 "platform": "linux",

68 "environment": "\u0003+(up!I",

@@ -81,7 +81,7 @@

81 "data": {

82 "notifier": {

83 "name": "rollbar-hs",

84− "version": "0.3.1.0"

84+ "version": "0.2.0.0"

85 },

86 "platform": "linux",

87 "environment": "V\u001csj\u001edR`T4?\u000eJ\u000cf",

package.yamlnew file+44

@@ -0,0 +1,44 @@

1+author: Hardy Jones

2+category: Web

3+copyright: 2018 Hardy Jones

4+extra-source-files:

5+ - README.md

6+github: joneshf/rollbar-hs

7+library:

8+ dependencies:

9+ - aeson >= 1.0 && < 1.3

10+ - base >= 4.9 && < 5

11+ - bytestring >= 0.10 && < 0.11

12+ - case-insensitive >= 1.2 && < 1.3

13+ - hostname >= 1.0 && < 1.1

14+ - http-client >= 0.5 && < 0.6

15+ - http-conduit >= 2.2 && < 2.4

16+ - http-types >= 0.9 && < 0.13

17+ - network >= 2.6 && < 2.7

18+ - text >= 1.2 && < 1.3

19+ - time >= 1.6 && < 1.9

20+ - unordered-containers >= 0.2 && < 0.3

21+ - uuid >= 1.3 && < 1.4

22+ source-dirs: src

23+license: BSD3

24+maintainer: jones3.hardy@gmail.com

25+name: rollbar-hs

26+synopsis: Core Rollbar data types and APIs.

27+tests:

28+ doc-test:

29+ dependencies:

30+ - QuickCheck >= 2.9

31+ - aeson >= 1.0

32+ - base >= 4.9

33+ - bytestring >= 0.10

34+ - case-insensitive >= 1.2

35+ - containers >= 0.5

36+ - hspec >= 2.4

37+ - hspec-golden-aeson >= 0.2

38+ - lens >= 4.15

39+ - lens-aeson >= 1.0

40+ - rollbar-hs

41+ - text >= 1.2

42+ main: Main.hs

43+ source-dirs: test

44+version: '0.2.0.0'

rollbar-hs.cabaldeleted−93

@@ -1,93 +0,0 @@

1−cabal-version: 1.12

2−

3−-- This file has been generated from package.yaml by hpack version 0.31.2.

4−--

5−-- see: https://github.com/sol/hpack

6−--

7−-- hash: ac4c551193d60902c95f89512121ee67cb0cafb3a6662796e40323bd0cedff7c

8−

9−name: rollbar-hs

10−version: 0.3.1.0

11−synopsis: Core Rollbar data types and APIs.

12−description: Provides a type-safe encoding of the Rollbar API.

13− Also provides functions to communicate with the Rollbar API.

14−category: Web

15−homepage: https://github.com/joneshf/rollbar-hs#readme

16−bug-reports: https://github.com/joneshf/rollbar-hs/issues

17−author: Hardy Jones

18−maintainer: jones3.hardy@gmail.com

19−copyright: 2018 Hardy Jones

20−license: BSD3

21−license-file: LICENSE

22−build-type: Simple

23−extra-source-files:

24− CHANGELOG.md

25− README.md

26−

27−source-repository head

28− type: git

29− location: https://github.com/joneshf/rollbar-hs

30−

31−library

32− exposed-modules:

33− Rollbar.AccessToken

34− Rollbar.API

35− Rollbar.Item

36− Rollbar.Item.Body

37− Rollbar.Item.CodeVersion

38− Rollbar.Item.Data

39− Rollbar.Item.Environment

40− Rollbar.Item.Hardcoded

41− Rollbar.Item.Internal.Notifier

42− Rollbar.Item.Internal.Platform

43− Rollbar.Item.Level

44− Rollbar.Item.MissingHeaders

45− Rollbar.Item.Person

46− Rollbar.Item.Request

47− Rollbar.Item.Server

48− Rollbar.Aeson

49− other-modules:

50− Paths_rollbar_hs

51− hs-source-dirs:

52− src

53− build-depends:

54− aeson >=1.1

55− , base >=4.9

56− , bytestring >=0.10

57− , case-insensitive >=1.2

58− , hostname >=1.0

59− , http-client >=0.5

60− , http-conduit >=2.2

61− , http-types >=0.8.6

62− , network >=2.6.3

63− , text >=1.2

64− , time >=1.6

65− , unordered-containers >=0.2

66− , uuid >=1.3

67− default-language: Haskell2010

68−

69−test-suite doc-test

70− type: exitcode-stdio-1.0

71− main-is: Main.hs

72− other-modules:

73− Rollbar.Golden

74− Rollbar.Item.Data.Test

75− Rollbar.Item.MissingHeaders.Test

76− Rollbar.Item.Request.Test

77− Rollbar.QuickCheck

78− Paths_rollbar_hs

79− hs-source-dirs:

80− test

81− build-depends:

82− QuickCheck >=2.9

83− , aeson

84− , base

85− , bytestring

86− , case-insensitive

87− , hashable

88− , hspec >=2.4

89− , hspec-golden-aeson >=0.2

90− , rollbar-hs

91− , text

92− , unordered-containers

93− default-language: Haskell2010

shell.nixdeleted−44

@@ -1,44 +0,0 @@

1−{ compiler ? "ghc822" }:

2−

3−let

4−

5− default = haskell-packages.callPackage (import ./default.nix) {};

6−

7− derivation = nixpkgs.haskell.lib.addBuildTools default tools;

8−

9− haskell-packages = nixpkgs.haskell.packages.${compiler};

10−

11− nixpkgs = import nixpkgs-tarball {};

12−

13− nixpkgs-revision = "120b013e0c082d58a5712cde0a7371ae8b25a601";

14−

15− nixpkgs-sha256 = "0hk4y2vkgm1qadpsm4b0q1vxq889jhxzjx3ragybrlwwg54mzp4f";

16−

17− nixpkgs-tarball = builtins.fetchTarball {

18− sha256 = nixpkgs-sha256;

19− url = "https://github.com/NixOS/nixpkgs/archive/${nixpkgs-revision}.tar.gz";

20− };

21−

22− # Tools affected by the compiler version.

23− tools-compiler = [

24− haskell-packages.cabal-install

25− haskell-packages.ghc

26− haskell-packages.ghcid

27− haskell-packages.hpack

28− ];

29−

30− # Tools that deal with the basic project infrastructure.

31− tools-infrastructure = [

32− nixpkgs.cabal2nix

33− nixpkgs.curl

34− nixpkgs.which

35− ];

36−

37− # All of the tools.

38− tools =

39− tools-compiler ++

40− tools-infrastructure;

41−

42−in

43−

44− derivation.env

src/Rollbar/Aeson.hsdeleted−22

@@ -1,22 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−

3−module Rollbar.Aeson

4− ( Key

5− , textToKey

6− ) where

7−

8−import Data.Text (Text)

9−#if MIN_VERSION_aeson(2,0,0)

10−import Data.Aeson.Key (Key)

11−import qualified Data.Aeson.Key as Key

12−#else

13−#endif

14−

15−#if MIN_VERSION_aeson(2,0,0)

16−textToKey :: Text -> Key

17−textToKey = Key.fromText

18−#else

19−type Key = Text

20−textToKey :: Text -> Key

21−textToKey = id

22−#endif

src/Rollbar/Item.hs−8

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

1{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE NamedFieldPuns #-}

@@ -198,17 +197,10 @@ data Item a headers

198 }

197 }

199 deriving (Eq, Generic, Show)

198 deriving (Eq, Generic, Show)

200

199

201−#if MIN_VERSION_aeson(2, 2, 0)

202−itemKVs

203− :: (KeyValue e kv, RemoveHeaders headers, ToJSON v)

204− => Item v headers

205− -> [kv]

206−#else

207itemKVs

200itemKVs

208 :: (KeyValue kv, RemoveHeaders headers, ToJSON v)

201 :: (KeyValue kv, RemoveHeaders headers, ToJSON v)

209 => Item v headers

202 => Item v headers

210 -> [kv]

203 -> [kv]

211−#endif

212itemKVs Item{accessToken, itemData} =

204itemKVs Item{accessToken, itemData} =

213 [ "access_token" .= accessToken

205 [ "access_token" .= accessToken

214 , "data" .= itemData

206 , "data" .= itemData

src/Rollbar/Item/Body.hs+4−10

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE NamedFieldPuns #-}

@@ -34,7 +33,7 @@ import Data.Aeson

34 , (.=)

33 , (.=)

35 )

34 )

36import Data.Aeson.Encoding (pair)

35import Data.Aeson.Encoding (pair)

37−import Data.Aeson.Types (explicitParseField, typeMismatch)

36+import Data.Aeson.Types (typeMismatch)

38import Data.String (IsString)

37import Data.String (IsString)

39

38

40import GHC.Generics (Generic)

39import GHC.Generics (Generic)

@@ -53,21 +52,16 @@ data Body arbitrary

53 }

52 }

54 deriving (Eq, Generic, Show)

53 deriving (Eq, Generic, Show)

55

54

56−#if MIN_VERSION_aeson(2, 2, 0)

57−bodyKVs :: (KeyValue e kv, ToJSON v) => Body v -> [kv]

58−#else

59bodyKVs :: (KeyValue kv, ToJSON v) => Body v -> [kv]

55bodyKVs :: (KeyValue kv, ToJSON v) => Body v -> [kv]

60−#endif

61bodyKVs Message{messageBody, messageData} =

56bodyKVs Message{messageBody, messageData} =

62 [ "body" .= messageBody

57 [ "body" .= messageBody

63 , "data" .= messageData

58 , "data" .= messageData

64 ]

59 ]

65

60

66instance FromJSON arbitrary => FromJSON (Body arbitrary) where

61instance FromJSON arbitrary => FromJSON (Body arbitrary) where

67− parseJSON (Object o') = explicitParseField parseMessage o' "message"

62+ parseJSON (Object o') = do

68− where

63+ o <- o' .: "message"

69− parseMessage (Object o) = Message <$> o .: "body" <*> o .: "data"

64+ Message <$> o .: "body" <*> o .: "data"

70− parseMessage v = typeMismatch "Body arbitrary (message)" v

71 parseJSON v = typeMismatch "Body arbitrary" v

65 parseJSON v = typeMismatch "Body arbitrary" v

72

66

73instance ToJSON arbitrary => ToJSON (Body arbitrary) where

67instance ToJSON arbitrary => ToJSON (Body arbitrary) where

src/Rollbar/Item/MissingHeaders.hs+3−8

@@ -3,7 +3,6 @@

3{-# LANGUAGE KindSignatures #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE CPP #-}

7

6

8{-|

7{-|

9 Module : Rollbar.Item.MissingHeaders

8 Module : Rollbar.Item.MissingHeaders

@@ -21,7 +20,6 @@ module Rollbar.Item.MissingHeaders

21

20

22import Data.Aeson

21import Data.Aeson

23 (FromJSON, KeyValue, ToJSON, object, parseJSON, toJSON, (.=))

22 (FromJSON, KeyValue, ToJSON, object, parseJSON, toJSON, (.=))

24−import Rollbar.Aeson

25import Data.Bifunctor (bimap)

23import Data.Bifunctor (bimap)

26import Data.CaseInsensitive (mk, original)

24import Data.CaseInsensitive (mk, original)

27import Data.Maybe (catMaybes)

25import Data.Maybe (catMaybes)

@@ -33,6 +31,7 @@ import Network.HTTP.Types (Header, RequestHeaders)

33

31

34import qualified Data.ByteString as BS

32import qualified Data.ByteString as BS

35import qualified Data.ByteString.Char8 as BSC8

33import qualified Data.ByteString.Char8 as BSC8

34+import qualified Data.Text as T

36import qualified Data.Text.Encoding as TE

35import qualified Data.Text.Encoding as TE

37

36

38-- | The request headers with some missing

37-- | The request headers with some missing

@@ -64,11 +63,7 @@ instance FromJSON (MissingHeaders headers) where

64instance RemoveHeaders headers => ToJSON (MissingHeaders headers) where

63instance RemoveHeaders headers => ToJSON (MissingHeaders headers) where

65 toJSON = object . catMaybes . requestHeadersKVs . removeHeaders

64 toJSON = object . catMaybes . requestHeadersKVs . removeHeaders

66

65

67−#if MIN_VERSION_aeson(2, 2, 0)

68−requestHeadersKVs :: forall e kv. KeyValue e kv => RequestHeaders -> [Maybe kv]

69−#else

70requestHeadersKVs :: forall kv. KeyValue kv => RequestHeaders -> [Maybe kv]

66requestHeadersKVs :: forall kv. KeyValue kv => RequestHeaders -> [Maybe kv]

71−#endif

72requestHeadersKVs = fmap go

67requestHeadersKVs = fmap go

73 where

68 where

74 go :: Header -> Maybe kv

69 go :: Header -> Maybe kv

@@ -77,5 +72,5 @@ requestHeadersKVs = fmap go

77 val <- myDecodeUtf8 val'

72 val <- myDecodeUtf8 val'

78 pure (key .= val)

73 pure (key .= val)

79

74

80−myDecodeUtf8 :: BS.ByteString -> Maybe Key

75+myDecodeUtf8 :: BS.ByteString -> Maybe T.Text

81−myDecodeUtf8 = either (const Nothing) (Just . textToKey) . TE.decodeUtf8'

76+myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'

src/Rollbar/Item/Request.hs+2−12

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE NamedFieldPuns #-}

@@ -49,7 +48,6 @@ import GHC.Generics (Generic)

49import Network.HTTP.Types (Query)

48import Network.HTTP.Types (Query)

50import Network.Socket (SockAddr(SockAddrInet), tupleToHostAddress)

49import Network.Socket (SockAddr(SockAddrInet), tupleToHostAddress)

51

50

52−import Rollbar.Aeson

53import Rollbar.Item.MissingHeaders

51import Rollbar.Item.MissingHeaders

54

52

55import Text.Read (readMaybe)

53import Text.Read (readMaybe)

@@ -98,18 +96,14 @@ instance ToJSON Get where

98 toJSON (Get q) = object . catMaybes . queryKVs $ q

96 toJSON (Get q) = object . catMaybes . queryKVs $ q

99 toEncoding (Get q) = pairs . mconcat . catMaybes . queryKVs $ q

97 toEncoding (Get q) = pairs . mconcat . catMaybes . queryKVs $ q

100

98

101−#if MIN_VERSION_aeson(2, 2, 0)

99+queryKVs :: forall kv. (KeyValue kv) => Query -> [Maybe kv]

102−queryKVs :: forall e kv. KeyValue e kv => Query -> [Maybe kv]

103−#else

104−queryKVs :: forall kv. KeyValue kv => Query -> [Maybe kv]

105−#endif

106queryKVs = fmap go

100queryKVs = fmap go

107 where

101 where

108 go :: (BS.ByteString, Maybe BS.ByteString) -> Maybe kv

102 go :: (BS.ByteString, Maybe BS.ByteString) -> Maybe kv

109 go (key', val') = do

103 go (key', val') = do

110 key <- myDecodeUtf8 key'

104 key <- myDecodeUtf8 key'

111 let val = val' >>= myDecodeUtf8

105 let val = val' >>= myDecodeUtf8

112− pure (textToKey key .= val)

106+ pure (key .= val)

113

107

114-- | The HTTP Verb

108-- | The HTTP Verb

115newtype Method

109newtype Method

@@ -155,11 +149,7 @@ instance ToJSON IP where

155 toJSON (IP ip) = toJSON (show ip)

149 toJSON (IP ip) = toJSON (show ip)

156 toEncoding (IP ip) = toEncoding (show ip)

150 toEncoding (IP ip) = toEncoding (show ip)

157

151

158−#if MIN_VERSION_aeson(2, 2, 0)

159−requestKVs :: (KeyValue e kv, RemoveHeaders headers) => Request headers -> [kv]

160−#else

161requestKVs :: (KeyValue kv, RemoveHeaders headers) => Request headers -> [kv]

152requestKVs :: (KeyValue kv, RemoveHeaders headers) => Request headers -> [kv]

162−#endif

163requestKVs Request{get, headers, method, queryString, rawBody, url, userIP} =

153requestKVs Request{get, headers, method, queryString, rawBody, url, userIP} =

164 [ "body" .= rawBody

154 [ "body" .= rawBody

165 , "GET" .= get

155 , "GET" .= get

src/Rollbar/Item/Server.hs−5

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE NamedFieldPuns #-}

@@ -58,11 +57,7 @@ data Server

58 }

57 }

59 deriving (Eq, Generic, Show)

58 deriving (Eq, Generic, Show)

60

59

61−#if MIN_VERSION_aeson(2, 2, 0)

62−serverKVs :: KeyValue e kv => Server -> [Maybe kv]

63−#else

64serverKVs :: KeyValue kv => Server -> [Maybe kv]

60serverKVs :: KeyValue kv => Server -> [Maybe kv]

65−#endif

66serverKVs Server{branch, host, root, serverCodeVersion} =

61serverKVs Server{branch, host, root, serverCodeVersion} =

67 [ ("host" .=) <$> host

62 [ ("host" .=) <$> host

68 , ("root" .=) <$> root

63 , ("root" .=) <$> root

stack.yaml+63−3

@@ -1,6 +1,66 @@

1+# This file was automatically generated by 'stack init'

2+#

3+# Some commonly used options have been documented as comments in this file.

4+# For advanced use and comprehensive documentation of the format, please see:

5+# https://docs.haskellstack.org/en/stable/yaml_configuration/

6+

7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.

8+# A snapshot resolver dictates the compiler version and the set of packages

9+# to be used for project dependencies. For example:

10+#

1−resolver: lts-23.7

11+# resolver: lts-3.5

12+# resolver: nightly-2015-09-21

13+# resolver: ghc-7.10.2

14+# resolver: ghcjs-0.1.0_ghc-7.10.2

15+# resolver:

16+# name: custom-snapshot

17+# location: "./custom-snapshot.yaml"

18+resolver: lts-10.5

19+

20+# User packages to be built.

21+# Various formats can be used as shown in the example below.

22+#

23+# packages:

24+# - some-directory

25+# - https://example.com/foo/bar/baz-0.0.2.tar.gz

26+# - location:

27+# git: https://github.com/commercialhaskell/stack.git

28+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

29+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a

30+# extra-dep: true

31+# subdirs:

32+# - auto-update

33+# - wai

34+#

35+# A package marked 'extra-dep: true' will only be built if demanded by a

36+# non-dependency (i.e. a user package), and its test suites and benchmarks

37+# will not be run. This is useful for tweaking upstream packages.

2packages:

38packages:

3- .

39- .

40+# Dependency packages to be pulled from upstream that are not in the resolver

41+# (e.g., acme-missiles-0.3)

42+# extra-deps: []

43+

44+# Override default flag values for local packages and extra-deps

45+# flags: {}

46+

47+# Extra package databases containing global packages

48+# extra-package-dbs: []

4

49

5−nix:

50+# Control whether we use the GHC we find on the path

6− packages: [ zlib ]

51+# system-ghc: true

52+#

53+# Require a specific version of stack, using version ranges

54+# require-stack-version: -any # Default

55+# require-stack-version: ">=1.6"

56+#

57+# Override the architecture used by stack, especially useful on Windows

58+# arch: i386

59+# arch: x86_64

60+#

61+# Extra directories used by stack for building

62+# extra-include-dirs: [/path/to/dir]

63+# extra-lib-dirs: [/path/to/dir]

64+#

65+# Allow a newer minor version of GHC than the snapshot specifies

66+# compiler-check: newer-minor

test/Rollbar/Item/Data/Test.hs+10−18

@@ -1,18 +1,17 @@

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

4module Rollbar.Item.Data.Test where

3module Rollbar.Item.Data.Test where

5

4

6−import Data.Aeson (Value (Null, Object), decode', encode,

5+import Control.Lens ((^@..))

7− toJSON)

8−import Data.Text (Text)

9

6

10−import Rollbar.Item

7+import Data.Aeson (encode, toJSON)

11−import Rollbar.QuickCheck ()

8+import Data.Aeson.Lens (key, members)

9+import Data.Text (Text)

12

10

13−import Test.QuickCheck (conjoin, quickCheck)

11+import Rollbar.Item

12+import Rollbar.QuickCheck ()

14

13

15−import qualified Data.HashMap.Strict

14+import Test.QuickCheck (conjoin, quickCheck)

16

15

17props :: IO ()

16props :: IO ()

18props =

17props =

@@ -25,20 +24,13 @@ prop_valueDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool

25prop_valueDataBodyHasRequiredKey x =

24prop_valueDataBodyHasRequiredKey x =

26 length ms == 1 && fst (head ms) `elem` requiredBodyKeys

25 length ms == 1 && fst (head ms) `elem` requiredBodyKeys

27 where

26 where

28− ms = key "body" (toJSON x)

27+ ms = toJSON x ^@.. key "body" . members

29

28

30prop_encodingDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool

29prop_encodingDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool

31prop_encodingDataBodyHasRequiredKey x =

30prop_encodingDataBodyHasRequiredKey x =

32 length ms == 1 && fst (head ms) `elem` requiredBodyKeys

31 length ms == 1 && fst (head ms) `elem` requiredBodyKeys

33 where

32 where

34− ms = foldMap (key "body") (decode' $ encode x)

33+ ms = encode x ^@.. key "body" . members

35

34

36requiredBodyKeys :: [Text]

35requiredBodyKeys :: [Text]

37requiredBodyKeys = ["trace", "trace_chain", "message", "crash_report"]

36requiredBodyKeys = ["trace", "trace_chain", "message", "crash_report"]

38−

39−key :: Text -> Value -> [(Text, Value)]

40−key k = \case

41− Object o -> case Data.HashMap.Strict.lookupDefault Null k o of

42− Object o' -> Data.HashMap.Strict.toList o'

43− _ -> mempty

44− _ -> mempty

test/Rollbar/Item/MissingHeaders/Test.hs+30−41

@@ -1,26 +1,23 @@

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4−{-# LANGUAGE LambdaCase #-}

5{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

6−{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE TypeOperators #-}

7module Rollbar.Item.MissingHeaders.Test where

6module Rollbar.Item.MissingHeaders.Test where

8

7

9−import Data.Aeson (Value (Object), decode', encode,

8+import Control.Lens ((&), (^@..))

10− toJSON)

11−import Data.Functor (void)

12−import Data.Hashable

13−import Data.HashSet (HashSet)

14−import Data.Text (Text)

15

9

16−import Prelude hiding (error)

10+import Data.Aeson (encode, toJSON)

11+import Data.Aeson.Lens (members)

17

12

18−import Rollbar.Item.MissingHeaders (MissingHeaders (..))

13+import Prelude hiding (error)

19−import Rollbar.QuickCheck ()

20

14

21−import Test.QuickCheck (conjoin, quickCheck)

15+import Rollbar.Item.MissingHeaders (MissingHeaders(..))

16+import Rollbar.QuickCheck ()

22

17

23−import qualified Data.HashSet

18+import Test.QuickCheck (conjoin, quickCheck)

19+

20+import Data.Set as S

24

21

25props :: IO ()

22props :: IO ()

26props = do

23props = do

@@ -41,56 +38,48 @@ props = do

41

38

42prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool

39prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool

43prop_valueAuthorizationIsRemoved hs =

40prop_valueAuthorizationIsRemoved hs =

44− "Authorization" `notMember` actual

41+ "Authorization" `S.notMember` actual

45 where

42 where

46− actual = keys (toJSON hs)

43+ actual = toJSON hs ^@.. members & fmap fst & S.fromList

47

44

48prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool

45prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool

49prop_encodingAuthorizationIsRemoved hs =

46prop_encodingAuthorizationIsRemoved hs =

50− "Authorization" `notMember` actual

47+ "Authorization" `S.notMember` actual

51 where

48 where

52− actual = foldMap keys (decode' $ encode hs)

49+ actual = encode hs ^@.. members & fmap fst & S.fromList

53

50

54prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool

51prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool

55prop_valueX_AccessTokenIsRemoved hs =

52prop_valueX_AccessTokenIsRemoved hs =

56− "X-AccessToken" `notMember` actual

53+ "X-AccessToken" `S.notMember` actual

57 where

54 where

58− actual = keys (toJSON hs)

55+ actual = toJSON hs ^@.. members & fmap fst & S.fromList

59

56

60prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool

57prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool

61prop_encodingX_AccessTokenIsRemoved hs =

58prop_encodingX_AccessTokenIsRemoved hs =

62− "X-AccessToken" `notMember` actual

59+ "X-AccessToken" `S.notMember` actual

63 where

60 where

64− actual = foldMap keys (decode' $ encode hs)

61+ actual = encode hs ^@.. members & fmap fst & S.fromList

65

62

66prop_valueAllHeadersAreRemoved

63prop_valueAllHeadersAreRemoved

67 :: MissingHeaders

64 :: MissingHeaders

68 '["Authorization", "this is made up", "Server", "X-AccessToken"]

65 '["Authorization", "this is made up", "Server", "X-AccessToken"]

69 -> Bool

66 -> Bool

70prop_valueAllHeadersAreRemoved hs =

67prop_valueAllHeadersAreRemoved hs =

71− "Authorization" `notMember` actual

68+ "Authorization" `S.notMember` actual

72− && "this is made up" `notMember` actual

69+ && "this is made up" `S.notMember` actual

73− && "Server" `notMember` actual

70+ && "Server" `S.notMember` actual

74− && "X-AccessToken" `notMember` actual

71+ && "X-AccessToken" `S.notMember` actual

75 where

72 where

76− actual = keys (toJSON hs)

73+ actual = toJSON hs ^@.. members & fmap fst & S.fromList

77

74

78prop_encodingAllHeadersAreRemoved

75prop_encodingAllHeadersAreRemoved

79 :: MissingHeaders

76 :: MissingHeaders

80 '["Authorization", "this is made up", "Server", "X-AccessToken"]

77 '["Authorization", "this is made up", "Server", "X-AccessToken"]

81 -> Bool

78 -> Bool

82prop_encodingAllHeadersAreRemoved hs =

79prop_encodingAllHeadersAreRemoved hs =

83− "Authorization" `notMember` actual

80+ "Authorization" `S.notMember` actual

84− && "this is made up" `notMember` actual

81+ && "this is made up" `S.notMember` actual

85− && "Server" `notMember` actual

82+ && "Server" `S.notMember` actual

86− && "X-AccessToken" `notMember` actual

83+ && "X-AccessToken" `S.notMember` actual

87 where

84 where

88− actual = foldMap keys (decode' $ encode hs)

85+ actual = encode hs ^@.. members & fmap fst & S.fromList

89−

90−keys :: Value -> HashSet Text

91−keys = \case

92− Object o -> Data.HashSet.fromMap (void o)

93− _ -> mempty

94−

95−notMember :: (Eq a, Hashable a) => a -> HashSet a -> Bool

96−notMember x = not . Data.HashSet.member x

test/Rollbar/Item/Request/Test.hs+18−29

@@ -1,27 +1,24 @@

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeOperators #-}

4+{-# LANGUAGE TypeOperators #-}

6module Rollbar.Item.Request.Test where

5module Rollbar.Item.Request.Test where

7

6

8−import Data.Aeson (Value (Object), decode', encode, toJSON)

7+import Control.Lens ((&), (^@..))

9−import Data.CaseInsensitive (original)

10−import Data.Foldable (fold)

11−import Data.Functor (void)

12−import Data.HashSet (HashSet)

13−import Data.Text (Text)

14

8

15−import Prelude hiding (error)

9+import Data.Aeson (encode, toJSON)

10+import Data.Aeson.Lens (members)

11+import Data.CaseInsensitive (original)

16

12

17−import Rollbar.Item.Request (MissingHeaders (..))

13+import Prelude hiding (error)

18−import Rollbar.QuickCheck ()

19

14

20−import Test.QuickCheck (conjoin, quickCheck)

15+import Rollbar.Item.Request (MissingHeaders(..))

16+import Rollbar.QuickCheck ()

21

17

22−import qualified Data.Text.Encoding as TE

18+import Test.QuickCheck (conjoin, quickCheck)

23

19

24−import qualified Data.HashSet

20+import Data.Set as S

21+import Data.Text.Encoding as TE

25

22

26props :: IO ()

23props :: IO ()

27props =

24props =

@@ -32,22 +29,14 @@ props =

32

29

33prop_valueHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool

30prop_valueHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool

34prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) =

31prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) =

35− actual `isSubsetOf` expected

32+ actual `S.isSubsetOf` expected

36 where

33 where

37− actual = keys (toJSON hs)

34+ actual = toJSON hs ^@.. members & fmap fst & S.fromList

38− expected = Data.HashSet.fromList $ fold . TE.decodeUtf8' . original . fst <$> rhs

35+ expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs

39− isSubsetOf x y = Data.HashSet.difference x y == mempty

40

36

41prop_encodingHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool

37prop_encodingHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool

42prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) =

38prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) =

43− actual `isSubsetOf` expected

39+ actual `S.isSubsetOf` expected

44 where

40 where

45− actual = foldMap keys (decode' $ encode hs)

41+ actual = encode hs ^@.. members & fmap fst & S.fromList

46− expected = Data.HashSet.fromList $ fold . TE.decodeUtf8' . original . fst <$> rhs

42+ expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs

47− isSubsetOf x y = Data.HashSet.difference x y == mempty

48−

49−keys :: Value -> HashSet Text

50−keys = \case

51− Object o -> Data.HashSet.fromMap (void o)

52− _ -> mempty

53−