{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The telegraph API.
-- Every function that runs in 'MonadTelegraph' might throw a 'TelegraphError'.
module Web.Telegraph.API
  ( -- ** Types
    Telegraph (..),
    MonadTelegraph (..),
    AccountInfo (..),

    -- ** Interpreting 'MonadTelegraph'
    TelegraphT (..),
    runTelegraph,
    runTelegraph',

    -- ** Type Synonyms
    HasHttpCap,

    -- ** Account related APIs
    editAccountInfo,
    getAccountInfo,
    revokeAccessToken,
    createPage,
    editPage,
    getPageList,

    -- ** Account independent APIs
    createAccount,
    getAccountInfo',
    getPage,
    getTotalViews,

    -- ** Image uploading API
    uploadImageFromFile,
    uploadImageFromFiles,
    ImgStream (..),
    uploadImageStreaming,
    uploadImagesStreaming,
    uploadParts,
  )
where

import Conduit
  ( ConduitT,
    sourceHandle,
  )
import Control.Concurrent
import Control.Exception (throwIO)
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Cont
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Data.Aeson (eitherDecode, encode, object, (.=))
import Data.ByteString (ByteString)
import Data.Function ((&))
import Data.Maybe
import Data.Text (Text, pack, unpack)
import Deriving.Aeson
import Deriving.Aeson.Stock
import Network.HTTP.Client.Conduit
import Network.HTTP.Client.MultipartFormData
import System.IO
import Web.Telegraph.Types
import Prelude as P

type HasHttpCap env m = (MonadIO m, HasHttpManager env, MonadReader env m)

class MonadThrow m => MonadTelegraph m where
  takeTelegraph :: m Telegraph
  readTelegraph :: m Telegraph
  putTelegraph :: Telegraph -> m ()

newtype TelegraphT m a = TelegraphT {TelegraphT m a -> ReaderT (MVar Telegraph) m a
runTelegraphT :: ReaderT (MVar Telegraph) m a}
  deriving newtype
    ( a -> TelegraphT m b -> TelegraphT m a
(a -> b) -> TelegraphT m a -> TelegraphT m b
(forall a b. (a -> b) -> TelegraphT m a -> TelegraphT m b)
-> (forall a b. a -> TelegraphT m b -> TelegraphT m a)
-> Functor (TelegraphT m)
forall a b. a -> TelegraphT m b -> TelegraphT m a
forall a b. (a -> b) -> TelegraphT m a -> TelegraphT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> TelegraphT m b -> TelegraphT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> TelegraphT m a -> TelegraphT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TelegraphT m b -> TelegraphT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> TelegraphT m b -> TelegraphT m a
fmap :: (a -> b) -> TelegraphT m a -> TelegraphT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> TelegraphT m a -> TelegraphT m b
Functor,
      Functor (TelegraphT m)
a -> TelegraphT m a
Functor (TelegraphT m)
-> (forall a. a -> TelegraphT m a)
-> (forall a b.
    TelegraphT m (a -> b) -> TelegraphT m a -> TelegraphT m b)
-> (forall a b c.
    (a -> b -> c)
    -> TelegraphT m a -> TelegraphT m b -> TelegraphT m c)
-> (forall a b. TelegraphT m a -> TelegraphT m b -> TelegraphT m b)
-> (forall a b. TelegraphT m a -> TelegraphT m b -> TelegraphT m a)
-> Applicative (TelegraphT m)
TelegraphT m a -> TelegraphT m b -> TelegraphT m b
TelegraphT m a -> TelegraphT m b -> TelegraphT m a
TelegraphT m (a -> b) -> TelegraphT m a -> TelegraphT m b
(a -> b -> c) -> TelegraphT m a -> TelegraphT m b -> TelegraphT m c
forall a. a -> TelegraphT m a
forall a b. TelegraphT m a -> TelegraphT m b -> TelegraphT m a
forall a b. TelegraphT m a -> TelegraphT m b -> TelegraphT m b
forall a b.
TelegraphT m (a -> b) -> TelegraphT m a -> TelegraphT m b
forall a b c.
(a -> b -> c) -> TelegraphT m a -> TelegraphT m b -> TelegraphT m c
forall (f :: Type -> Type).
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
forall (m :: Type -> Type). Applicative m => Functor (TelegraphT m)
forall (m :: Type -> Type) a. Applicative m => a -> TelegraphT m a
forall (m :: Type -> Type) a b.
Applicative m =>
TelegraphT m a -> TelegraphT m b -> TelegraphT m a
forall (m :: Type -> Type) a b.
Applicative m =>
TelegraphT m a -> TelegraphT m b -> TelegraphT m b
forall (m :: Type -> Type) a b.
Applicative m =>
TelegraphT m (a -> b) -> TelegraphT m a -> TelegraphT m b
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c) -> TelegraphT m a -> TelegraphT m b -> TelegraphT m c
<* :: TelegraphT m a -> TelegraphT m b -> TelegraphT m a
$c<* :: forall (m :: Type -> Type) a b.
Applicative m =>
TelegraphT m a -> TelegraphT m b -> TelegraphT m a
*> :: TelegraphT m a -> TelegraphT m b -> TelegraphT m b
$c*> :: forall (m :: Type -> Type) a b.
Applicative m =>
TelegraphT m a -> TelegraphT m b -> TelegraphT m b
liftA2 :: (a -> b -> c) -> TelegraphT m a -> TelegraphT m b -> TelegraphT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c) -> TelegraphT m a -> TelegraphT m b -> TelegraphT m c
<*> :: TelegraphT m (a -> b) -> TelegraphT m a -> TelegraphT m b
$c<*> :: forall (m :: Type -> Type) a b.
Applicative m =>
TelegraphT m (a -> b) -> TelegraphT m a -> TelegraphT m b
pure :: a -> TelegraphT m a
$cpure :: forall (m :: Type -> Type) a. Applicative m => a -> TelegraphT m a
$cp1Applicative :: forall (m :: Type -> Type). Applicative m => Functor (TelegraphT m)
Applicative,
      Applicative (TelegraphT m)
a -> TelegraphT m a
Applicative (TelegraphT m)
-> (forall a b.
    TelegraphT m a -> (a -> TelegraphT m b) -> TelegraphT m b)
