packages feed

api-maker (empty) → 0.1.0.0

raw patch · 11 files changed

+468/−0 lines, 11 filesdep +aesondep +api-makerdep +basesetup-changed

Dependencies added: aeson, api-maker, base, bytestring, containers, http-client, http-client-tls, http-types, lens, monad-control, mtl, req, text, transformers, transformers-base

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for borl-trader++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Manuel Schneckenreither (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Manuel Schneckenreither nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,63 @@+# Api Maker: Implementing APIs like never before++Api Maker let's you implement APIs simply by implementing the `class Request` for each possible+request. It is built on top of the [Req](https://hackage.haskell.org/package/req) library.++Lets say we want to implement a `GET` request that returns orders taken in an account. This actually+implements the [GET orders request of+oanda.com](https://developer.oanda.com/rest-live-v20/order-ep/). So we create a data type structure+to hold what we want:++    -- | GET Order(s) request+    data GetOrder =+      GetOrder AccountId OrderConfig++    -- | This data type defines the header options that we can send+    data OrderConfig = OrderConfig+      { ids        :: Maybe [OrderId]           -- ^ List of Order IDs to retrieve+      , state      :: Maybe OrderStateFilter    -- ^ The state to filter the requested Orders by [default=PENDING]+      , instrument :: Maybe InstrumentName      -- ^ The instrument to filter the requested orders by+      , orderCount :: Maybe Int                 -- ^ The maximum number of Orders to return [default=50, maximum=500]+      , beforeID   :: Maybe OrderId             -- ^ The maximum Order ID to return. If not provided the most recent Orders in the Account are returned+      } deriving (Show, Eq, Ord, ToJSON, Generic, NFData)+++and then we implement the class++    instance Request OandaConfig GetOrder where+      type Method GetOrder = GET                        -- It's a GET request+      type Body GetOrder = NoReqBody                    -- We do not send a body+      type Response GetOrder = JsonResponse OrderList   -- The response is a JSON list of orders+      type Output GetOrder = OrderList                  -- We simply output the list in the `process` function without transformation+      method _ GetOrder {} = GET                        -- GET request again+      url cfg (GetOrder accId _) = ".../account/orders" -- The URL+      body _ (GetOrder _ req) = NoReqBody               -- No Body to send+      response _ GetOrder {} = jsonResponse             -- The expected response is in JSON format and is parsed using `aeson` with this function.+      option _ (GetOrder _ cfg) =                       -- What header options to send+        headerRFC3339DatetimeFormat <> configs+          where+            configs =+              case cfg of+                OrderConfig ids state instrument count beforeID ->+                  "ids"        `queryParam` fmap (T.intercalate ";") ids <>+                  "state"      `queryParam` fmap show state <>+                  "instrument" `queryParam` instrument <>+                  "count"      `queryParam` count <>+                  "beforeID"   `queryParam` beforeID++      -- Defines how to process the Response. One might change it here, e.g. filter values that cannot be specified by the request options.+      process _ GetOrder {} response = return $ responseBody response++The request `State` monad is then run like this:++    runSessReqM cfg $ runRequests $ do+      orders <- mkReq $ GetOrder myAccountId (OrderConfig Nothing Nothing (Just "USD/EUR") (Just 100) Nothing)+      print orders++This will create the session and run the requests. All `HttpException`s errors are caught and+converted to exceptions. Thus `runSessReqM` returns a `Either HttpException a`. The function `mkReq`+is used to actually make the requests, the data-type `GetOrder` defines what request to make and+uses the corresponding account ID and the configuration provided. The result is a list of Orders,+with type `OrderList`.++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ api-maker.cabal view
@@ -0,0 +1,88 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6a6fa3f0f379eade6020b6c856c601ee0501ed76dedb9ef47f70a2a62406e38c++name:           api-maker+version:        0.1.0.0+synopsis:       Package to make APIs+description:    Please see the README on GitHub at <https://github.com/schnecki/api-maker#readme>+category:       Web+homepage:       https://github.com/schnecki/api-maker#readme+bug-reports:    https://github.com/schnecki/api-maker/issues+author:         Manuel Schneckenreither+maintainer:     manuel.schneckenreither@uibk.ac.at+copyright:      2019 Manuel Schneckenreither+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/schnecki/api-maker++library+  exposed-modules:+      ApiMaker+      Network.HTTP.ApiMaker.Class+      Network.HTTP.ApiMaker.HeaderContent+      Network.HTTP.ApiMaker.Ops+      Network.HTTP.ApiMaker.SessionState+  other-modules:+      Paths_api_maker+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fwarn-tabs -fno-warn-name-shadowing -O2 -funbox-strict-fields+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , containers+    , http-client+    , http-client-tls+    , http-types+    , lens+    , monad-control+    , mtl+    , req+    , text+    , transformers+    , transformers-base+  if impl(ghc < 8.0)+    ghc-options: -fno-warn-incomplete-patterns+    cpp-options: -DType=*+  if impl(ghc >= 8.6)+    default-extensions: NoStarIsType+  default-language: Haskell2010++test-suite api-maker-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_api_maker+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , api-maker+    , base >=4.7 && <5+    , bytestring+    , containers+    , http-client+    , http-client-tls+    , http-types+    , lens+    , monad-control+    , mtl+    , req+    , text+    , transformers+    , transformers-base+  default-language: Haskell2010
+ src/ApiMaker.hs view
@@ -0,0 +1,11 @@+module ApiMaker+    ( module R+    ) where++import           Network.HTTP.ApiMaker.Class         as R+import           Network.HTTP.ApiMaker.Ops           as R++import           Network.HTTP.ApiMaker.HeaderContent as R++import           Network.HTTP.Req                    as R+
+ src/Network/HTTP/ApiMaker/Class.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE UndecidableSuperClasses    #-}+module Network.HTTP.ApiMaker.Class+  ( Request(..)+  , Config (..)+  , SessionState (..)+  , Session(..)+  , emptySession+  , runSafeReqM+  , askConfig+  , askApiConfig+  , SafeReqSt+  , SafeReq+  , SafeReqM (..)+  ) where++import           Control.Monad.Base+import           Control.Monad.Except+import           Control.Monad.Trans.Reader+import           Control.Monad.Trans.State+import           Data.Kind                          (Type)+import           Data.Proxy+import           Network.HTTP.Req++import           Network.HTTP.ApiMaker.SessionState+++-- | Class definition for a 'Request'. Every request should implement this, the rest is then handled by the library. See 'Network.HTTP.ApiMaker.Ops.mkReq' to create a request, the functions+--  'Network.HTTP.ApiMaker.Ops.mkReqM' and 'Network.HTTP.ApiMaker.Ops.runRequests' to build a 'SafeReqM' monad that shares the same state, session and configuration, and finally+--  'Network.HTTP.ApiMaker.Ops.runReqM', 'Network.HTTP.ApiMaker.Ops.runSessReqM', 'Network.HTTP.ApiMaker.Ops.runReqWithParamsM' and 'Network.HTTP.ApiMaker.Ops.runSessReqWithParamsM' to run the monad.+class (HttpMethod (Method r), HttpBody (Body r), HttpResponse (Response r), HttpBodyAllowed (AllowsBody (Method r)) (ProvidesBody (Body r))) =>+      Request cfg r+  where+  type Method r :: Type+  type Body r :: Type+  type Response r :: Type+  type Output r :: Type+  -- type Protocol r :: Scheme+  method   :: cfg -> r -> Method r+  url      :: cfg -> r -> Url 'Https -- (Protocol r)+  body     :: cfg -> r -> Body r+  response :: cfg -> r -> Proxy (Response r)+  option   :: cfg -> r -> Option 'Https -- (Protocol r)+  process  :: (MonadHttp m, SessionState st) => cfg -> r -> Response r -> StateT st m (Output r)+++-- Type safe request++-- | Configuration that is passed from request to request to hold the session and default https header options. It also holds a user defined configuration.+data Config cfg = Config+  { httpConfig           :: HttpConfig+  , apiDefaultParameters :: [Option 'Https]+  , apiConfig            :: cfg+  }++type SafeReqSt sessionState cfg a = StateT sessionState (SafeReqM cfg) a+type SafeReq cfg a = SafeReqSt Session cfg a++-- | Safe request, e.g. all errors are caught and tured into exceptions.+newtype SafeReqM cfg a =+  SafeReqM (ExceptT HttpException (ReaderT (Config cfg) IO) a)+  deriving (Functor, Applicative, Monad, MonadIO)++askConfig :: SafeReqM cfg (Config cfg)+askConfig = SafeReqM (lift ask)++askApiConfig :: SafeReqM cfg cfg+askApiConfig = apiConfig <$> SafeReqM (lift ask)++instance MonadBase IO (SafeReqM cfg) where+  liftBase = liftIO++instance MonadHttp (SafeReqM cfg) where+  handleHttpException = SafeReqM . throwError+  getHttpConfig = httpConfig <$> SafeReqM (lift ask)++-- | Safely run the request monad.+runSafeReqM ::+     MonadIO m+  => Config cfg                 -- ^ Config including 'HttpConfig' to use+  -> SafeReqM cfg a             -- ^ Computation to run+  -> m (Either HttpException a)+runSafeReqM config (SafeReqM m) = liftIO (runReaderT (runExceptT m) config)++
+ src/Network/HTTP/ApiMaker/HeaderContent.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE UndecidableSuperClasses    #-}+module Network.HTTP.ApiMaker.HeaderContent+  ( headerContentTypeJson+  , headerContentTypeMultipart+  , headerContentDispositionFile+  ) where++import qualified Data.Text          as T+import qualified Data.Text.Encoding as E+import           Network.HTTP.Req+++-- | Option for specifying `application/json`.+headerContentTypeJson :: Option scheme+headerContentTypeJson = header "content-type" "application/json"++-- | Option for specifying `multipart/form-data`.+headerContentTypeMultipart :: Option scheme+headerContentTypeMultipart = header "content-type" "multipart/form-data"++-- | Option for specifying a file.+headerContentDispositionFile :: T.Text -> Option scheme+headerContentDispositionFile filename = header "Content-Disposition" (E.encodeUtf8 $ T.concat ["attachment; filename=\"", filename, "\""])++
+ src/Network/HTTP/ApiMaker/Ops.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.ApiMaker.Ops+  ( mkReq+  , runRequests+  , runStRequests+  , runReqM+  , runReqWithParamsM+  , runSessReqM+  , runSessReqWithParamsM+  ) where++import           Control.Lens+import           Control.Monad.Except+import           Control.Monad.Trans.State+import qualified Data.ByteString.Char8       as B+import           Data.List                   (find)+import qualified Network.HTTP.Client         as C+import           Network.HTTP.Req++import           Network.HTTP.ApiMaker.Class+++-- | Prepare to run requests.+runReqM :: (MonadIO m) => SafeReqM () a -> m (Either HttpException a)+runReqM = runSafeReqM (Config defaultHttpConfig [] ())++-- | Prepare to run requests with addional header options.+runReqWithParamsM :: (MonadIO m) => [Option 'Https] -> SafeReqM () a -> m (Either HttpException a)+runReqWithParamsM params = runSafeReqM (Config defaultHttpConfig params ())++-- | Prepare to run request with config.+runSessReqM :: (MonadIO m) => cfg -> SafeReqM cfg a -> m (Either HttpException a)+runSessReqM cfg = runSafeReqM (Config defaultHttpConfig [] cfg)++-- | Prepare to run request with config and additional header options.+runSessReqWithParamsM :: (MonadIO m) => [Option 'Https] -> cfg -> SafeReqM cfg a -> m (Either HttpException a)+runSessReqWithParamsM params cfg = runSafeReqM (Config defaultHttpConfig params cfg)+++-- | Run a normal session based request state monad.+runRequests :: StateT Session (SafeReqM cfg) a -> SafeReqM cfg a+runRequests = flip evalStateT (Session Nothing Nothing Nothing)+++-- | Run a user defined session request state monad.+runStRequests :: st -> StateT st (SafeReqM cfg) a -> SafeReqM cfg a+runStRequests = flip evalStateT+++-- | Call a single request. See 'runRequest' and 'runStRequests' to build and execute a set of requests that share the+-- same state, session and configuration.+mkReq :: (Request cfg request, SessionState st) => request -> SafeReqSt st cfg (Output request)+mkReq r = do+  session <- get+  cfg <- lift askConfig+  apiCfg <- lift askApiConfig++  let ops = option apiCfg r <> mkSessionOps session <> mconcat (apiDefaultParameters cfg)+  -- liftIO $ putStrLn $ "Running a request to " <> show (url r)+  resp <- lift $ req (method apiCfg r) (url apiCfg r) (body apiCfg r) (response apiCfg r) ops+  updateSession r resp+  process apiCfg r resp+  where+    mkSessionOps session =+      maybe mempty cookieJar (session ^. cookieJarData) <> header "Cookie" (B.intercalate ";" (mkSessionCookie session ++ mkCsrfCookie session)) <> mkCsrfHeader session++updateSession :: (Request cfg request, SessionState st) => request -> Response request -> SafeReqSt st cfg ()+updateSession _ resp =+  let cookies = C.destroyCookieJar $ responseCookieJar resp+      sessData = C.cookie_value <$> find ((== "_SESSION") . C.cookie_name) cookies+   in sessionData .= sessData >> cookieJarData ?= responseCookieJar resp+++-- Note: Server does not check/receive cookie!+mkSessionCookie :: (SessionState st) => st -> [B.ByteString]+mkSessionCookie st =+  case st ^. sessionData of+    Nothing   -> mempty+    Just sess -> ["_SESSION=" <> sess]++mkCsrfCookie :: (SessionState st) => st -> [B.ByteString]+mkCsrfCookie st =+  case st ^. csrfToken of+    Nothing   -> mempty+    Just csrf -> ["XSRF-TOKEN=" <> csrf]++mkCsrfHeader :: (SessionState st) => st -> Option scheme+mkCsrfHeader st =+  case st ^. csrfToken of+    Nothing   -> mempty+    Just csrf -> header "X-XSRF-TOKEN" csrf
+ src/Network/HTTP/ApiMaker/SessionState.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE CPP                     #-}+{-# LANGUAGE DataKinds               #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE UndecidableInstances    #-}+{-# LANGUAGE UndecidableSuperClasses #-}+module Network.HTTP.ApiMaker.SessionState+  ( SessionState(..)+  , Session(..)+  , emptySession+  ) where++import           Control.Lens+import qualified Data.ByteString.Char8 as B+import qualified Network.HTTP.Client   as C++-- | Session state contract.+class SessionState st where+  csrfToken :: Lens' st (Maybe B.ByteString)+  sessionData :: Lens' st (Maybe B.ByteString)+  cookieJarData :: Lens' st (Maybe C.CookieJar)+++-- | Simple session state. This probably is sufficient for the day-to-day use.+data Session = Session+   --  { unSession :: C.CookieJar }   -- TODO: Does not work? Bug in req library?+  { sessCsrfToken     :: Maybe B.ByteString+  , sessSessionData   :: Maybe B.ByteString+  , sessCookieJarData :: Maybe C.CookieJar+  } deriving (Show)++-- | Simple session state implemention.+instance SessionState Session where+  csrfToken = lens sessCsrfToken (\sess c' -> sess {sessCsrfToken = c'})+  sessionData = lens sessSessionData (\sess d' -> sess {sessSessionData = d'})+  cookieJarData = lens sessCookieJarData (\sess d' -> sess {sessCookieJarData = d'})+++-- | Empty session state.+emptySession :: Session+emptySession = Session Nothing Nothing Nothing+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"