{-|
Module      : GoPro.Plus.Upload
Description : Functionality for uploading media to GoPro Plus.
Copyright   : (c) Dustin Sallings, 2020
License     : BSD3
Maintainer  : dustin@spy.net
Stability   : experimental

GoPro Plus media upload client.
-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}

module GoPro.Plus.Upload (
  -- * High level upload all-in-one convenience.
  uploadMedium,
  -- * Low-level upload parts.
  runUpload, resumeUpload,
  createMedium, createSource, createDerivative, createUpload,
  completeUpload, getUpload, uploadChunk, markAvailable,
  -- * Data Types
  UploadID, DerivativeID,
  UploadPart(..), uploadLength, uploadPart, uploadURL,
  Upload(..), uploadID, uploadParts,
  -- * Uploader monad.
  Uploader,
  setMediumType, setLogAction,
  -- * For your convenience.
  listUploading
  ) where

import           Control.Applicative          (liftA3)
import           Control.Lens
import           Control.Monad                (void, when, zipWithM_)
import           Control.Monad.Catch          (MonadMask (..))
import           Control.Monad.Fail           (MonadFail (..))
import           Control.Monad.IO.Class       (MonadIO (..))
import           Control.Monad.State          (StateT (..), evalStateT, get, gets, lift, modify)
import           Control.Retry                (RetryStatus (..), exponentialBackoff, limitRetries, recoverAll)
import qualified Data.Aeson                   as J
import           Data.Aeson.Lens
import qualified Data.ByteString.Lazy         as BL
import           Data.Char                    (toUpper)
import           Data.Maybe                   (fromJust)
import qualified Data.Text                    as T
import           Data.Time.Clock.POSIX        (getCurrentTime)
import qualified Data.Vector                  as V
import           Network.Wreq                 (Options, header, params, putWith)
import           Prelude                      hiding (fail)
import           System.FilePath.Posix        (takeExtension, takeFileName)
import           System.IO                    (IOMode (..), SeekMode (..), hSeek, withFile)
import           System.Posix.Files           (fileSize, getFileStatus)
import           UnliftIO                     (MonadUnliftIO (..))

import           GoPro.Plus.Auth              (AuthInfo (..), HasGoProAuth (..))
import           GoPro.Plus.Internal.AuthHTTP
import           GoPro.Plus.Internal.HTTP
import           GoPro.Plus.Media             (Medium (..), MediumID, MediumType (..), ReadyToViewType (..), list,
                                               putMedium)

type UploadID = T.Text
type DerivativeID = T.Text

-- | GoPro Plus uploader monad.
type Uploader m = StateT (Env m) m

-- This is typically a bad idea, but we assume we only mutate state
-- before we'd ever need an unlift.
instance MonadUnliftIO m => MonadUnliftIO (StateT (Env m) m) where
  withRunInIO :: ((forall a. StateT (Env m) m a -> IO a) -> IO b)
-> StateT (Env m) m b
withRunInIO (forall a. StateT (Env m) m a -> IO a) -> IO b
inner =
    StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get StateT (Env m) m (Env m)
-> (Env m -> StateT (Env m) m b) -> StateT (Env m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env m
st -> (Env m -> m (b, Env m)) -> StateT (Env m) m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Env m -> m (b, Env m)) -> StateT (Env m) m b)
-> (Env m -> m (b, Env m)) -> StateT (Env m) m b
forall a b. (a -> b) -> a -> b
$ \Env m
_ ->
                              ((forall a. m a -> IO a) -> IO (b, Env m)) -> m (b, Env m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (b, Env m)) -> m (b, Env m))
-> ((forall a. m a -> IO a) -> IO (b, Env m)) -> m (b, Env m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (,Env m
st) (b -> (b, Env m)) -> IO b -> IO (b, Env m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. StateT (Env m) m a -> IO a) -> IO b
inner (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (StateT (Env m) m a -> m a) -> StateT (Env m) m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (Env m) m a -> Env m -> m a)
-> Env m -> StateT (Env m) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Env m) m a -> Env m -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Env m
st)

instance HasGoProAuth m => HasGoProAuth (Uploader m) where
  goproAuth :: Uploader m AuthInfo
goproAuth = m AuthInfo -> Uploader m AuthInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth

