-- | Client Types
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Blockfrost.Client.Types
  ( BlockfrostClient
  , BlockfrostError (..)
  , ClientConfig
  , runBlockfrost
  , apiClient
  , api0Client
  , commonClient
  , cardanoClient
  , ipfsClient
  , nutLinkClient
  , Project (..)
  , Paged (..)
  , SortOrder (..)
  , go
  , AsClientT
  , fromServant
  , tryError
  , def
  , BlockfrostClientT (..)
  , MonadBlockfrost (..)
  , runBlockfrostClientT
  , newClientConfig
  ) where

import Control.Monad.Except
import Control.Monad.Reader
import Data.Default

import Servant.API.Generic
import Servant.Client
import Servant.Client.Generic

import Blockfrost.API
import Blockfrost.Client.Core

type ClientConfig = (ClientEnv, Project)

newtype BlockfrostClientT m a = BlockfrostClientT {
  forall (m :: * -> *) a.
BlockfrostClientT m a
-> ExceptT BlockfrostError (ReaderT ClientConfig m) a
unBlockfrostClientT
    :: ExceptT BlockfrostError
        (ReaderT ClientConfig m) a
  } deriving
      ( forall a b. a -> BlockfrostClientT m b -> BlockfrostClientT m a
forall a b.
(a -> b) -> BlockfrostClientT m a -> BlockfrostClientT m b
forall (m :: * -> *) a b.
Functor m =>
a -> BlockfrostClientT m b -> BlockfrostClientT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BlockfrostClientT m a -> BlockfrostClientT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BlockfrostClientT m b -> BlockfrostClientT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> BlockfrostClientT m b -> BlockfrostClientT m a
fmap :: forall a b.
(a -> b) -> BlockfrostClientT m a -> BlockfrostClientT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BlockfrostClientT m a -> BlockfrostClientT m b
Functor
      , forall a. a -> BlockfrostClientT m a
forall a b.
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m a
forall a b.
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
forall a b.
BlockfrostClientT m (a -> b)
-> BlockfrostClientT m a -> BlockfrostClientT m b
forall a b c.
(a -> b -> c)
-> BlockfrostClientT m a
-> BlockfrostClientT m b
-> BlockfrostClientT m c
forall {m :: * -> *}. Monad m => Functor (BlockfrostClientT m)
forall (m :: * -> *) a. Monad m => a -> BlockfrostClientT m a
forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m a
forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m (a -> b)
-> BlockfrostClientT m a -> BlockfrostClientT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> BlockfrostClientT m a
-> BlockfrostClientT m b
-> BlockfrostClientT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m a
*> :: forall a b.
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> BlockfrostClientT m a
-> BlockfrostClientT m b
-> BlockfrostClientT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> BlockfrostClientT m a
-> BlockfrostClientT m b
-> BlockfrostClientT m c
<*> :: forall a b.
BlockfrostClientT m (a -> b)
-> BlockfrostClientT m a -> BlockfrostClientT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m (a -> b)
-> BlockfrostClientT m a -> BlockfrostClientT m b
pure :: forall a. a -> BlockfrostClientT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> BlockfrostClientT m a
Applicative
      , forall a. a -> BlockfrostClientT m a
forall a b.
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
forall a b.
BlockfrostClientT m a
-> (a -> BlockfrostClientT m b) -> BlockfrostClientT m b
forall (m :: * -> *). Monad m => Applicative (BlockfrostClientT m)
forall (m :: * -> *) a. Monad m => a -> BlockfrostClientT m a
forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> (a -> BlockfrostClientT m b) -> BlockfrostClientT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> BlockfrostClientT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> BlockfrostClientT m a
>> :: forall a b.
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> BlockfrostClientT m b -> BlockfrostClientT m b
>>= :: forall a b.
BlockfrostClientT m a
-> (a -> BlockfrostClientT m b) -> BlockfrostClientT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
BlockfrostClientT m a
-> (a -> BlockfrostClientT m b) -> BlockfrostClientT m b
Monad
      , forall a. IO a -> BlockfrostClientT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (BlockfrostClientT m)
forall (m :: * -> *) a. MonadIO m => IO a -> BlockfrostClientT m a
liftIO :: forall a. IO a -> BlockfrostClientT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> BlockfrostClientT m a
MonadIO
      , MonadReader ClientConfig
      , MonadError BlockfrostError
      )

type BlockfrostClient = BlockfrostClientT IO

class MonadIO m => MonadBlockfrost m where
  liftBlockfrostClient :: ClientM a -> m a
  getConf :: m ClientConfig

instance MonadIO m => MonadBlockfrost (BlockfrostClientT m) where
  liftBlockfrostClient :: forall a. ClientM a -> BlockfrostClientT m a
liftBlockfrostClient ClientM a
act = forall (m :: * -> *) a.
ExceptT BlockfrostError (ReaderT ClientConfig m) a
-> BlockfrostClientT m a
BlockfrostClientT forall a b. (a -> b) -> a -> b
$ do
    (ClientEnv
env, Project
_proj) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
act ClientEnv
env)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> BlockfrostError
fromServantClientError)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure
  getConf :: BlockfrostClientT m ClientConfig
getConf = forall (m :: * -> *) a.
ExceptT BlockfrostError (ReaderT ClientConfig m) a
-> BlockfrostClientT m a
BlockfrostClientT forall r (m :: * -> *). MonadReader r m => m r
ask

instance MonadBlockfrost ClientM where
  liftBlockfrostClient :: forall a. ClientM a -> ClientM a
