5deb32b...master · typeable/rollbar-hs

.circleci/config.yml+19−41

since splitsnapshots

unifiedsplit

@@ -1,62 +1,40 @@

1version: 2

2jobs:

3− compile:

3+ ghc-8.2.2:

4 docker:

5− - image: haskell:8.2.2

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

6 steps:

7 - checkout

8 - restore_cache:

9 keys:

10− - v1-stack-{{ checksum "package.yaml" }}-{{ checksum "stack.yaml" }}

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

11− - v1-stack-{{ checksum "package.yaml" }}-

11+ - v2-nix-

12− - v1-stack-

13− name: Restoring stack cache

12+ name: Restoring cache

14 - run:

13 - run:

15 name: Compile

14 name: Compile

16− command: make build

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

17− - presist_to_workspace:

16+ environment:

18− root: dist

17+ CABAL_BUILD_FLAGS: --jobs=2

19− paths:

20− - '*'

21 - save_cache:

18 - save_cache:

22− key: v1-stack-{{ checksum "package.yaml" }}-{{ checksum "stack.yaml" }}

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

23− name: Caching stack

20+ name: Caching nix

24 paths:

21 paths:

25− - .stack-work

22+ - /nix

26− - /root/.stack

23+ - dist

27

24

28− sdist:

25+ for-github:

29 docker:

26 docker:

30− - image: haskell:8.2.2

27+ - image: alpine

31 steps:

28 steps:

32− - checkout

33− - restore_cache:

34− keys:

35− - v1-stack-{{ checksum "package.yaml" }}-{{ checksum "stack.yaml" }}

36− - v1-stack-{{ checksum "package.yaml" }}-

37− - v1-stack-

38− name: Restoring stack cache

39− - run:

40− name: Build sdist

41− command: make sdist

42−

43− test:

44− docker:

45− - image: haskell:8.2.2

46− steps:

47− - checkout

48− - attach_workspace:

49− at: dist

50 - run:

29 - run:

51− name: Test

30+ name: Passed

52− command: make test

31+ command: echo passed

53

32

54workflows:

33workflows:

55 version: 2

34 version: 2

56 base:

35 base:

57 jobs:

36 jobs:

58− - compile

37+ - for-github:

59− - sdist

60− - test:

61 requires:

38 requires:

62− - compile

39+ - ghc-8.2.2

40+ - ghc-8.2.2

.gitignore+1−2

@@ -1,6 +1,5 @@

1### Project specific ###

2

3−*.cabal

4.make

3.make

5bin

4bin

6

5

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

186*.lnk

185*.lnk

187

186

188

187

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

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

CHANGELOG.mdnew file+31

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

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.

Makefile+36−43

@@ -1,68 +1,61 @@

1−BIN ?= bin

2CABAL ?= cabal

1CABAL ?= cabal

2+CABAL_FLAGS ?=

3+CABAL_BUILD_FLAGS ?=

3DIST ?= dist

4DIST ?= dist

4−EMPTY ?= .make

5+GHCID ?= ghcid

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

7+HPACK ?= hpack

8+NIX_SHELL ?= nix-shell

9+NIX_SHELL_FLAGS ?=

5−PROJECT_NAME ?= rollbar-hs

10+PROJECT_NAME := rollbar-hs

6−STACK ?= stack

7−STACK_WORK ?= .stack-work

8−VERBOSITY ?= warn

9

11

10CABAL_FILE := $(PROJECT_NAME).cabal

12CABAL_FILE := $(PROJECT_NAME).cabal

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

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

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

12−GHCID := $(BIN)/ghcid

13−STACK_FLAGS := --verbosity $(VERBOSITY)

14

15

15−.DEFAULT_GOAL := $(EMPTY)/build

16+.DEFAULT_GOAL := build

16−

17−$(BIN) $(DIST) $(EMPTY):

18− mkdir -p $@

19

17

20$(CABAL_FILE): package.yaml

18$(CABAL_FILE): package.yaml

21− # `stack` has no way to run `hpack` directly.

19+ $(HPACK)

22− # We can run `hpack` indirectly with little overhead.