-> (forall a b. TelegraphT m a -> TelegraphT m b -> TelegraphT m b)
-> (forall a. a -> TelegraphT m a)
-> Monad (TelegraphT m)
TelegraphT m a -> (a -> TelegraphT m b) -> TelegraphT m b
TelegraphT m a -> TelegraphT m b -> TelegraphT m b
forall a. a -> TelegraphT m a
forall a b. TelegraphT m a -> TelegraphT m b -> TelegraphT m b
forall a b.
TelegraphT m a -> (a -> TelegraphT m b) -> TelegraphT m b
forall (m :: Type -> Type). Monad m => Applicative (TelegraphT m)
forall (m :: Type -> Type) a. Monad m => a -> TelegraphT m a
forall (m :: Type -> Type) a b.
Monad m =>
TelegraphT m a -> TelegraphT m b -> TelegraphT m b
forall (m :: Type -> Type) a b.
Monad m =>
TelegraphT m a -> (a -> TelegraphT m b) -> TelegraphT m b
forall (m :: Type -> Type).
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 -> TelegraphT m a
$creturn :: forall (m :: Type -> Type) a. Monad m => a -> TelegraphT m a
>> :: TelegraphT m a -> TelegraphT m b -> TelegraphT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
TelegraphT m a -> TelegraphT m b -> TelegraphT m b
>>= :: TelegraphT m a -> (a -> TelegraphT m b) -> TelegraphT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
TelegraphT m a -> (a -> TelegraphT m b) -> TelegraphT m b
$cp1Monad :: forall (m :: Type -> Type). Monad m => Applicative (TelegraphT m)
Monad,
      m a -> TelegraphT m a
(forall (m :: Type -> Type) a. Monad m => m a -> TelegraphT m a)
-> MonadTrans TelegraphT
forall (m :: Type -> Type) a. Monad m => m a -> TelegraphT m a
forall (t :: (Type -> Type) -> Type -> Type).
(forall (m :: Type -> Type) a. Monad m => m a -> t m a)
-> MonadTrans t
lift :: m a -> TelegraphT m a
$clift :: forall (m :: Type -> Type) a. Monad m => m a -> TelegraphT m a
MonadTrans,
      Monad (TelegraphT m)
Monad (TelegraphT m)
-> (forall a. IO a -> TelegraphT m a) -> MonadIO (TelegraphT m)
IO a -> TelegraphT m a
forall a. IO a -> TelegraphT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type). MonadIO m => Monad (TelegraphT m)
forall (m :: Type -> Type) a. MonadIO m => IO a -> TelegraphT m a
liftIO :: IO a -> TelegraphT m a
$cliftIO :: forall (m :: Type -> Type) a. MonadIO m => IO a -> TelegraphT m a
$cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (TelegraphT m)
MonadIO,
      Monad (TelegraphT m)
e -> TelegraphT m a
Monad (TelegraphT m)
-> (forall e a. Exception e => e -> TelegraphT m a)
-> MonadThrow (TelegraphT m)
forall e a. Exception e => e -> TelegraphT m a
forall (m :: Type -> Type).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: Type -> Type). MonadThrow m => Monad (TelegraphT m)
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> TelegraphT m a
throwM :: e -> TelegraphT m a
$cthrowM :: forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> TelegraphT m a
$cp1MonadThrow :: forall (m :: Type -> Type). MonadThrow m => Monad (TelegraphT m)
MonadThrow,
      MonadThrow (TelegraphT m)
MonadThrow (TelegraphT m)
-> (forall e a.
    Exception e =>
    TelegraphT m a -> (e -> TelegraphT m a) -> TelegraphT m a)
-> MonadCatch (TelegraphT m)
TelegraphT m a -> (e -> TelegraphT m a) -> TelegraphT m a
forall e a.
Exception e =>
TelegraphT m a -> (e -> TelegraphT m a) -> TelegraphT m a
forall (m :: Type -> Type).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: Type -> Type).
MonadCatch m =>
MonadThrow (TelegraphT m)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
TelegraphT m a -> (e -> TelegraphT m a) -> TelegraphT m a
catch :: TelegraphT m a -> (e -> TelegraphT m a) -> TelegraphT m a
$ccatch :: forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
TelegraphT m a -> (e -> TelegraphT m a) -> TelegraphT m a
$cp1MonadCatch :: forall (m :: Type -> Type).
MonadCatch m =>
MonadThrow (TelegraphT m)
MonadCatch,
      MonadCatch (TelegraphT m)
