{-# OPTIONS_GHC -Wall -fdefer-typed-holes #-}

{-# LANGUAGE BlockArguments, DerivingVia, LambdaCase, NamedFieldPuns #-}

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 Data.Function ((&))
import Data.Functor.Const
import Data.Functor.Identity
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

-- mwc-random
import System.Random.MWC (GenIO, createSystemRandom, uniformR)

-- 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

------------------------------------------------------------

-- from the 'lens' library

type Getting r s a = (a -> Const r a) -> s -> Const r s

(^.) :: s -> Getting a s a -> a
s
s ^. :: s -> Getting a s a -> a
^. Getting a s a
l = Const a s -> a
forall a k (b :: k). Const a b -> a
getConst (Getting a s a
l a -> Const a a
forall k a (b :: k). a -> Const a b
Const s
s)

type ASetter s t a b = (a -> Identity b) -> s -> Identity t

(.~) :: ASetter s t a b -> b -> s -> t
ASetter s t a b
l .~ :: ASetter s t a b -> b -> s -> t
.~ b
b = (Identity t -> t) -> (s -> Identity t) -> s -> t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity t -> t
forall a. Identity a -> a
runIdentity ((s -> Identity t) -> s -> t) -> (s -> Identity t) -> s -> t
forall a b. (a -> b) -> a -> b
$ ASetter s t a b
l (\a
_ -> b -> Identity b
forall a. a -> Identity a
Identity b
b)

------------------------------------------------------------

text :: String -> Text
text :: String -> Text
text = String -> Text
Data.Text.pack

ascii :: String -> Data.ByteString.ByteString
ascii :: String -> ByteString
ascii = String -> ByteString
Data.ByteString.Char8.pack

------------------------------------------------------------

data Context =
  Context
    { Context -> Session
contextSession :: Session
    , Context -> Maybe ApiSecretKey
contextKeyMaybe :: Maybe ApiSecretKey
    , Context -> GenIO
contextRandom :: GenIO
    }

{- | 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 ( a -> Leanpub b -> Leanpub a
(a -> b) -> Leanpub a -> Leanpub b
(forall a b. (a -> b) -> Leanpub a -> Leanpub b)
-> (forall a b. a -> Leanpub b -> Leanpub a) -> Functor Leanpub
forall a b. a -> Leanpub b -> Leanpub a
forall a b. (a -> b) -> Leanpub a -> Leanpub b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Leanpub b -> Leanpub a
$c<$ :: forall a b. a -> Leanpub b -> Leanpub a
fmap :: (a -> b) -> Leanpub a -> Leanpub b
$cfmap :: forall a b. (a -> b) -> Leanpub a -> Leanpub b
Functor, Functor Leanpub
a -> Leanpub a
Functor Leanpub
-> (forall a. a -> Leanpub a)
-> (forall a b. Leanpub (a -> b) -> Leanpub a -> Leanpub b)
-> (forall a b c.
    (a -> b -> c) -> Leanpub a -> Leanpub b -> Leanpub c)
-> (forall a b. Leanpub a -> Leanpub b -> Leanpub b)
-> (forall a b. Leanpub a -> Leanpub b -> Leanpub a)
-> Applicative Leanpub
Leanpub a -> Leanpub b -> Leanpub b
Leanpub a -> Leanpub b -> Leanpub a
Leanpub (a -> b) -> Leanpub a -> Leanpub b
(a -> b -> c) -> Leanpub a -> Leanpub b -> Leanpub c
forall a. a -> Leanpub a
forall a b. Leanpub a -> Leanpub b -> Leanpub a
forall a b. Leanpub a -> Leanpub b -> Leanpub b
forall a b. Leanpub (a -> b) -> Leanpub a -> Leanpub b
forall a b c. (a -> b -> c) -> Leanpub a -> Leanpub b -> Leanpub 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
<* :: Leanpub a -> Leanpub b -> Leanpub a
$c<* :: forall a b. Leanpub a -> Leanpub b -> Leanpub a
*> :: Leanpub a -> Leanpub b -> Leanpub b
$c*> :: forall a b. Leanpub a -> Leanpub b -> Leanpub b
liftA2 :: (a -> b -> c) -> Leanpub a -> Leanpub b -> Leanpub c
$cliftA2 :: forall a b c. (a -> b -> c) -> Leanpub a -> Leanpub b -> Leanpub c
<*> :: Leanpub (a -> b) -> Leanpub a -> Leanpub b
$c<*> :: forall a b. Leanpub (a -> b) -> Leanpub a -> Leanpub b
pure :: a -> Leanpub a
$cpure :: forall a. a -> Leanpub a
$cp1Applicative :: Functor Leanpub
Applicative, Applicative Leanpub
a -> Leanpub a
Applicative Leanpub
-> (forall a b. Leanpub a -> (a -> Leanpub b) -> Leanpub b)
-> (forall a b. Leanpub a -> Leanpub b -> Leanpub b)
-> (forall a. a -> Leanpub a)
-> Monad Leanpub
Leanpub a -> (a -> Leanpub b) -> Leanpub b
Leanpub a -> Leanpub b -> Leanpub b
forall a. a -> Leanpub a
forall a b. Leanpub a -> Leanpub b -> Leanpub b
forall a b. Leanpub a -> (a -> Leanpub b) -> Leanpub 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 :: a -> Leanpub a
$creturn :: forall a. a -> Leanpub a
>> :: Leanpub a -> Leanpub b -> Leanpub b
$c>> :: forall a b. Leanpub a -> Leanpub b -> Leanpub b
>>= :: Leanpub a -> (a -> Leanpub b) -> Leanpub b
$c>>= :: forall a b. Leanpub a -> (a -> Leanpub b) -> Leanpub b
$cp1Monad :: Applicative Leanpub
Monad, Monad Leanpub
Monad Leanpub -> (forall a. IO a -> Leanpub a) -> MonadIO Leanpub
IO a -> Leanpub a
forall a. IO a -> Leanpub a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Leanpub a
$cliftIO :: forall a. IO a -> Leanpub a
$cp1MonadIO :: Monad Leanpub
MonadIO, Monad Leanpub
Monad Leanpub
-> (forall a. String -> Leanpub a) -> MonadFail Leanpub
String -> Leanpub a
forall a. String -> Leanpub a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Leanpub a
$cfail :: forall a. String -> Leanpub a
$cp1MonadFail :: Monad Leanpub
MonadFail )
    via ReaderT Context IO

requireKey :: Leanpub ()
requireKey :: Leanpub ()
requireKey =
    (Context -> IO ()) -> Leanpub ()
forall a. (Context -> IO a) -> Leanpub a
Leanpub \Context{ Maybe ApiSecretKey
contextKeyMaybe :: Maybe ApiSecretKey
contextKeyMaybe :: Context -> Maybe ApiSecretKey
contextKeyMaybe } ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ApiSecretKey -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ApiSecretKey
contextKeyMaybe) (String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"API key is required.")

------------------------------------------------------------

runLeanpub :: Config -> Leanpub a -> IO a
runLeanpub :: Config -> Leanpub a -> IO a
runLeanpub (Config ConfigData -> ConfigData
config) (Leanpub Context -> IO a
action) =
    ConfigData -> IO Context
createContext (ConfigData -> ConfigData
config ConfigData
baseConfigData) IO Context -> (Context -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> IO a
action

createContext :: ConfigData -> IO Context
createContext :: ConfigData -> IO Context
createContext ConfigData{ Maybe Session
configData_session :: ConfigData -> Maybe Session
configData_session :: Maybe Session
configData_session, KeyConfig
configData_key :: ConfigData -> KeyConfig
configData_key :: KeyConfig
configData_key } =
  do
    Session
contextSession <-
        case Maybe Session
configData_session of
            Maybe Session
Nothing -> IO Session
newAPISession
            Just Session
x -> Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return Session
x

    Maybe ApiSecretKey
contextKeyMaybe <-
        case KeyConfig
configData_key of
            KeyConfig_Pure ApiSecretKey
x  -> Maybe ApiSecretKey -> IO (Maybe ApiSecretKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiSecretKey -> Maybe ApiSecretKey
forall a. a -> Maybe a
Just ApiSecretKey
x)
            KeyConfig_File String
x  -> (ApiSecretKey -> Maybe ApiSecretKey)
-> IO ApiSecretKey -> IO (Maybe ApiSecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiSecretKey -> Maybe ApiSecretKey
forall a. a -> Maybe a
Just (String -> IO ApiSecretKey
readKeyFile String
x)
            KeyConfig
KeyConfig_Nothing -> Maybe ApiSecretKey -> IO (Maybe ApiSecretKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ApiSecretKey
forall a. Maybe a
Nothing

    Gen RealWorld
contextRandom <- IO (Gen RealWorld)
IO GenIO
createSystemRandom

    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context :: Session -> Maybe ApiSecretKey -> GenIO -> Context
Context{ Session
contextSession :: Session
contextSession :: Session
contextSession, Maybe ApiSecretKey
contextKeyMaybe :: Maybe ApiSecretKey
contextKeyMaybe :: Maybe ApiSecretKey
contextKeyMaybe, Gen RealWorld
GenIO
contextRandom :: Gen RealWorld
contextRandom :: GenIO
contextRandom }

{- | 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 (b -> Config -> Config
NonEmpty Config -> Config
Config -> Config -> Config
(Config -> Config -> Config)
-> (NonEmpty Config -> Config)
-> (forall b. Integral b => b -> Config -> Config)
-> Semigroup Config
forall b. Integral b => b -> Config -> Config
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Config -> Config
$cstimes :: forall b. Integral b => b -> Config -> Config
sconcat :: NonEmpty Config -> Config
$csconcat :: NonEmpty Config -> Config
<> :: Config -> Config -> Config
$c<> :: Config -> Config -> Config
Semigroup, Semigroup Config
Config
Semigroup Config
-> Config
-> (Config -> Config -> Config)
-> ([Config] -> Config)
-> Monoid Config
[Config] -> Config
Config -> Config -> Config
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Config] -> Config
$cmconcat :: [Config] -> Config
mappend :: Config -> Config -> Config
$cmappend :: Config -> Config -> Config
mempty :: Config
$cmempty :: Config
$cp1Monoid :: Semigroup Config
Monoid) via (Endo ConfigData)

data ConfigData =
  ConfigData
    { ConfigData -> Maybe Session
configData_session :: Maybe Session
    , ConfigData -> KeyConfig
configData_key :: KeyConfig
    }

data KeyConfig
  = KeyConfig_Pure ApiSecretKey
  | KeyConfig_File FilePath
  | KeyConfig_Nothing

baseConfigData :: ConfigData
baseConfigData :: ConfigData
baseConfigData =
  ConfigData :: Maybe Session -> KeyConfig -> ConfigData
ConfigData
    { configData_session :: Maybe Session
configData_session = Maybe Session
forall a. Maybe a
Nothing
    , configData_key :: KeyConfig
configData_key = KeyConfig
KeyConfig_Nothing
    }

readKeyFile :: FilePath -> IO ApiSecretKey
readKeyFile :: String -> IO ApiSecretKey
readKeyFile String
fp =
    (Text -> ApiSecretKey) -> IO Text -> IO ApiSecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ApiSecretKey
ApiSecretKey (Text -> ApiSecretKey) -> (Text -> Text) -> Text -> ApiSecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Data.Text.strip) (String -> IO Text
Data.Text.IO.readFile String
fp)

configSession :: Session -> Config
configSession :: Session -> Config
configSession Session
x = (ConfigData -> ConfigData) -> Config
Config (\ConfigData
c -> ConfigData
c { configData_session :: Maybe Session
configData_session = Session -> Maybe Session
forall a. a -> Maybe a
Just Session
x })

configKey :: ApiSecretKey -> Config
configKey :: ApiSecretKey -> Config
configKey ApiSecretKey
x = (ConfigData -> ConfigData) -> Config
Config (\ConfigData
c -> ConfigData
c { configData_key :: KeyConfig
configData_key = ApiSecretKey -> KeyConfig
KeyConfig_Pure ApiSecretKey
x })

configKeyFile :: FilePath -> Config
configKeyFile :: String -> Config
configKeyFile String
x = (ConfigData -> ConfigData) -> Config
Config (\ConfigData
c -> ConfigData
c { configData_key :: KeyConfig
configData_key = String -> KeyConfig
KeyConfig_File String
x })

------------------------------------------------------------

type WreqResponse = Network.Wreq.Response Data.ByteString.Lazy.ByteString

type Path = [Text]

type Extension = Text

type QueryParam = (Text, Text)

urlBase :: Text
urlBase :: Text
urlBase = String -> Text
text String
"https://leanpub.com/"

makeUrl :: Path -> Extension -> String
makeUrl :: Path -> Text -> String
makeUrl Path
xs Text
ext =
    Path -> String
f Path
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Data.Text.unpack Text
ext
  where
    f :: Path -> String
f =
        Text -> String
Data.Text.unpack
        (Text -> String) -> (Path -> Text) -> Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Path -> Text
Data.Text.intercalate (String -> Text
text String
"/")
        (Path -> Text) -> (Path -> Path) -> Path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
urlBase Text -> Path -> Path
forall a. a -> [a] -> [a]
:)

wreqDefaults :: Network.Wreq.Options
wreqDefaults :: Options
wreqDefaults = Options
Network.Wreq.defaults

authGetParam :: ApiSecretKey -> (Text, Text)
authGetParam :: ApiSecretKey -> (Text, Text)
authGetParam (ApiSecretKey Text
key) = (String -> Text
text String
"api_key", Text
key)

authFormParam :: ApiSecretKey -> FormParam
authFormParam :: ApiSecretKey -> FormParam
authFormParam (ApiSecretKey Text
key) = String -> ByteString
ascii String
"api_key" ByteString -> Text -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Text
key

wreqGet :: Path -> Extension -> [QueryParam] -> Leanpub WreqResponse
wreqGet :: Path -> Text -> [(Text, Text)] -> Leanpub WreqResponse
wreqGet Path
path Text
extension [(Text, Text)]
params =
    (Context -> IO WreqResponse) -> Leanpub WreqResponse
forall a. (Context -> IO a) -> Leanpub a
Leanpub \Context{ Maybe ApiSecretKey
contextKeyMaybe :: Maybe ApiSecretKey
contextKeyMaybe :: Context -> Maybe ApiSecretKey
contextKeyMaybe, Session
contextSession :: Session
contextSession :: Context -> Session
contextSession } ->
      let
          url :: String
url = Path -> Text -> String
makeUrl Path
path Text
extension

          params' :: [(Text, Text)]
params' =
              ([(Text, Text)] -> [(Text, Text)])
-> (ApiSecretKey -> [(Text, Text)] -> [(Text, Text)])
-> Maybe ApiSecretKey
-> [(Text, Text)]
-> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id (\ApiSecretKey
key -> (ApiSecretKey -> (Text, Text)
authGetParam ApiSecretKey
key (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)) Maybe ApiSecretKey
contextKeyMaybe
              [(Text, Text)]
params

          opts :: Options
opts =
              Options
wreqDefaults
                  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
Network.Wreq.params (([(Text, Text)] -> Identity [(Text, Text)])
 -> Options -> Identity Options)
-> [(Text, Text)] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Text)]
params'
      in
          Options -> Session -> String -> IO WreqResponse
Network.Wreq.Session.getWith Options
opts Session
contextSession String
url

wreqPost :: Path -> Extension -> [FormParam] -> Leanpub WreqResponse
wreqPost :: Path -> Text -> [FormParam] -> Leanpub WreqResponse
wreqPost Path
path Text
extension [FormParam]
params =
    (Context -> IO WreqResponse) -> Leanpub WreqResponse
forall a. (Context -> IO a) -> Leanpub a
Leanpub \Context{ Maybe ApiSecretKey
contextKeyMaybe :: Maybe ApiSecretKey
contextKeyMaybe :: Context -> Maybe ApiSecretKey
contextKeyMaybe, Session
contextSession :: Session
contextSession :: Context -> Session
contextSession } ->
        let
            url :: String
url = Path -> Text -> String
makeUrl Path
path Text
extension

            params' :: [FormParam]
params' =
                ([FormParam] -> [FormParam])
-> (ApiSecretKey -> [FormParam] -> [FormParam])
-> Maybe ApiSecretKey
-> [FormParam]
-> [FormParam]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FormParam] -> [FormParam]
forall a. a -> a
id (\ApiSecretKey
key -> (ApiSecretKey -> FormParam
authFormParam ApiSecretKey
key FormParam -> [FormParam] -> [FormParam]
forall a. a -> [a] -> [a]
:)) Maybe ApiSecretKey
contextKeyMaybe
                [FormParam]
params

            opts :: Options
opts =
                Options
wreqDefaults
        in
            Options -> Session -> String -> [FormParam] -> IO WreqResponse
forall a.
Postable a =>
Options -> Session -> String -> a -> IO WreqResponse
Network.Wreq.Session.postWith Options
opts Session
contextSession String
url [FormParam]
params'

------------------------------------------------------------

extJson :: Extension
extJson :: Text
extJson = String -> Text
text String
"json"

wreqBodyAeson :: MonadFail m => WreqResponse -> m Data.Aeson.Value
wreqBodyAeson :: WreqResponse -> m Value
wreqBodyAeson =
    (String -> m Value)
-> (Value -> m Value) -> Either String Value -> m Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Either String Value -> m Value)
-> (WreqResponse -> Either String Value) -> WreqResponse -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecode
    (ByteString -> Either String Value)
