{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

-- | 'Util' contains various utility functions used throughout Docker.API.Client's internals.
module Docker.API.Client.Internal.Util where

import Control.Monad.IO.Class (MonadIO)
import Data.Binary.Get (getWord32be, getWord8, runGet)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Conduit (ConduitT, await, yield)
import qualified Data.Conduit.Tar as Tar
import qualified Data.Text as T
import Docker.API.Client.Internal.Schemas (CreateContainer (..), HostConfig (..))
import Docker.API.Client.Internal.Types (ContainerLogType (..), ContainerSpec (..), DockerStreamType (..))
import System.Posix.Types (GroupID, UserID)

-- | (Internal only, do not export) Converts a client ContainerSpec into the format expected by the docker api
containerSpecToCreateContainer :: ContainerSpec -> CreateContainer
containerSpecToCreateContainer :: ContainerSpec -> CreateContainer
containerSpecToCreateContainer ContainerSpec
spec =
  CreateContainer :: Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> Text
-> Maybe Text
-> Maybe HostConfig
-> CreateContainer
CreateContainer
    { createContainerUser :: Maybe Text
createContainerUser = Text -> Maybe Text
textToMaybe (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ContainerSpec -> Text
user ContainerSpec
spec,
      createContainerWorkingDir :: Maybe Text
createContainerWorkingDir = Text -> Maybe Text
textToMaybe (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ContainerSpec -> Text
workingDir ContainerSpec
spec,
      createContainerEnv :: Maybe [Text]
createContainerEnv = [Text] -> Maybe [Text]
forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a)
listToMaybe ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ ContainerSpec -> [Text]
envVars ContainerSpec
spec,
      createContainerImage :: Text
createContainerImage = ContainerSpec -> Text
image ContainerSpec
spec,
      createContainerCmd :: Maybe [Text]
createContainerCmd = [Text] -> Maybe [Text]
forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a)
listToMaybe ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ ContainerSpec -> [Text]
cmd ContainerSpec
spec,
      createContainerHostConfig :: Maybe HostConfig
createContainerHostConfig = [Text] -> Maybe HostConfig
convertHostVolumes ([Text] -> Maybe HostConfig) -> [Text] -> Maybe HostConfig
forall a b. (a -> b) -> a -> b
$ ContainerSpec -> [Text]
hostVolumes ContainerSpec
spec
    }
  where
    textToMaybe :: Text -> Maybe Text
textToMaybe Text
t = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
t then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t else Maybe Text
forall a. Maybe a
Nothing
    listToMaybe :: t a -> Maybe (t a)
listToMaybe t a
l = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
l then t a -> Maybe (t a)
forall a. a -> Maybe a
Just t a
l else Maybe (t a)
forall a. Maybe a
Nothing
    convertHostVolumes :: [Text] -> Maybe HostConfig
convertHostVolumes [Text]
hvs =
      if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
hvs
        then Maybe HostConfig
forall a. Maybe a
Nothing
        else HostConfig -> Maybe HostConfig
forall a. a -> Maybe a
Just HostConfig :: Maybe [Text] -> HostConfig
HostConfig {hostConfigBinds :: Maybe [Text]
hostConfigBinds = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
hvs}

-- | Conduit helper which checks the length of the input bytestring and reads data from upstream
-- until the length is at least nBytes. Note that this method may return a Bytestring result which
-- has length >= nBytes.
readUpstream :: Monad m => B.ByteString -> Int -> ConduitT B.ByteString o m (Maybe B.ByteString)
readUpstream :: ByteString -> Int -> ConduitT ByteString o m (Maybe ByteString)
readUpstream ByteString
acc Int
nBytes =
  if ByteString -> Int
B.length ByteString
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nBytes
    then do Maybe ByteString -> ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> ConduitT ByteString o m (Maybe ByteString))
-> Maybe ByteString -> ConduitT ByteString o m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
acc
    else do
      Maybe ByteString
