packages feed

leanpub-wreq (empty) → 1.0.0.0

raw patch · 4 files changed

+405/−0 lines, 4 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, exceptions, leanpub-concepts, lens, rando, text, time, transformers, unordered-containers, wreq

Files

+ changelog.md view
@@ -0,0 +1,1 @@+2019 Feb 3 - Initial release, v1.0.0.0
+ leanpub-wreq.cabal view
@@ -0,0 +1,49 @@+cabal-version: 2.0++name: leanpub-wreq+version: 1.0.0.0++synopsis: Use the Leanpub API via Wreq+category: Web++description:+    This package helps you make requests to the+    <https://leanpub.com/help/api Leanpub API> in conjunction with+    the <https://hackage.haskell.org/package/wreq wreq> package.++homepage:    https://github.com/typeclasses/leanpub+bug-reports: https://github.com/typeclasses/leanpub/issues++author:     Chris Martin+maintainer: Chris Martin, Julie Moronuki++copyright: 2018 Typeclass Consulting, LLC+license: MIT+license-file: license.txt++build-type: Simple+tested-with: GHC==8.6.1++extra-source-files:+    changelog.md++library+    hs-source-dirs: library+    default-language: Haskell2010++    exposed-modules:+        Leanpub.Wreq++    build-depends:+        aeson+      , base >=4.10 && <5+      , bytestring+      , exceptions+      , lens+      , leanpub-concepts+      , rando+      , text+      , time+      , transformers+      , unordered-containers+      , wreq
+ library/Leanpub/Wreq.hs view
@@ -0,0 +1,337 @@+{-# OPTIONS_GHC -Wall -fdefer-typed-holes #-}++{-# LANGUAGE BlockArguments, DerivingVia, LambdaCase, RecordWildCards #-}++module Leanpub.Wreq+  (+  -- * The Leanpub monad+    Leanpub (..), Context (..)++  -- * Configuration+  , runLeanpub, Config, configSession, configKey, configKeyFile++  -- * Leanpub actions+  , getBookSummary+  , getBookSalesSummary+  , createFreeBookCoupon+  , createManyFreeBookCoupons++  -- * Wreq+  , wreqGet, wreqPost, wreqGetAeson, wreqPostAeson, wreqPostAeson_+  , WreqResponse, Path, Extension+  , QueryParam, FormParam (..), Session, newAPISession++  ) where++-- aeson+import qualified Data.Aeson++-- base+import Control.Monad hiding (fail, foldM)+import Control.Monad.IO.Class+import Control.Monad.Fail+import qualified Data.List+import Data.Maybe+import Data.Monoid+import Numeric.Natural+import Prelude hiding (fail)++-- bytestring+import qualified Data.ByteString.Char8+import qualified Data.ByteString+import qualified Data.ByteString.Lazy++-- leanpub-concepts+import Leanpub.Concepts++-- lens+import Control.Lens ((&), (.~), (^.))++-- rando+import System.Random.Pick (pickOne)++-- text+import           Data.Text (Text)+import qualified Data.Text+import qualified Data.Text.IO++-- time+import           Data.Time (Day)+import qualified Data.Time++-- transformers+import Control.Monad.Trans.Reader++-- wreq+import           Network.Wreq         (FormParam (..))+import qualified Network.Wreq+import           Network.Wreq.Session (Session, newAPISession)+import qualified Network.Wreq.Session++text :: String -> Text+text = Data.Text.pack++ascii :: String -> Data.ByteString.ByteString+ascii = Data.ByteString.Char8.pack++------------------------------------------------------------++data Context =+  Context+    { contextSession :: Session+    , contextKeyMaybe :: Maybe ApiSecretKey+    }++{- | There are two ways to run a 'Leanpub' action:++1. Create a 'Context' and then apply the newtyped+   @Context -> IO a@ function directly.++2. Create a 'Config' and then apply the 'runLeanpub' function.+   This approach is likely more convenient, because it can do+   some things automatically like creating the 'Session' and+   reading your API key from a file. -}++newtype Leanpub a = Leanpub (Context -> IO a)+  deriving ( Functor, Applicative, Monad, MonadIO, MonadFail )+    via ReaderT Context IO++requireKey :: Leanpub ()+requireKey =+    Leanpub \Context{..} ->+        when (isNothing contextKeyMaybe) (fail "API key is required.")++------------------------------------------------------------++runLeanpub :: Config -> Leanpub a -> IO a+runLeanpub (Config config) (Leanpub action) =+    createContext (config baseConfigData) >>= action++createContext :: ConfigData -> IO Context+createContext ConfigData{..} =+  do+    contextSession <-+        case configData_session of+            Nothing -> newAPISession+            Just x -> return x++    contextKeyMaybe <-+        case configData_key of+            KeyConfig_Pure x  -> return (Just x)+            KeyConfig_File x  -> fmap Just (readKeyFile x)+            KeyConfig_Nothing -> return Nothing++    return Context{..}++{- | Construct a 'Config' by using '<>' to combine any of the following:++* Either 'configKey' or 'configKeyFile' (not both)+* Optionally, 'configSession'++Then use the config as the first argument to the 'runLeanpub' function. -}++newtype Config = Config (ConfigData -> ConfigData)+  deriving (Semigroup, Monoid) via (Endo ConfigData)++data ConfigData =+  ConfigData+    { configData_session :: Maybe Session+    , configData_key :: KeyConfig+    }++data KeyConfig+  = KeyConfig_Pure ApiSecretKey+  | KeyConfig_File FilePath+  | KeyConfig_Nothing++baseConfigData :: ConfigData+baseConfigData =+  ConfigData+    { configData_session = Nothing+    , configData_key = KeyConfig_Nothing+    }++readKeyFile :: FilePath -> IO ApiSecretKey+readKeyFile fp =+    fmap (ApiSecretKey . Data.Text.strip) (Data.Text.IO.readFile fp)++configSession :: Session -> Config+configSession x = Config (\c -> c { configData_session = Just x })++configKey :: ApiSecretKey -> Config+configKey x = Config (\c -> c { configData_key = KeyConfig_Pure x })++configKeyFile :: FilePath -> Config+configKeyFile x = Config (\c -> c { configData_key = KeyConfig_File x })++------------------------------------------------------------++type WreqResponse = Network.Wreq.Response Data.ByteString.Lazy.ByteString++type Path = [Text]++type Extension = Text++type QueryParam = (Text, Text)++urlBase :: Text+urlBase = text "https://leanpub.com/"++makeUrl :: Path -> Extension -> String+makeUrl xs ext =+    f xs ++ "." ++ Data.Text.unpack ext+  where+    f =+        Data.Text.unpack+        . Data.Text.intercalate (text "/")+        . (urlBase :)++wreqDefaults :: Network.Wreq.Options+wreqDefaults = Network.Wreq.defaults++authGetParam :: ApiSecretKey -> (Text, Text)+authGetParam (ApiSecretKey key) = (text "api_key", key)++authFormParam :: ApiSecretKey -> FormParam+authFormParam (ApiSecretKey key) = ascii "api_key" := key++wreqGet :: Path -> Extension -> [QueryParam] -> Leanpub WreqResponse+wreqGet path extension params =+    Leanpub \Context{..} ->+      let+          url = makeUrl path extension++          params' =+              maybe id (\key -> (authGetParam key :)) contextKeyMaybe+              params++          opts =+              wreqDefaults+                  & Network.Wreq.params .~ params'+      in+          Network.Wreq.Session.getWith opts contextSession url++wreqPost :: Path -> Extension -> [FormParam] -> Leanpub WreqResponse+wreqPost path extension params =+    Leanpub \Context{..} ->+        let+            url = makeUrl path extension++            params' =+                maybe id (\key -> (authFormParam key :)) contextKeyMaybe+                params++            opts =+                wreqDefaults+        in+            Network.Wreq.Session.postWith opts contextSession url params'++------------------------------------------------------------++extJson :: Extension+extJson = text "json"++wreqBodyAeson :: MonadFail m => WreqResponse -> m Data.Aeson.Value+wreqBodyAeson =+    either fail return+    . Data.Aeson.eitherDecode+    . (^. Network.Wreq.responseBody)++wreqGetAeson :: Path -> [QueryParam] -> Leanpub Data.Aeson.Value+wreqGetAeson path params =+    wreqGet path extJson params >>= wreqBodyAeson++wreqPostAeson :: Path -> [FormParam] -> Leanpub Data.Aeson.Value+wreqPostAeson path params =+    wreqPost path extJson params >>= wreqBodyAeson++wreqPostAeson_ :: Path -> [FormParam] -> Leanpub ()+wreqPostAeson_ path params = void (wreqPostAeson path params)++------------------------------------------------------------++getBookSummary :: BookSlug -> Leanpub Data.Aeson.Value+getBookSummary (BookSlug slug) =+    wreqGetAeson [slug] []++getBookSalesSummary :: BookSlug -> Leanpub Data.Aeson.Value+getBookSalesSummary (BookSlug slug) =+  do+    requireKey+    wreqGetAeson [slug, text "sales"] []++createFreeBookCoupon+    :: BookSlug           -- ^ What book does the coupon give away?+    -> CouponCode         -- ^ The secret that the user needs to have+                          --   to redeem the coupon+    -> CouponMaxUses      -- ^ How many times can each coupon be used?+    -> Maybe CouponNote   -- ^ An optional note to remind you what the+                          --   coupon is for, why it was issued, etc.+    -> Leanpub Data.Aeson.Value+createFreeBookCoupon (BookSlug slug) code uses noteMaybe =+  do+    requireKey+    start <- liftIO getToday++    wreqPostAeson+        [slug, text "coupons"]+        (freeBookParams start code uses noteMaybe)++createManyFreeBookCoupons+    :: (CouponCode -> IO ())  -- ^ Action to perform after creating each coupon,+                              --   e.g. perhaps 'print' for use in a REPL.+    -> Natural                -- ^ How many coupons?+    -> BookSlug               -- ^ What book does the coupon give away?+    -> CouponMaxUses          -- ^ How many times can each coupon be used?+    -> Maybe CouponNote       -- ^ An optional note to remind you what the+                              --   coupon is for, why it was issued, etc.+    -> Leanpub ()+createManyFreeBookCoupons done n (BookSlug slug) uses noteMaybe =+  do+    requireKey+    start <- liftIO getToday++    (sequence_ . replicate (fromIntegral n))+      do+        code <- liftIO randomCouponCode+        wreqPostAeson_+            [slug, text "coupons"]+            (freeBookParams start code uses noteMaybe)+        liftIO (done code)++freeBookParams+    :: Day -> CouponCode -> CouponMaxUses -> Maybe CouponNote+    -> [FormParam]+freeBookParams start (CouponCode code) uses noteMaybe =+    catMaybes+        [ Just (ascii "coupon[coupon_code]" := code)+        , Just (ascii "coupon[start_date]" := formatDay start)+        , Just (+            ascii "coupon[package_discounts_attributes][0][package_slug]"+            := "book")+        , Just (+            ascii "coupon[package_discounts_attributes][0][discounted_price]"+            := "0.00")+        , case uses of+            CouponUseUnlimited -> Nothing+            CouponMaxUses n -> Just (+              ascii "coupon[max_uses]" := toInteger n)+        , case noteMaybe of+            Nothing -> Nothing+            Just (CouponNote note) -> Just (ascii "coupon[note]" := note)+        ]++getToday :: IO Day+getToday = fmap Data.Time.utctDay Data.Time.getCurrentTime++formatDay :: Day -> String+formatDay = Data.Time.formatTime Data.Time.defaultTimeLocale "%Y-%m-%d"++randomCouponCode :: IO CouponCode+randomCouponCode =+  do+    s <- sequence (Data.List.replicate 20 randomChar)+    return (CouponCode (text s))+  where+    randomChar = pickOne charset+    charset = ['a'..'z'] ++ ['0'..'9']
+ license.txt view
@@ -0,0 +1,18 @@+Copyright 2019 Typeclass Consulting, LLC++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.