23− $(STACK) $(STACK_FLAGS) build --dry-run

24−

25−$(DOC_TEST): $(EMPTY)/build golden/**/*.json

26− $@

27−

28−$(EMPTY)/build: $(EMPTY)/stack-setup README.md Setup.hs package.yaml stack.yaml src/**/*.hs test/**/*.hs | $(DIST)

29− $(STACK) $(STACK_FLAGS) build --no-run-tests --test

30− cp -R $$($(STACK) $(STACK_FLAGS) path --dist-dir)/build $(DIST)/build

31− touch $@

32−

33−$(EMPTY)/doc-test: $(EMPTY)/build

34− touch $@

35

20

36−$(EMPTY)/stack-setup: | $(EMPTY)

21+$(CONFIGURE): $(CABAL_FILE)

37− $(STACK) $(STACK_FLAGS) setup

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

38− touch $@

39

23

40−$(GHCID): $(EMPTY)/stack-setup | $(BIN)

24+.PHONY: build

41− $(STACK) $(STACK_FLAGS) install ghcid --local-bin-path $(BIN)

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

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

42

27

43−.PHONY: cabal-check

28+.PHONY: check

44−cabal-check: $(CABAL_FILE)

29+check: $(CABAL_FILE)

45− $(CABAL) check

30+ $(CABAL) $(CABAL_FLAGS) check

46

31

47.PHONY: clean

32.PHONY: clean

48clean:

33clean:

49 rm -f $(CABAL_FILE)

34 rm -f $(CABAL_FILE)

50− rm -fr $(BIN)

51 rm -fr $(DIST)

35 rm -fr $(DIST)

52− rm -fr $(EMPTY)

36+

53− rm -fr $(STACK_WORK)

37+default.nix: $(CABAL_FILE)

38+ cabal2nix . > $@

54

39

55.PHONY: sdist

40.PHONY: sdist

56−sdist: cabal-check | $(DIST)

41+sdist: check

57− $(CABAL) sdist

42+ $(CABAL) $(CABAL_FLAGS) sdist

43+

44+.PHONY: shell

45+shell:

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

58

47

59.PHONY: test

48.PHONY: test

49+test: test-doc-test

50+

51+.PHONY: test-doc-test

60−test: $(DOC_TEST)

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

53+ $<

61

54

62.PHONY: upload-hackage

55.PHONY: upload-hackage

63upload-hackage: sdist

56upload-hackage: sdist

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

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

65

58

66.PHONY: watch

59.PHONY: watch

67−watch: $(GHCID)

60+watch: $(CONFIGURE)

68− $(GHCID)

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

default.nixnew file+21

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

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.2.0.0"

8+ "version": "0.3.1.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.2.0.0"

27+ "version": "0.3.1.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.2.0.0"

46+ "version": "0.3.1.0"

47 },

48 "platform": "linux",

49 "environment": "/dt",

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

