content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Main where
  
  import           Data.Either               (rights)
  import           Data.String               (IsString(..))
  import           Prelude                   hiding (all)
  import qualified Test.QuickCheck.Monadic   as QCM
  import           Test.Tasty
  import           Test.Tasty.HUnit
  import           Test.Tasty.QuickCheck     (testProperty)
  
  import           Control.Concurrent        (threadDelay)
  import           Control.Lens              ((^.), (^?))
  import           Control.Monad             (forM_)
  import           Control.Monad.IO.Class
  import           Control.Monad.Trans.Class (lift)
  import qualified Data.Aeson                as JSON
  import           Data.Aeson                ((.=))
  #if MIN_VERSION_aeson(2,0,0)
  import qualified Data.Aeson.KeyMap         as KM
  #endif
  import           Data.Aeson.Lens           (key, _Array, _Null, _Object,
                                              _String, _Value)
  import qualified Data.Aeson.Types          as JSON
  import qualified Data.ByteString           as B
  import qualified Data.ByteString.Char8     as C
  import qualified Data.ByteString.Lazy      as BL
  import qualified Data.HashMap.Strict       as HM
  import           Data.Int                  (Int)
  import qualified Data.Map                  as M
  import           Data.Maybe                (fromJust, isJust, isNothing, listToMaybe)
  import           Data.Monoid
  import           Data.Text                 (Text, unpack)
  import qualified Data.Vector               as V
  import           Network.Connection        (TLSSettings (..))
  import           Network.HTTP.Client       (newManager)
  import           Network.HTTP.Client.TLS
  import           Network.HTTP.Types.Status
  import           System.Directory          (getCurrentDirectory)
  import           System.Environment        (lookupEnv)
  import           System.Process            (system)
  
  import           Docker.Client
  
  #if MIN_VERSION_lens_aeson(1,2,0)
  emptyMap :: KM.KeyMap v
  emptyMap = KM.empty
  #else
  emptyMap :: HM.HashMap k v
  emptyMap = HM.empty
  #endif
  
  -- opts = defaultClientOpts
  testImageName = "docker-hs/test"
  imageToDeleteFullName = "hello-world:latest"
  
  toStrict1 = B.concat . BL.toChunks
  
  runDocker f
            -- let opts = defaultClientOpts {baseUrl = "https://127.0.0.1:2376/"}
            -- params' <- clientParamsWithClientAuthentication "127.0.0.1" 2376 "~/.docker/test-client-key.pem" "~/.docker/test-client-cert.pem" >>= fromRight
            -- params <- clientParamsSetCA params' "~/.docker/test-ca.pem"
            -- let settings = mkManagerSettings (TLSSettings params) Nothing
            -- mgr <- newManager settings
   = do
    h <- unixHttpHandler "/var/run/docker.sock"
    runDockerT (defaultClientOpts, h) f
  
  testDockerVersion :: IO ()
  testDockerVersion =
    runDocker $
    do v <- getDockerVersion
       lift $ assert $ isRight v
  
  testStopNonexisting :: IO ()
  testStopNonexisting = runDocker $ do
      res <- stopContainer DefaultTimeout $ fromJust $ toContainerID "thisshouldnotexist"
      lift $ assert $ isLeft res
  
  testFindImage :: IO ()
  testFindImage =
    runDocker $
    do images <- listImages defaultListOpts >>= fromRight
       let xs = filter (elem imageFullName . imageRepoTags) images
       lift $ assert $ length xs == 1
    where
      imageFullName = testImageName <> ":latest"
  
  testDeleteImage :: IO ()
  testDeleteImage = runDocker $ do
    img <- fmap fromJust findTestImage
    result <- deleteImage defaultImageDeleteOpts (imageId img)
    lift $ assert $ isRight result
    maybeTestImageAfter <- findTestImage
    lift $ assert $ isNothing maybeTestImageAfter
    where
      findTestImage =
        do
          images <- listImages defaultListOpts >>= fromRight
          return $ listToMaybe
                 $ filter (elem imageToDeleteFullName . imageRepoTags) images
  
  testListContainers :: IO ()
  testListContainers =
    runDocker $
    do containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
       c <- fromRight containerId
       res <- listContainers $ ListOpts { all=True }
       deleteContainer (ContainerDeleteOpts True True) c
       lift $ assert $ isRight res
  
  testBuildFromDockerfile :: IO ()
  testBuildFromDockerfile = do
    cur <- getCurrentDirectory
    let ctxDir = cur ++ "/tests"
    runDocker $ do
      r <- buildImageFromDockerfile (defaultBuildOpts "docker-hs/dockerfile-test") ctxDir
      lift $ assert $ isRight r
  
  
  testRunAndReadLog :: IO ()
  testRunAndReadLog = testRunAndReadLogHelper $ NetworkingConfig HM.empty
  
  testRunAndReadLogWithNetworking :: IO ()
  testRunAndReadLogWithNetworking = testRunAndReadLogHelper $ NetworkingConfig $ HM.fromList [("test-network", EndpointConfig ["cellar-door"])]
  
  testRunAndReadLogHelper :: NetworkingConfig -> IO ()
  testRunAndReadLogHelper networkingConfig =
    runDocker $
    do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
       createdNetworks <- rights <$> mapM createNetworkWithName networkNames
       containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
       c <- fromRight containerId
       status1 <- startContainer defaultStartOpts c
       _ <- inspectContainer c >>= fromRight
       lift $ threadDelay 300000 -- give 300ms for the application to finish
       lift $ assertBool ("starting the container, unexpected status: " ++ show status1) $ isRightUnit status1
       logs <- getContainerLogs defaultLogOpts c >>= fromRight
       lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
       status3 <- deleteContainer (ContainerDeleteOpts True True) c
       lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3
       mapM_ removeNetwork createdNetworks
    where
      isRightUnit (Right ()) = True
      isRightUnit _          = False
      networkNames = HM.keys $ endpointsConfig networkingConfig
      createNetworkWithName name = createNetwork $
        (defaultCreateNetworkOpts name) { createNetworkCheckDuplicate = True }
  
  testCreateRemoveNetwork :: IO ()
  testCreateRemoveNetwork = do
    runDocker $ do
      createStatus <- createNetwork $ defaultCreateNetworkOpts "test-network"
      lift $ assertBool ("creating a network, unexpected status: " ++ show createStatus) $ isRight createStatus
      nid <- fromRight createStatus
      removeStatus <- removeNetwork nid
      lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus
  
  testLogDriverOptionsJson :: TestTree
  testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
    where
      test1 = testCase "Driver option 1" $ assert $ JSON.toJSON sample ^. key key1 . _String == val1
      test2 = testCase "Driver option 2" $ assert $ JSON.toJSON sample ^. key key2 . _String == val2
      test3 =
        testCase "Test override" $ assert $ JSON.toJSON sample2 ^. key key1 . _String == "override"
      sample = [LogDriverOption key1 val1, LogDriverOption key2 val2]
      sample2 = [LogDriverOption key1 val1, LogDriverOption key1 "override"]
      key1 :: IsString a => a
      key1 = "some-key"
      val1 = "some-val"
      key2 :: IsString a => a
      key2 = "some-key2"
      val2 = "some-key2"
  
  testExposedPortsJson :: TestTree
  testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [testTCP, testUDP]
    where
      testTCP = testCase "tcp port" $ assert $ JSON.toJSON sampleEP ^. key "80/tcp" . _Object == emptyMap
      testUDP =
        testCase "udp port" $ assert $ JSON.toJSON sampleEP ^. key "1337/tcp" . _Object == emptyMap
      sampleEP = [ExposedPort 80 TCP, ExposedPort 1337 UDP]
  
  testLabelsJson :: TestTree
  testLabelsJson = testGroup "Testing Labels JSON" [testLS1, testLS2, testOverride]
    where
      testLS1 = testCase "test label key1" $ assert $ JSON.toJSON sampleLS ^. key key1 . _String == val1
      testLS2 = testCase "test label key2" $ assert $ JSON.toJSON sampleLS ^. key key2 . _String == val2
      testOverride =
        testCase "test label override" $ assert $ JSON.toJSON [Label key1 val1, Label key1 "override"] ^.
        key key1 .
        _String ==
        "override"
      sampleLS = [Label key1 val1, Label key2 val2]
      key1 :: IsString a => a
      key1 = "com.example.some-label"
      val1 = "some-value"
      key2 :: IsString a => a
      key2 = "something"
      val2 = "value"
  
  testVolumesJson :: TestTree
  testVolumesJson = testGroup "Testing Volumes JSON" [testSample1, testSample2]
    where
      testSample1 =
        testCase "Test exposing volume: /tmp" $ assert $ JSON.toJSON sampleVolumes ^. key "/tmp" . _Object ==
        emptyMap
      testSample2 =
        testCase "Test exposing volume: /opt" $ assert $ JSON.toJSON sampleVolumes ^. key "/opt" . _Object ==
        emptyMap
      sampleVolumes = [Volume "/tmp", Volume "/opt"]
  
  testBindsJson :: TestTree
  testBindsJson = testGroup "Testing Binds JSON" [testSample1, testSample2, testSample3]
    where
      testSample1 =
        testCase "Testing Bind without VolumePermission" $
          JSON.String "/foo:/bar" @=? JSON.toJSON (Bind "/foo" "/bar" Nothing)
      testSample2 =
        testCase "Testing Bind with ReadOnly" $
          JSON.String "/foo:/bar:ro" @=? JSON.toJSON (Bind "/foo" "/bar" (Just ReadOnly))
      testSample3 =
        testCase "Testing Bind with WriteOnly" $
          JSON.String "/foo:/bar:rw" @=? JSON.toJSON (Bind "/foo" "/bar" (Just ReadWrite))
  
  testPortBindingJSON :: TestTree
  testPortBindingJSON = testGroup "Testing PortBinding JSON" [testSample1]
    where
      testSample1 =
        testCase "Test decoding null hostPorts" $ assert $ (JSON.decode "{ \"22/tcp\": null }" :: Maybe [PortBinding]) == Just [PortBinding 22 TCP []]
  
  
  testEntrypointJson :: TestTree
  testEntrypointJson = testGroup "Testing ContainerConfig JSON" [testSample1, testSample2, testSample3, testSample4, testSample5]
    where
      testSample1 =
        testCase "Test toJSON with empty entrypoint (null)" $ assert $ JSON.toJSON (Entrypoint []) ^. _Null == ()
      testSample2 =
        testCase "Test toJSON with entrypoint as Array" $ assert $
        JSON.toJSON (Entrypoint sampleEntrypointArr) ==
        JSON.toJSON sampleEntrypointArr
      testSample3 =
        testCase "Test decoding entrypoint as string" $ assert $ (JSON.decode "\"cmd\"") ==
        Just (Entrypoint ["cmd"])
      testSample4 =
        testCase "Test decoding as null" $ assert $ (JSON.decode "null" :: Maybe Entrypoint) ==
        Just (Entrypoint [])
      testSample5 =
        testCase "Test decoding as array" $ assert $ (JSON.decode (JSON.encode sampleEntrypointArr) :: Maybe Entrypoint) ==
        Just (Entrypoint sampleEntrypointArr)
      sampleEntrypointArr = ["cmd", "--some-flag", "--some-flag2"]
  
  testEnvVarJson :: TestTree
  testEnvVarJson = testGroup "Testing EnvVar JSON" [testSampleEncode, testSampleDecode]
    where
      testSampleEncode =
        testCase "Test toJSON" $ assert $ JSON.toJSON (EnvVar "cellar" "door") == JSON.String "cellar=door"
      testSampleDecode =
        testCase "Test fromJSON" $ assert $ (JSON.decode "\"cellar=door\"" :: Maybe EnvVar) ==
          Just (EnvVar "cellar" "door")
  
  testNetworkingConfigJson :: TestTree
  testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSampleEncode]
    where
      testSampleEncode =
        let networkingConfig = NetworkingConfig $ HM.fromList [("custom-network", EndpointConfig ["cellar", "door"])]
         in testCase "Test toJSON" $ assert $ JSON.toJSON networkingConfig ==
          JSON.object
            [ "EndpointsConfig" .= JSON.object
              [ "custom-network" .= JSON.object
                [ "Aliases" .= (["cellar", "door"] :: [Text])
                ]
              ]
            ]
  
  integrationTests :: TestTree
  integrationTests =
    testGroup
      "Integration Tests"
      [ testCase "Get docker version" testDockerVersion
      , testCase "Build image from Dockerfile" testBuildFromDockerfile
      , testCase "Find image by name" testFindImage
      , testCase "Delete image" testDeleteImage
      , testCase "List containers" testListContainers
      , testCase "Run a dummy container and read its log" testRunAndReadLog
      , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
      , testCase "Try to stop a container that doesn't exist" testStopNonexisting
      , testCase "Create and remove a network" testCreateRemoveNetwork
      ]
  
  jsonTests :: TestTree
  jsonTests =
    testGroup
      "JSON Tests"
      [ testExposedPortsJson
      , testVolumesJson
      , testBindsJson
      , testLabelsJson
      , testLogDriverOptionsJson
      , testPortBindingJSON
      , testEntrypointJson
      , testEnvVarJson
      , testNetworkingConfigJson
      ]
  
  setup :: IO ()
  setup =
    mapM_ system
          [ "docker pull " ++ unpack imageToDeleteFullName
          , "docker build -t " ++ unpack testImageName ++ " tests"
          ]
  
  isLeft = not . isRight
  
  isRight (Left _)  = False
  isRight (Right _) = True
  
  fromRight
    :: (MonadIO m, Show l)
    => Either l r -> m r
  fromRight (Left l) = do
    liftIO $ assertFailure $ "Left: " ++ show l
    undefined
  fromRight (Right r) = return r
  
  main :: IO ()
  main = do
    stackage  <- lookupEnv "RUN_INTEGRATION_TESTS"
    case  stackage of
      Nothing -> defaultMain $ testGroup "Tests" [jsonTests]
      Just _ -> do
        setup
        defaultMain $ testGroup "Tests" [jsonTests, integrationTests]
  