diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,10 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html) +## 0.50.1 +### Fixed +- Do not allow incoming POST requests of unlimited body size. + ## 0.50.0 ### Added - Limit number of simultaneous xpubs being cached. diff --git a/haskoin-store.cabal b/haskoin-store.cabal --- a/haskoin-store.cabal +++ b/haskoin-store.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5b36767c6735c36f43dfb4f75547a52955c10cde6bd527c536bdc387d03d6482 +-- hash: bd4a50aa77300f41f9483c3f6931ebf56585ffd7ff1d19040ba6b0323e5bc86e name: haskoin-store -version: 0.50.0 +version: 0.50.1 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -61,7 +61,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 - , haskoin-store-data ==0.49.0 + , haskoin-store-data ==0.50.1 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -82,6 +82,7 @@ , unliftio >=0.2.12.1 , unordered-containers >=0.2.10.0 , wai >=3.2.2.1 + , wai-extra >=3.1.6 , warp >=3.3.10 , wreq >=0.5.3.2 default-language: Haskell2010 @@ -113,7 +114,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.49.0 + , haskoin-store-data ==0.50.1 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -135,6 +136,7 @@ , unliftio >=0.2.12.1 , unordered-containers >=0.2.10.0 , wai >=3.2.2.1 + , wai-extra >=3.1.6 , warp >=3.3.10 , wreq >=0.5.3.2 default-language: Haskell2010 @@ -170,7 +172,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.49.0 + , haskoin-store-data ==0.50.1 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3 @@ -192,6 +194,7 @@ , unliftio >=0.2.12.1 , unordered-containers >=0.2.10.0 , wai >=3.2.2.1 + , wai-extra >=3.1.6 , warp >=3.3.10 , wreq >=0.5.3.2 default-language: Haskell2010 diff --git a/src/Haskoin/Store/Web.hs b/src/Haskoin/Store/Web.hs --- a/src/Haskoin/Store/Web.hs +++ b/src/Haskoin/Store/Web.hs @@ -17,69 +17,83 @@ , runWeb ) where -import Conduit (ConduitT, await, dropC, - dropWhileC, mapC, runConduit, - sinkList, takeC, yield, (.|)) -import Control.Applicative ((<|>)) -import Control.Arrow (second) -import Control.Concurrent.STM (check) -import Control.Lens -import Control.Monad (forM, forever, unless, when, - (<=<)) -import Control.Monad.Logger (MonadLoggerIO, logDebugS, - logErrorS, logInfoS) -import Control.Monad.Reader (ReaderT, ask, asks, local, - runReaderT) -import Control.Monad.Trans (lift) -import Control.Monad.Trans.Control (liftWith, restoreT) -import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) -import Data.Aeson (Encoding, ToJSON (..), Value) -import Data.Aeson.Encode.Pretty (Config (..), defConfig, - encodePretty') -import Data.Aeson.Encoding (encodingToLazyByteString, list) -import Data.Aeson.Text (encodeToLazyText) -import Data.ByteString.Builder (lazyByteString) -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Base16 as BL16 -import qualified Data.ByteString.Lazy.Char8 as C +import Conduit (ConduitT, await, + dropC, dropWhileC, + mapC, runConduit, + sinkList, takeC, + yield, (.|)) +import Control.Applicative ((<|>)) +import Control.Arrow (second) +import Control.Concurrent.STM (check) +import Control.Lens ((^.)) +import Control.Monad (forM, forever, unless, + when, (<=<)) +import Control.Monad.Logger (MonadLoggerIO, + logDebugS, logErrorS, + logInfoS) +import Control.Monad.Reader (ReaderT, ask, asks, + local, runReaderT) +import Control.Monad.Trans (lift) +import Control.Monad.Trans.Control (liftWith, restoreT) +import Control.Monad.Trans.Maybe (MaybeT (..), + runMaybeT) +import Data.Aeson (Encoding, ToJSON (..), + Value, object, (.=)) +import qualified Data.Aeson as A +import Data.Aeson.Encode.Pretty (Config (..), + defConfig, + encodePretty') +import Data.Aeson.Encoding (encodingToLazyByteString, + list) +import Data.Aeson.Text (encodeToLazyText) +import Data.ByteString.Builder (lazyByteString) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Base16 as BL16 +import qualified Data.ByteString.Lazy.Char8 as C import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial -import Data.Char (isSpace) -import Data.Default (Default (..)) -import Data.Function (on, (&)) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import Data.HashSet (HashSet) -import qualified Data.HashSet as HashSet -import Data.Int (Int64) -import Data.List (nub, sortBy) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromJust, fromMaybe, - isJust, listToMaybe, mapMaybe, - maybeToList) -import Data.Proxy (Proxy (..)) -import qualified Data.Set as Set -import Data.String (fromString) -import Data.String.Conversions (cs) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Text.Lazy (toStrict) -import qualified Data.Text.Lazy as TL -import Data.Time.Clock (NominalDiffTime, diffUTCTime) -import Data.Time.Clock.System (getSystemTime, systemSeconds, - systemToUTCTime) -import Data.Word (Word32, Word64) -import Database.RocksDB (Property (..), getProperty) +import Data.Char (isSpace) +import Data.Default (Default (..)) +import Data.Function (on, (&)) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet +import Data.Int (Int64) +import Data.List (nub, sortBy) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, fromJust, + fromMaybe, isJust, + listToMaybe, mapMaybe, + maybeToList) +import Data.Proxy (Proxy (..)) +import qualified Data.Set as Set +import Data.String (fromString) +import Data.String.Conversions (cs) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Text.Lazy (toStrict) +import qualified Data.Text.Lazy as TL +import Data.Time.Clock (NominalDiffTime, + diffUTCTime) +import Data.Time.Clock.System (getSystemTime, + systemSeconds, + systemToUTCTime) +import Data.Word (Word32, Word64) +import Database.RocksDB (Property (..), + getProperty) import Haskoin.Address -import qualified Haskoin.Block as H +import qualified Haskoin.Block as H import Haskoin.Constants import Haskoin.Keys import Haskoin.Network -import Haskoin.Node (Chain, OnlinePeer (..), - PeerManager, chainGetBest, - getPeers, sendMessage) +import Haskoin.Node (Chain, + OnlinePeer (..), + PeerManager, + chainGetBest, + getPeers, sendMessage) import Haskoin.Store.BlockStore import Haskoin.Store.Cache import Haskoin.Store.Common @@ -91,36 +105,46 @@ import Haskoin.Store.WebCommon import Haskoin.Transaction import Haskoin.Util -import NQE (Inbox, receive, - withSubscription) -import Network.HTTP.Types (Status (..), status400, - status403, status404, status409, - status500, status503, - statusIsClientError, - statusIsServerError, - statusIsSuccessful) -import Network.Wai (Middleware, Request (..), - responseStatus) -import Network.Wai.Handler.Warp (defaultSettings, setHost, - setPort) -import qualified Network.Wreq as Wreq -import System.IO.Unsafe (unsafeInterleaveIO) -import qualified System.Metrics as Metrics -import qualified System.Metrics.Counter as Metrics (Counter) -import qualified System.Metrics.Counter as Metrics.Counter -import qualified System.Metrics.Gauge as Metrics (Gauge) -import qualified System.Metrics.Gauge as Metrics.Gauge -import Text.Printf (printf) -import UnliftIO (MonadIO, MonadUnliftIO, TVar, - askRunInIO, atomically, bracket, - bracket_, handleAny, liftIO, - modifyTVar, newTVarIO, readTVar, - readTVarIO, timeout, withAsync, - withRunInIO, writeTVar) -import UnliftIO.Concurrent (threadDelay) -import Web.Scotty.Internal.Types (ActionT) -import Web.Scotty.Trans (Parsable) -import qualified Web.Scotty.Trans as S +import NQE (Inbox, receive, + withSubscription) +import Network.HTTP.Types (Status (..), + requestEntityTooLarge413, + status400, status403, + status404, status409, + status500, status503, + statusIsClientError, + statusIsServerError, + statusIsSuccessful) +import Network.Wai (Middleware, + Request (..), + responseLBS, + responseStatus) +import Network.Wai.Handler.Warp (defaultSettings, + setHost, setPort) +import Network.Wai.Middleware.RequestSizeLimit +import qualified Network.Wreq as Wreq +import System.IO.Unsafe (unsafeInterleaveIO) +import qualified System.Metrics as Metrics +import qualified System.Metrics.Counter as Metrics (Counter) +import qualified System.Metrics.Counter as Metrics.Counter +import qualified System.Metrics.Gauge as Metrics (Gauge) +import qualified System.Metrics.Gauge as Metrics.Gauge +import Text.Printf (printf) +import UnliftIO (MonadIO, + MonadUnliftIO, TVar, + askRunInIO, + atomically, bracket, + bracket_, handleAny, + liftIO, modifyTVar, + newTVarIO, readTVar, + readTVarIO, timeout, + withAsync, + withRunInIO, + writeTVar) +import UnliftIO.Concurrent (threadDelay) +import Web.Scotty.Internal.Types (ActionT) +import Web.Scotty.Trans (Parsable) +import qualified Web.Scotty.Trans as S type WebT m = ActionT Except (ReaderT WebState m) @@ -396,12 +420,19 @@ runner <- askRunInIO S.scottyOptsT opts (runner . (`runReaderT` st)) $ do S.middleware reqLogger + S.middleware $ requestSizeLimitMiddleware lim S.defaultHandler defHandler handlePaths S.notFound $ S.raise ThingNotFound where + lim = setOnLengthExceeded too_big defaultRequestSizeLimitSettings opts = def {S.settings = settings defaultSettings} settings = setPort port . setHost (fromString host) + too_big w64 = \_app _req send -> send $ + responseLBS + requestEntityTooLarge413 + [("Content-Type", "application/json")] + (A.encode $ object ["error" .= ("request size too large" :: Text)]) price :: (MonadUnliftIO m, MonadLoggerIO m) => Network