NodeData.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune #-}

{- |
Module      : Network.HStratus.Internal.Drive.NodeData
Copyright   : (c) 2026 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD-3-Clause

JSON parsers for iCloud Drive API responses: node metadata, download URLs, and upload receipts.
-}
module Network.HStratus.Internal.Drive.NodeData
  ( parseNodeResponse
  , parseChildrenResponse
  , parseDownloadUrl
  , UploadReceipt (..)
  , parseUploadTokenResponse
  , parseUploadReceiptResponse
  )
where

import Data.Aeson
  ( Object
  , Value
  , withArray
  , withObject
  , (.:)
  , (.:?)
  )
import Data.Aeson.Types (Parser)
import Data.Functor ((<&>))
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (UTCTime, ZonedTime, zonedTimeToUTC)
import Data.Time.Format.ISO8601 (iso8601ParseM)
import qualified Data.Vector as V
import Network.HStratus.Internal.Drive.Node
  ( DriveNode (..)
  , DriveNodeId (..)
  , FileData (..)
  , FolderData (..)
  )


{- | Parse the first element of a @retrieveItemDetailsInFolders@ response as a
@DriveNode@.
-}
parseNodeResponse :: Value -> Parser DriveNode
parseNodeResponse = withArray "node response" $ \arr ->
  case V.toList arr of
    [] -> fail "retrieveItemDetailsInFolders: empty response array"
    (v : _) -> parseNode v


{- | Parse the children from the first element of a
@retrieveItemDetailsInFolders@ response.
-}
parseChildrenResponse :: Value -> Parser [DriveNode]
parseChildrenResponse = withArray "children response" $ \arr ->
  case V.toList arr of
    [] -> fail "retrieveItemDetailsInFolders: empty response array"
    (v : _) -> withObject "folder" parseItems v


-- | Extract the download URL from a @download/by_id@ response.
parseDownloadUrl :: Value -> Parser Text
parseDownloadUrl = withObject "download response" $ \o -> do
  dataToken <- o .:? "data_token"
  pkgToken <- o .:? "package_token"
  case (dataToken, pkgToken) of
    (Just dt, _) -> withObject "data_token" (.: "url") dt
    (_, Just pt) -> withObject "package_token" (.: "url") pt
    _other -> fail "download response: neither data_token nor package_token found"


parseNode :: Value -> Parser DriveNode
parseNode = withObject "DriveNode" $ \o -> do
  nodeType <- o .: "type" :: Parser Text
  case nodeType of
    "FILE" -> DriveFile <$> parseFileData o
    "FOLDER" -> DriveFolder <$> parseFolderData o
    "APP_LIBRARY" -> DriveFolder <$> parseFolderData o
    other -> fail $ "DriveNode: unknown node type: " <> Text.unpack other


parseFolderData :: Object -> Parser FolderData
parseFolderData o =
  (FolderData . DriveNodeId <$> (o .: "drivewsid"))
    <*> o .: "etag"
    <*> o .: "name"
    <*> o .: "zone"
    <*> (o .:? "dateCreated" >>= traverse parseTimestamp)


parseFileData :: Object -> Parser FileData
parseFileData o =
  (FileData . DriveNodeId <$> (o .: "drivewsid"))
    <*> o .: "docwsid"
    <*> o .: "etag"
    <*> o .: "name"
    <*> o .:? "extension"
    <*> o .: "zone"
    <*> o .:? "size"
    <*> (o .:? "dateCreated" >>= traverse parseTimestamp)
    <*> (o .:? "dateModified" >>= traverse parseTimestamp)


parseItems :: Object -> Parser [DriveNode]
parseItems o = do
  items <- (o .:? "items") <&> fromMaybe []
  mapM parseNode items


-- | Checksum metadata returned after uploading file content (step 2 of upload).
data UploadReceipt = UploadReceipt
  { urFileChecksum :: !Text
  -- ^ SHA-256 checksum of the uploaded file
  , urWrappingKey :: !Text
  -- ^ encryption wrapping key returned by the upload endpoint
  , urReferenceChecksum :: !Text
  -- ^ reference checksum used in the commit body
  , urSize :: !Int64
  -- ^ byte size of the uploaded content
  , urReceipt :: !(Maybe Text)
  -- ^ opaque receipt token; @Nothing@ when absent from the server response
  }


-- | Parse the @upload/web@ response to extract @(document_id, upload_url)@.
parseUploadTokenResponse :: Value -> Parser (Text, Text)
parseUploadTokenResponse = withArray "upload token response" $ \arr ->
  case V.toList arr of
    [] -> fail "upload token response: empty array"
    (v : _) ->
      withObject "upload token" (\o -> (,) <$> o .: "document_id" <*> o .: "url") v


-- | Parse the multipart-upload response body to extract 'UploadReceipt'.
parseUploadReceiptResponse :: Value -> Parser UploadReceipt
parseUploadReceiptResponse = withObject "upload receipt response" $ \o -> do
  sf <- o .: "singleFile"
  withObject "singleFile" parseReceiptFields sf


parseReceiptFields :: Object -> Parser UploadReceipt
parseReceiptFields o =
  UploadReceipt
    <$> o .: "fileChecksum"
    <*> o .: "wrappingKey"
    <*> o .: "referenceChecksum"
    <*> o .: "size"
    <*> o .:? "receipt"


-- | Parse an ISO 8601 timestamp in either UTC (@Z@) or offset (@±HH:MM@) form.
parseTimestamp :: Text -> Parser UTCTime
parseTimestamp t =
  let s = Text.unpack t
   in case (iso8601ParseM s :: Maybe UTCTime) of
        Just ut -> pure ut
        Nothing -> case (iso8601ParseM s :: Maybe ZonedTime) of
          Just zt -> pure (zonedTimeToUTC zt)
          Nothing -> fail $ "invalid ISO 8601 timestamp: " <> s