{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module Haskoin.Store.WebClient
  ( ApiConfig (..),
    apiCall,
    apiBatch,
    -- Blocks
    GetBlock (..),
    GetBlocks (..),
    GetBlockRaw (..),
    GetBlockBest (..),
    GetBlockBestRaw (..),
    GetBlockLatest (..),
    GetBlockHeight (..),
    GetBlockHeights (..),
    GetBlockHeightRaw (..),
    GetBlockTime (..),
    GetBlockTimeRaw (..),
    -- Transactions
    GetTx (..),
    GetTxs (..),
    GetTxRaw (..),
    GetTxsRaw (..),
    GetTxsBlock (..),
    GetTxsBlockRaw (..),
    GetTxAfter (..),
    PostTx (..),
    GetMempool (..),
    GetEvents (..),
    -- Address
    GetAddrTxs (..),
    GetAddrsTxs (..),
    GetAddrTxsFull (..),
    GetAddrsTxsFull (..),
    GetAddrBalance (..),
    GetAddrsBalance (..),
    GetAddrUnspent (..),
    GetAddrsUnspent (..),
    -- XPubs
    GetXPub (..),
    GetXPubTxs (..),
    GetXPubTxsFull (..),
    GetXPubBalances (..),
    GetXPubUnspent (..),
    DelCachedXPub (..),
    -- Network
    GetPeers (..),
    GetHealth (..),
    -- Params
    StartParam (..),
    OffsetParam (..),
    LimitParam (..),
    LimitsParam (..),
    HeightParam (..),
    HeightsParam (..),
    Store.DeriveType (..),
    NoCache (..),
    NoTx (..),
  )
where

import Control.Arrow (second)
import Control.Exception
import Control.Lens ((.~), (?~), (^.))
import Control.Monad.Except
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BL
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Default (Default, def)
import Data.Monoid (Endo (..), appEndo)
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text as Text
import Haskoin.Constants
import Haskoin.Data
import qualified Haskoin.Store.Data as Store
import Haskoin.Store.WebCommon
import Haskoin.Transaction
import Haskoin.Util
import Network.HTTP.Client (Request (..))
import Network.HTTP.Types (StdMethod (..))
import Network.HTTP.Types.Status
import qualified Network.Wreq as HTTP
import Network.Wreq.Types (ResponseChecker)
import Numeric.Natural (Natural)

-- | Configuration specifying the Network and the Host for API calls.
-- Default instance:
--
-- @
-- ApiConfig
-- { configNetwork = bch
-- , configHost = "https://api.haskoin.com/"
-- }
-- @
data ApiConfig = ApiConfig
  { ApiConfig -> Network
configNetwork :: !Network,
    ApiConfig -> String
configHost :: !String
  }
  deriving (ApiConfig -> ApiConfig -> Bool
(ApiConfig -> ApiConfig -> Bool)
-> (ApiConfig -> ApiConfig -> Bool) -> Eq ApiConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiConfig -> ApiConfig -> Bool
$c/= :: ApiConfig -> ApiConfig -> Bool
== :: ApiConfig -> ApiConfig -> Bool
$c== :: ApiConfig -> ApiConfig -> Bool
Eq, Int -> ApiConfig -> ShowS
[ApiConfig] -> ShowS
ApiConfig -> String
(Int -> ApiConfig -> ShowS)
-> (ApiConfig -> String)
-> ([ApiConfig] -> ShowS)
-> Show ApiConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiConfig] -> ShowS
$cshowList :: [ApiConfig] -> ShowS
show :: ApiConfig -> String
$cshow :: ApiConfig -> String
showsPrec :: Int -> ApiConfig -> ShowS
$cshowsPrec :: Int -> ApiConfig -> ShowS
Show)

instance Default ApiConfig where
  def :: ApiConfig
def =
    ApiConfig :: Network -> String -> ApiConfig
ApiConfig
      { configNetwork :: Network
configNetwork = Network
bch,
        configHost :: String
configHost = String
"https://api.haskoin.com/"
      }

