{-|
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, setChunkSize,
  -- * 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.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.Char8        as BC
import qualified Data.ByteString.Lazy         as BL
import           Data.Char                    (toUpper)
import           Data.List.NonEmpty           (NonEmpty (..))
import qualified Data.List.NonEmpty           as NE
import           Data.Maybe                   (fromJust, fromMaybe)
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           System.FilePath.Posix        (takeExtension, takeFileName)
import           System.IO                    (IOMode (..), SeekMode (..), hSeek, withFile)
import           System.Posix.Files           (fileSize, getFileStatus)
import           Text.Read                    (readMaybe)
import           UnliftIO                     (MonadUnliftIO (..))

import           Control.Monad.Logger         (MonadLogger (..), logInfoN)
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 = StateT Env

-- 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) where
  withRunInIO :: ((forall a. StateT Env m a -> IO a) -> IO b) -> StateT Env m b
withRunInIO (forall a. StateT Env m a -> IO a) -> IO b
inner =
    StateT Env m Env
forall s (m :: * -> *). MonadState s m => m s
get StateT Env m Env -> (Env -> StateT Env m b) -> StateT Env m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env
st -> (Env -> m (b, Env)) -> StateT Env m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Env -> m (b, Env)) -> StateT Env m b)
-> (Env -> m (b, Env)) -> StateT Env m b
forall a b. (a -> b) -> a -> b
$ \Env
_ ->
                              ((forall a. m a -> IO a) -> IO (b, Env)) -> m (b, Env)
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 (b, Env))
-> ((forall a. m a -> IO a) -> IO (b, Env)) -> m (b, Env)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (,Env
st) (b -> (b, Env)) -> IO b -> IO (b, Env)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. StateT Env 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 a -> m a) -> StateT Env m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Env m a -> Env -> m a) -> Env -> StateT Env m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Env m a -> Env -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Env
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 = Env {
  Env -> NonEmpty FilePath
fileList   :: NonEmpty FilePath,
  Env -> MediumType
mediumType :: MediumType,
  Env -> Text
extension  :: T.Text,
  Env -> FilePath
filename   :: String,
  Env -> Text
mediumID   :: MediumID,
  Env -> Integer
chunkSize  :: Integer
  }

-- | 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
UTCTime
Text
ReadyToViewType
MediumType
_medium_filename :: Medium -> Maybe FilePath
_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_filename :: Maybe FilePath
_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, MonadIO m)
          => NonEmpty 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 :: NonEmpty FilePath -> Uploader m a -> m a
runUpload NonEmpty FilePath
fileList = NonEmpty FilePath -> Text -> Uploader m a -> m a
forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Text -> Uploader m a -> m a
resumeUpload NonEmpty FilePath
fileList Text
""

defaultChunkSize :: Integer
defaultChunkSize :: Integer
defaultChunkSize = Integer
6Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1024Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1024

-- | Run an Uploader monad for which we already know the MediumID
-- (i.e., we're resuming an upload we previously began).
resumeUpload :: (HasGoProAuth m, MonadIO m) => NonEmpty FilePath -> MediumID -> Uploader m a -> m a
resumeUpload :: NonEmpty FilePath -> Text -> Uploader m a -> m a
resumeUpload fileList :: NonEmpty FilePath
fileList@(FilePath
fp :| [FilePath]
_) Text
mediumID Uploader m a
a = Uploader m a -> Env -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Uploader m a
a Env :: NonEmpty FilePath
-> MediumType -> Text -> FilePath -> Text -> Integer -> Env
Env{Integer
FilePath
Text
NonEmpty FilePath
MediumType
chunkSize :: Integer
mediumType :: MediumType
filename :: FilePath
extension :: Text
mediumID :: Text
fileList :: NonEmpty FilePath
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty 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
    chunkSize :: Integer
chunkSize = Integer
defaultChunkSize

    fileType :: a -> MediumType
fileType a
"JPG" = MediumType
Photo
    fileType a
"GPR" = 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 -> Env) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
m -> Env
m{mediumType :: MediumType
mediumType=MediumType
t})

-- | Set the individual chunk size for uploading parts of media.
setChunkSize :: (Monad m, MonadMask m) => Integer -> Uploader m ()
setChunkSize :: Integer -> Uploader m ()
setChunkSize Integer
t = (Env -> Env) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
m -> Env
m{chunkSize :: Integer
chunkSize=Integer
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{Integer
FilePath
Text
NonEmpty FilePath
MediumType
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
chunkSize :: Env -> Integer
mediumID :: Env -> Text
filename :: Env -> FilePath
extension :: Env -> Text
mediumType :: Env -> MediumType
fileList :: Env -> NonEmpty FilePath
..} <- StateT Env m Env
forall s (m :: * -> *). MonadState s m => m s
get
  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
..} <- StateT Env 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
"gda"
                     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 (Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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. AsValue t => Prism' t Text
_String) (Value -> Text) -> StateT Env m Value -> Uploader m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Value -> StateT Env m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal FilePath
"https://api.gopro.com/media" Value
m1
  (Env -> Env) -> StateT Env m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
