From 13bd8f0addaee98e3efe1c7c2ba5c0546a31193c Mon Sep 17 00:00:00 2001 From: iphydf Date: Fri, 20 Jul 2018 23:41:57 +0000 Subject: [PATCH] Build with `stack` instead of `cabal` on Travis. Also, clean up some hlint warnings. --- .leaf.yml | 8 --- .travis.yml | 63 ++++------------------ src/GitHub/Types/Base/Change.hs | 2 +- src/GitHub/Types/Base/DeploymentPayload.hs | 2 +- src/GitHub/Types/Base/Link.hs | 2 +- src/GitHub/Types/Base/PageBuildError.hs | 2 +- src/GitHub/WebHook/Handler.hs | 43 +++++++-------- stack.yaml | 55 +++++++++++++++++++ web/TokTok/Hello.hs | 3 +- 9 files changed, 93 insertions(+), 87 deletions(-) delete mode 100644 .leaf.yml create mode 100644 stack.yaml diff --git a/.leaf.yml b/.leaf.yml deleted file mode 100644 index 06e0efc..0000000 --- a/.leaf.yml +++ /dev/null @@ -1,8 +0,0 @@ -# The 'haskell' template is looked up first in the current directory and then in -# the 'templates' directory. The templates directory location is known to the -# generator tool. -inherits: haskell - -package: - name: github-tools - version: 0.1.1 diff --git a/.travis.yml b/.travis.yml index 9ce804b..e58b1e5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,58 +1,17 @@ -# DO NOT EDIT: This file was generated using the following command: -# github-tools/tools/expand-yaml github-tools/.leaf.yml github-tools/.travis.yml ---- -addons: - apt: - packages: - - alex-3.1.7 - - happy-1.19.5 - - cabal-install-1.18 - - ghc-7.8.4 - sources: - - hvr-ghc -after_script: -- rm -f $HOME/.cabal && ln -s $HOME/.cabal-tools $HOME/.cabal -- rm -f $HOME/.ghc && ln -s $HOME/.ghc-tools $HOME/.ghc -- hpc-coveralls github-tools-0.1.1 -branches: - only: - - master +language: generic + cache: + timeout: 600 directories: - - $HOME/.cabal-build - - $HOME/.cabal-tools - - $HOME/.ghc-build - - $HOME/.ghc-tools -env: CABALVER=1.18 GHCVER=7.8.4 -install: -- export PATH=$HOME/.cabal/bin:$PATH -- export PATH=$HOME/.cabal-build/bin:$PATH -- export PATH=$HOME/.cabal-tools/bin:$PATH -- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:$PATH -- rm -rf $HOME/.cabal $HOME/.ghc -- mkdir -p $HOME/.cabal-tools $HOME/.ghc-tools -- rm -f $HOME/.cabal && ln -s $HOME/.cabal-tools $HOME/.cabal -- rm -f $HOME/.ghc && ln -s $HOME/.ghc-tools $HOME/.ghc -- cabal update -- mkdir -p $HOME/.cabal-build $HOME/.ghc-build -- rm -f $HOME/.cabal && ln -s $HOME/.cabal-build $HOME/.cabal -- rm -f $HOME/.ghc && ln -s $HOME/.ghc-build $HOME/.ghc -- cabal update -language: generic + - $HOME/.stack + +before_install: +- export PATH=$HOME/.local/bin:$PATH +- travis_retry curl -L https://github.com/TokTok/hs-tools/releases/download/v0.1/hs-tools-v0.1.tar.gz | tar xz -C $HOME + script: -- rm -f $HOME/.cabal && ln -s $HOME/.cabal-tools $HOME/.cabal -- rm -f $HOME/.ghc && ln -s $HOME/.ghc-tools $HOME/.ghc -- cabal install hpc-coveralls stylish-haskell hlint yaml-0.8.27 aeson-0.9.0.1 -- curl https://raw.githubusercontent.com/TokTok/toktok-stack/master/tools/stylish-haskell-lhs - -o $HOME/.cabal/bin/stylish-haskell-lhs -- chmod +x $HOME/.cabal/bin/stylish-haskell-lhs - hlint . - stylish-haskell-lhs -i . - git diff --exit-code -- rm -f $HOME/.cabal && ln -s $HOME/.cabal-build $HOME/.cabal -- rm -f $HOME/.ghc && ln -s $HOME/.ghc-build $HOME/.ghc -- cabal install --enable-tests --enable-benchmarks --only-dependencies ./ -- if [ -n "" ]; then cabal install ; fi -- cabal configure --enable-tests --enable-benchmarks --enable-library-coverage -- travis_wait cabal test -- cabal check +- stack --no-terminal test --coverage +- shc github-tools testsuite diff --git a/src/GitHub/Types/Base/Change.hs b/src/GitHub/Types/Base/Change.hs index 5f86dcd..6a26331 100644 --- a/src/GitHub/Types/Base/Change.hs +++ b/src/GitHub/Types/Base/Change.hs @@ -12,7 +12,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..)) ------------------------------------------------------------------------------ -- Change -data Change = Change +newtype Change = Change { changesFrom :: Text } deriving (Eq, Show, Read) diff --git a/src/GitHub/Types/Base/DeploymentPayload.hs b/src/GitHub/Types/Base/DeploymentPayload.hs index e169e4b..a87f9a0 100644 --- a/src/GitHub/Types/Base/DeploymentPayload.hs +++ b/src/GitHub/Types/Base/DeploymentPayload.hs @@ -12,7 +12,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..)) ------------------------------------------------------------------------------ -- DeploymentPayload -data DeploymentPayload = DeploymentPayload +newtype DeploymentPayload = DeploymentPayload { deploymentPayloadWebUrl :: Maybe Text } deriving (Eq, Show, Read) diff --git a/src/GitHub/Types/Base/Link.hs b/src/GitHub/Types/Base/Link.hs index 90c7c2d..ce6ec4f 100644 --- a/src/GitHub/Types/Base/Link.hs +++ b/src/GitHub/Types/Base/Link.hs @@ -12,7 +12,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..)) ------------------------------------------------------------------------------ -- Link -data Link = Link +newtype Link = Link { linkHref :: Text } deriving (Eq, Show, Read) diff --git a/src/GitHub/Types/Base/PageBuildError.hs b/src/GitHub/Types/Base/PageBuildError.hs index a1881e8..ffaa10e 100644 --- a/src/GitHub/Types/Base/PageBuildError.hs +++ b/src/GitHub/Types/Base/PageBuildError.hs @@ -12,7 +12,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..)) ------------------------------------------------------------------------------ -- PageBuildError -data PageBuildError = PageBuildError +newtype PageBuildError = PageBuildError { pageBuildErrorMessage :: Maybe Text } deriving (Eq, Show, Read) diff --git a/src/GitHub/WebHook/Handler.hs b/src/GitHub/WebHook/Handler.hs index 6b58849..6e96e68 100644 --- a/src/GitHub/WebHook/Handler.hs +++ b/src/GitHub/WebHook/Handler.hs @@ -95,32 +95,33 @@ verifySecretKey rawBody sig key = sig == ("sha1=" <> digestToHexByteString runHandler :: (Applicative m, Monad m) => Handler m -> m (Either Error (UUID, Payload)) runHandler h = do - mbDelivery <- pure . (fromASCIIBytes =<<) =<< hHeader h "X-GitHub-Delivery" + mbDelivery <- (fromASCIIBytes =<<) <$> hHeader h "X-GitHub-Delivery" res <- do rawBody <- hBody h mbSignature <- hHeader h "X-Hub-Signature" - authenticatedBody <- pure $ case (hSecretKeys h, mbSignature) of - - -- No secret key and no signature. Pass along the body unverified. - ([], Nothing) -> Right rawBody - - -- Signature is available but no secret keys to verify it. This is - -- not a fatal error, we can still process the event. - ([], Just _) -> Right rawBody - - -- Secret keys are available but the request is not signed. Reject - -- the request. - (_, Nothing) -> Left UnsignedRequest - - -- Both the signature and secret keys are available. Verify the - -- signature with the first key which works, otherwise reject the - -- request. - (secretKeys, Just sig) -> - if any (verifySecretKey rawBody sig) secretKeys - then Right rawBody - else Left InvalidSignature + let authenticatedBody + = case (hSecretKeys h, mbSignature) of + -- No secret key and no signature. Pass along the body + -- unverified. + ([], Nothing) -> Right rawBody + + -- Signature is available but no secret keys to verify it. + -- This is not a fatal error, we can still process the event. + ([], Just _) -> Right rawBody + + -- Secret keys are available but the request is not signed. + -- Reject the request. + (_, Nothing) -> Left UnsignedRequest + + -- Both the signature and secret keys are available. Verify + -- the signature with the first key which works, otherwise + -- reject the request. + (secretKeys, Just sig) -> + if any (verifySecretKey rawBody sig) secretKeys + then Right rawBody + else Left InvalidSignature mbEventName <- hHeader h "X-GitHub-Event" pure $ do diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..c254d76 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,55 @@ +packages: [.] +resolver: lts-6.27 +extra-deps: +- HUnit-1.6.0.0 +- QuickCheck-2.11.3 +- aeson-1.4.0.0 +- aeson-compat-0.3.8 +- attoparsec-0.13.2.2 +- attoparsec-iso8601-1.0.0.0 +- base-compat-0.10.4 +- base-orphans-0.5.4 +- bifunctors-5.5.3 +- binary-orphans-0.1.8.0 +- bsb-http-chunked-0.0.0.2 +- bytestring-builder-0.10.8.1.0 +- cabal-doctest-1.0.6 +- case-insensitive-1.2.0.11 +- cpphs-1.20.8 +- exceptions-0.8.3 +- fast-logger-2.4.11 +- github-0.19 +- hspec-2.5.5 +- hspec-core-2.5.5 +- hspec-discover-2.5.5 +- hspec-expectations-0.8.2 +- http-api-data-0.3.8.1 +- http-media-0.7.1.2 +- http-types-0.12.1 +- mmorph-1.1.2 +- natural-transformation-0.4 +- network-2.7.0.2 +- parsec-3.1.13.0 +- quickcheck-io-0.2.0 +- resourcet-1.1.11 +- safe-0.3.17 +- semigroupoids-5.2.1 +- semigroups-0.18.5 +- servant-0.13.0.1 +- servant-server-0.13.0.1 +- singleton-bool-0.1.4 +- split-0.2.3.3 +- string-conversions-0.4.0.1 +- tagged-0.8.6 +- text-1.2.3.0 +- th-abstraction-0.2.8.0 +- transformers-compat-0.5.1.4 +- unix-compat-0.5.0.1 +- unix-time-0.3.8 +- unliftio-core-0.1.1.0 +- vault-0.3.1.1 +- vector-binary-instances-0.2.4 +- vector-instances-3.4 +- wai-extra-3.0.22.0 +- warp-3.2.23 +- word8-0.1.3 diff --git a/web/TokTok/Hello.hs b/web/TokTok/Hello.hs index 8b21993..ef84a97 100644 --- a/web/TokTok/Hello.hs +++ b/web/TokTok/Hello.hs @@ -48,8 +48,7 @@ newGitHubCache timeout fetchUpdates = (consistentDuration timeout $ \state () -> do infos <- fetchUpdates return (state, infos)) - (do time <- POSIX.getPOSIXTime - return $ round time) + (round <$> POSIX.getPOSIXTime) 1 (CacheWithLRUList 1 1 1)