purescript-testcontainers/test/Test/Binds.purs at main · massix/purescript-testcontainers · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
module Test.Binds (bindTest) where

import Prelude

import Data.Either (Either(..))
import Effect.Aff (error, throwError)
import Effect.Class (liftEffect)
import Node.Process as Process
import Test.Assertions (shouldInclude)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Test.Testcontainers (setBindMounts, setCommand, setCopyFilesToContainer, setTmpFs, withContainer)
import Test.Testcontainers.Types (CopyContentToContainer(..), FileMode(..))
import Test.Utils (launchCommand, mkAffContainer)

bindTest :: Spec Unit
bindTest = do
  describe "Binds and Volumes" $ do
    it "should bind single files" $ do
      currentDir <- liftEffect Process.cwd
      alpine <- mkAffContainer "alpine:latest" $
        setCommand [ "sleep", "infinity" ]
          <<< setBindMounts [ { readOnly: true, source: currentDir <> "/test/bound_file.txt", target: "/bound_file.txt" } ]

      res <- withContainer alpine $ \c -> do
        launchCommand c [ "cat", "/bound_file.txt" ]
          (\s -> s `shouldInclude` "hello world from a bounded file\n\n")
          (\exitCode -> exitCode `shouldEqual` 0)

      case res of
        Left err -> throwError $ error err
        Right _ -> pure unit

    it "should bind folders" $ do
      currentDir <- liftEffect Process.cwd
      alpine <- mkAffContainer "alpine:latest" $
        setCommand [ "sleep", "infinity" ]
          <<< setBindMounts [ { readOnly: true, source: currentDir <> "/src/", target: "/sources" } ]

      res <- withContainer alpine $ \c -> do
        launchCommand c [ "ls", "/sources" ]
          (\s -> s `shouldInclude` "Test\n")
          (\exitCode -> exitCode `shouldEqual` 0)

        -- Read only should be respected
        launchCommand c [ "touch", "/sources/a" ]
          (\_ -> pure unit)
          (\exitCode -> exitCode `shouldEqual` 1)

      case res of
        Left err -> throwError $ error err
        Right _ -> pure unit

    it "should copy files and contents to containers" $ do
      currentDir <- liftEffect Process.cwd
      alpine <- mkAffContainer "alpine:latest" $
        setCommand [ "sleep", "infinity" ]
          <<< setCopyFilesToContainer
            [ (FromSource "test/bound_file.txt" "/bound_file.txt" $ FileMode "0644")
            , (FromContent "hello world from copied content" "/copied_content.txt" $ FileMode "0644")
            , (FromDirectory (currentDir <> "/test") "/test" $ FileMode "0644")
            ]

      res <- withContainer alpine $ \c -> do
        launchCommand c [ "cat", "/bound_file.txt" ]
          (\s -> s `shouldEqual` "hello world from a bounded file\n\n")
          (\exitCode -> exitCode `shouldEqual` 0)

        launchCommand c [ "cat", "/copied_content.txt" ]
          (\s -> s `shouldEqual` "hello world from copied content")
          (\exitCode -> exitCode `shouldEqual` 0)

        launchCommand c [ "ls", "/test" ]
          (\s -> s `shouldInclude` "bound_file.txt")
          (\exitCode -> exitCode `shouldEqual` 0)

      case res of
        Left err -> throwError $ error err
        Right _ -> pure unit

    it "should bind tmpfs volumes" $ do
      alpine <- mkAffContainer "alpine:latest" $
        setCommand [ "sleep", "infinity" ]
          <<< setTmpFs { path: "/tmpfsmount", mountOptions: "rw,noexec,nosuid,size=655536k" }

      res <- withContainer alpine $ \c -> do
        launchCommand c [ "touch", "/tmpfsmount/a" ]
          (\_ -> pure unit)
          (\exitCode -> exitCode `shouldEqual` 0)
        launchCommand c [ "mount" ]
          (\s -> s `shouldInclude` "/tmpfsmount")
          (\_ -> pure unit)

      case res of
        Left e -> throwError $ error e
        Right _ -> pure unit