62 "data": {

63 "notifier": {

64 "name": "rollbar-hs",

65− "version": "0.2.0.0"

65+ "version": "0.3.1.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.2.0.0"

84+ "version": "0.3.1.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.2.0.0"

8+ "version": "0.3.1.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.2.0.0"

27+ "version": "0.3.1.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.2.0.0"

46+ "version": "0.3.1.0"

47 },

48 "platform": "linux",

49 "environment": "/dt",

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

62 "data": {

63 "notifier": {

64 "name": "rollbar-hs",

65− "version": "0.2.0.0"

65+ "version": "0.3.1.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.2.0.0"

84+ "version": "0.3.1.0"

85 },

86 "platform": "linux",

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

package.yamldeleted−47

@@ -1,47 +0,0 @@

1−author: Hardy Jones

2−category: Web

3−copyright: 2018 Hardy Jones

4−description: |

5− Provides a type-safe encoding of the Rollbar API.

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

7−extra-source-files:

8− - README.md

9−github: joneshf/rollbar-hs

10−library:

11− dependencies:

12− - aeson >= 1.0 && < 1.5

13− - base >= 4.9 && < 5

14− - bytestring >= 0.10 && < 0.11

15− - case-insensitive >= 1.2 && < 1.3

16− - hostname >= 1.0 && < 1.1

17− - http-client >= 0.5 && < 0.6

18− - http-conduit >= 2.2 && < 2.4

19− - http-types >= 0.9 && < 0.13

20− - network >= 2.6 && < 2.7

21− - text >= 1.2 && < 1.3

22− - time >= 1.6 && < 1.9

23− - unordered-containers >= 0.2 && < 0.3

24− - uuid >= 1.3 && < 1.4

25− source-dirs: src

26−license: BSD3

27−maintainer: jones3.hardy@gmail.com

28−name: rollbar-hs

29−synopsis: Core Rollbar data types and APIs.

30−tests:

31− doc-test:

32− dependencies:

33− - QuickCheck >= 2.9

34− - aeson >= 1.0

35− - base >= 4.9

36− - bytestring >= 0.10

37− - case-insensitive >= 1.2

38− - containers >= 0.5

39− - hspec >= 2.4

40− - hspec-golden-aeson >= 0.2

41− - lens >= 4.15

42− - lens-aeson >= 1.0

43− - rollbar-hs

44− - text >= 1.2

45− main: Main.hs

46− source-dirs: test

47−version: '0.2.0.0'

rollbar-hs.cabalnew file+93

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

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.nixnew file+44

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

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.hsnew file+22

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

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,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE NamedFieldPuns #-}

4{-# LANGUAGE NamedFieldPuns #-}

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

197 }

198 }

198 deriving (Eq, Generic, Show)

199 deriving (Eq, Generic, Show)

199

200

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

200itemKVs

207itemKVs

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

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

202 => Item v headers

209 => Item v headers

203 -> [kv]

210 -> [kv]

211+#endif

204itemKVs Item{accessToken, itemData} =

212itemKVs Item{accessToken, itemData} =

205 [ "access_token" .= accessToken

213 [ "access_token" .= accessToken

206 , "data" .= itemData

214 , "data" .= itemData

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

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE NamedFieldPuns #-}

4{-# LANGUAGE NamedFieldPuns #-}

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

33 , (.=)

34 , (.=)

34 )

35 )

35import Data.Aeson.Encoding (pair)

36import Data.Aeson.Encoding (pair)

36−import Data.Aeson.Types (typeMismatch)

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

37import Data.String (IsString)

38import Data.String (IsString)

38

39

39import GHC.Generics (Generic)

40import GHC.Generics (Generic)

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

52 }

53 }

53 deriving (Eq, Generic, Show)

54 deriving (Eq, Generic, Show)

54

55

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

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

58+#else

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

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

60+#endif

56bodyKVs Message{messageBody, messageData} =

61bodyKVs Message{messageBody, messageData} =

57 [ "body" .= messageBody

62 [ "body" .= messageBody

58 , "data" .= messageData

63 , "data" .= messageData

59 ]

64 ]

60

65

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

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

