{-# LANGUAGE LambdaCase #-}

module Main (main) where

import           Data.Text (Text)
import qualified Data.Text as T
import           Nuthatch.Paths
  ( buildObjectKey
  , encodeUserId
  , listCacheAncestorPrefixes
  , validateRelativePath
  )
import           Nuthatch.Protocol
  ( MutationRecord (..)
  , ObjectObservation (..)
  , desiredMatches
  , priorMatches
  )
import           Nuthatch.Types

main :: IO ()
main = do
  assertRight "simple path" (validateRelativePath "a/b.txt")
  assertLeft "dotdot" (validateRelativePath "a/../b")
  assertLeft "empty segment" (validateRelativePath "a//b")
  assertLeft "slash only" (validateRelativePath "/")
  let uid = encodeUserId "iss" "sub"
  assertTrue "user id stable" (uid == encodeUserId "iss" "sub")
  assertTrue "user id differs"
    (encodeUserId "iss" "sub" /= encodeUserId "iss" "other")
  let key = buildObjectKey Personal uid (RelativePath "docs/a.txt")
  assertTrue "personal key prefix" $
    T.isPrefixOf ("users/" <> unUserId uid <> "/") (unObjectKey key)
  let shared = buildObjectKey Shared uid (RelativePath "docs/a.txt")
  assertTrue "shared key" (unObjectKey shared == "shared/docs/a.txt")

  assertTrue "list ancestors nested" $
    listCacheAncestorPrefixes (RelativePath "docs/a/b.txt")
      == ["", "docs", "docs/a"]
  assertTrue "list ancestors root file" $
    listCacheAncestorPrefixes (RelativePath "file.txt") == [""]

  let putRec = samplePut
  assertTrue "put desired present" $
    desiredMatches putRec (ObjectPresent 10 (Just (ContentSha256 "abc")))
  assertTrue "put not desired absent" $
    not (desiredMatches putRec ObjectAbsent)
  assertTrue "put unavailable not desired" $
    not (desiredMatches putRec (ObjectUnavailable "timeout"))
  assertTrue "put prior empty absent" $
    priorMatches putRec ObjectAbsent
  assertTrue "put unavailable not prior" $
    not (priorMatches putRec (ObjectUnavailable "timeout"))
  let delRec = sampleDelete
  assertTrue "delete desired absent" $
    desiredMatches delRec ObjectAbsent
  assertTrue "delete not desired present" $
    not (desiredMatches delRec (ObjectPresent 10 Nothing))

  putStrLn "nuthatch-unit: ok"

samplePut :: MutationRecord
samplePut = MutationRecord
  { mrUserId = UserId "u"
  , mrKind = Put
  , mrOperationId = OperationId "op"
  , mrPoolId = PoolId "personal:u"
  , mrObjectKey = ObjectKey "users/u/file.txt"
  , mrRelativePath = RelativePath "file.txt"
  , mrDeclaredSize = 10
  , mrContentSha256 = Just (ContentSha256 "abc")
  , mrPriorSize = 0
  , mrPriorSha256 = Nothing
  , mrGrowth = 10
  , mrState = Applying
  , mrExternal = ExtSettled
  }

sampleDelete :: MutationRecord
sampleDelete = samplePut
  { mrKind = Delete
  , mrDeclaredSize = 0
  , mrContentSha256 = Nothing
  , mrPriorSize = 10
  , mrPriorSha256 = Just (ContentSha256 "abc")
  , mrGrowth = 0
  }

assertRight :: String -> Either Text a -> IO ()
assertRight label = \case
  Right _ -> pure ()
  Left err -> fail (label <> ": " <> T.unpack err)

assertLeft :: String -> Either Text a -> IO ()
assertLeft label = \case
  Left _  -> pure ()
  Right _ -> fail (label <> ": expected failure")

assertTrue :: String -> Bool -> IO ()
assertTrue _ True  = pure ()
assertTrue label False = fail (label <> ": expected True")