{-# 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(..)
-- 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           Data.Default              (Default, def)
import           Data.Monoid               (Endo (..), appEndo)
import qualified Data.Serialize            as S
import           Data.String.Conversions   (cs)
import           Data.Text                 (Text)
import qualified Data.Text                 as Text
import           Haskoin.Constants
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 = $WApiConfig :: Network -> String -> ApiConfig
ApiConfig
          { configNetwork :: Network
configNetwork = Network
bch
          , configHost :: String
configHost = "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 net :: Network
net apiHost :: String
apiHost) res :: 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
        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.
Serialize a =>
Endo Options -> String -> IO (Either Except a)
getBinary Endo Options
args String
url)
        POST ->
            case a -> Maybe PostBox
forall a b. ApiResource a b => a -> Maybe PostBox
resourceBody a
res of
                Just (PostBox val :: 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.
(Serialize a, Serialize r) =>
Endo Options -> String -> a -> IO (Either Except r)
postBinary Endo Options
args String
url s
val)
                _ -> 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 "Could not post resource"
        _ -> 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 "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 i :: Natural
i conf :: ApiConfig
conf res :: 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.BlockData] where
    resourceBatch :: Natural -> GetBlocks -> [GetBlocks]
resourceBatch i :: Natural
i (GetBlocks hs :: [BlockHash]
hs t :: 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.BlockData] where
    resourceBatch :: Natural -> GetBlockHeights -> [GetBlockHeights]
resourceBatch i :: Natural
i (GetBlockHeights (HeightsParam hs :: [Natural]
hs) n :: 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.Transaction] where
    resourceBatch :: Natural -> GetTxs -> [GetTxs]
resourceBatch i :: Natural
i (GetTxs ts :: [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 i :: Natural
i (GetTxsRaw ts :: [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.TxRef] where
    resourceBatch :: Natural -> GetAddrsTxs -> [GetAddrsTxs]
resourceBatch i :: Natural
i (GetAddrsTxs as :: [Address]
as l :: 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.Transaction] where
    resourceBatch :: Natural -> GetAddrsTxsFull -> [GetAddrsTxsFull]
resourceBatch i :: Natural
i (GetAddrsTxsFull as :: [Address]
as l :: 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.Balance] where
    resourceBatch :: Natural -> GetAddrsBalance -> [GetAddrsBalance]
resourceBatch i :: Natural
i (GetAddrsBalance as :: [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.Unspent] where
    resourceBatch :: Natural -> GetAddrsUnspent -> [GetAddrsUnspent]
resourceBatch i :: Natural
i (GetAddrsUnspent as :: [Address]
as l :: 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 net :: Network
net res :: 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
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 net :: Network
net a :: 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 "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 p :: Text
p t :: [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]
t]

getBinary ::
       S.Serialize a
    => Endo HTTP.Options
    -> String
    -> IO (Either Store.Except a)
getBinary :: Endo Options -> String -> IO (Either Except a)
getBinary opts :: Endo Options
opts url :: 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
        Either String a -> Either Except a
forall a. Either String a -> Either Except a
toExcept (Either String a -> Either Except a)
-> Either String a -> Either Except a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
S.decodeLazy (ByteString -> Either String a) -> ByteString -> Either String 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 ::
       (S.Serialize a, S.Serialize r)
    => Endo HTTP.Options
    -> String
    -> a
    -> IO (Either Store.Except r)
postBinary :: Endo Options -> String -> a -> IO (Either Except r)
postBinary opts :: Endo Options
opts url :: String
url body :: 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 (a -> ByteString
forall a. Serialize a => a -> ByteString
S.encode 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
        Either String r -> Either Except r
forall a. Either String a -> Either Except a
toExcept (Either String r -> Either Except r)
-> Either String r -> Either Except r
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String r
forall a. Serialize a => ByteString -> Either String a
S.decodeLazy (ByteString -> Either String r) -> ByteString -> Either String 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 opts :: 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 "Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ["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 req :: Request
req res :: 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
== 503 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Ignore health checks
    | Bool
otherwise = do
        Either String Except
e <- ByteString -> Either String Except
forall a. Serialize a => ByteString -> Either String a
S.decode (ByteString -> Either String Except)
-> BodyReader -> IO (Either String 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 Either String Except
e of
                Right except :: Except
except -> Except
except :: Store.Except
                _ -> String -> Except
Store.StringError String
err
  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
    err :: String
err = [String] -> String
unwords ["Code:", Int -> String
forall a. Show a => a -> String
show Int
code, "Message:", ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
message]
    isHealthPath :: Bool
isHealthPath = "/health" Text -> Text -> Bool
`Text.isInfixOf` ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Request -> ByteString
path Request
req)

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

toExcept :: Either String a -> Either Store.Except a
toExcept :: Either String a -> Either Except a
toExcept (Right a :: a
a)  = a -> Either Except a
forall a b. b -> Either a b
Right a
a
toExcept (Left err :: String
err) = Except -> Either Except a
forall a b. a -> Either a b
Left (Except -> Either Except a) -> Except -> Either Except a
forall a b. (a -> b) -> a -> b
$ String -> Except
Store.UserError String
err

chunksOf :: Natural -> [a] -> [[a]]
chunksOf :: Natural -> [a] -> [[a]]
chunksOf n :: Natural
n xs :: [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