data Env m = Env {
  Env m -> [FilePath]
fileList   :: [FilePath],
  Env m -> MediumType
mediumType :: MediumType,
  Env m -> Text
extension  :: T.Text,
  Env m -> FilePath
filename   :: String,
  Env m -> Text
mediumID   :: MediumID,
  Env m -> (MonadMask m, Monad m) => FilePath -> m ()
logAction  :: (MonadMask m, Monad m) => String -> m ()
  }

-- | List all media in uploading state.
listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium]
listUploading :: m [Medium]
listUploading = (Medium -> Bool) -> [Medium] -> [Medium]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Medium{Int
FilePath
Maybe Int
Maybe FilePath
Text
UTCTime
ReadyToViewType
MediumType
_medium_height :: Medium -> Maybe Int
_medium_width :: Medium -> Maybe Int
_medium_token :: Medium -> FilePath
_medium_type :: Medium -> MediumType
_medium_source_duration :: Medium -> Maybe FilePath
_medium_ready_to_view :: Medium -> ReadyToViewType
_medium_moments_count :: Medium -> Int
_medium_file_size :: Medium -> Maybe Int
_medium_created_at :: Medium -> UTCTime
_medium_captured_at :: Medium -> UTCTime
_medium_camera_model :: Medium -> Maybe FilePath
_medium_id :: Medium -> Text
_medium_height :: Maybe Int
_medium_width :: Maybe Int
_medium_token :: FilePath
_medium_type :: MediumType
_medium_source_duration :: Maybe FilePath
_medium_ready_to_view :: ReadyToViewType
_medium_moments_count :: Int
_medium_file_size :: Maybe Int
_medium_created_at :: UTCTime
_medium_captured_at :: UTCTime
_medium_camera_model :: Maybe FilePath
_medium_id :: Text
..} -> ReadyToViewType
_medium_ready_to_view ReadyToViewType -> ReadyToViewType -> Bool
forall a. Eq a => a -> a -> Bool
== ReadyToViewType
ViewUploading) ([Medium] -> [Medium])
-> (([Medium], PageInfo) -> [Medium])
-> ([Medium], PageInfo)
-> [Medium]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Medium], PageInfo) -> [Medium]
forall a b. (a, b) -> a
fst (([Medium], PageInfo) -> [Medium])
-> m ([Medium], PageInfo) -> m [Medium]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> m ([Medium], PageInfo)
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Int -> m ([Medium], PageInfo)
list Int
30 Int
1

-- | Run an Uploader monad to create a single medium and upload the content for it.
runUpload :: (HasGoProAuth m, MonadFail m, MonadIO m)
          => [FilePath]   -- ^ The list of files to include in the medium.
          -> Uploader m a -- ^ The action to perform.
          -> m a          -- ^ The result of the inner action.
runUpload :: [FilePath] -> Uploader m a -> m a
runUpload [FilePath]
fileList = [FilePath] -> Text -> Uploader m a -> m a
forall (m :: * -> *) a.
(HasGoProAuth m, MonadFail m, MonadIO m) =>
[FilePath] -> Text -> Uploader m a -> m a
resumeUpload [FilePath]
fileList Text
""

-- | Run an Uploader monad for which we already know the MediumID
-- (i.e., we're resuming an upload we previously began).
resumeUpload :: (HasGoProAuth m, MonadFail m, MonadIO m) => [FilePath] -> MediumID -> Uploader m a -> m a
resumeUpload :: [FilePath] -> Text -> Uploader m a -> m a
resumeUpload [] Text
_ Uploader m a
_ = FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"empty file list"
resumeUpload fileList :: [FilePath]
fileList@(FilePath
fp:[FilePath]
_) Text
mediumID Uploader m a
a =
  m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth m AuthInfo -> (AuthInfo -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AuthInfo{Int
Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
..} -> Uploader m a -> Env m -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Uploader m a
a Env :: forall (m :: * -> *).
[FilePath]
-> MediumType
-> Text
-> FilePath
-> Text
-> ((MonadMask m, Monad m) => FilePath -> m ())
-> Env m
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
forall (f :: * -> *) p. Applicative f => p -> f ()
logAction :: forall (f :: * -> *) p. Applicative f => p -> f ()
mediumType :: MediumType
filename :: FilePath
extension :: Text
mediumID :: Text
fileList :: [FilePath]
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
..}
  where
    extension :: Text
extension = FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
filename
    filename :: FilePath
filename = FilePath -> FilePath
takeFileName FilePath
fp
    mediumType :: MediumType
mediumType = Text -> MediumType
forall a. (Eq a, IsString a) => a -> MediumType
fileType Text
extension
    logAction :: p -> f ()
logAction p
_ = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    fileType :: a -> MediumType
fileType a
"JPG" = MediumType
Photo
    fileType a
_     = MediumType
Video

-- | Override the detected medium type.
setMediumType :: Monad m => MediumType -> Uploader m ()
setMediumType :: MediumType -> Uploader m ()
setMediumType MediumType
t = (Env m -> Env m) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
m -> Env m
m{mediumType :: MediumType
mediumType=MediumType
t})