MonadCatch (TelegraphT m)
-> (forall b.
    ((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
    -> TelegraphT m b)
-> (forall b.
    ((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
    -> TelegraphT m b)
-> (forall a b c.
    TelegraphT m a
    -> (a -> ExitCase b -> TelegraphT m c)
    -> (a -> TelegraphT m b)
    -> TelegraphT m (b, c))
-> MonadMask (TelegraphT m)
TelegraphT m a
-> (a -> ExitCase b -> TelegraphT m c)
-> (a -> TelegraphT m b)
-> TelegraphT m (b, c)
((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
forall b.
((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
forall a b c.
TelegraphT m a
-> (a -> ExitCase b -> TelegraphT m c)
-> (a -> TelegraphT m b)
-> TelegraphT m (b, c)
forall (m :: Type -> Type).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: Type -> Type).
MonadMask m =>
MonadCatch (TelegraphT m)
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
forall (m :: Type -> Type) a b c.
MonadMask m =>
TelegraphT m a
-> (a -> ExitCase b -> TelegraphT m c)
-> (a -> TelegraphT m b)
-> TelegraphT m (b, c)
generalBracket :: TelegraphT m a
-> (a -> ExitCase b -> TelegraphT m c)
-> (a -> TelegraphT m b)
-> TelegraphT m (b, c)
$cgeneralBracket :: forall (m :: Type -> Type) a b c.
MonadMask m =>
TelegraphT m a
-> (a -> ExitCase b -> TelegraphT m c)
-> (a -> TelegraphT m b)
-> TelegraphT m (b, c)
uninterruptibleMask :: ((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
$cuninterruptibleMask :: forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
mask :: ((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
$cmask :: forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. TelegraphT m a -> TelegraphT m a) -> TelegraphT m b)
-> TelegraphT m b
$cp1MonadMask :: forall (m :: Type -> Type).
MonadMask m =>
MonadCatch (TelegraphT m)
MonadMask,
      MonadBase b,
      MonadBaseControl b
    )

instance MonadReader r m => MonadReader r (TelegraphT m) where
  ask :: TelegraphT m r
ask = m r -> TelegraphT m r
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: Type -> Type). MonadReader r m => m r
ask
  local :: (r -> r) -> TelegraphT m a -> TelegraphT m a
local r -> r
f TelegraphT m a
m = do
    MVar Telegraph
ref <- ReaderT (MVar Telegraph) m (MVar Telegraph)
-> TelegraphT m (MVar Telegraph)
forall (m :: Type -> Type) a.
ReaderT (MVar Telegraph) m a -> TelegraphT m a
TelegraphT ReaderT (MVar Telegraph) m (MVar Telegraph)
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    m a -> TelegraphT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TelegraphT m a) -> m a -> TelegraphT m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall r (m :: Type -> Type) a.
MonadReader r m =>
(r -> r) -> m a -> m a
local r -> r
f (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (ReaderT (MVar Telegraph) m a -> MVar Telegraph -> m a)
-> MVar Telegraph -> ReaderT (MVar Telegraph) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MVar Telegraph) m a -> MVar Telegraph -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT MVar Telegraph
ref (ReaderT (MVar Telegraph) m a -> m a)
-> ReaderT (MVar Telegraph) m a -> m a
forall a b. (a -> b) -> a -> b
$ TelegraphT m a -> ReaderT (MVar Telegraph) m a
forall (m :: Type -> Type) a.
TelegraphT m a -> ReaderT (MVar Telegraph) m a
runTelegraphT TelegraphT m a
m

instance (MonadThrow m, MonadIO m) => MonadTelegraph (TelegraphT m) where
  takeTelegraph :: TelegraphT m Telegraph
takeTelegraph = ReaderT (MVar Telegraph) m (MVar Telegraph)
-> TelegraphT m (MVar Telegraph)
forall (m :: Type -> Type) a.
ReaderT (MVar Telegraph) m a -> TelegraphT m a
TelegraphT ReaderT (MVar Telegraph) m (MVar Telegraph)
forall r (m :: Type -> Type). MonadReader r m => m r
ask TelegraphT m (MVar Telegraph)
-> (MVar Telegraph -> TelegraphT m Telegraph)
-> TelegraphT m Telegraph
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Telegraph -> TelegraphT m Telegraph
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Telegraph -> TelegraphT m Telegraph)
-> (MVar Telegraph -> IO Telegraph)
-> MVar Telegraph
-> TelegraphT m Telegraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Telegraph -> IO Telegraph
forall a. MVar a -> IO a
takeMVar
  readTelegraph :: TelegraphT m Telegraph
readTelegraph = ReaderT (MVar Telegraph) m (MVar Telegraph)
-> TelegraphT m (MVar Telegraph)
forall (m :: Type -> Type) a.
ReaderT (MVar Telegraph) m a -> TelegraphT m a
TelegraphT ReaderT (MVar Telegraph) m (MVar Telegraph)
forall r (m :: Type -> Type). MonadReader r m => m r
ask TelegraphT m (MVar Telegraph)
-> (MVar Telegraph -> TelegraphT m Telegraph)
-> TelegraphT m Telegraph
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Telegraph -> TelegraphT m Telegraph
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Telegraph -> TelegraphT m Telegraph)
-> (MVar Telegraph -> IO Telegraph)
-> MVar Telegraph
-> TelegraphT m Telegraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Telegraph -> IO Telegraph
forall a. MVar a -> IO a
readMVar
  putTelegraph :: Telegraph -> TelegraphT m ()
putTelegraph Telegraph
t = ReaderT (MVar Telegraph) m (MVar Telegraph)
-> TelegraphT m (MVar Telegraph)
forall (m :: Type -> Type) a.
ReaderT (MVar Telegraph) m a -> TelegraphT m a
TelegraphT ReaderT (MVar Telegraph) m (MVar Telegraph)
forall r (m :: Type -> Type). MonadReader r m => m r
ask TelegraphT m (MVar Telegraph)
-> (MVar Telegraph -> TelegraphT m ()) -> TelegraphT m ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar Telegraph
ref -> IO () -> TelegraphT m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> TelegraphT m ()) -> IO () -> TelegraphT m ()
forall a b. (a -> b) -> a -> b
$ MVar Telegraph -> Telegraph -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Telegraph
ref Telegraph
t

instance
  {-# OVERLAPPABLE #-}
  ( MonadTelegraph m,
    MonadTrans f,
    MonadThrow (f m)
  ) =>
  MonadTelegraph (f m)
  where
  takeTelegraph :: f m Telegraph
takeTelegraph = m Telegraph -> f m Telegraph
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
takeTelegraph
  readTelegraph :: f m Telegraph
readTelegraph = m Telegraph -> f m Telegraph
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
readTelegraph
  putTelegraph :: Telegraph -> f m ()
putTelegraph = m () -> f m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> f m ()) -> (Telegraph -> m ()) -> Telegraph -> f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telegraph -> m ()
forall (m :: Type -> Type). MonadTelegraph m => Telegraph -> m ()
putTelegraph

data Telegraph = Telegraph
  { Telegraph -> Text
accessToken :: Text,
    Telegraph -> Text
shortName :: Text,
    Telegraph -> Text
authorName :: Text,
    Telegraph -> Text
authorUrl :: Text
  }
  deriving (Int -> Telegraph -> ShowS
[Telegraph] -> ShowS
Telegraph -> String
(Int -> Telegraph -> ShowS)
-> (Telegraph -> String)
-> ([Telegraph] -> ShowS)
-> Show Telegraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Telegraph] -> ShowS
$cshowList :: [Telegraph] -> ShowS
show :: Telegraph -> String
$cshow :: Telegraph -> String
showsPrec :: Int -> Telegraph -> ShowS
$cshowsPrec :: Int -> Telegraph -> ShowS
Show, Telegraph -> Telegraph -> Bool
(Telegraph -> Telegraph -> Bool)
-> (Telegraph -> Telegraph -> Bool) -> Eq Telegraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Telegraph -> Telegraph -> Bool
$c/= :: Telegraph -> Telegraph -> Bool
== :: Telegraph -> Telegraph -> Bool
$c== :: Telegraph -> Telegraph -> Bool
Eq, (forall x. Telegraph -> Rep Telegraph x)
-> (forall x. Rep Telegraph x -> Telegraph) -> Generic Telegraph
forall x. Rep Telegraph x -> Telegraph
forall x. Telegraph -> Rep Telegraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Telegraph x -> Telegraph
$cfrom :: forall x. Telegraph -> Rep Telegraph x
Generic)

data AccountInfo = AccountInfo
  { AccountInfo -> Text
shortName :: Text,
    AccountInfo -> Text
authorName :: Text,
    AccountInfo -> Text
authorUrl :: Text
  }
  deriving (Int -> AccountInfo -> ShowS
[AccountInfo] -> ShowS
AccountInfo -> String
(Int -> AccountInfo -> ShowS)
-> (AccountInfo -> String)
-> ([AccountInfo] -> ShowS)
-> Show AccountInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountInfo] -> ShowS
$cshowList :: [AccountInfo] -> ShowS
show :: AccountInfo -> String
$cshow :: AccountInfo -> String
showsPrec :: Int -> AccountInfo -> ShowS
$cshowsPrec :: Int -> AccountInfo -> ShowS
Show, AccountInfo -> AccountInfo -> Bool
(AccountInfo -> AccountInfo -> Bool)
-> (AccountInfo -> AccountInfo -> Bool) -> Eq AccountInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountInfo -> AccountInfo -> Bool
$c/= :: AccountInfo -> AccountInfo -> Bool
== :: AccountInfo -> AccountInfo -> Bool
$c== :: AccountInfo -> AccountInfo -> Bool
Eq, (forall x. AccountInfo -> Rep AccountInfo x)
-> (forall x. Rep AccountInfo x -> AccountInfo)
-> Generic AccountInfo
forall x. Rep AccountInfo x -> AccountInfo
forall x. AccountInfo -> Rep AccountInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountInfo x -> AccountInfo
$cfrom :: forall x. AccountInfo -> Rep AccountInfo x
Generic)
  deriving (Value -> Parser [AccountInfo]
Value -> Parser AccountInfo
(Value -> Parser AccountInfo)
-> (Value -> Parser [AccountInfo]) -> FromJSON AccountInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AccountInfo]
$cparseJSONList :: Value -> Parser [AccountInfo]
parseJSON :: Value -> Parser AccountInfo
$cparseJSON :: Value -> Parser AccountInfo
FromJSON, [AccountInfo] -> Encoding
[AccountInfo] -> Value
AccountInfo -> Encoding
AccountInfo -> Value
(AccountInfo -> Value)
-> (AccountInfo -> Encoding)
-> ([AccountInfo] -> Value)
-> ([AccountInfo] -> Encoding)
-> ToJSON AccountInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AccountInfo] -> Encoding
$ctoEncodingList :: [AccountInfo] -> Encoding
toJSONList :: [AccountInfo] -> Value
$ctoJSONList :: [AccountInfo] -> Value
toEncoding :: AccountInfo -> Encoding
$ctoEncoding :: AccountInfo -> Encoding
toJSON :: AccountInfo -> Value
$ctoJSON :: AccountInfo -> Value
ToJSON) via Snake AccountInfo