result <- ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
      case Maybe ByteString
result of
        Maybe ByteString
Nothing -> Maybe ByteString -> ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
        Just ByteString
val -> ByteString -> Int -> ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) o.
Monad m =>
ByteString -> Int -> ConduitT ByteString o m (Maybe ByteString)
readUpstream ([ByteString] -> ByteString
B.concat [ByteString
Item [ByteString]
acc, ByteString
Item [ByteString]
val]) Int
nBytes

-- | Parses the first byte from a stream metadata bytestring returned by the Docker Engine API
-- and returns the corresponding stream type.
getStreamType :: B.ByteString -> DockerStreamType
getStreamType :: ByteString -> DockerStreamType
getStreamType ByteString
meta
  | Word8
indicator Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = DockerStreamType
DockerStreamStdIn
  | Word8
indicator Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 = DockerStreamType
DockerStreamStdOut
  | Word8
indicator Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 = DockerStreamType
DockerStreamStdErr
  | Bool
otherwise = [Char] -> DockerStreamType
forall a. HasCallStack => [Char] -> a
error [Char]
"Unrecognized stream type in docker engine response"
  where
    indicator :: Word8
indicator = Get Word8 -> ByteString -> Word8
forall a. Get a -> ByteString -> a
runGet Get Word8
getWord8 (ByteString -> ByteString
LBS.fromStrict ByteString
meta)

-- | Converts an 8 byte section length ByteString into an integer. This value
-- indicates the number of data bytes in the body of a Docker Engine stream record.
getSectionLength :: B.ByteString -> Int
getSectionLength :: ByteString -> Int
getSectionLength = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (ByteString -> Word32) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> Word32)
-> (ByteString -> ByteString) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict

-- | Parses a docker metadata bytestring of length >= 8 into it's individual components
-- See https://docs.docker.com/engine/api/v1.40/#operation/ContainerAttach
parseDockerStream :: B.ByteString -> (DockerStreamType, Int, B.ByteString)
parseDockerStream :: ByteString -> (DockerStreamType, Int, ByteString)
parseDockerStream ByteString
bytes =
  let parts :: (ByteString, (ByteString, ByteString))
parts = ByteString -> (ByteString, (ByteString, ByteString))
splitToParts ByteString
bytes
      streamType :: DockerStreamType
streamType = ByteString -> DockerStreamType
getStreamType (ByteString -> DockerStreamType) -> ByteString -> DockerStreamType
forall a b. (a -> b) -> a -> b
$ (ByteString, (ByteString, ByteString)) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, (ByteString, ByteString))
parts
      sectionLength :: Int
sectionLength = ByteString -> Int
getSectionLength (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, (ByteString, ByteString)) -> (ByteString, ByteString)
forall a b. (a, b) -> b
snd (ByteString, (ByteString, ByteString))
parts
      dataBytes :: ByteString
dataBytes = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, (ByteString, ByteString)) -> (ByteString, ByteString)
forall a b. (a, b) -> b
snd (ByteString, (ByteString, ByteString))
parts
   in (DockerStreamType
streamType, Int
sectionLength, ByteString
dataBytes)
  where
    splitToParts :: ByteString -> (ByteString, (ByteString, ByteString))
