|
| 1 | +{-# LANGUAGE DataKinds #-} |
| 2 | +{-# LANGUAGE TypeApplications #-} |
| 3 | +{-# LANGUAGE TypeOperators #-} |
| 4 | + |
| 5 | +-- | |
| 6 | +-- Copyright: © 2018-2020 IOHK |
| 7 | +-- License: Apache-2.0 |
| 8 | +-- |
| 9 | +-- API and corresponding client for dealing with a metadata aggregation server |
| 10 | +-- in Shelley. Such servers follow an OpenAPI specification, and on existing |
| 11 | +-- implementation written in Haskell is available at: |
| 12 | +-- |
| 13 | +-- - https://github.com/input-output-hk/smash |
| 14 | +-- |
| 15 | +module Cardano.Pool.Metadata |
| 16 | + ( Api |
| 17 | + , Client(..) |
| 18 | + , mkClient |
| 19 | + |
| 20 | + -- * Re-export |
| 21 | + , BaseUrl (..) |
| 22 | + , Scheme (..) |
| 23 | + , Manager |
| 24 | + , defaultManagerSettings |
| 25 | + , newManager |
| 26 | + ) where |
| 27 | + |
| 28 | +import Prelude |
| 29 | + |
| 30 | +import Cardano.Wallet.Api.Types |
| 31 | + ( ApiT (..) ) |
| 32 | +import Cardano.Wallet.Primitive.Types |
| 33 | + ( PoolId, StakePoolOffChainMetadata (..) ) |
| 34 | +import Data.Proxy |
| 35 | + ( Proxy (..) ) |
| 36 | +import Network.HTTP.Client |
| 37 | + ( Manager, defaultManagerSettings, newManager ) |
| 38 | +import Servant |
| 39 | + ( (:>), Capture, Get, JSON ) |
| 40 | +import Servant.Client |
| 41 | + ( BaseUrl (..) |
| 42 | + , ClientError (..) |
| 43 | + , ClientM |
| 44 | + , Scheme (..) |
| 45 | + , client |
| 46 | + , mkClientEnv |
| 47 | + , runClientM |
| 48 | + ) |
| 49 | + |
| 50 | +-- |
| 51 | +-- Api |
| 52 | +-- |
| 53 | + |
| 54 | +type Api |
| 55 | + = "api" |
| 56 | + :> "v1" |
| 57 | + :> "metadata" |
| 58 | + :> Capture "hash" (ApiT PoolId) |
| 59 | + :> Get '[JSON] (ApiT StakePoolOffChainMetadata) |
| 60 | + |
| 61 | +-- |
| 62 | +-- Client |
| 63 | +-- |
| 64 | + |
| 65 | +-- | A client for fetching metadata from an Aggregation server. |
| 66 | +-- |
| 67 | +-- See also 'newClient' to construct a client. |
| 68 | +newtype Client api = Client |
| 69 | + { getStakePoolMetadata |
| 70 | + :: PoolId |
| 71 | + -> IO (Either ClientError StakePoolOffChainMetadata) |
| 72 | + } |
| 73 | + |
| 74 | +mkClient |
| 75 | + :: Manager |
| 76 | + -> BaseUrl |
| 77 | + -> Client Api |
| 78 | +mkClient mgr baseUrl = Client |
| 79 | + { getStakePoolMetadata = \pid -> |
| 80 | + fmap getApiT <$> run (getMetadata (ApiT pid)) |
| 81 | + } |
| 82 | + where |
| 83 | + run :: ClientM a -> IO (Either ClientError a) |
| 84 | + run query = runClientM query (mkClientEnv mgr baseUrl) |
| 85 | + |
| 86 | + getMetadata = |
| 87 | + client (Proxy @Api) |
0 commit comments