-> (WreqResponse -> ByteString)
-> WreqResponse
-> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WreqResponse
-> Getting ByteString WreqResponse ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString WreqResponse ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Network.Wreq.responseBody)

wreqGetAeson :: Path -> [QueryParam] -> Leanpub Data.Aeson.Value
wreqGetAeson :: Path -> [(Text, Text)] -> Leanpub Value
wreqGetAeson Path
path [(Text, Text)]
params =
    Path -> Text -> [(Text, Text)] -> Leanpub WreqResponse
wreqGet Path
path Text
extJson [(Text, Text)]
params Leanpub WreqResponse
-> (WreqResponse -> Leanpub Value) -> Leanpub Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WreqResponse -> Leanpub Value
forall (m :: * -> *). MonadFail m => WreqResponse -> m Value
wreqBodyAeson

wreqPostAeson :: Path -> [FormParam] -> Leanpub Data.Aeson.Value
wreqPostAeson :: Path -> [FormParam] -> Leanpub Value
wreqPostAeson Path
path [FormParam]
params =
    Path -> Text -> [FormParam] -> Leanpub WreqResponse
wreqPost Path
path Text
extJson [FormParam]
params Leanpub WreqResponse
-> (WreqResponse -> Leanpub Value) -> Leanpub Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WreqResponse -> Leanpub Value
forall (m :: * -> *). MonadFail m => WreqResponse -> m Value
wreqBodyAeson