-- | Set the logging action to report retries (or whatever other
-- interesting things might happen).
setLogAction :: (Monad m, MonadMask m) => (String -> m ()) -> Uploader m ()
setLogAction :: (FilePath -> m ()) -> Uploader m ()
setLogAction FilePath -> m ()
t = (Env m -> Env m) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
m -> Env m
m{logAction :: (MonadMask m, Monad m) => FilePath -> m ()
logAction=FilePath -> m ()
(MonadMask m, Monad m) => FilePath -> m ()
t})

jpostVal :: (HasGoProAuth m, MonadIO m) => Options -> String -> J.Value -> m J.Value
jpostVal :: Options -> FilePath -> Value -> m Value
jpostVal Options
opts FilePath
u Value
v = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> Value -> IO Value
forall (m :: * -> *) a r.
(MonadIO m, Postable a, FromJSON r) =>
Options -> FilePath -> a -> m r
jpostWith Options
opts FilePath
u Value
v

jpostAuthVal :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value
jpostAuthVal :: FilePath -> Value -> m Value
jpostAuthVal = FilePath -> Value -> m Value
forall (m :: * -> *) a r.
(HasGoProAuth m, MonadIO m, Postable a, FromJSON r) =>
FilePath -> a -> m r
jpostAuth

-- | Create a new medium (e.g., video, photo, etc...) and return its ID.
createMedium :: (HasGoProAuth m, MonadIO m) => Uploader m MediumID
createMedium :: Uploader m Text
createMedium = do
  Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
  AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  let m1 :: Value
m1 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"file_extension" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
extension
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"filename" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String (FilePath -> Text
T.pack FilePath
filename)
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"type" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ MediumType -> Value
forall a. ToJSON a => a -> Value
J.toJSON MediumType
mediumType
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"on_public_profile" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"content_title" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String (FilePath -> Text
T.pack FilePath
filename)
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"content_source" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"web_media_library"
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
  Text
m <- Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> (Value -> Maybe Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Value -> Text) -> StateT (Env m) m Value -> Uploader m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Value -> StateT (Env m) m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal FilePath
"https://api.gopro.com/media" Value
m1
  (Env m -> Env m) -> StateT (Env m) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
s -> Env m
s{mediumID :: Text
mediumID=Text
m})
  Text -> Uploader m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
m

-- | Convenient action for creating a Source derivative.
createSource :: (HasGoProAuth m, MonadIO m) => Int -> Uploader m DerivativeID
createSource :: Int -> Uploader m Text
createSource Int
nparts = Int -> Text -> Text -> Uploader m Text
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Text -> Text -> Uploader m Text
createDerivative Int
nparts Text
"Source" Text
"Source"

-- | Create a new derivative of the current medium containing the given number of parts.
createDerivative :: (HasGoProAuth m, MonadIO m)
                 => Int     -- ^ The number of parts this derivative contains.
                 -> T.Text  -- ^ The "type" of this derivative.
                 -> T.Text  -- ^ The label of this derivative.
                 -> Uploader m DerivativeID
createDerivative :: Int -> Text -> Text -> Uploader m Text
createDerivative Int
nparts Text
typ Text
lbl = do
  Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
  AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  let d1 :: Value
d1 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"medium_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
mediumID
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"file_extension" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
extension
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"type" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String  Text
typ
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"label" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
lbl
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"available" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"item_count" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nparts)
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"camera_positions" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"on_public_profile" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
  Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> (Value -> Maybe Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Value -> Text) -> StateT (Env m) m Value -> Uploader m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Value -> StateT (Env m) m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal FilePath
"https://api.gopro.com/derivatives" Value
d1

