{-# OPTIONS_GHC -Wall -fdefer-typed-holes #-}
{-# LANGUAGE BlockArguments, DerivingVia, LambdaCase, NamedFieldPuns #-}
module Leanpub.Wreq
(
Leanpub (..), Context (..)
, runLeanpub, Config, configSession, configKey, configKeyFile
, getBookSummary
, getBookSalesSummary
, createFreeBookCoupon
, createManyFreeBookCoupons
, wreqGet, wreqPost, wreqGetAeson, wreqPostAeson, wreqPostAeson_
, WreqResponse, Path, Extension
, QueryParam, FormParam (..), Session, newAPISession
) where
import qualified Data.Aeson
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)
import qualified Data.ByteString.Char8
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import Leanpub.Concepts
import System.Random.MWC (GenIO, createSystemRandom, uniformR)
import Data.Text (Text)
import qualified Data.Text
import qualified Data.Text.IO
import Data.Time (Day)
import qualified Data.Time
import Control.Monad.Trans.Reader
import Network.Wreq (FormParam (..))
import qualified Network.Wreq
import Network.Wreq.Session (Session, newAPISession)
import qualified Network.Wreq.Session
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
}
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 }
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
-> CouponCode
-> CouponMaxUses
-> Maybe CouponNote
-> 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 ())
-> Natural
-> BookSlug
-> CouponMaxUses
-> Maybe CouponNote
-> 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)