-- | Use this method to create a new Telegraph account
createAccount :: HasHttpCap env m => AccountInfo -> m (Result Account)
createAccount :: AccountInfo -> m (Result Account)
createAccount !AccountInfo
a = String -> AccountInfo -> m (Result Account)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/createAccount" AccountInfo
a

-- | Use this method to update information about this Telegraph account
editAccountInfo :: (HasHttpCap env m, MonadTelegraph m, MonadMask m) => AccountInfo -> m ()
editAccountInfo :: AccountInfo -> m ()
editAccountInfo AccountInfo {Text
authorUrl :: Text
authorName :: Text
shortName :: Text
$sel:authorUrl:AccountInfo :: AccountInfo -> Text
$sel:authorName:AccountInfo :: AccountInfo -> Text
$sel:shortName:AccountInfo :: AccountInfo -> Text
..} =
  m Telegraph -> (Telegraph -> m ()) -> (Telegraph -> m ()) -> m ()
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError
    m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
takeTelegraph
    Telegraph -> m ()
forall (m :: Type -> Type). MonadTelegraph m => Telegraph -> m ()
putTelegraph
    ((Telegraph -> m ()) -> m ()) -> (Telegraph -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \t :: Telegraph
t@Telegraph {Text
accessToken :: Text
$sel:accessToken:Telegraph :: Telegraph -> Text
accessToken} -> do
      let o :: Value
o =
            [Pair] -> Value
object
              [ Text
"access_token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
accessToken,
                Text
"short_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
shortName,
                Text
"author_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorName,
                Text
"author_url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorUrl
              ]
      Result Account
r <- String -> Value -> m (Result Account)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/editAccountInfo" Value
o
      case Result Account
r of
        Error Text
e -> do
          Telegraph -> m ()
forall (m :: Type -> Type). MonadTelegraph m => Telegraph -> m ()
putTelegraph Telegraph
t
          TelegraphError -> m ()
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (TelegraphError -> m ()) -> TelegraphError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
        Result Account {} -> do
          let t' :: Telegraph
t' = Telegraph :: Text -> Text -> Text -> Text -> Telegraph
Telegraph {Text
accessToken :: Text
authorUrl :: Text
authorName :: Text
shortName :: Text
$sel:authorUrl:Telegraph :: Text
$sel:authorName:Telegraph :: Text
$sel:shortName:Telegraph :: Text
$sel:accessToken:Telegraph :: Text
..}
          Telegraph -> m ()
forall (m :: Type -> Type). MonadTelegraph m => Telegraph -> m ()
putTelegraph Telegraph
t'

-- | Use this method to get information about this Telegraph account
getAccountInfo :: (HasHttpCap env m, MonadTelegraph m) => m Account
getAccountInfo :: m Account
getAccountInfo = do
  Telegraph {Text
accessToken :: Text
$sel:accessToken:Telegraph :: Telegraph -> Text
accessToken} <- m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
readTelegraph
  Result Account
r <- Text -> m (Result Account)
forall env (m :: Type -> Type).
HasHttpCap env m =>
Text -> m (Result Account)
getAccountInfo' Text
accessToken
  case Result Account
r of
    Error Text
e -> TelegraphError -> m Account
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (TelegraphError -> m Account) -> TelegraphError -> m Account
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
    Result Account
a -> Account -> m Account
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Account
a

getAccountInfo' :: HasHttpCap env m => Text -> m (Result Account)
getAccountInfo' :: Text -> m (Result Account)
getAccountInfo' Text
accessToken = String -> Value -> m (Result Account)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/getAccountInfo" Value
o
  where
    fields :: [Text]
    fields :: [Text]
fields = [Text
"short_name", Text
"author_name", Text
"author_url", Text
"auth_url", Text
"page_count"]
    o :: Value
o =
      [Pair] -> Value
object
        [ Text
"access_token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
accessToken,
          Text
"fields" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
fields
        ]

-- | Use this method to revoke access_token and generate a new one
revokeAccessToken :: (HasHttpCap env m, MonadTelegraph m, MonadMask m) => m Account
revokeAccessToken :: m Account
revokeAccessToken =
  m Telegraph
-> (Telegraph -> m ()) -> (Telegraph -> m Account) -> m Account
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError
    m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
takeTelegraph
    Telegraph -> m ()
forall (m :: Type -> Type). MonadTelegraph m => Telegraph -> m ()
putTelegraph
    ((Telegraph -> m Account) -> m Account)
-> (Telegraph -> m Account) -> m Account
forall a b. (a -> b) -> a -> b
$ \Telegraph {Text
authorUrl :: Text
authorName :: Text
shortName :: Text
accessToken :: Text
$sel:authorUrl:Telegraph :: Telegraph -> Text
$sel:authorName:Telegraph :: Telegraph -> Text
$sel:shortName:Telegraph :: Telegraph -> Text
$sel:accessToken:Telegraph :: Telegraph -> Text
..} -> do
      let o :: Value
o = [Pair] -> Value
object [Text
"access_token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
accessToken]
      Result Account
r <- String -> Value -> m (Result Account)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/revokeAccessToken" Value
o
      case Result Account
r of
        Error Text
e -> TelegraphError -> m Account
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (TelegraphError -> m Account) -> TelegraphError -> m Account
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
        Result a :: Account
a@Account {$sel:accessToken:Account :: Account -> Maybe Text
accessToken = Maybe Text
accessToken'} -> do
          let t' :: Telegraph
t' = Telegraph :: Text -> Text -> Text -> Text -> Telegraph
Telegraph {$sel:accessToken:Telegraph :: Text
accessToken = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
accessToken', Text
authorUrl :: Text
authorName :: Text
shortName :: Text
$sel:authorUrl:Telegraph :: Text
$sel:authorName:Telegraph :: Text
$sel:shortName:Telegraph :: Text
..}
          Telegraph -> m ()
forall (m :: Type -> Type). MonadTelegraph m => Telegraph -> m ()
putTelegraph Telegraph
t'
          Account -> m Account
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Account
a

data CreatePage = CreatePage
  { CreatePage -> Text
accessToken :: Text,
    CreatePage -> Text
title :: Text,
    CreatePage -> Maybe Text
authorName :: Maybe Text,
    CreatePage -> Maybe Text
authorUrl :: Maybe Text,
    CreatePage -> [Node]
content :: [Node],
    CreatePage -> Bool
returnContent :: Bool
  }
  deriving (Int -> CreatePage -> ShowS
[CreatePage] -> ShowS
CreatePage -> String
(Int -> CreatePage -> ShowS)
-> (CreatePage -> String)
-> ([CreatePage] -> ShowS)
-> Show CreatePage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePage] -> ShowS
$cshowList :: [CreatePage] -> ShowS
show :: CreatePage -> String
$cshow :: CreatePage -> String
showsPrec :: Int -> CreatePage -> ShowS
$cshowsPrec :: Int -> CreatePage -> ShowS
Show, CreatePage -> CreatePage -> Bool
(CreatePage -> CreatePage -> Bool)
-> (CreatePage -> CreatePage -> Bool) -> Eq CreatePage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePage -> CreatePage -> Bool
$c/= :: CreatePage -> CreatePage -> Bool
== :: CreatePage -> CreatePage -> Bool
$c== :: CreatePage -> CreatePage -> Bool
Eq, (forall x. CreatePage -> Rep CreatePage x)
-> (forall x. Rep CreatePage x -> CreatePage) -> Generic CreatePage
forall x. Rep CreatePage x -> CreatePage
forall x. CreatePage -> Rep CreatePage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePage x -> CreatePage
$cfrom :: forall x. CreatePage -> Rep CreatePage x
Generic)
  deriving (Value -> Parser [CreatePage]
Value -> Parser CreatePage
(Value -> Parser CreatePage)
-> (Value -> Parser [CreatePage]) -> FromJSON CreatePage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CreatePage]
$cparseJSONList :: Value -> Parser [CreatePage]
parseJSON :: Value -> Parser CreatePage
$cparseJSON :: Value -> Parser CreatePage
FromJSON, [CreatePage] -> Encoding
[CreatePage] -> Value
CreatePage -> Encoding
CreatePage -> Value
(CreatePage -> Value)
-> (CreatePage -> Encoding)
-> ([CreatePage] -> Value)
-> ([CreatePage] -> Encoding)
-> ToJSON CreatePage
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreatePage] -> Encoding
$ctoEncodingList :: [CreatePage] -> Encoding
toJSONList :: [CreatePage] -> Value
$ctoJSONList :: [CreatePage] -> Value
toEncoding :: CreatePage -> Encoding
$ctoEncoding :: CreatePage -> Encoding
toJSON :: CreatePage -> Value
$ctoJSON :: CreatePage -> Value
ToJSON) via Snake CreatePage

