module MSGraphAPI.Files.DriveItems where

import GHC.Generics (Generic(..))

-- aeson
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON)
-- bytestring
import qualified Data.ByteString.Lazy as LBS (ByteString)
-- hoauth
import Network.OAuth.OAuth2.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (Req)
-- text
import Data.Text (Text, pack, unpack)

import qualified MSGraphAPI.Internal.Common as MSG (get, getLbs, post, Collection, aesonOptions)

-- | download a complete file from user's directory
--
-- @GET \/me\/drive\/items\/{item-id}\/content@
--
-- https://learn.microsoft.com/en-us/graph/api/driveitem-get-content?view=graph-rest-1.0&tabs=http#request
downloadFileMe :: Text -- ^ item ID
               -> AccessToken -> Req LBS.ByteString
downloadFileMe :: Text -> AccessToken -> Req ByteString
downloadFileMe Text
itemId = [Text] -> Option 'Https -> AccessToken -> Req ByteString
MSG.getLbs [Text
"me", Text
"drive", Text
"items", Text
itemId, Text
"content"] forall a. Monoid a => a
mempty

-- | download a file from a drive
--
-- @GET \/drives\/{drive-id}\/items\/{item-id}\/content@
--
-- https://learn.microsoft.com/en-us/graph/api/driveitem-get-content?view=graph-rest-1.0&tabs=http#request
downloadFile :: Text -- ^ drive ID
             -> Text -- ^ file ID
             -> AccessToken -> Req LBS.ByteString
downloadFile :: Text -> Text -> AccessToken -> Req ByteString
downloadFile Text
did Text
itemId = [Text] -> Option 'Https -> AccessToken -> Req ByteString
MSG.getLbs [Text
"drives", Text
did, Text
"items", Text
itemId, Text
"content"] forall a. Monoid a => a
mempty