{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
module System.Directory.Layout.InterpreterSpec
  ( spec
  ) where

import           Control.Applicative
import           Control.Lens
import           Control.Monad
import qualified Data.ByteString as ByteString
import           Data.Foldable (traverse_)
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import           System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
import           System.FilePath ((</>))
import           System.IO.Error (doesNotExistErrorType, permissionErrorType)
import qualified System.Posix as Posix
import           Test.Hspec

import           SpecHelper
import           System.Directory.Layout


spec :: Spec
spec = do
  describe "Validation" $
    it "combines failures with the Semigroup instance's (<>)" $
      traverse_ tonel ([1, 2, 3, 4] :: [Int]) `shouldBe` Error (NonEmpty.fromList [1,2,3,4])

  describe "fit" $ do
    it "tests regular file existence" $ do
      temporary $ \p -> do
        r <- fit p $ do
          file "foo"
        r `shouldBe` fromErrors [FitIOException (p </> "foo") doesNotExistErrorType]

    it "does not test regular file contents" $ do
      temporary $ \p -> do
        writeFile (p </> "foo") "foo"
        r <- fit p $ do
          file "foo"
        r `shouldBe` fromErrors []

    it "tests text file existence" $ do
      temporary $ \p -> do
        r <- fit p $ do
          file "foo"
            & contents ?~ text "bar"
        r `shouldBe` fromErrors [FitIOException (p </> "foo") doesNotExistErrorType]

    it "tests text file contents" $ do
      temporary $ \p -> do
        writeFile (p </> "foo") "foo"
        r <- fit p $ do
          file "foo"
            & contents ?~ text "bar"
        r `shouldBe` fromErrors
          [ FitBadFileContents (p </> "foo") $
              FitBadText "bar" "foo"
          ]

    it "tests text file contents specified with the quasiquoter" $ do
      temporary $ \p -> do
        writeFile (p </> "foo") "foo"
        r <- fit p $ do
          file "foo"
            & contents ?~ [dedent|
                foo
                bar
                |]
        r `shouldBe` fromErrors
          [ FitBadFileContents (p </> "foo") $
              FitBadText "foo\nbar\n" "foo"
          ]

    it "tests binary file existence" $ do
      temporary $ \p -> do
        r <- fit p $ do
          file "foo"
            & contents ?~ binary (ByteString.pack [1, 2, 3, 4])
        r `shouldBe` fromErrors [FitIOException (p </> "foo") doesNotExistErrorType]

    it "tests binary file contents" $ do
      temporary $ \p -> do
        ByteString.writeFile (p </> "foo") (ByteString.pack [5, 6, 7, 8])
        r <- fit p $ do
          file "foo"
            & contents ?~ binary (ByteString.pack [1, 2, 3, 4])
        r `shouldBe` fromErrors
         [ FitBadFileContents (p </> "foo") $
             FitBadBinary (ByteString.pack [1, 2, 3, 4]) (ByteString.pack [5, 6, 7, 8])
         ]

    it "tests copy file contents" $ do
      temporary $ \p -> do
        ByteString.writeFile (p </> "foo") (ByteString.pack [1, 2, 3, 4])
        ByteString.writeFile (p </> "bar") (ByteString.pack [5, 6, 7, 8])
        r <- fit p $ do
          file "foo"
            & contents ?~ copyOf (p </> "bar")
        r `shouldBe` fromErrors
          [ FitBadFileContents (p </> "foo") $
              FitBadCopyOf (p </> "bar")
          ]

    it "tests copy file contents" $ do
      temporary $ \p -> do
        ByteString.writeFile (p </> "foo") (ByteString.pack [1, 2, 3, 4])
        ByteString.writeFile (p </> "bar") (ByteString.pack [1, 2, 3, 4])
        r <- fit p $ do
          file "foo"
            & contents ?~ copyOf (p </> "bar")
        r `shouldBe` fromErrors []

    it "tests symbolic link existence" $ do
      temporary $ \p -> do
        r <- fit p $ do
          symlink "foo" "bar"
        r `shouldBe` fromErrors [FitIOException (p </> "foo") doesNotExistErrorType]

    it "tests symbolic link source" $ do
      temporary $ \p -> do
        Posix.createSymbolicLink "baz" (p </> "foo")
        r <- fit p $ do
          symlink "foo" "bar"
        r `shouldBe` fromErrors [FitBadLinkSource (p </> "foo") "bar" "baz"]

    it "combines multiple errors on one layer" $ do
      temporary $ \p -> do
        writeFile (p </> "bar") "qux"
        r <- fit p $ do
          file "foo"
          file "bar"
            & contents ?~ text "quux"
          file "baz"
        r `shouldBe` fromErrors
          [ FitIOException (p </> "foo") doesNotExistErrorType
          , FitBadFileContents (p </> "bar") $
              FitBadText "quux" "qux"
          , FitIOException (p </> "baz") doesNotExistErrorType
          ]

    it "combines multiple errors on multiple layers" $ do
      temporary $ \p -> do
        createDirectoryIfMissing True (p </> "xyz" </> "xyzzy")
        writeFile (p </> "xyz" </> "xyzzy" </> "bar") "qux"
        r <- fit p $ do
          dirs ["xyz", "xyzzy"] $ do
            file "foo"
            file "bar"
              & contents ?~ text "quux"
          dir "boo" $
            file "hoo"
        r `shouldBe` fromErrors
          [ FitIOException (p </> "xyz" </> "xyzzy" </> "foo") doesNotExistErrorType
          , FitBadFileContents (p </> "xyz" </> "xyzzy" </> "bar") $
              FitBadText "quux" "qux"
          , FitIOException (p </> "boo") doesNotExistErrorType
          , FitIOException (p </> "boo" </> "hoo") doesNotExistErrorType
          ]

    it "tests file owner user id" $ do
      temporary $ \p -> do
        let u = p </> "foo"
        writeFile u ""
        n <- fileOwnerUID u
        r <- fit p $ do
          file "foo"
            & user ?~ uid 0
        r `shouldBe` fromErrors [FitBadOwnerUser u (uid 0) (uid n)]

    it "tests file owner user name" $ do
      temporary $ \p -> do
        let u = p </> "foo"
        writeFile u ""
        n <- fileOwnerUserName u
        r <- fit p $ do
          file "foo"
            & user ?~ username "root"
        r `shouldBe` fromErrors [FitBadOwnerUser u (username "root") (username n)]

    it "tests file owner group id" $ do
      temporary $ \p -> do
        let u = p </> "foo"
        writeFile u ""
        n <- fileOwnerGID u
        r <- fit p $ do
          file "foo"
            & group ?~ gid 0
        r `shouldBe` fromErrors [FitBadOwnerGroup u (gid 0) (gid n)]

    it "tests file owner group id" $ do
      temporary $ \p -> do
        let u = p </> "foo"
        writeFile u ""
        n <- fileOwnerGroupName u
        r <- fit p $ do
          file "foo"
            & group ?~ groupname "root"
        r `shouldBe` fromErrors [FitBadOwnerGroup u (groupname "root") (groupname n)]

    it "tests file permissions" $ do
      temporary $ \p -> do
        writeFile (p </> "foo") ""
        Posix.setFileMode (p </> "foo") 0o100644
        r <- fit p $ do
          file "foo"
            & mode ?~ 0o100777
        r `shouldBe` fromErrors [FitBadFileMode (p </> "foo") 0o100777 0o100644]

    it "tests symbolic link's source exists" $ do
      temporary $ \p -> do
        let l = symlink "boo" "hoo"
        Posix.createSymbolicLink "hoo" (p </> "boo")
        fit p l `shouldReturn`
          fromErrors []
        fit p (l & exists .~ True) `shouldReturn`
          fromErrors [FitIOException (p </> "boo") doesNotExistErrorType]
        writeFile (p </> "hoo") ""
        fit p (l & exists .~ True) `shouldReturn`
          fromErrors []

    it "does not throw exceptions if root directory does not exist" $
      temporary $ \p -> do
        removeDirectoryRecursive p
        r <- fit p $
          file "foo"
            & contents ?~ text "bar"
        r `shouldBe` fromErrors
          [ FitIOException (p </> "foo") doesNotExistErrorType
          ]

  describe "make" $ do
    -- examples use 'fit' because if the above spec passes then
    -- we can be reasonably sure 'fit' works as expected
    it "creates a file" $
      makefit $
        file "foo"

    it "creates a file with the specified text" $ do
      makefit $
        file "foo"
          & contents ?~ text "bar"

    it "creates a copy of the file with the specified text" $ do
      temporary $ \p -> do
        writeFile (p </> "qux") "quux"
        makefit $
          file "foo"
            & contents ?~ copyOf (p </> "qux")

    it "creates two files with the specified text" $ do
      makefit $ do
        file "foo"
          & contents ?~ text "bar"
        file "qux"
          & contents ?~ text "quux"

    it "creates two files and a symlink" $ do
      makefit $ do
        file "foo"
          & contents ?~ text "bar"
        file "qux"
          & contents ?~ text "quux"
        symlink "boo" "hoo"

    it "creates a directory with a file" $ do
      makefit $
        dir "foo" $
          file "bar"

    it "creates a directory with two files" $ do
      makefit $
        dir "foo" $ do
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
          file "quux"
            & contents ?~ binary (ByteString.pack [98, 121, 101])

    it "creates a nested directory with two files" $ do
      makefit $
        dirs ["foo", "bar"] $ do
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
          file "quux"
            & contents ?~ binary (ByteString.pack [98, 121, 101])

    it "creates a nested directory with two files and a directory" $ do
      makefit $
        dirs ["foo", "bar"] $ do
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
          file "quux"
            & contents ?~ binary (ByteString.pack [98, 121, 101])

    it "creates a tree of directories with files" $ do
      makefit $
        dir "foo" $ do
          dir "bar" $ do
            file "qux"
              & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
            file "quux"
              & contents ?~ binary (ByteString.pack [98, 121, 101])
          dir "baz" $
            symlink "boo" "hoo"

    it "changes the user id of the file owner" $ do
      temporary $ \p -> do
        r <- make p $
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
            & user ?~ uid 0
        r `shouldBe` fromErrors [MakeIOException (p </> "qux") permissionErrorType]

    it "changes the user id of the symbolic link owner" $ do
      temporary $ \p -> do
        r <- make p $
          symlink "foo" "bar"
            & user ?~ uid 0
        r `shouldBe` fromErrors [MakeIOException (p </> "foo") permissionErrorType]

    it "changes the user name of the file owner" $ do
      temporary $ \p -> do
        r <- make p $
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
            & user ?~ username "root"
        r `shouldBe` fromErrors [MakeIOException (p </> "qux") permissionErrorType]

    it "changes the user name of the symbolic link owner" $ do
      temporary $ \p -> do
        r <- make p $
          symlink "foo" "bar"
            & user ?~ username "root"
        r `shouldBe` fromErrors [MakeIOException (p </> "foo") permissionErrorType]

    it "changes the user id of the directory owner" $ do
      temporary $ \p -> do
        r <- make p $
          emptydir "boo"
            & user ?~ uid 0
        r `shouldBe` fromErrors [MakeIOException (p </> "boo") permissionErrorType]

    it "changes the user name of the directory owner" $ do
      temporary $ \p -> do
        r <- make p $
          emptydir "boo"
            & user ?~ username "root"
        r `shouldBe` fromErrors [MakeIOException (p </> "boo") permissionErrorType]

    it "changes the group id of the file owner" $ do
      temporary $ \p -> do
        r <- make p $
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
            & group ?~ gid 0
        r `shouldBe` fromErrors [MakeIOException (p </> "qux") permissionErrorType]

    it "changes the group name of the file owner" $ do
      temporary $ \p -> do
        r <- make p $
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
            & group ?~ groupname "root"
        r `shouldBe` fromErrors [MakeIOException (p </> "qux") permissionErrorType]

    it "changes the group id of the symbolic link owner" $ do
      temporary $ \p -> do
        r <- make p $
          symlink "foo" "bar"
            & group ?~ gid 0
        r `shouldBe` fromErrors [MakeIOException (p </> "foo") permissionErrorType]

    it "changes the group name of the symbolic link owner" $ do
      temporary $ \p -> do
        r <- make p $
          symlink "foo" "bar"
            & group ?~ groupname "root"
        r `shouldBe` fromErrors [MakeIOException (p </> "foo") permissionErrorType]

    it "changes the group id of the directory owner" $ do
      temporary $ \p -> do
        r <- make p $
          file "boo"
            & group ?~ gid 0
        r `shouldBe` fromErrors [MakeIOException (p </> "boo") permissionErrorType]

    it "changes the group name of the directory owner" $ do
      temporary $ \p -> do
        r <- make p $
          file "boo"
            & group ?~ groupname "root"
        r `shouldBe` fromErrors [MakeIOException (p </> "boo") permissionErrorType]

    it "changes the file permissions" $ do
      makefit $
        file "qux"
          & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
          & mode ?~ 0o100777

    it "changes the directory permissions" $ do
      makefit $
        emptydir "boo"
          & mode ?~ 0o040777

    it "tolerates redundant directories" $ do
      makefit $ do
        dir "foo" $
          file "qux"
            & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
        dir "foo" $
          file "quux"
            & contents ?~ binary (ByteString.pack [98, 121, 101])

    it "the latter write wins" $ do
      temporary $ \p -> do
        let l = do
              dir "foo" $
                file "qux"
                  & contents ?~ binary (ByteString.pack [104, 101, 108, 108, 111])
              dir "foo" $
                file "qux"
                  & contents ?~ binary (ByteString.pack [98, 121, 101])
        _ <- make p l
        fit p l `shouldReturn` fromErrors
          [ FitBadFileContents (p </> "foo" </> "qux") $ FitBadBinary
              (ByteString.pack [104, 101, 108, 108, 111])
              (ByteString.pack [98, 121, 101])
          ]

    it "does not throw exceptions if root directory does not exist" $
      temporary $ \p -> do
        removeDirectoryRecursive p
        r <- make p $
          file "foo"
            & contents ?~ text "bar"
        r `shouldBe` fromErrors [MakeIOException (p </> "foo") doesNotExistErrorType]

  describe "remake" $ do
    it "does not throw exceptions if root directory does not exist, but it checks its existence" $
      temporary $ \p -> do
        removeDirectoryRecursive p
        r <- remake p $
          file "foo"
            & contents ?~ text "bar"
        r `shouldBe` fromErrors
          [ MakeIOException p doesNotExistErrorType
          , MakeIOException (p </> "foo") doesNotExistErrorType
          ]

    it "does not remove symlink sources" $
      temporary $ \p -> do
        temporary $ \p' -> do
          make p' (file "quux" & contents ?~ "symlink source") `shouldReturn` fromErrors []
          make p (symlink "qux" (p' </> "quux")) `shouldReturn` fromErrors []
          remake p (file "foo" & contents ?~ text "bar") `shouldReturn` fromErrors []
          fit p' (file "quux" & contents ?~ "symlink source") `shouldReturn` fromErrors []

tonel :: a -> NonEmpty a \/ b
tonel = Error . pure

makefit :: Layout a -> IO ()
makefit l = temporary $ \p -> do
  make p l `shouldReturn` fromErrors []
  fit p l `shouldReturn` fromErrors []

fileOwnerUID :: FilePath -> IO Posix.UserID
fileOwnerUID = fmap Posix.fileOwner . Posix.getSymbolicLinkStatus

fileOwnerUserName :: FilePath -> IO String
fileOwnerUserName = fmap Posix.userName . Posix.getUserEntryForID <=< fileOwnerUID

fileOwnerGID :: FilePath -> IO Posix.GroupID
fileOwnerGID = fmap Posix.fileGroup . Posix.getSymbolicLinkStatus

fileOwnerGroupName :: FilePath -> IO String
fileOwnerGroupName = fmap Posix.groupName . Posix.getGroupEntryForID <=< fileOwnerGID