-- | Use this method to create a new Telegraph page
createPage ::
  (HasHttpCap env m, MonadTelegraph m) =>
  -- | title
  Text ->
  -- | content
  [Node] ->
  m Page
createPage :: Text -> [Node] -> m Page
createPage Text
title [Node]
content = do
  Telegraph {Text
authorUrl :: Text
authorName :: Text
shortName :: Text
accessToken :: Text
$sel:authorUrl:Telegraph :: Telegraph -> Text
$sel:authorName:Telegraph :: Telegraph -> Text
$sel:shortName:Telegraph :: Telegraph -> Text
$sel:accessToken:Telegraph :: Telegraph -> Text
..} <- m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
readTelegraph
  let o :: Value
o =
        [Pair] -> Value
object
          [ Text
"access_token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
accessToken,
            Text
"title" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
title,
            Text
"author_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorName,
            Text
"author_url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorUrl,
            Text
"content" Text -> [Node] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Node]
content
          ]
  Result Page
r <- String -> Value -> m (Result Page)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/createPage" Value
o
  case Result Page
r of
    Error Text
e -> TelegraphError -> m Page
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (TelegraphError -> m Page) -> TelegraphError -> m Page
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
    Result Page
p -> Page -> m Page
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Page
p

-- | Use this method to edit an existing Telegraph page
editPage ::
  (HasHttpCap env m, MonadTelegraph m) =>
  -- | path
  Text ->
  -- | title
  Text ->
  -- | content
  [Node] ->
  m Page