wreqPostAeson_ :: Path -> [FormParam] -> Leanpub ()
wreqPostAeson_ :: Path -> [FormParam] -> Leanpub ()
wreqPostAeson_ Path
path [FormParam]
params = Leanpub Value -> Leanpub ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Path -> [FormParam] -> Leanpub Value
wreqPostAeson Path
path [FormParam]
params)

------------------------------------------------------------

getBookSummary :: BookSlug -> Leanpub Data.Aeson.Value
getBookSummary :: BookSlug -> Leanpub Value
getBookSummary (BookSlug Text
slug) =
    Path -> [(Text, Text)] -> Leanpub Value
wreqGetAeson [Text
slug] []

getBookSalesSummary :: BookSlug -> Leanpub Data.Aeson.Value
getBookSalesSummary :: BookSlug -> Leanpub Value
getBookSalesSummary (BookSlug Text
slug) =
  do
    Leanpub ()
requireKey
    Path -> [(Text, Text)] -> Leanpub Value
wreqGetAeson [Text
slug, String -> Text
text String
"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
-> CouponCode -> CouponMaxUses -> Maybe CouponNote -> Leanpub Value
createFreeBookCoupon (BookSlug Text
slug) CouponCode
code CouponMaxUses
uses Maybe CouponNote
noteMaybe =
  do
    Leanpub ()
requireKey
    Day
start <- IO Day -> Leanpub Day
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getToday

    Path -> [FormParam] -> Leanpub Value
wreqPostAeson
        [Text
slug, String -> Text
text String
"coupons"]
        (Day
-> CouponCode -> CouponMaxUses -> Maybe CouponNote -> [FormParam]
freeBookParams Day
start CouponCode
code CouponMaxUses
uses Maybe CouponNote
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 :: (CouponCode -> IO ())
-> Natural
-> BookSlug
-> CouponMaxUses
-> Maybe CouponNote
-> Leanpub ()
createManyFreeBookCoupons CouponCode -> IO ()
done Natural
n (BookSlug Text
slug) CouponMaxUses
uses Maybe CouponNote
noteMaybe =
  do
    Leanpub ()
requireKey
    Day
start <- IO Day -> Leanpub Day
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getToday
    ([Leanpub ()] -> Leanpub ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Leanpub ()] -> Leanpub ())
-> (Leanpub () -> [Leanpub ()]) -> Leanpub () -> Leanpub ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Leanpub () -> [Leanpub ()]
forall a. Int -> a -> [a]
replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n))
      do
        CouponCode