data UploadPart = UploadPart {
  UploadPart -> Integer
_uploadLength :: Integer,
  UploadPart -> Integer
_uploadPart   :: Integer,
  UploadPart -> FilePath
_uploadURL    :: String
  } deriving Int -> UploadPart -> FilePath -> FilePath
[UploadPart] -> FilePath -> FilePath
UploadPart -> FilePath
(Int -> UploadPart -> FilePath -> FilePath)
-> (UploadPart -> FilePath)
-> ([UploadPart] -> FilePath -> FilePath)
-> Show UploadPart
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [UploadPart] -> FilePath -> FilePath
$cshowList :: [UploadPart] -> FilePath -> FilePath
show :: UploadPart -> FilePath
$cshow :: UploadPart -> FilePath
showsPrec :: Int -> UploadPart -> FilePath -> FilePath
$cshowsPrec :: Int -> UploadPart -> FilePath -> FilePath
Show

makeLenses ''UploadPart

data Upload = Upload {
  Upload -> Text
_uploadID    :: UploadID,
  Upload -> [UploadPart]
_uploadParts :: [UploadPart]
  } deriving Int -> Upload -> FilePath -> FilePath
[Upload] -> FilePath -> FilePath
Upload -> FilePath
(Int -> Upload -> FilePath -> FilePath)
-> (Upload -> FilePath)
-> ([Upload] -> FilePath -> FilePath)
-> Show Upload
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Upload] -> FilePath -> FilePath
$cshowList :: [Upload] -> FilePath -> FilePath
show :: Upload -> FilePath
$cshow :: Upload -> FilePath
showsPrec :: Int -> Upload -> FilePath -> FilePath
$cshowsPrec :: Int -> Upload -> FilePath -> FilePath
Show

makeLenses ''Upload

chunkSize :: Integer
chunkSize :: Integer
chunkSize = Integer
6291456

-- | Create a new upload for a derivative.
createUpload :: (HasGoProAuth m, MonadIO m)
             => DerivativeID -- ^ The derivative into which we're uploading.
             -> Int          -- ^ The part number (1-based) being uploaded.
             -> Int          -- ^ The size of the file being uploaded in this part.
             -> Uploader m Upload
createUpload :: Text -> Int -> Int -> Uploader m Upload
createUpload Text
did Int
part Int
fsize = do
  Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
  AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  let u1 :: Value
u1 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"derivative_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
did
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"camera_position" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"item_number" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part)
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
  Value
ur <- FilePath -> Value -> StateT (Env m) m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpost FilePath
"https://api.gopro.com/user-uploads" Value
u1
  let Just Text
upid = Value
ur Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
  Text -> Text -> Int -> Int -> Uploader m Upload
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Text -> Int -> Int -> Uploader m Upload
getUpload Text
upid Text
did Int
part Int
fsize

  where
    popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~  [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]
    jpost :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value
    jpost :: FilePath -> Value -> m Value
jpost FilePath
u Value
p = (AuthInfo -> Text
_access_token (AuthInfo -> Text) -> m AuthInfo -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth) m Text -> (Text -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
tok -> Options -> FilePath -> Value -> m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Options -> FilePath -> Value -> m Value
jpostVal (Text -> Options
popts Text
tok) FilePath
u Value
p

-- | Retreive an Upload with the given upload and derivative ID.
getUpload :: (HasGoProAuth m, MonadIO m)
          => UploadID      -- ^ ID of the upload to retrieve
          -> DerivativeID  -- ^ ID of the derivative to which the upload belongs
          -> Int           -- ^ Part number within the derivative.
          -> Int           -- ^ Size of this part.
          -> Uploader m Upload
getUpload :: Text -> Text -> Int -> Int -> Uploader m Upload
getUpload Text
upid Text
did Int
part Int
fsize = do
  Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
  AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth

  let pages :: Int
pages = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsize :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunkSize) :: Int
      upopts :: Options