liftBlockfrostClient = forall a. a -> a
id
  getConf :: ClientM ClientConfig
getConf = forall (m :: * -> *). MonadIO m => m ClientConfig
newClientConfig

instance MonadBlockfrost IO where
  liftBlockfrostClient :: forall a. ClientM a -> IO a
liftBlockfrostClient ClientM a
act =
    forall (m :: * -> *). MonadBlockfrost m => m ClientConfig
getConf
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ClientEnv
env, Project
_prj) ->
        forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
act ClientEnv
env
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure
  getConf :: IO ClientConfig
getConf = forall (m :: * -> *). MonadIO m => m ClientConfig
newClientConfig

apiClient
  :: MonadBlockfrost m
  => BlockfrostAPI (AsClientT m)
apiClient :: forall (m :: * -> *).
MonadBlockfrost m =>
BlockfrostAPI (AsClientT m)
apiClient = forall (routes :: * -> *) (m :: * -> *) (n :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT n),
 Client n (ToServantApi routes) ~ ToServant routes (AsClientT n)) =>
(forall x. m x -> n x) -> routes (AsClientT n)
genericClientHoist forall (m :: * -> *) a. MonadBlockfrost m => ClientM a -> m a
liftBlockfrostClient

api0Client
  :: MonadBlockfrost m
  => Project
  -> BlockfrostV0API (AsClientT m)
api0Client :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> BlockfrostV0API (AsClientT m)
api0Client = forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall route.
BlockfrostAPI route
-> route
   :- ("api"
       :> ("v0"
           :> (BlockfrostAuth
               :> (UserAgent :> ToServantApi BlockfrostV0API))))
_apiV0 forall (m :: * -> *).
MonadBlockfrost m =>
BlockfrostAPI (AsClientT m)
apiClient

-- ** Client runner

-- | Run @BlockfrostClientT@ monad in @IO@, using provided @Project@
runBlockfrost
  :: Project
  -> BlockfrostClientT IO a
  -> IO (Either BlockfrostError a)
runBlockfrost :: forall a.
Project -> BlockfrostClientT IO a -> IO (Either BlockfrostError a)
runBlockfrost = forall (m :: * -> *) a.
MonadIO m =>
Project -> BlockfrostClientT m a -> m (Either BlockfrostError a)
runBlockfrostClientT

-- | Run @BlockfrostClientT@, using provided @Project@
runBlockfrostClientT
  :: MonadIO m
  => Project
  -> BlockfrostClientT m a
  -> m (Either BlockfrostError a)
runBlockfrostClientT :: forall (m :: * -> *) a.
MonadIO m =>
Project -> BlockfrostClientT m a -> m (Either BlockfrostError a)
runBlockfrostClientT Project
proj BlockfrostClientT m a
act = do
  ClientEnv
env <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Project -> IO ClientEnv
newEnvByProject Project
proj
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ClientEnv
env, Project
proj)
    forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
BlockfrostClientT m a
-> ExceptT BlockfrostError (ReaderT ClientConfig m) a
unBlockfrostClientT BlockfrostClientT m a
act

-- | Build default `ClientConfig` using BLOCKFROST_TOKEN_PATH environment variable
newClientConfig
  :: MonadIO m
  => m ClientConfig
newClientConfig :: forall (m :: * -> *). MonadIO m => m ClientConfig
newClientConfig = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Project
prj <- IO Project
projectFromEnv
  ClientEnv
env <- Project -> IO ClientEnv
newEnvByProject Project
prj
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientEnv
env, Project
prj)

-- | Helper
go :: MonadBlockfrost m
   => (Project -> m a)
   -> m a
go :: forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go Project -> m a
act = forall (m :: * -> *). MonadBlockfrost m => m ClientConfig
getConf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Project -> m a
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

-- Until mtl > 2.2.2
-- https://github.com/haskell/mtl/pull/66
#if !MIN_VERSION_mtl(2,3,0)
-- | 'MonadError' analogue to the 'Control.Exception.try' function.
tryError :: MonadError e m => m a -> m (Either e a)
tryError :: forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
tryError m a
action = (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
#endif

-- ** Service clients

commonClient
  :: MonadBlockfrost m
  => Project
  -> CommonAPI (AsClientT m)
commonClient :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> CommonAPI (AsClientT m)
commonClient = forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall route.
BlockfrostV0API route -> route :- ToServantApi CommonAPI
_common forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> BlockfrostV0API (AsClientT m)
api0Client

cardanoClient
  :: MonadBlockfrost m
  => Project
  -> CardanoAPI (AsClientT m)
cardanoClient :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> CardanoAPI (AsClientT m)
cardanoClient = forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall route.
BlockfrostV0API route -> route :- ToServantApi CardanoAPI
_cardano forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> BlockfrostV0API (AsClientT m)
api0Client

ipfsClient
  :: MonadBlockfrost m
  => Project
  -> IPFSAPI (AsClientT m)
ipfsClient :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> IPFSAPI (AsClientT m)
ipfsClient = forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall route.
BlockfrostV0API route -> route :- ("ipfs" :> ToServantApi IPFSAPI)
_ipfs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> BlockfrostV0API (AsClientT m)
api0Client

nutLinkClient
  :: MonadBlockfrost m
  => Project
  -> NutLinkAPI (AsClientT m)
nutLinkClient :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> NutLinkAPI (AsClientT m)
nutLinkClient = forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall route.
BlockfrostV0API route
-> route
   :- ("nutlink" :> (Tag "Nut.link" :> ToServantApi NutLinkAPI))
_nutLink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> BlockfrostV0API (AsClientT m)
api0Client