code <- Leanpub CouponCode
randomCouponCode
        Path -> [FormParam] -> Leanpub ()
wreqPostAeson_
            [Text
slug, String -> Text
text String
"coupons"]
            (Day
-> CouponCode -> CouponMaxUses -> Maybe CouponNote -> [FormParam]
freeBookParams Day
start CouponCode
code CouponMaxUses
uses Maybe CouponNote
noteMaybe)
        IO () -> Leanpub ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CouponCode -> IO ()
done CouponCode
code)

freeBookParams
    :: Day -> CouponCode -> CouponMaxUses -> Maybe CouponNote
    -> [FormParam]
freeBookParams :: Day
-> CouponCode -> CouponMaxUses -> Maybe CouponNote -> [FormParam]
freeBookParams Day
start (CouponCode Text
code) CouponMaxUses
uses Maybe CouponNote
noteMaybe =
    [Maybe FormParam] -> [FormParam]
forall a. [Maybe a] -> [a]
catMaybes
        [ FormParam -> Maybe FormParam
forall a. a -> Maybe a
Just (String -> ByteString
ascii String
"coupon[coupon_code]" ByteString -> Text -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Text
code)
        , FormParam -> Maybe FormParam
forall a. a -> Maybe a
Just (String -> ByteString
ascii String
"coupon[start_date]" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Day -> String
formatDay Day
start)
        , FormParam -> Maybe FormParam
forall a. a -> Maybe a
Just (
            String -> ByteString
ascii String
"coupon[package_discounts_attributes][0][package_slug]"
            ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
"book")
        , FormParam -> Maybe FormParam
forall a. a -> Maybe a
Just (
            String -> ByteString
ascii String
"coupon[package_discounts_attributes][0][discounted_price]"
            ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
"0.00")
        , case CouponMaxUses
uses of
            CouponMaxUses
CouponUseUnlimited -> Maybe FormParam
forall a. Maybe a
Nothing
            CouponMaxUses Natural
n -> FormParam -> Maybe FormParam
forall a. a -> Maybe a
Just (
              String -> ByteString
ascii String
"coupon[max_uses]" ByteString -> Integer -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n)
        , case Maybe CouponNote
noteMaybe of
            Maybe CouponNote
Nothing -> Maybe FormParam
forall a. Maybe a
Nothing
            Just (CouponNote Text
note) -> FormParam -> Maybe FormParam
forall a. a -> Maybe a
Just (String -> ByteString
ascii String
"coupon[note]" ByteString -> Text -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Text
note)
        ]

