module MSGraphAPI.Files.Drive (
  listDrivesMe
  , listDrivesGroup
  -- * types
  , Drive(..)
                              ) where

-- import Control.Applicative (Alternative(..))
-- import Data.Int (Int32)
import GHC.Generics (Generic(..))

-- aeson
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON)
-- import qualified Data.Aeson.Types as A (Parser)
-- 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)
-- time
import Data.Time (ZonedTime)

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

-- | The top-level object that represents a user's OneDrive or a document library in SharePoint.
--
-- OneDrive users will always have at least one drive available, their default drive. Users without a OneDrive license may not have a default drive available.
--
-- https://learn.microsoft.com/en-us/graph/api/resources/drive?view=graph-rest-1.0
data Drive = Drive {
  Drive -> Text
dId :: Text
  , Drive -> Text
dName :: Text
  , Drive -> Text
dDescription :: Text
  , Drive -> ZonedTime
dLastModifiedDateTime :: ZonedTime -- 2022-11-28T09:18:45Z
  , Drive -> Text
dDriveType :: Text
                           } deriving (Int -> Drive -> ShowS
[Drive] -> ShowS
Drive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Drive] -> ShowS
$cshowList :: [Drive] -> ShowS
show :: Drive -> String
$cshow :: Drive -> String
showsPrec :: Int -> Drive -> ShowS
$cshowsPrec :: Int -> Drive -> ShowS
Show, forall x. Rep Drive x -> Drive
forall x. Drive -> Rep Drive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Drive x -> Drive
$cfrom :: forall x. Drive -> Rep Drive x
Generic)
instance A.FromJSON Drive where
  parseJSON :: Value -> Parser Drive
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"d")
instance A.ToJSON Drive

-- | List the current user's drives
--
-- @GET \/me\/drives@
listDrivesMe :: AccessToken -> Req (MSG.Collection Drive)
listDrivesMe :: AccessToken -> Req (Collection Drive)
listDrivesMe = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"me", Text
"drives"] forall a. Monoid a => a
mempty


-- | To list the document libraries for a group, your app requests the drives relationship on the Group.
--
-- @GET \/groups\/{groupId}\/drives@
listDrivesGroup :: Text -- ^ group ID
                -> AccessToken -> Req (MSG.Collection Drive)
listDrivesGroup :: Text -> AccessToken -> Req (Collection Drive)
listDrivesGroup Text
gid = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"groups", Text
gid, Text
"drives"] forall a. Monoid a => a
mempty