editPage :: Text -> Text -> [Node] -> m Page
editPage Text
path Text
title [Node]
content = do
  Telegraph {Text
authorUrl :: Text
authorName :: Text
shortName :: Text
accessToken :: Text
$sel:authorUrl:Telegraph :: Telegraph -> Text
$sel:authorName:Telegraph :: Telegraph -> Text
$sel:shortName:Telegraph :: Telegraph -> Text
$sel:accessToken:Telegraph :: Telegraph -> Text
..} <- m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
readTelegraph
  let o :: Value
o =
        [Pair] -> Value
object
          [ Text
"access_token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
accessToken,
            Text
"path" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
path,
            Text
"title" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
title,
            Text
"author_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorName,
            Text
"author_url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorUrl,
            Text
"content" Text -> [Node] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Node]
content
          ]
  Result Page
r <- String -> Value -> m (Result Page)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/editPage" Value
o
  case Result Page
r of
    Error Text
e -> TelegraphError -> m Page
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (TelegraphError -> m Page) -> TelegraphError -> m Page
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
    Result Page
p -> Page -> m Page
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Page
p

-- | Use this method to get a Telegraph page
getPage :: HasHttpCap env m => Text -> m (Result Page)
getPage :: Text -> m (Result Page)
getPage Text
path = do
  let o :: Value
o =
        [Pair] -> Value
object
          [ Text
"path" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
path,
            Text
"return_content" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True
          ]
  String -> Value -> m (Result Page)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/getPage" Value
o

-- | Use this method to get a list of pages belonging to this Telegraph account
getPageList ::
  (HasHttpCap env m, MonadTelegraph m) =>
  -- | offset
  Int ->
  -- | limit (0 - 200)
  Int ->
  m PageList
getPageList :: Int -> Int -> m PageList
getPageList Int
offset Int
limit = do
  Telegraph {Text
authorUrl :: Text
authorName :: Text
shortName :: Text
accessToken :: Text
$sel:authorUrl:Telegraph :: Telegraph -> Text
$sel:authorName:Telegraph :: Telegraph -> Text
$sel:shortName:Telegraph :: Telegraph -> Text
$sel:accessToken:Telegraph :: Telegraph -> Text
..} <- m Telegraph
forall (m :: Type -> Type). MonadTelegraph m => m Telegraph
readTelegraph
  let o :: Value
o =
        [Pair] -> Value
object
          [ Text
"access_token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
accessToken,
            Text
"offset" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
offset,
            Text
"limit" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
limit
          ]
  Result PageList
r <- String -> Value -> m (Result PageList)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/getPageList" Value
o
  case Result PageList
r of
    Error Text
e -> TelegraphError -> m PageList
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (TelegraphError -> m PageList) -> TelegraphError -> m PageList
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
    Result PageList
p -> PageList -> m PageList
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PageList
p

-- | Use this method to get the total number of views for a Telegraph article
getTotalViews :: HasHttpCap env m => Text -> m (Result PageViews)
getTotalViews :: Text -> m (Result PageViews)
getTotalViews Text
path = String -> Value -> m (Result PageViews)
forall a b env (m :: Type -> Type).
(ToJSON a, FromJSON b, HasHttpCap env m) =>
String -> a -> m b
postAeson String
"https://api.telegra.ph/getViews" Value
o
  where
    o :: Value
o = [Pair] -> Value
object [Text
"path" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
path]

--------------------------------------------------
-- Upload API

uploadParts :: HasHttpCap env m => [PartM m] -> m UploadResult
uploadParts :: [PartM m] -> m UploadResult
uploadParts [PartM m]
parts = do
  let initReq :: Request
initReq = String -> Request
parseRequest_ String
"POST https://telegra.ph/upload"
  ByteString
boundary <- IO ByteString -> m ByteString
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO ByteString
webkitBoundary
  Request
req <- ByteString -> [PartM m] -> Request -> m Request
forall (m :: Type -> Type).
Applicative m =>
ByteString -> [PartM m] -> Request -> m Request
formDataBodyWithBoundary ByteString
boundary [PartM m]
parts Request
initReq
  Response ByteString
resp <- Request -> m (Response ByteString)
forall (m :: Type -> Type) env.
(MonadIO m, HasHttpManager env, MonadReader env m) =>
Request -> m (Response ByteString)
httpLbs Request
req
  case ByteString -> Either String UploadResult
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp) of
    Left String
e -> String -> m UploadResult
forall a. HasCallStack => String -> a
P.error (String
"impossible: json decode failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)
    Right UploadResult
r -> UploadResult -> m UploadResult
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure UploadResult
r

-- | Upload a image from a filepath to Telegraph
uploadImageFromFile :: (HasHttpCap env m, MonadMask m) => FilePath -> m UploadResult
uploadImageFromFile :: String -> m UploadResult
uploadImageFromFile String
fp =
  ContT UploadResult m UploadResult -> m UploadResult
forall (m :: Type -> Type) r. Applicative m => ContT r m r -> m r
evalContT (ContT UploadResult m UploadResult -> m UploadResult)
-> ContT UploadResult m UploadResult -> m UploadResult
forall a b. (a -> b) -> a -> b
$ do
    ConduitT () ByteString IO ()
src <- String -> ContT UploadResult m (ConduitT () ByteString IO ())
forall (m :: Type -> Type) (n :: Type -> Type) r i.
(MonadMask m, MonadIO m, MonadIO n) =>
String -> ContT r m (ConduitT i ByteString n ())
withSourceFile String
fp
    let body :: RequestBody
body = ConduitT () ByteString IO () -> RequestBody
requestBodySourceChunked ConduitT () ByteString IO ()
src
        part :: PartM m
part = Text -> String -> RequestBody -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
"file" String
fp RequestBody
body
    m UploadResult -> ContT UploadResult m UploadResult
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UploadResult -> ContT UploadResult m UploadResult)
-> m UploadResult -> ContT UploadResult m UploadResult
forall a b. (a -> b) -> a -> b
$ [PartM m] -> m UploadResult
forall env (m :: Type -> Type).
HasHttpCap env m =>
[PartM m] -> m UploadResult
uploadParts [PartM m
part]