-- | Make a call to the haskoin-store API.
--
-- Usage (default options):
--
-- > apiCall def $ GetAddrsTxs addrs def
--
-- With options:
--
-- > apiCall def $ GetAddrsUnspent addrs def{ paramLimit = Just 10 }
apiCall ::
  (ApiResource a b, MonadIO m, MonadError Store.Except m) =>
  ApiConfig ->
  a ->
  m b
apiCall :: ApiConfig -> a -> m b
apiCall (ApiConfig Network
net String
apiHost) a
res = do
  Endo Options
args <- Either Except (Endo Options) -> m (Endo Options)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Except (Endo Options) -> m (Endo Options))
-> Either Except (Endo Options) -> m (Endo Options)
forall a b. (a -> b) -> a -> b
$ Network -> a -> Either Except (Endo Options)
forall a b.
ApiResource a b =>
Network -> a -> Either Except (Endo Options)
toOptions Network
net a
res
  let url :: String
url = String
apiHost String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Network -> String
getNetworkName Network
net String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Network -> a -> Text
forall a b. ApiResource a b => Network -> a -> Text
queryPath Network
net a
res)
  case Proxy a -> StdMethod
forall a b. ApiResource a b => Proxy a -> StdMethod
resourceMethod (Proxy a -> StdMethod) -> Proxy a -> StdMethod
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
asProxy a
res of
    StdMethod
GET -> Either Except b -> m b
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Except b -> m b) -> m (Either Except b) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Except b) -> m (Either Except b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Endo Options -> String -> IO (Either Except b)
forall a.
Serial a =>
Endo Options -> String -> IO (Either Except a)
getBinary Endo Options
args String
url)
    StdMethod
POST ->
      case a -> Maybe PostBox
forall a b. ApiResource a b => a -> Maybe PostBox
resourceBody a
res of
        Just (PostBox s
val) ->
          Either Except b -> m b
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Except b -> m b) -> m (Either Except b) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Except b) -> m (Either Except b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Endo Options -> String -> s -> IO (Either Except b)
forall a r.
(Serial a, Serial r) =>
Endo Options -> String -> a -> IO (Either Except r)
postBinary Endo Options
args String
url s
val)
        Maybe PostBox
_ -> Except -> m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Except -> m b) -> Except -> m b
forall a b. (a -> b) -> a -> b
$ String -> Except
Store.StringError String
"Could not post resource"
    StdMethod
_ -> Except -> m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Except -> m b) -> Except -> m b
forall a b. (a -> b) -> a -> b
$ String -> Except
Store.StringError String
"Unsupported HTTP method"

-- | Batch commands that have a large list of arguments:
--
-- > apiBatch 20 def (GetAddrsTxs addrs def)
apiBatch ::
  (Batchable a b, MonadIO m, MonadError Store.Except m) =>
  Natural ->
  ApiConfig ->
  a ->
  m b
apiBatch :: Natural -> ApiConfig -> a -> m b
apiBatch Natural
i ApiConfig
conf a
res = [b] -> b
forall a. Monoid a => [a] -> a
mconcat ([b] -> b) -> m [b] -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ApiConfig -> a -> m b
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m, MonadError Except m) =>
ApiConfig -> a -> m b
apiCall ApiConfig
conf) (Natural -> a -> [a]
forall a b. Batchable a b => Natural -> a -> [a]
resourceBatch Natural
i a
res)

class (ApiResource a b, Monoid b) => Batchable a b where
  resourceBatch :: Natural -> a -> [a]

instance Batchable GetBlocks (Store.SerialList Store.BlockData) where
  resourceBatch :: Natural -> GetBlocks -> [GetBlocks]