splitToParts ByteString
b = (Char -> ByteString
B.singleton (Char -> ByteString) -> Char -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Char
B.head ByteString
b, Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
4 (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
4 ByteString
b)

-- | Conduit for parsing a multiplexed stream from the Docker Engine API (e.g. the output of the attatch and logs endpoints).
-- This will force memory usage up to the returned frame size (for docker logs this is usually just one line of text).
-- See https://docs.docker.com/engine/api/v1.40/#operation/ContainerAttach for more details on this format.
parseMultiplexedDockerStream :: MonadIO m => ConduitT B.ByteString (DockerStreamType, B.ByteString) m ()
parseMultiplexedDockerStream :: ConduitT ByteString (DockerStreamType, ByteString) m ()
parseMultiplexedDockerStream = ByteString
-> ConduitT ByteString (DockerStreamType, ByteString) m ()
forall (m :: * -> *).
Monad m =>
ByteString
-> ConduitT ByteString (DockerStreamType, ByteString) m ()
loop ByteString
B.empty
  where
    loop :: ByteString
-> ConduitT ByteString (DockerStreamType, ByteString) m ()
loop ByteString
acc = do
      -- This whole thing could be recursive
      -- This ensures that we get at least 8 bytes (could be more)
      Maybe ByteString
input <- ByteString
-> Int
-> ConduitT
     ByteString (DockerStreamType, ByteString) m (Maybe ByteString)
forall (m :: * -> *) o.
Monad m =>
ByteString -> Int -> ConduitT ByteString o m (Maybe ByteString)
readUpstream ByteString
acc Int
8
      case Maybe ByteString
input of
        Maybe ByteString
Nothing -> () -> ConduitT ByteString (DockerStreamType, ByteString) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ByteString
meta -> do
          let (DockerStreamType
streamType, Int
sectionLength, ByteString
dataBytes) = ByteString -> (DockerStreamType, Int, ByteString)
parseDockerStream ByteString
meta
          -- This ensures that we have at least as much data as our section (could be more)
          Maybe ByteString
section <- ByteString
-> Int
-> ConduitT
     ByteString (DockerStreamType, ByteString) m (Maybe ByteString)
forall (m :: * -> *) o.
Monad m =>
ByteString -> Int -> ConduitT ByteString o m (Maybe ByteString)
readUpstream ByteString
dataBytes Int
sectionLength
          case Maybe ByteString
section of
            Maybe ByteString
Nothing -> () -> ConduitT ByteString (DockerStreamType, ByteString) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ByteString
s -> do
              let (ByteString
expectedBytes, ByteString
additionalBytes) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
sectionLength ByteString
s
              (DockerStreamType, ByteString)
-> ConduitT ByteString (DockerStreamType, ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (DockerStreamType
streamType, ByteString
expectedBytes)
              ByteString
-> ConduitT ByteString (DockerStreamType, ByteString) m ()
loop ByteString
additionalBytes

-- | Creates a DockerStreamType filter using the input ContainerLogType
createLogTypeFilter :: ContainerLogType -> ((DockerStreamType, a) -> Bool)
createLogTypeFilter :: ContainerLogType -> (DockerStreamType, a) -> Bool
createLogTypeFilter ContainerLogType
clt = case ContainerLogType
clt of
  ContainerLogType
Stdout -> \(DockerStreamType
t, a
_) ->
    case DockerStreamType
t of
      DockerStreamType
DockerStreamStdOut -> Bool
True
      DockerStreamType
_ -> Bool
False
  ContainerLogType
StdErr -> \(DockerStreamType
t, a
_) ->
    case DockerStreamType
t of
      DockerStreamType
DockerStreamStdErr -> Bool
True
      DockerStreamType
_ -> Bool
False
  ContainerLogType
Both -> \(DockerStreamType
t, a
_) ->
    case DockerStreamType
t of
      DockerStreamType
_ -> Bool
True

-- | Replaces the user and group id for an entry in a tarball with the specified user and group
chownTarballContent :: UserID -> GroupID -> Tar.FileInfo -> Tar.FileInfo
chownTarballContent :: UserID -> GroupID -> FileInfo -> FileInfo
chownTarballContent UserID
uid GroupID
gid FileInfo
info =
  FileInfo
info
    { fileUserName :: ByteString
Tar.fileUserName = ByteString
"",
      fileUserId :: UserID
Tar.fileUserId = UserID
uid,
      fileGroupName :: ByteString
Tar.fileGroupName = ByteString
"",
      fileGroupId :: GroupID
Tar.fileGroupId = GroupID
gid
    }