-- | Upload a list of images to Telegraph. The resulting list of images will be in the same order
uploadImageFromFiles :: (HasHttpCap env m, MonadMask m) => [FilePath] -> m UploadResult
uploadImageFromFiles :: [String] -> m UploadResult
uploadImageFromFiles [String]
fps =
  ContT UploadResult m UploadResult -> m UploadResult
forall (m :: Type -> Type) r. Applicative m => ContT r m r -> m r
evalContT (ContT UploadResult m UploadResult -> m UploadResult)
-> ContT UploadResult m UploadResult -> m UploadResult
forall a b. (a -> b) -> a -> b
$ do
    [ConduitT () ByteString IO ()]
srcs <- (String -> ContT UploadResult m (ConduitT () ByteString IO ()))
-> [String] -> ContT UploadResult m [ConduitT () ByteString IO ()]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> ContT UploadResult m (ConduitT () ByteString IO ())
forall (m :: Type -> Type) (n :: Type -> Type) r i.
(MonadMask m, MonadIO m, MonadIO n) =>
String -> ContT r m (ConduitT i ByteString n ())
withSourceFile [String]
fps
    let bodies :: [RequestBody]
bodies = (ConduitT () ByteString IO () -> RequestBody)
-> [ConduitT () ByteString IO ()] -> [RequestBody]
forall a b. (a -> b) -> [a] -> [b]
map ConduitT () ByteString IO () -> RequestBody
requestBodySourceChunked [ConduitT () ByteString IO ()]
srcs
        parts :: [PartM m]
parts = (String -> RequestBody -> PartM m)
-> [String] -> [RequestBody] -> [PartM m]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
fp -> Text -> String -> RequestBody -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody (String -> Text
pack String
fp) String
fp) [String]
fps [RequestBody]
bodies
    m UploadResult -> ContT UploadResult m UploadResult
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UploadResult -> ContT UploadResult m UploadResult)
-> m UploadResult -> ContT UploadResult m UploadResult
forall a b. (a -> b) -> a -> b
$ [PartM m] -> m UploadResult
forall env (m :: Type -> Type).
HasHttpCap env m =>
[PartM m] -> m UploadResult
uploadParts [PartM m]
parts

data ImgStream = ImgStream
  { -- | an image stream needs a filename
    ImgStream -> Text
name :: Text,
    ImgStream
-> forall i (n :: Type -> Type).
   MonadIO n =>
   ConduitT i ByteString n ()
stream :: forall i n. MonadIO n => ConduitT i ByteString n ()
  }

imgStream2Part :: Applicative m => ImgStream -> PartM m
imgStream2Part :: ImgStream -> PartM m
imgStream2Part ImgStream {Text
forall i (n :: Type -> Type).
MonadIO n =>
ConduitT i ByteString n ()
stream :: forall i (n :: Type -> Type).
MonadIO n =>
ConduitT i ByteString n ()
name :: Text
$sel:stream:ImgStream :: ImgStream
-> forall i (n :: Type -> Type).
   MonadIO n =>
   ConduitT i ByteString n ()
$sel:name:ImgStream :: ImgStream -> Text
..} = Text -> String -> RequestBody -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
name (Text -> String
unpack Text
name) RequestBody
body
  where
    body :: RequestBody
body = ConduitT () ByteString IO () -> RequestBody
requestBodySourceChunked ConduitT () ByteString IO ()
forall i (n :: Type -> Type).
MonadIO n =>
ConduitT i ByteString n ()
stream

-- | Upload a image stream to Telegraph
uploadImageStreaming :: HasHttpCap env m => ImgStream -> m UploadResult
uploadImageStreaming :: ImgStream -> m UploadResult
uploadImageStreaming ImgStream
imgs = [PartM m] -> m UploadResult
forall env (m :: Type -> Type).
HasHttpCap env m =>
[PartM m] -> m UploadResult
uploadParts [ImgStream -> PartM m
forall (m :: Type -> Type). Applicative m => ImgStream -> PartM m
imgStream2Part ImgStream
imgs]

-- | Upload a list of image streams to Telegraph. The resulting list of images
uploadImagesStreaming :: HasHttpCap env m => [ImgStream] -> m UploadResult
uploadImagesStreaming :: [ImgStream] -> m UploadResult
uploadImagesStreaming [ImgStream]
imgss = [PartM m] -> m UploadResult
forall env (m :: Type -> Type).
HasHttpCap env m =>
[PartM m] -> m UploadResult
uploadParts ([PartM m] -> m UploadResult) -> [PartM m] -> m UploadResult
forall a b. (a -> b) -> a -> b
$ (ImgStream -> PartM m) -> [ImgStream] -> [PartM m]
forall a b. (a -> b) -> [a] -> [b]
map ImgStream -> PartM m
forall (m :: Type -> Type). Applicative m => ImgStream -> PartM m
imgStream2Part [ImgStream]
imgss

--------------------------------------------------
-- Utils
postAeson :: (ToJSON a, FromJSON b, HasHttpCap env m) => String -> a -> m b
postAeson :: String -> a -> m b
postAeson String
url a
c = do
  let req :: Request
req =
        (String -> Request
parseRequest_ String
url)
          { method :: ByteString
method = ByteString
"POST",
            requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
c,
            requestHeaders :: RequestHeaders
requestHeaders =
              [ (HeaderName
"content-type", ByteString
"application/json"),
                (HeaderName
"accept", ByteString
"application/json")
              ]
          }
  Response ByteString
resp <- Request -> m (Response ByteString)
forall (m :: Type -> Type) env.
(MonadIO m, HasHttpManager env, MonadReader env m) =>
Request -> m (Response ByteString)
httpLbs Request
req
  case ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp) of
    Left String