resourceBatch Natural
i (GetBlocks [BlockHash]
hs NoTx
t) =
    ([BlockHash] -> NoTx -> GetBlocks
`GetBlocks` NoTx
t) ([BlockHash] -> GetBlocks) -> [[BlockHash]] -> [GetBlocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [BlockHash] -> [[BlockHash]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [BlockHash]
hs

instance Batchable GetBlockHeights (Store.SerialList Store.BlockData) where
  resourceBatch :: Natural -> GetBlockHeights -> [GetBlockHeights]
resourceBatch Natural
i (GetBlockHeights (HeightsParam [Natural]
hs) NoTx
n) =
    (HeightsParam -> NoTx -> GetBlockHeights
`GetBlockHeights` NoTx
n)
      (HeightsParam -> GetBlockHeights)
-> [HeightsParam] -> [GetBlockHeights]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Natural] -> HeightsParam
HeightsParam ([Natural] -> HeightsParam) -> [[Natural]] -> [HeightsParam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [Natural] -> [[Natural]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [Natural]
hs)

instance Batchable GetTxs (Store.SerialList Store.Transaction) where
  resourceBatch :: Natural -> GetTxs -> [GetTxs]
resourceBatch Natural
i (GetTxs [TxHash]
ts) =
    [TxHash] -> GetTxs
GetTxs ([TxHash] -> GetTxs) -> [[TxHash]] -> [GetTxs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [TxHash] -> [[TxHash]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [TxHash]
ts

instance Batchable GetTxsRaw (Store.RawResultList Tx) where
  resourceBatch :: Natural -> GetTxsRaw -> [GetTxsRaw]
resourceBatch Natural
i (GetTxsRaw [TxHash]
ts) =
    [TxHash] -> GetTxsRaw
GetTxsRaw ([TxHash] -> GetTxsRaw) -> [[TxHash]] -> [GetTxsRaw]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [TxHash] -> [[TxHash]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [TxHash]
ts

instance Batchable GetAddrsTxs (Store.SerialList Store.TxRef) where
  resourceBatch :: Natural -> GetAddrsTxs -> [GetAddrsTxs]
resourceBatch Natural
i (GetAddrsTxs [Address]
as LimitsParam
l) =
    ([Address] -> LimitsParam -> GetAddrsTxs
`GetAddrsTxs` LimitsParam
l) ([Address] -> GetAddrsTxs) -> [[Address]] -> [GetAddrsTxs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [Address] -> [[Address]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [Address]
as

instance Batchable GetAddrsTxsFull (Store.SerialList Store.Transaction) where
  resourceBatch :: Natural -> GetAddrsTxsFull -> [GetAddrsTxsFull]
resourceBatch Natural
i (GetAddrsTxsFull [Address]
as LimitsParam
l) =
    ([Address] -> LimitsParam -> GetAddrsTxsFull
`GetAddrsTxsFull` LimitsParam
l) ([Address] -> GetAddrsTxsFull) -> [[Address]] -> [GetAddrsTxsFull]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [Address] -> [[Address]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [Address]
as

instance Batchable GetAddrsBalance (Store.SerialList Store.Balance) where
  resourceBatch :: Natural -> GetAddrsBalance -> [GetAddrsBalance]
resourceBatch Natural
i (GetAddrsBalance [Address]
as) =
    [Address] -> GetAddrsBalance
GetAddrsBalance ([Address] -> GetAddrsBalance) -> [[Address]] -> [GetAddrsBalance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [Address] -> [[Address]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [Address]
as

instance Batchable GetAddrsUnspent (Store.SerialList Store.Unspent) where
  resourceBatch :: Natural -> GetAddrsUnspent -> [GetAddrsUnspent]
resourceBatch Natural
i (GetAddrsUnspent [Address]
as LimitsParam
l) =
    ([Address] -> LimitsParam -> GetAddrsUnspent
`GetAddrsUnspent` LimitsParam
l) ([Address] -> GetAddrsUnspent) -> [[Address]] -> [GetAddrsUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> [Address] -> [[Address]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
i [Address]
as

------------------
-- API Internal --
------------------

toOptions ::
  ApiResource a b => Network -> a -> Either Store.Except (Endo HTTP.Options)
toOptions :: Network -> a -> Either Except (Endo Options)
toOptions Network
net a
res =
  [Endo Options] -> Endo Options
forall a. Monoid a => [a] -> a
mconcat ([Endo Options] -> Endo Options)
-> Either Except [Endo Options] -> Either Except (Endo Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParamBox -> Either Except (Endo Options))
-> [ParamBox] -> Either Except [Endo Options]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParamBox -> Either Except (Endo Options)
f (([ParamBox], [ParamBox]) -> [ParamBox]
forall a b. (a, b) -> b
snd (([ParamBox], [ParamBox]) -> [ParamBox])
-> ([ParamBox], [ParamBox]) -> [ParamBox]
forall a b. (a -> b) -> a -> b
$ a -> ([ParamBox], [ParamBox])
forall a b. ApiResource a b => a -> ([ParamBox], [ParamBox])
queryParams a
res)
  where
    f :: ParamBox -> Either Except (Endo Options)
f (ParamBox p
p) = Network -> p -> Either Except (Endo Options)
forall a. Param a => Network -> a -> Either Except (Endo Options)
toOption Network
net p
p

toOption :: Param a => Network -> a -> Either Store.Except (Endo HTTP.Options)
toOption :: Network -> a -> Either Except (Endo Options)
toOption Network
net a
a = do
  [Text]
res <- Except -> Maybe [Text] -> Either Except [Text]
forall b a. b -> Maybe a -> Either b a
maybeToEither (String -> Except
Store.UserError String
"Invalid Param") (Maybe [Text] -> Either Except [Text])
-> Maybe [Text] -> Either Except [Text]
forall a b. (a -> b) -> a -> b
$ Network -> a -> Maybe [Text]
forall a. Param a => Network -> a -> Maybe [Text]
encodeParam Network
net a
a
  Endo Options -> Either Except (Endo Options)
forall (m :: * -> *) a. Monad m => a -> m a
return (Endo Options -> Either Except (Endo Options))
-> Endo Options -> Either Except (Endo Options)
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Endo Options
applyOpt (a -> Text
forall p. Param p => p -> Text
paramLabel a
a) [Text]
res

applyOpt :: Text -> [Text] -> Endo HTTP.Options
applyOpt :: Text -> [Text] -> Endo Options
applyOpt Text
p [Text]
t = (Options -> Options) -> Endo Options
forall a. (a -> a) -> Endo a
Endo ((Options -> Options) -> Endo Options)
-> (Options -> Options) -> Endo Options
forall a b. (a -> b) -> a -> b
$ Text -> Lens' Options [Text]
HTTP.param Text
p (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
t]

getBinary ::
  Serial a =>
  Endo HTTP.Options ->
  String ->
  IO (Either Store.Except a)
getBinary :: Endo Options -> String -> IO (Either Except a)
getBinary Endo Options
opts String
url = do
  Either Except (Response ByteString)
resE <- IO (Response ByteString)
-> IO (Either Except (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
 -> IO (Either Except (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either Except (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
HTTP.getWith (Endo Options -> Options
binaryOpts Endo Options
opts) String
url
  Either Except a -> IO (Either Except a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except a -> IO (Either Except a))
-> Either Except a -> IO (Either Except a)
forall a b. (a -> b) -> a -> b
$ do
    Response ByteString
res <- Either Except (Response ByteString)
resE
    a -> Either Except a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either Except a)
-> (ByteString -> a) -> ByteString -> Either Except a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGetL Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Either Except a) -> ByteString -> Either Except a
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
HTTP.responseBody

postBinary ::
  (Serial a, Serial r) =>
  Endo HTTP.Options ->
  String ->
  a ->
  IO (Either Store.Except r)
postBinary :: Endo Options -> String -> a -> IO (Either Except r)
postBinary Endo Options
opts String
url a
body = do
  Either Except (Response ByteString)
resE <- IO (Response ByteString)
-> IO (Either Except (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
 -> IO (Either Except (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either Except (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Options -> String -> ByteString -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
HTTP.postWith (Endo Options -> Options
binaryOpts Endo Options
opts) String
url (Put -> ByteString
runPutL (a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
body))
  Either Except r -> IO (Either Except r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except r -> IO (Either Except r))
-> Either Except r -> IO (Either Except r)
forall a b. (a -> b) -> a -> b
$ do
    Response ByteString
res <- Either Except (Response ByteString)
resE
    r -> Either Except r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Either Except r)
-> (ByteString -> r) -> ByteString -> Either Except r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get r -> ByteString -> r
forall a. Get a -> ByteString -> a
runGetL Get r
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Either Except r) -> ByteString -> Either Except r
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
HTTP.responseBody

binaryOpts :: Endo HTTP.Options -> HTTP.Options
binaryOpts :: Endo Options -> Options
binaryOpts Endo Options
opts =
  Endo Options -> Options -> Options
forall a. Endo a -> a -> a
appEndo (Endo Options
opts Endo Options -> Endo Options -> Endo Options
forall a. Semigroup a => a -> a -> a
<> Endo Options
accept Endo Options -> Endo Options -> Endo Options
forall a. Semigroup a => a -> a -> a
<> Endo Options
stat) Options
HTTP.defaults
  where
    accept :: Endo Options
accept = (Options -> Options) -> Endo Options
forall a. (a -> a) -> Endo a
Endo ((Options -> Options) -> Endo Options)
-> (Options -> Options) -> Endo Options
forall a b. (a -> b) -> a -> b
$ HeaderName -> Lens' Options [ByteString]
HTTP.header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/octet-stream"]
    stat :: Endo Options
stat = (Options -> Options) -> Endo Options
forall a. (a -> a) -> Endo a
Endo ((Options -> Options) -> Endo Options)
-> (Options -> Options) -> Endo Options
forall a b. (a -> b) -> a -> b
$ (Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options
Lens' Options (Maybe ResponseChecker)
HTTP.checkResponse ((Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
 -> Options -> Identity Options)
-> ResponseChecker -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ResponseChecker
checkStatus

checkStatus :: ResponseChecker
checkStatus :: ResponseChecker
checkStatus Request
req Response BodyReader
res
  | Status -> Bool
statusIsSuccessful Status
status = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
isHealthPath Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
503 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Ignore health checks
  | Bool
otherwise = do
    Maybe Except
e <- ByteString -> Maybe Except
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict (ByteString -> Maybe Except) -> BodyReader -> IO (Maybe Except)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response BodyReader
res Response BodyReader
-> Getting BodyReader (Response BodyReader) BodyReader
-> BodyReader
forall s a. s -> Getting a s a -> a
^. Getting BodyReader (Response BodyReader) BodyReader
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
HTTP.responseBody
    Except -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Except -> IO ()) -> Except -> IO ()
forall a b. (a -> b) -> a -> b
$
      case Maybe Except
e of
        Just Except
except -> Except
except :: Store.Except
        Maybe Except
Nothing -> String -> Except
Store.StringError String
"could not decode error"
  where
    code :: Int
code = Response BodyReader
res Response BodyReader -> Getting Int (Response BodyReader) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Status -> Const Int Status)
-> Response BodyReader -> Const Int (Response BodyReader)
forall body. Lens' (Response body) Status
HTTP.responseStatus ((Status -> Const Int Status)
 -> Response BodyReader -> Const Int (Response BodyReader))
-> ((Int -> Const Int Int) -> Status -> Const Int Status)
-> Getting Int (Response BodyReader) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Status -> Const Int Status
Lens' Status Int
HTTP.statusCode
    message :: ByteString
message = Response BodyReader
res Response BodyReader
-> Getting ByteString (Response BodyReader) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. (Status -> Const ByteString Status)
-> Response BodyReader -> Const ByteString (Response BodyReader)
forall body. Lens' (Response body) Status
HTTP.responseStatus ((Status -> Const ByteString Status)
 -> Response BodyReader -> Const ByteString (Response BodyReader))
-> ((ByteString -> Const ByteString ByteString)
    -> Status -> Const ByteString Status)
-> Getting ByteString (Response BodyReader) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const ByteString ByteString)
-> Status -> Const ByteString Status
Lens' Status ByteString
HTTP.statusMessage
    status :: Status
status = Int -> ByteString -> Status
mkStatus Int
code ByteString
message
    isHealthPath :: Bool
isHealthPath = Text
"/health" Text -> Text -> Bool
`Text.isInfixOf` ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Request -> ByteString
path Request
req)

---------------
-- Utilities --
---------------

chunksOf :: Natural -> [a] -> [[a]]
chunksOf :: Natural -> [a] -> [[a]]
chunksOf Natural
n [a]
xs
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = []
  | Bool
otherwise =
    ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [[a]]) -> ([a], [a]) -> ([a], [[a]])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Natural -> [a] -> [[a]]
forall a. Natural -> [a] -> [[a]]
chunksOf Natural
n) (([a], [a]) -> ([a], [[a]])) -> ([a], [a]) -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) [a]
xs