module MSGraphAPI.Files.DriveItem 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)
-- time
import Data.Time (LocalTime)

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

data DriveItem = DriveItem {
  DriveItem -> Text
diId :: Text
  , DriveItem -> Text
diName :: Text
  , DriveItem -> LocalTime
diLastModifiedDateTime :: LocalTime
                           } deriving (DriveItem -> DriveItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DriveItem -> DriveItem -> Bool
$c/= :: DriveItem -> DriveItem -> Bool
== :: DriveItem -> DriveItem -> Bool
$c== :: DriveItem -> DriveItem -> Bool
Eq, Eq DriveItem
DriveItem -> DriveItem -> Bool
DriveItem -> DriveItem -> Ordering
DriveItem -> DriveItem -> DriveItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DriveItem -> DriveItem -> DriveItem
$cmin :: DriveItem -> DriveItem -> DriveItem
max :: DriveItem -> DriveItem -> DriveItem
$cmax :: DriveItem -> DriveItem -> DriveItem
>= :: DriveItem -> DriveItem -> Bool
$c>= :: DriveItem -> DriveItem -> Bool
> :: DriveItem -> DriveItem -> Bool
$c> :: DriveItem -> DriveItem -> Bool
<= :: DriveItem -> DriveItem -> Bool
$c<= :: DriveItem -> DriveItem -> Bool
< :: DriveItem -> DriveItem -> Bool
$c< :: DriveItem -> DriveItem -> Bool
compare :: DriveItem -> DriveItem -> Ordering
$ccompare :: DriveItem -> DriveItem -> Ordering
Ord, Int -> DriveItem -> ShowS
[DriveItem] -> ShowS
DriveItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DriveItem] -> ShowS
$cshowList :: [DriveItem] -> ShowS
show :: DriveItem -> String
$cshow :: DriveItem -> String
showsPrec :: Int -> DriveItem -> ShowS
$cshowsPrec :: Int -> DriveItem -> ShowS
Show, forall x. Rep DriveItem x -> DriveItem
forall x. DriveItem -> Rep DriveItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DriveItem x -> DriveItem
$cfrom :: forall x. DriveItem -> Rep DriveItem x
Generic)
instance A.FromJSON DriveItem where
  parseJSON :: Value -> Parser DriveItem
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"di")


-- | 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