getToday :: IO Day
getToday :: IO Day
getToday = (UTCTime -> Day) -> IO UTCTime -> IO Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Day
Data.Time.utctDay IO UTCTime
Data.Time.getCurrentTime

formatDay :: Day -> String
formatDay :: Day -> String
formatDay = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Data.Time.formatTime TimeLocale
Data.Time.defaultTimeLocale String
"%Y-%m-%d"

randomCouponCode :: Leanpub CouponCode
randomCouponCode :: Leanpub CouponCode
randomCouponCode =
  do
    String
s <- [Leanpub Char] -> Leanpub String
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Int -> Leanpub Char -> [Leanpub Char]
forall a. Int -> a -> [a]
Data.List.replicate Int
20 Leanpub Char
randomChar)
    CouponCode -> Leanpub CouponCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> CouponCode
CouponCode (String -> Text
text String
s))

randomChar :: Leanpub Char
randomChar :: Leanpub Char
randomChar = (Context -> IO Char) -> Leanpub Char
forall a. (Context -> IO a) -> Leanpub a
Leanpub \Context{ GenIO
contextRandom :: GenIO
contextRandom :: Context -> GenIO
contextRandom } ->
    GenIO -> String -> IO Char
forall a. GenIO -> [a] -> IO a
pickOne GenIO
contextRandom String
charset
  where
    charset :: String
charset = [Char
'a'..Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']

pickOne :: GenIO -> [a] -> IO a
pickOne :: GenIO -> [a] -> IO a
pickOne GenIO
g [a]
xs =
  do
    Int
i <- (Int, Int) -> GenIO -> IO Int
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (Int
0, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) GenIO
g
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i)