e -> String -> m b
forall a. HasCallStack => String -> a
P.error (String
"impossible: json decode failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)
    Right b
r -> b -> m b
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure b
r

-- | interprets 'TelegraphT' using the access token of an existing account
runTelegraph :: HasHttpCap env m => Text -> TelegraphT m a -> m a
runTelegraph :: Text -> TelegraphT m a -> m a
runTelegraph Text
accessToken TelegraphT m a
m = do
  Result Account
r <- Text -> m (Result Account)
forall env (m :: Type -> Type).
HasHttpCap env m =>
Text -> m (Result Account)
getAccountInfo' Text
accessToken
  case Result Account
r of
    Error Text
e -> IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ TelegraphError -> IO a
forall e a. Exception e => e -> IO a
throwIO (TelegraphError -> IO a) -> TelegraphError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
    Result Account {Text
$sel:shortName:Account :: Account -> Text
shortName :: Text
shortName, Text
$sel:authorName:Account :: Account -> Text
authorName :: Text
authorName, Text
$sel:authorUrl:Account :: Account -> Text
authorUrl :: Text
authorUrl} -> do
      let t :: Telegraph
t = Telegraph :: Text -> Text -> Text -> Text -> Telegraph
Telegraph {Text
authorUrl :: Text
authorName :: Text
shortName :: Text
accessToken :: Text
$sel:authorUrl:Telegraph :: Text
$sel:authorName:Telegraph :: Text
$sel:shortName:Telegraph :: Text
$sel:accessToken:Telegraph :: Text
..}
      MVar Telegraph
ref <- IO (MVar Telegraph) -> m (MVar Telegraph)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar Telegraph) -> m (MVar Telegraph))
-> IO (MVar Telegraph) -> m (MVar Telegraph)
forall a b. (a -> b) -> a -> b
$ Telegraph -> IO (MVar Telegraph)
forall a. a -> IO (MVar a)
newMVar Telegraph
t
      TelegraphT m a
m
        TelegraphT m a
-> (TelegraphT m a -> ReaderT (MVar Telegraph) m a)
-> ReaderT (MVar Telegraph) m a
forall a b. a -> (a -> b) -> b
& TelegraphT m a -> ReaderT (MVar Telegraph) m a
forall (m :: Type -> Type) a.
TelegraphT m a -> ReaderT (MVar Telegraph) m a
runTelegraphT
        ReaderT (MVar Telegraph) m a
-> (ReaderT (MVar Telegraph) m a -> m a) -> m a
forall a b. a -> (a -> b) -> b
& (ReaderT (MVar Telegraph) m a -> MVar Telegraph -> m a)
-> MVar Telegraph -> ReaderT (MVar Telegraph) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MVar Telegraph) m a -> MVar Telegraph -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT MVar Telegraph
ref

-- | Create a new account and interprets 'TelegraphT' using that account
runTelegraph' :: HasHttpCap env m => AccountInfo -> TelegraphT m a -> m a
runTelegraph' :: AccountInfo -> TelegraphT m a -> m a
runTelegraph' AccountInfo
acc TelegraphT m a
m = do
  Result Account
r <- AccountInfo -> m (Result Account)
forall env (m :: Type -> Type).
HasHttpCap env m =>
AccountInfo -> m (Result Account)
createAccount AccountInfo
acc
  case Result Account
r of
    Error Text
e -> IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ TelegraphError -> IO a
forall e a. Exception e => e -> IO a
throwIO (TelegraphError -> IO a) -> TelegraphError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> TelegraphError
APICallFailure Text
e
    Result Account {Text
shortName :: Text
$sel:shortName:Account :: Account -> Text
shortName, Text
authorName :: Text
$sel:authorName:Account :: Account -> Text
authorName, Text
authorUrl :: Text
$sel:authorUrl:Account :: Account -> Text
authorUrl, $sel:accessToken:Account :: Account -> Maybe Text
accessToken = Maybe Text
accessToken'} -> do
      let t :: Telegraph
t = Telegraph :: Text -> Text -> Text -> Text -> Telegraph
Telegraph {$sel:accessToken:Telegraph :: Text
accessToken = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
accessToken', Text
authorUrl :: Text
authorName :: Text
shortName :: Text
$sel:authorUrl:Telegraph :: Text
$sel:authorName:Telegraph :: Text
$sel:shortName:Telegraph :: Text
..}
      MVar Telegraph
ref <- IO (MVar Telegraph) -> m (MVar Telegraph)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar Telegraph) -> m (MVar Telegraph))
-> IO (MVar Telegraph) -> m (MVar Telegraph)
forall a b. (a -> b) -> a -> b
$ Telegraph -> IO (MVar Telegraph)
forall a. a -> IO (MVar a)
newMVar Telegraph
t
      TelegraphT m a
m
        TelegraphT m a
-> (TelegraphT m a -> ReaderT (MVar Telegraph) m a)
-> ReaderT (MVar Telegraph) m a
forall a b. a -> (a -> b) -> b
& TelegraphT m a -> ReaderT (MVar Telegraph) m a
forall (m :: Type -> Type) a.
TelegraphT m a -> ReaderT (MVar Telegraph) m a
runTelegraphT
        ReaderT (MVar Telegraph) m a
-> (ReaderT (MVar Telegraph) m a -> m a) -> m a
forall a b. a -> (a -> b) -> b
& (ReaderT (MVar Telegraph) m a -> MVar Telegraph -> m a)
-> MVar Telegraph -> ReaderT (MVar Telegraph) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MVar Telegraph) m a -> MVar Telegraph -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT MVar Telegraph
ref

evalContT :: Applicative m => ContT r m r -> m r
evalContT :: ContT r m r -> m r
evalContT ContT r m r
m = ContT r m r -> (r -> m r) -> m r
forall k (r :: k) (m :: k -> Type) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m r
m r -> m r
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
{-# INLINE evalContT #-}

withSourceFile :: (MonadMask m, MonadIO m, MonadIO n) => FilePath -> ContT r m (ConduitT i ByteString n ())
withSourceFile :: String -> ContT r m (ConduitT i ByteString n ())
withSourceFile String
fp = ((ConduitT i ByteString n () -> m r) -> m r)
-> ContT r m (ConduitT i ByteString n ())
forall k (r :: k) (m :: k -> Type) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((ConduitT i ByteString n () -> m r) -> m r)
 -> ContT r m (ConduitT i ByteString n ()))
-> ((ConduitT i ByteString n () -> m r) -> m r)
-> ContT r m (ConduitT i ByteString n ())
forall a b. (a -> b) -> a -> b
$ \ConduitT i ByteString n () -> m r
k ->
  m Handle -> (Handle -> m ()) -> (Handle -> m r) -> m r
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
    (IO Handle -> m Handle
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openBinaryFile String
fp IOMode
ReadMode)
    (IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
    (ConduitT i ByteString n () -> m r
k (ConduitT i ByteString n () -> m r)
-> (Handle -> ConduitT i ByteString n ()) -> Handle -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ConduitT i ByteString n ()
forall (m :: Type -> Type) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle)