blockfrost-client-core (empty) → 0.1.0.0
raw patch · 10 files changed
+376/−0 lines, 10 filesdep +aesondep +basedep +blockfrost-apisetup-changed
Dependencies added: aeson, base, blockfrost-api, bytestring, case-insensitive, containers, data-default, http-client, http-client-tls, http-types, servant, servant-client, servant-client-core, servant-multipart-api, servant-multipart-client, text
Files
- CHANGELOG.md +10/−0
- LICENSE +13/−0
- README.md +3/−0
- Setup.hs +2/−0
- blockfrost-client-core.cabal +64/−0
- src/Blockfrost/Client/Auth.hs +36/−0
- src/Blockfrost/Client/Core.hs +130/−0
- src/Blockfrost/Client/Pagination.hs +57/−0
- src/Blockfrost/Client/Sorting.hs +38/−0
- src/Blockfrost/Client/Tag.hs +23/−0
+ CHANGELOG.md view
@@ -0,0 +1,10 @@+# Version [0.1.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/initial...0.1.0.0) (2021-09-14)++* Initial release++---++`blockfrost-client-core` uses [PVP Versioning][1].++[1]: https://pvp.haskell.org+
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright 2021 blockfrost.io++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ README.md view
@@ -0,0 +1,3 @@+# blockfrost-client-core++Instances and helpers shared by all clients.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ blockfrost-client-core.cabal view
@@ -0,0 +1,64 @@+cabal-version: 2.2+name: blockfrost-client-core+version: 0.1.0.0+synopsis: blockfrost.io common client definitions / instances+description: HasClient for our auth+homepage: https://github.com/blockfrost/blockfrost-haskell+license: Apache-2.0+license-file: LICENSE+author: blockfrost.io+maintainer: srk@48.io+copyright: 2021 blockfrost.io+category: Web+build-type: Simple++extra-source-files:+ CHANGELOG.md+ LICENSE+ README.md++flag BuildFast+ Default: True+ Description: Turn off optimizations++flag Production+ Default: False+ Manual: True+ Description: Production build++common libstuff+ default-language: Haskell2010+ ghc-options: -Wall -Wunused-packages -fno-warn-orphans+ if flag(BuildFast)+ ghc-options: -O0+ if flag(Production)+ ghc-options: -Werror++library+ import: libstuff+ hs-source-dirs: src+ exposed-modules: Blockfrost.Client.Core+ , Blockfrost.Client.Auth+ , Blockfrost.Client.Pagination+ , Blockfrost.Client.Sorting+ , Blockfrost.Client.Tag+ build-depends: base >= 4.7 && < 5+ , blockfrost-api+ , aeson+ , bytestring+ , case-insensitive+ , containers+ , data-default+ , http-client+ , http-client-tls+ , http-types+ , servant ^>= 0.18+ , servant-client+ , servant-client-core+ , servant-multipart-api+ , servant-multipart-client+ , text++source-repository head+ type: git+ location: https://github.com/blockfrost/blockfrost-haskell
+ src/Blockfrost/Client/Auth.hs view
@@ -0,0 +1,36 @@+-- | Blockfrost authentication scheme instance for HasClient++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Blockfrost.Client.Auth+ ( Project+ ) where++import Blockfrost.Auth+import Data.CaseInsensitive (mk)+import Data.Proxy (Proxy (..))+import Data.Sequence ((<|))+import GHC.TypeLits+import Servant.API ((:>))+import Servant.Client.Core (Client, HasClient (..), requestHeaders)++import qualified Data.ByteString.Char8+import qualified Data.Text.Encoding++instance {-# OVERLAPS #-} (HasClient m api, KnownSymbol sym) => HasClient m (ProjectAuth '[APIKeyInHeader sym] a :> api) where+ type Client m (ProjectAuth '[APIKeyInHeader sym] a :> api) = Project -> Client m api++ clientWithRoute m _ req proj+ = clientWithRoute m (Proxy :: Proxy api)+ $ req { requestHeaders = (headerName, headerVal) <| requestHeaders req }+ where+ headerVal = Data.Text.Encoding.encodeUtf8 $ projectId proj+ headerName = mk $ Data.ByteString.Char8.pack $ symbolVal (Proxy @sym)++ hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl
+ src/Blockfrost/Client/Core.hs view
@@ -0,0 +1,130 @@+-- | Core shared by clients+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Blockfrost.Client.Core+ ( BlockfrostError (..)+ , Paged (..)+ , SortOrder (..)+ , asc+ , def+ , desc+ , fromServantClientError+ , newEnvByProject+ , page+ , paged+ , allPages+ , projectFromEnv+ , projectFromEnv'+ , projectFromFile+ ) where++import Blockfrost.API (Form (..))+import Blockfrost.Auth+import Blockfrost.Client.Auth ()+import Blockfrost.Client.Pagination+import Blockfrost.Client.Sorting+import Blockfrost.Client.Tag ()+import Blockfrost.Types.ApiError+import Data.Aeson (eitherDecode)+import Data.Default (Default (def))+import Data.Text (Text)+import qualified Data.Text.IO+import qualified Network.HTTP.Client+import qualified Network.HTTP.Client.TLS+import Network.HTTP.Types+import Servant.Client+import Servant.Multipart.API+import Servant.Multipart.Client ()+import qualified System.Environment++domain :: String+domain = "blockfrost.io"++newEnvByProject :: Project -> IO ClientEnv+newEnvByProject prj = do+ conman <- Network.HTTP.Client.newManager Network.HTTP.Client.TLS.tlsManagerSettings+ pure $ mkClientEnv conman (baseUrlByEnv $ projectEnv prj)++buildUrl :: String -> BaseUrl+buildUrl subdomain =+ BaseUrl+ Https+ (subdomain <> "." <> domain)+ 443+ mempty++baseUrlByEnv :: Env -> BaseUrl+baseUrlByEnv Localhost = BaseUrl Http "localhost" 8000 ""+baseUrlByEnv e = maybe (error "absurd") buildUrl (subdomainByEnv e)++subdomainByEnv :: Env -> Maybe String+subdomainByEnv Alonzo = pure "cardano-alonzo"+subdomainByEnv Ipfs = pure "ipfs"+subdomainByEnv Mainnet = pure "cardano-mainnet"+subdomainByEnv Testnet = pure "cardano-testnet"+subdomainByEnv Localhost = Nothing++-- | Read file according to BLOCKFROST_TOKEN_PATH environment variable name.+projectFromEnv :: IO Project+projectFromEnv = projectFromEnv' "BLOCKFROST_TOKEN_PATH"++-- | Read file according to environment variable name.+projectFromEnv' :: String -> IO Project+projectFromEnv' envVarName = do+ tokPath <- System.Environment.getEnv envVarName+ projectFromFile tokPath++-- | Read file with token and turn it into @Project@+-- Expects tokens prefixed with environment, e.g.+-- @testnetA3C2E...@+projectFromFile :: FilePath -> IO Project+projectFromFile f = mkProject <$> Data.Text.IO.readFile f++data BlockfrostError =+ BlockfrostError Text+ | BlockfrostBadRequest Text -- 400+ | BlockfrostTokenMissing Text -- 403+ | BlockfrostNotFound -- 404+ | BlockfrostIPBanned -- 418+ | BlockfrostUsageLimitReached -- 429+ | BlockfrostFatal Text -- 500+ | ServantClientError ClientError+ deriving (Eq, Show)++fromServantClientError :: ClientError -> BlockfrostError+fromServantClientError e = case e of+ FailureResponse _bUrl (Response s _ _ body)+ | s == status400 ->+ BlockfrostBadRequest (withMessage body)+ | s == status403 ->+ BlockfrostTokenMissing (withMessage body)+ | s == status404 ->+ BlockfrostNotFound+ | s == status418 ->+ BlockfrostIPBanned+ | s == status429 ->+ BlockfrostUsageLimitReached+ | s == status500 ->+ BlockfrostFatal (withMessage body)+ | otherwise ->+ BlockfrostError (withMessage body)+ _ -> ServantClientError e+ where+ withMessage body =+ case eitherDecode body of+ (Right (ae :: ApiError)) -> apiErrorMessage ae+ _ -> mempty++instance ToMultipart Tmp Form where+ toMultipart (Form fileName filePath) =+ MultipartData+ mempty -- no text fields+ [ FileData "file"+ fileName+ "application/octet-stream"+ filePath+ ]
+ src/Blockfrost/Client/Pagination.hs view
@@ -0,0 +1,57 @@+-- | Pagination instance for HasClient++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Blockfrost.Client.Pagination+ ( Paged (..)+ , page+ , paged+ , nextPage+ , allPages+ ) where++import Data.Default (Default (def))+import Data.Proxy (Proxy (..))+import Servant.API ((:>))+import Servant.Client.Core (Client, HasClient (..))++import Blockfrost.Util.Pagination+ ( Paged (..)+ , Pagination+ , PaginationExpanded+ , page+ , paged+ , maxPageSize+ , nextPage+ )++-- | Query all results, until we get less than maximum+-- items per page.+allPages :: Monad m => (Paged -> m [a]) -> m [a]+allPages act = do+ let fetch page' = do+ res <- act page'+ case res of+ xs | length xs < maxPageSize -> pure xs+ xs -> do+ next <- fetch (nextPage page')+ pure $ next ++ xs+ fetch def++instance HasClient m subApi => HasClient m (Pagination :> subApi) where+ type Client m (Pagination :> subApi) = Paged -> Client m subApi+ clientWithRoute pm _ req paged' =+ clientWithRoute+ pm+ (Proxy @(PaginationExpanded subApi))+ req+ (Just $ countPerPage paged')+ (Just $ pageNumber paged')++ hoistClientMonad pm _ hst subCli = hoistClientMonad pm (Proxy @subApi) hst . subCli
+ src/Blockfrost/Client/Sorting.hs view
@@ -0,0 +1,38 @@+-- | Sorting instance for HasClient++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Blockfrost.Client.Sorting+ ( SortOrder (..)+ , asc+ , desc+ ) where++import Data.Proxy (Proxy (..))+import Servant.API ((:>))+import Servant.Client.Core (Client, HasClient (..))++import Blockfrost.Util.Sorting+ ( SortOrder (..)+ , Sorting+ , SortingExpanded+ , asc+ , desc+ )++instance HasClient m subApi => HasClient m (Sorting :> subApi) where+ type Client m (Sorting :> subApi) = SortOrder -> Client m subApi+ clientWithRoute pm _ req sOrder =+ clientWithRoute+ pm+ (Proxy @(SortingExpanded subApi))+ req+ (Just sOrder)++ hoistClientMonad pm _ hst subCli = hoistClientMonad pm (Proxy @subApi) hst . subCli
+ src/Blockfrost/Client/Tag.hs view
@@ -0,0 +1,23 @@+-- | Tag instance for HasClient++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Blockfrost.Client.Tag+ where++import Data.Proxy (Proxy (..))+import Servant.API ((:>))+import Servant.Client.Core (Client, HasClient (..))++import Blockfrost.Util.Tag (Tag)++instance HasClient m subApi => HasClient m (Tag name :> subApi) where+ type Client m (Tag name :> subApi) = Client m subApi+ clientWithRoute pm _ = clientWithRoute pm (Proxy @subApi)+ hoistClientMonad pm _ hst = hoistClientMonad pm (Proxy @subApi) hst