upopts = Text -> Options
authOpts Text
_access_token Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
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
"id", Text
upid),
                                                   (Text
"page", Text
"1"),
                                                   (Text
"per_page", (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
pages),
                                                   (Text
"item_number", (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
part),
                                                   (Text
"camera_position", Text
"default"),
                                                   (Text
"file_size", (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
fsize),
                                                   (Text
"part_size", (FilePath -> Text
T.pack (FilePath -> Text) -> (Integer -> FilePath) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) Integer
chunkSize)]
               Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~  [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]
  Value
upaths <- Options -> FilePath -> StateT (Env m) m Value
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Options -> FilePath -> m a
jgetWith Options
upopts (Text -> FilePath
T.unpack (Text
"https://api.gopro.com/user-uploads/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
did))
  let Just [Value]
ups = (Value
upaths :: J.Value) Value -> Getting (First [Value]) Value [Value] -> Maybe [Value]
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"_embedded" ((Value -> Const (First [Value]) Value)
 -> Value -> Const (First [Value]) Value)
-> Getting (First [Value]) Value [Value]
-> Getting (First [Value]) Value [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"authorizations" ((Value -> Const (First [Value]) Value)
 -> Value -> Const (First [Value]) Value)
-> Getting (First [Value]) Value [Value]
-> Getting (First [Value]) Value [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First [Value]) (Vector Value))
-> Value -> Const (First [Value]) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> Const (First [Value]) (Vector Value))
 -> Value -> Const (First [Value]) Value)
-> (([Value] -> Const (First [Value]) [Value])
    -> Vector Value -> Const (First [Value]) (Vector Value))
-> Getting (First [Value]) Value [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> [Value])
-> ([Value] -> Const (First [Value]) [Value])
-> Vector Value
-> Const (First [Value]) (Vector Value)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList
  Upload -> Uploader m Upload
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Upload -> Uploader m Upload) -> Upload -> Uploader m Upload
forall a b. (a -> b) -> a -> b
$ Text -> [UploadPart] -> Upload
Upload Text
upid (Maybe [UploadPart] -> [UploadPart]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [UploadPart] -> [UploadPart])
-> Maybe [UploadPart] -> [UploadPart]
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe UploadPart) -> [Value] -> Maybe [UploadPart]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Maybe UploadPart
forall s. AsValue s => s -> Maybe UploadPart
aChunk [Value]
ups)

  where
    tInt :: T.Text -> Integer
    tInt :: Text -> Integer
tInt = FilePath -> Integer
forall a. Read a => FilePath -> a
read (FilePath -> Integer) -> (Text -> FilePath) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
    aChunk :: s -> Maybe UploadPart
aChunk s
v = (Integer -> Integer -> FilePath -> UploadPart)
-> Maybe Integer
-> Maybe Integer
-> Maybe FilePath
-> Maybe UploadPart
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Integer -> Integer -> FilePath -> UploadPart
UploadPart (s
v s -> Getting (First Integer) s Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"Content-Length" ((Value -> Const (First Integer) Value)
 -> s -> Const (First Integer) s)
-> ((Integer -> Const (First Integer) Integer)
    -> Value -> Const (First Integer) Value)
-> Getting (First Integer) s Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Integer) Text)
-> Value -> Const (First Integer) Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const (First Integer) Text)
 -> Value -> Const (First Integer) Value)
-> ((Integer -> Const (First Integer) Integer)
    -> Text -> Const (First Integer) Text)
-> (Integer -> Const (First Integer) Integer)
-> Value
-> Const (First Integer) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Integer)
-> (Integer -> Const (First Integer) Integer)
-> Text
-> Const (First Integer) Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Integer
tInt)
                                 (s
v s -> Getting (First Integer) s Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"part" ((Value -> Const (First Integer) Value)
 -> s -> Const (First Integer) s)
-> ((Integer -> Const (First Integer) Integer)
    -> Value -> Const (First Integer) Value)
-> Getting (First Integer) s Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value
forall t. AsNumber t => Prism' t Integer
_Integer ((Integer -> Const (First Integer) Integer)
 -> Value -> Const (First Integer) Value)
-> ((Integer -> Const (First Integer) Integer)
    -> Integer -> Const (First Integer) Integer)
-> (Integer -> Const (First Integer) Integer)
-> Value
-> Const (First Integer) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer)
-> (Integer -> Const (First Integer) Integer)
-> Integer
-> Const (First Integer) Integer
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Integer -> Integer
forall a. Integral a => a -> Integer
toInteger)
                                 (s
v s -> Getting (First FilePath) s FilePath -> Maybe FilePath
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"url" ((Value -> Const (First FilePath) Value)
 -> s -> Const (First FilePath) s)
-> ((FilePath -> Const (First FilePath) FilePath)
    -> Value -> Const (First FilePath) Value)
-> Getting (First FilePath) s FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First FilePath) Text)
-> Value -> Const (First FilePath) Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const (First FilePath) Text)
 -> Value -> Const (First FilePath) Value)