s -> Env
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{Integer
FilePath
Text
NonEmpty FilePath
MediumType
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
chunkSize :: Env -> Integer
mediumID :: Env -> Text
filename :: Env -> FilePath
extension :: Env -> Text
mediumType :: Env -> MediumType
fileList :: Env -> NonEmpty FilePath
..} <- StateT Env m Env
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 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 (Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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. AsValue t => Prism' t Text
_String) (Value -> Text) -> StateT Env m Value -> Uploader m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Value -> StateT Env 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

-- | 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
  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 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 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
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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. AsValue 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
  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 AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  Integer
csize <- (Env -> Integer) -> StateT Env m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Integer
chunkSize

  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
csize) :: 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
csize)]
               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 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
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"_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
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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 = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer)
-> (Text -> Maybe Integer) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Integer
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe Integer)
-> (Text -> FilePath) -> Text -> Maybe 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
^? Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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. AsValue 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
^? Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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
^? Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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. AsValue 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, MonadLogger 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)
-> (RetryStatus -> Uploader m ()) -> Uploader m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll RetryPolicyM (StateT Env 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
$ m () -> Uploader m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoN (Int -> Text
forall a. Show a => a -> Text
retryMsg (RetryStatus -> Int
rsIterNumber RetryStatus
r)))
  Integer
csize <- (Env -> Integer) -> StateT Env m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Integer
chunkSize
  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
csize)
    ByteString
bytes <- Handle -> Int -> IO ByteString
BL.hGet Handle
fh (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_uploadLength)
    let opts :: Options
opts = Options
defOpts Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Content-Length" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath -> ByteString
BC.pack (FilePath -> ByteString)
-> (ByteString -> FilePath) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> FilePath
forall a. Show a => a -> FilePath
show (Int64 -> FilePath)
-> (ByteString -> Int64) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bytes]
    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
opts FilePath
_uploadURL ByteString
bytes

    where policy :: RetryPolicyM (StateT Env m)
policy = Int -> RetryPolicyM (StateT Env m)
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
exponentialBackoff Int
2000000 RetryPolicyM (StateT Env m)
-> RetryPolicyM (StateT Env m) -> RetryPolicyM (StateT Env m)
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
9
          retryMsg :: a -> Text
retryMsg a
a = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [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
  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 AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  Integer
csize <- (Env -> Integer) -> StateT Env m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Integer
chunkSize
  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
csize))
  StateT Env m (Response ByteString) -> Uploader m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Env m (Response ByteString) -> Uploader m ())
-> (IO (Response ByteString) -> StateT Env m (Response ByteString))
-> IO (Response ByteString)
-> Uploader m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ByteString) -> StateT Env 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{Integer
FilePath
Text
NonEmpty FilePath
MediumType
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
chunkSize :: Env -> Integer
mediumID :: Env -> Text
filename :: Env -> FilePath
extension :: Env -> Text
mediumType :: Env -> MediumType
fileList :: Env -> NonEmpty FilePath
..} <- StateT Env m Env
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 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 (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> StateT Env m (Response ByteString))
-> IO (Response ByteString) -> StateT Env 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 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, MonadIO m, MonadLogger m)
             => NonEmpty FilePath -- ^ Parts of a single medium to upload (e.g., a video file).
             -> m MediumID
uploadMedium :: NonEmpty FilePath -> m Text
uploadMedium NonEmpty FilePath
fps = NonEmpty FilePath -> Uploader m Text -> m Text
forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Uploader m a -> m a
runUpload NonEmpty 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 (NonEmpty FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty FilePath
fps)
  (FilePath -> Int -> StateT Env m ())
-> [FilePath] -> [Int] -> StateT Env 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 FileStatus -> StateT Env m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO FileStatus -> StateT Env m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> StateT Env m FileStatus)
-> (FilePath -> IO FileStatus)
-> FilePath
-> StateT Env 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 ()) -> [UploadPart] -> StateT Env m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> UploadPart -> StateT Env m ()
forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadLogger m) =>
FilePath -> UploadPart -> Uploader m ()
uploadChunk FilePath
fp) [UploadPart]
_uploadParts
            Text -> Text -> Int -> Integer -> StateT Env m ()
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Text -> Int -> Integer -> Uploader m ()
completeUpload Text
_uploadID Text
did Int
n Integer
fsize
        ) (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
fps) [Int
1..]
  Text -> StateT Env 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