62− parseJSON (Object o') = do

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

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

68+ where

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

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

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

65 parseJSON v = typeMismatch "Body arbitrary" v

71 parseJSON v = typeMismatch "Body arbitrary" v

66

72

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

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

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

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

3{-# LANGUAGE KindSignatures #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE CPP #-}

6

7

7{-|

8{-|

8 Module : Rollbar.Item.MissingHeaders

9 Module : Rollbar.Item.MissingHeaders

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

20

21

21import Data.Aeson

22import Data.Aeson

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

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

24+import Rollbar.Aeson

23import Data.Bifunctor (bimap)

25import Data.Bifunctor (bimap)

24import Data.CaseInsensitive (mk, original)

26import Data.CaseInsensitive (mk, original)

25import Data.Maybe (catMaybes)

27import Data.Maybe (catMaybes)

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

31

33

32import qualified Data.ByteString as BS

34import qualified Data.ByteString as BS

33import qualified Data.ByteString.Char8 as BSC8

35import qualified Data.ByteString.Char8 as BSC8

34−import qualified Data.Text as T

35import qualified Data.Text.Encoding as TE

36import qualified Data.Text.Encoding as TE

36

37

37-- | The request headers with some missing

38-- | The request headers with some missing

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

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

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

64 toJSON = object . catMaybes . requestHeadersKVs . removeHeaders

65 toJSON = object . catMaybes . requestHeadersKVs . removeHeaders

65

66

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

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

69+#else

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

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

71+#endif

67requestHeadersKVs = fmap go

72requestHeadersKVs = fmap go

68 where

73 where

69 go :: Header -> Maybe kv

74 go :: Header -> Maybe kv

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

72 val <- myDecodeUtf8 val'

77 val <- myDecodeUtf8 val'

73 pure (key .= val)

78 pure (key .= val)

74

79

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

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

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

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

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

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE NamedFieldPuns #-}

4{-# LANGUAGE NamedFieldPuns #-}

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

48import Network.HTTP.Types (Query)

49import Network.HTTP.Types (Query)

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

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

50

51

52+import Rollbar.Aeson

51import Rollbar.Item.MissingHeaders

53import Rollbar.Item.MissingHeaders

52

54

53import Text.Read (readMaybe)

55import Text.Read (readMaybe)

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

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

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

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

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

98

100

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

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

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

103+#else

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

105+#endif

100queryKVs = fmap go

106queryKVs = fmap go

101 where

107 where

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

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

103 go (key', val') = do

109 go (key', val') = do

104 key <- myDecodeUtf8 key'

110 key <- myDecodeUtf8 key'

105 let val = val' >>= myDecodeUtf8

111 let val = val' >>= myDecodeUtf8

106− pure (key .= val)

112+ pure (textToKey key .= val)

107

113

108-- | The HTTP Verb

114-- | The HTTP Verb

109newtype Method

115newtype Method

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

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

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

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

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

151

157

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

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

160+#else

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

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

162+#endif

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

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

154 [ "body" .= rawBody

164 [ "body" .= rawBody

155 , "GET" .= get

165 , "GET" .= get

src/Rollbar/Item/Server.hs+5

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE NamedFieldPuns #-}

4{-# LANGUAGE NamedFieldPuns #-}

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

57 }

58 }

58 deriving (Eq, Generic, Show)

59 deriving (Eq, Generic, Show)

59

60

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

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

63+#else

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

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

65+#endif

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

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

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

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

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

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

stack.yaml+3−63

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

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

11−# resolver: lts-3.5

1+resolver: lts-23.7

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.

38packages:

2packages:

39- .

3- .

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: []

49

4

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

5+nix:

51−# system-ghc: true

6+ packages: [ zlib ]

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+18−10

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

3module Rollbar.Item.Data.Test where

4module Rollbar.Item.Data.Test where

4

5

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

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

7+ toJSON)

8+import Data.Text (Text)

6

9

7−import Data.Aeson (encode, toJSON)

10+import Rollbar.Item

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

11+import Rollbar.QuickCheck ()

9−import Data.Text (Text)

10

12

11−import Rollbar.Item

13+import Test.QuickCheck (conjoin, quickCheck)

12−import Rollbar.QuickCheck ()

13

14

14−import Test.QuickCheck (conjoin, quickCheck)

15+import qualified Data.HashMap.Strict

15

16

16props :: IO ()

17props :: IO ()

17props =

18props =

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

24prop_valueDataBodyHasRequiredKey x =

25prop_valueDataBodyHasRequiredKey x =

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

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

26 where

27 where

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

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

28

29

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

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

30prop_encodingDataBodyHasRequiredKey x =

31prop_encodingDataBodyHasRequiredKey x =

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

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

32 where

33 where

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

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

34

35

35requiredBodyKeys :: [Text]

36requiredBodyKeys :: [Text]

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

37requiredBodyKeys = ["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+41−30

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeOperators #-}

6module Rollbar.Item.MissingHeaders.Test where

7module Rollbar.Item.MissingHeaders.Test where

7

8

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

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

10+ toJSON)

11+import Data.Functor (void)

12+import Data.Hashable

13+import Data.HashSet (HashSet)

14+import Data.Text (Text)

9

15

10−import Data.Aeson (encode, toJSON)

16+import Prelude hiding (error)

11−import Data.Aeson.Lens (members)

12

17

13−import Prelude hiding (error)

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

19+import Rollbar.QuickCheck ()

14

20

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

21+import Test.QuickCheck (conjoin, quickCheck)

16−import Rollbar.QuickCheck ()

17

22

18−import Test.QuickCheck (conjoin, quickCheck)

23+import qualified Data.HashSet

19−

20−import Data.Set as S

21

24

22props :: IO ()

25props :: IO ()

23props = do

26props = do

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

38

41

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

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

40prop_valueAuthorizationIsRemoved hs =

43prop_valueAuthorizationIsRemoved hs =

41− "Authorization" `S.notMember` actual

44+ "Authorization" `notMember` actual

42 where

45 where

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

46+ actual = keys (toJSON hs)

44

47

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

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

46prop_encodingAuthorizationIsRemoved hs =

49prop_encodingAuthorizationIsRemoved hs =

47− "Authorization" `S.notMember` actual

50+ "Authorization" `notMember` actual

48 where

51 where

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

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

50

53

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

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

52prop_valueX_AccessTokenIsRemoved hs =

55prop_valueX_AccessTokenIsRemoved hs =

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

56+ "X-AccessToken" `notMember` actual

54 where

57 where

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

58+ actual = keys (toJSON hs)

56

59

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

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

58prop_encodingX_AccessTokenIsRemoved hs =

61prop_encodingX_AccessTokenIsRemoved hs =

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

62+ "X-AccessToken" `notMember` actual

60 where

63 where

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

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

62

65

63prop_valueAllHeadersAreRemoved

66prop_valueAllHeadersAreRemoved

64 :: MissingHeaders

67 :: MissingHeaders

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

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

66 -> Bool

69 -> Bool

67prop_valueAllHeadersAreRemoved hs =

70prop_valueAllHeadersAreRemoved hs =

68− "Authorization" `S.notMember` actual

71+ "Authorization" `notMember` actual

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

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

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

73+ && "Server" `notMember` actual

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

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

72 where

75 where

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

76+ actual = keys (toJSON hs)

74

77

75prop_encodingAllHeadersAreRemoved

78prop_encodingAllHeadersAreRemoved

76 :: MissingHeaders

79 :: MissingHeaders

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

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

78 -> Bool

81 -> Bool

79prop_encodingAllHeadersAreRemoved hs =

82prop_encodingAllHeadersAreRemoved hs =

80− "Authorization" `S.notMember` actual

83+ "Authorization" `notMember` actual

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

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

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

85+ && "Server" `notMember` actual

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

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

84 where

87 where

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

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

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+29−18

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

4−{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE TypeOperators #-}

5module Rollbar.Item.Request.Test where

6module Rollbar.Item.Request.Test where

6

7

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

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

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)

8

14

9−import Data.Aeson (encode, toJSON)

15+import Prelude hiding (error)

10−import Data.Aeson.Lens (members)

11−import Data.CaseInsensitive (original)

12

16

13−import Prelude hiding (error)

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

18+import Rollbar.QuickCheck ()

14

19

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

20+import Test.QuickCheck (conjoin, quickCheck)

16−import Rollbar.QuickCheck ()

17

21

18−import Test.QuickCheck (conjoin, quickCheck)

22+import qualified Data.Text.Encoding as TE

19

23

20−import Data.Set as S

24+import qualified Data.HashSet

21−import Data.Text.Encoding as TE

22

25

23props :: IO ()

26props :: IO ()

24props =

27props =

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

29

32

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

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

31prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) =

34prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) =

32− actual `S.isSubsetOf` expected

35+ actual `isSubsetOf` expected

33 where

36 where

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

37+ actual = keys (toJSON hs)

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

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

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

36

40

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

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

38prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) =

42prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) =

39− actual `S.isSubsetOf` expected

43+ actual `isSubsetOf` expected

40 where

44 where

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

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

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

46+ expected = Data.HashSet.fromList $ fold . 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+