-> ((FilePath -> Const (First FilePath) FilePath)
    -> Text -> Const (First FilePath) Text)
-> (FilePath -> Const (First FilePath) FilePath)
-> Value
-> Const (First FilePath) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FilePath)
-> (FilePath -> Const (First FilePath) FilePath)
-> Text
-> Const (First FilePath) Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> FilePath
T.unpack)

-- | Upload a chunk of of the given file as specified by this UploadPart.
uploadChunk :: (MonadMask m, MonadIO m)
            => FilePath    -- ^ The path being uploaded.
            -> UploadPart  -- ^ The UploadPart describing the chunk of upload being transferred
            -> Uploader m ()
uploadChunk :: FilePath -> UploadPart -> Uploader m ()
uploadChunk FilePath
fp UploadPart{Integer
FilePath
_uploadURL :: FilePath
_uploadPart :: Integer
_uploadLength :: Integer
_uploadURL :: UploadPart -> FilePath
_uploadPart :: UploadPart -> Integer
_uploadLength :: UploadPart -> Integer
..} = RetryPolicyM (StateT (Env m) m)
-> (RetryStatus -> Uploader m ()) -> Uploader m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll RetryPolicyM (StateT (Env m) m)
policy ((RetryStatus -> Uploader m ()) -> Uploader m ())
-> (RetryStatus -> Uploader m ()) -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ \RetryStatus
r -> do
  Bool -> Uploader m () -> Uploader m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RetryStatus -> Int
rsIterNumber RetryStatus
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Uploader m () -> Uploader m ()) -> Uploader m () -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ (Env m -> FilePath -> m ()) -> StateT (Env m) m (FilePath -> m ())
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env m -> FilePath -> m ()
forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
logAction StateT (Env m) m (FilePath -> m ())
-> ((FilePath -> m ()) -> Uploader m ()) -> Uploader m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath -> m ()
f -> m () -> Uploader m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> m ()
f (Int -> FilePath
forall a. Show a => a -> FilePath
retryMsg (RetryStatus -> Int
rsIterNumber RetryStatus
r)))
  IO () -> Uploader m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Uploader m ()) -> IO () -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
fh -> do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
fh SeekMode
AbsoluteSeek ((Integer
_uploadPart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
chunkSize)
    IO (Response ByteString) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Response ByteString) -> IO ())
-> IO (Response ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> ByteString -> IO (Response ByteString)
forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith Options
defOpts FilePath
_uploadURL (ByteString -> IO (Response ByteString))
-> IO ByteString -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> Int -> IO ByteString
BL.hGet Handle
fh (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_uploadLength)

    where policy :: RetryPolicyM (StateT (Env m) m)
policy = Int -> RetryPolicy
exponentialBackoff Int
2000000 RetryPolicyM (StateT (Env m) m)
-> RetryPolicyM (StateT (Env m) m)
-> RetryPolicyM (StateT (Env m) m)
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
9
          retryMsg :: a -> FilePath
retryMsg a
a = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"Retrying upload of ", FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp,
                                FilePath
" part ", Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
_uploadPart, FilePath
" attempt ", a -> FilePath
forall a. Show a => a -> FilePath
show a
a]

-- | Mark the given upload for the given derivative as complete.
completeUpload :: (HasGoProAuth m, MonadIO m)
               => UploadID     -- ^ The upload ID.
               -> DerivativeID -- ^ The derivative ID.
               -> Int          -- ^ The part number within the derivative.
               -> Integer      -- ^ The size of the file that was uploaded.
               -> Uploader m ()
completeUpload :: Text -> Text -> Int -> Integer -> Uploader m ()
completeUpload Text
upid Text
did Int
part Integer
fsize = do
  Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
  AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  let u2 :: Value
u2 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
upid
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"item_number" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part)
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"camera_position" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"complete" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
True
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"derivative_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
did
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"file_size" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String ((FilePath -> Text
T.pack (FilePath -> Text) -> (Integer -> FilePath) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) Integer
fsize)
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"part_size" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String ((FilePath -> Text
T.pack (FilePath -> Text) -> (Integer -> FilePath) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) Integer
chunkSize))
  StateT (Env m) m (Response ByteString) -> Uploader m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT (Env m) m (Response ByteString) -> Uploader m ())
-> (IO (Response ByteString)
    -> StateT (Env m) m (Response ByteString))
-> IO (Response ByteString)
-> Uploader m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ByteString) -> StateT (Env m) m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> Uploader m ())
-> IO (Response ByteString) -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> Value -> IO (Response ByteString)
forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith (Text -> Options
popts Text
_access_token) (Text -> FilePath
T.unpack (Text
"https://api.gopro.com/user-uploads/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
did)) Value
u2

  where
    popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~  [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]

-- | Mark the given derivative as availble to use.  This also updates
-- the medium record marking it as having completed its upload.
markAvailable :: (HasGoProAuth m, MonadIO m) => DerivativeID -> Uploader m ()
markAvailable :: Text -> Uploader m ()
markAvailable Text
did = do
  Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
  AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  let d2 :: Value
d2 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"available" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
True
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
                     Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)

  Response ByteString
_ <- IO (Response ByteString) -> StateT (Env m) m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> StateT (Env m) m (Response ByteString))
-> IO (Response ByteString)
-> StateT (Env m) m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> Value -> IO (Response ByteString)
forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith (Text -> Options
popts Text
_access_token) (Text -> FilePath
T.unpack (Text
"https://api.gopro.com/derivatives/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
did)) Value
d2

  UTCTime
now <- IO UTCTime -> StateT (Env m) m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let done :: Value
done = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"upload_completed_at" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UTCTime -> Value
forall a. ToJSON a => a -> Value
J.toJSON UTCTime
now
                       Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"client_updated_at" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UTCTime -> Value
forall a. ToJSON a => a -> Value
J.toJSON UTCTime
now
                       Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"revision_number" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number Scientific
0
                       Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
                       Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)

  Text -> Value -> Uploader m ()
forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, Putable a) =>
Text -> a -> m ()
putMedium Text
mediumID Value
done

  where
    popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~  [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]

-- | Convenience action to upload a single medium.
uploadMedium :: (HasGoProAuth m, MonadMask m, MonadFail m, MonadIO m)
             => [FilePath] -- ^ Parts of a single medium to upload (e.g., a video file).
             -> m MediumID
uploadMedium :: [FilePath] -> m Text
uploadMedium [] = FilePath -> m Text
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no files provided"
uploadMedium [FilePath]
fps = [FilePath] -> Uploader m Text -> m Text
forall (m :: * -> *) a.
(HasGoProAuth m, MonadFail m, MonadIO m) =>
[FilePath] -> Uploader m a -> m a
runUpload [FilePath]
fps (Uploader m Text -> m Text) -> Uploader m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  Text
mid <- Uploader m Text
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Uploader m Text
createMedium
  Text
did <- Int -> Uploader m Text
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Uploader m Text
createSource ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
fps)
  (FilePath -> Int -> StateT (Env m) m ())
-> [FilePath] -> [Int] -> StateT (Env m) m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\FilePath
fp Int
n -> do
            Integer
fsize <- FileOffset -> Integer
forall a. Integral a => a -> Integer
toInteger (FileOffset -> Integer)
-> (FileStatus -> FileOffset) -> FileStatus -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize (FileStatus -> Integer)
-> StateT (Env m) m FileStatus -> StateT (Env m) m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO FileStatus -> StateT (Env m) m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> StateT (Env m) m FileStatus)
-> (FilePath -> IO FileStatus)
-> FilePath
-> StateT (Env m) m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getFileStatus) FilePath
fp
            Upload{[UploadPart]
Text
_uploadParts :: [UploadPart]
_uploadID :: Text
_uploadParts :: Upload -> [UploadPart]
_uploadID :: Upload -> Text
..} <- Text -> Int -> Int -> Uploader m Upload
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Int -> Int -> Uploader m Upload
createUpload Text
did Int
n (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
fsize)
            (UploadPart -> StateT (Env m) m ())
-> [UploadPart] -> StateT (Env m) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> UploadPart -> StateT (Env m) m ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
FilePath -> UploadPart -> Uploader m ()
uploadChunk FilePath
fp) [UploadPart]
_uploadParts
            Text -> Text -> Int -> Integer -> StateT (Env m) m ()
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Text -> Int -> Integer -> Uploader m ()
completeUpload Text
_uploadID Text
did Int
n Integer
fsize
        ) [FilePath]
fps [Int
1..]
  Text -> StateT (Env m) m ()
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Uploader m ()
markAvailable Text
did

  Text -> Uploader m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
mid