{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}

-- | Run commands using Docker
module Funflow.Tasks.Docker
  ( DockerTaskConfig (..),
    DockerTask (..),
    DockerTaskInput (..),
    VolumeBinding (..),
    Arg (..),
    renderArg,
    getIdFromArg,
  )
where

import Data.CAS.ContentStore as CS
import Data.List (foldl')
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as T
import Funflow.Config (ConfigKeysBySource, Configurable (Literal), ExternalConfig, configKeyBySource, render)
import Path (Abs, Dir, Path)

-- | Configure what task to run in Docker
data DockerTaskConfig = DockerTaskConfig
  { -- | The name of the docker image
    DockerTaskConfig -> Text
image :: Text,
    -- | The command to run
    DockerTaskConfig -> Text
command :: Text,
    -- | The arguments to pass to the command run inside of the container
    DockerTaskConfig -> [Arg]
args :: [Arg]
  }

-- | Represent an argument to pass to the command run inside of a Docker container
data Arg
  = -- | Raw text argument
    Arg (Configurable Text)
  | -- | A placeholder for an argument to be passed as runtime input to the task (filled by @argsVals@)
    Placeholder String

instance IsString Arg where
  fromString :: String -> Arg
fromString String
s = Configurable Text -> Arg
Arg (Configurable Text -> Arg) -> Configurable Text -> Arg
forall a b. (a -> b) -> a -> b
$ Text -> Configurable Text
forall a. a -> Configurable a
Literal (Text -> Configurable Text) -> Text -> Configurable Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

-- | Extracts a ConfigKey from an Arg, if it exists.
getIdFromArg :: Arg -> Maybe ConfigKeysBySource
getIdFromArg :: Arg -> Maybe ConfigKeysBySource
getIdFromArg Arg
arg = case Arg
arg of
  Arg Configurable Text
configurable -> ConfigKeysBySource -> Maybe ConfigKeysBySource
forall a. a -> Maybe a
Just (ConfigKeysBySource -> Maybe ConfigKeysBySource)
-> ConfigKeysBySource -> Maybe ConfigKeysBySource
forall a b. (a -> b) -> a -> b
$ Configurable Text -> ConfigKeysBySource
forall a. Configurable a -> ConfigKeysBySource
configKeyBySource Configurable Text
configurable
  Arg
_ -> Maybe ConfigKeysBySource
forall a. Maybe a
Nothing

-- | Renders an Arg with external configurations
renderArg :: ExternalConfig -> Arg -> Either String Arg
renderArg :: ExternalConfig -> Arg -> Either String Arg
renderArg ExternalConfig
external Arg
arg = case Arg
arg of
  Arg Configurable Text
configurable -> case Configurable Text
-> ExternalConfig -> Either String (Configurable Text)
forall a.
Configurable a -> ExternalConfig -> Either String (Configurable a)
render Configurable Text
configurable ExternalConfig
external of
    Left String
err -> String -> Either String Arg
forall a b. a -> Either a b
Left String
err
    Right Configurable Text
renderedConfig -> Arg -> Either String Arg
forall a b. b -> Either a b
Right (Arg -> Either String Arg) -> Arg -> Either String Arg
forall a b. (a -> b) -> a -> b
$ Configurable Text -> Arg
Arg Configurable Text
renderedConfig
  Arg
_ -> Arg -> Either String Arg
forall a b. b -> Either a b
Right Arg
arg

-- | Input to a Docker task to finalize its configuration
data DockerTaskInput = DockerTaskInput
  { -- | Input items to mount on the container
    DockerTaskInput -> [VolumeBinding]
inputBindings :: [VolumeBinding],
    -- | A map representing how to fill the argument placeholders (placeholder label -> argument value)
    DockerTaskInput -> Map String Text
argsVals :: Map.Map String Text
  }
  deriving (DockerTaskInput -> DockerTaskInput -> Bool
(DockerTaskInput -> DockerTaskInput -> Bool)
-> (DockerTaskInput -> DockerTaskInput -> Bool)
-> Eq DockerTaskInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DockerTaskInput -> DockerTaskInput -> Bool
$c/= :: DockerTaskInput -> DockerTaskInput -> Bool
== :: DockerTaskInput -> DockerTaskInput -> Bool
$c== :: DockerTaskInput -> DockerTaskInput -> Bool
Eq, Int -> DockerTaskInput -> ShowS
[DockerTaskInput] -> ShowS
DockerTaskInput -> String
(Int -> DockerTaskInput -> ShowS)
-> (DockerTaskInput -> String)
-> ([DockerTaskInput] -> ShowS)
-> Show DockerTaskInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerTaskInput] -> ShowS
$cshowList :: [DockerTaskInput] -> ShowS
show :: DockerTaskInput -> String
$cshow :: DockerTaskInput -> String
showsPrec :: Int -> DockerTaskInput -> ShowS
$cshowsPrec :: Int -> DockerTaskInput -> ShowS
Show)

-- | Combine task inputs by combining the collections they contain.
--
-- This treats @inputBindings@ as a "priority list"-like structure in case of repeat occurrence
-- of the same mount path. Specifically, the item associated with a particular path will be the
-- first one, left-to-right, from the @inputBinding@s being combined. Analogous for @argsVals@,
-- in accordance with ordinary @Semigroup Map@.
instance Semigroup DockerTaskInput where
  DockerTaskInput {inputBindings :: DockerTaskInput -> [VolumeBinding]
inputBindings = [VolumeBinding]
vols1, argsVals :: DockerTaskInput -> Map String Text
argsVals = Map String Text
args1} <> :: DockerTaskInput -> DockerTaskInput -> DockerTaskInput
<> DockerTaskInput {inputBindings :: DockerTaskInput -> [VolumeBinding]
inputBindings = [VolumeBinding]
vols2, argsVals :: DockerTaskInput -> Map String Text
argsVals = Map String Text
args2} =
    let agg :: (Set (Path Abs Dir), [VolumeBinding])
-> VolumeBinding -> (Set (Path Abs Dir), [VolumeBinding])
agg (Set (Path Abs Dir)
ms, [VolumeBinding]
vs) VolumeBinding
v = if Path Abs Dir -> Set (Path Abs Dir) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (VolumeBinding -> Path Abs Dir
mount VolumeBinding
v) Set (Path Abs Dir)
ms then (Set (Path Abs Dir)
ms, [VolumeBinding]
vs) else (Path Abs Dir -> Set (Path Abs Dir) -> Set (Path Abs Dir)
forall a. Ord a => a -> Set a -> Set a
Set.insert (VolumeBinding -> Path Abs Dir
mount VolumeBinding
v) Set (Path Abs Dir)
ms, VolumeBinding
v VolumeBinding -> [VolumeBinding] -> [VolumeBinding]
forall a. a -> [a] -> [a]
: [VolumeBinding]
vs)
        combVols :: [VolumeBinding]
combVols = [VolumeBinding] -> [VolumeBinding]
forall a. [a] -> [a]
reverse ([VolumeBinding] -> [VolumeBinding])
-> ((Set (Path Abs Dir), [VolumeBinding]) -> [VolumeBinding])
-> (Set (Path Abs Dir), [VolumeBinding])
-> [VolumeBinding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Path Abs Dir), [VolumeBinding]) -> [VolumeBinding]
forall a b. (a, b) -> b
snd ((Set (Path Abs Dir), [VolumeBinding]) -> [VolumeBinding])
-> (Set (Path Abs Dir), [VolumeBinding]) -> [VolumeBinding]
forall a b. (a -> b) -> a -> b
$ ((Set (Path Abs Dir), [VolumeBinding])
 -> VolumeBinding -> (Set (Path Abs Dir), [VolumeBinding]))
-> (Set (Path Abs Dir), [VolumeBinding])
-> [VolumeBinding]
-> (Set (Path Abs Dir), [VolumeBinding])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Set (Path Abs Dir), [VolumeBinding])
-> VolumeBinding -> (Set (Path Abs Dir), [VolumeBinding])
agg (Set (Path Abs Dir)
forall a. Set a
Set.empty, []) ([VolumeBinding]
vols1 [VolumeBinding] -> [VolumeBinding] -> [VolumeBinding]
forall a. [a] -> [a] -> [a]
++ [VolumeBinding]
vols2)
     in DockerTaskInput :: [VolumeBinding] -> Map String Text -> DockerTaskInput
DockerTaskInput {inputBindings :: [VolumeBinding]
inputBindings = [VolumeBinding]
combVols, argsVals :: Map String Text
argsVals = Map String Text
args1 Map String Text -> Map String Text -> Map String Text
forall a. Semigroup a => a -> a -> a
<> Map String Text
args2}

-- | An empty task input is one with fields of empty collections.
instance Monoid DockerTaskInput where
  mempty :: DockerTaskInput
mempty = DockerTaskInput :: [VolumeBinding] -> Map String Text -> DockerTaskInput
DockerTaskInput {inputBindings :: [VolumeBinding]
inputBindings = [], argsVals :: Map String Text
argsVals = Map String Text
forall k a. Map k a
Map.empty}

-- | Represent how to bind a directory from cas-store (@CS.Item@) to a container internal file system
data VolumeBinding = VolumeBinding {VolumeBinding -> Item
item :: CS.Item, VolumeBinding -> Path Abs Dir
mount :: Path Abs Dir}
  deriving (VolumeBinding -> VolumeBinding -> Bool
(VolumeBinding -> VolumeBinding -> Bool)
-> (VolumeBinding -> VolumeBinding -> Bool) -> Eq VolumeBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolumeBinding -> VolumeBinding -> Bool
$c/= :: VolumeBinding -> VolumeBinding -> Bool
== :: VolumeBinding -> VolumeBinding -> Bool
$c== :: VolumeBinding -> VolumeBinding -> Bool
Eq, Eq VolumeBinding
Eq VolumeBinding
-> (VolumeBinding -> VolumeBinding -> Ordering)
-> (VolumeBinding -> VolumeBinding -> Bool)
-> (VolumeBinding -> VolumeBinding -> Bool)
-> (VolumeBinding -> VolumeBinding -> Bool)
-> (VolumeBinding -> VolumeBinding -> Bool)
-> (VolumeBinding -> VolumeBinding -> VolumeBinding)
-> (VolumeBinding -> VolumeBinding -> VolumeBinding)
-> Ord VolumeBinding
VolumeBinding -> VolumeBinding -> Bool
VolumeBinding -> VolumeBinding -> Ordering
VolumeBinding -> VolumeBinding -> VolumeBinding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VolumeBinding -> VolumeBinding -> VolumeBinding
$cmin :: VolumeBinding -> VolumeBinding -> VolumeBinding
max :: VolumeBinding -> VolumeBinding -> VolumeBinding
$cmax :: VolumeBinding -> VolumeBinding -> VolumeBinding
>= :: VolumeBinding -> VolumeBinding -> Bool
$c>= :: VolumeBinding -> VolumeBinding -> Bool
> :: VolumeBinding -> VolumeBinding -> Bool
$c> :: VolumeBinding -> VolumeBinding -> Bool
<= :: VolumeBinding -> VolumeBinding -> Bool
$c<= :: VolumeBinding -> VolumeBinding -> Bool
< :: VolumeBinding -> VolumeBinding -> Bool
$c< :: VolumeBinding -> VolumeBinding -> Bool
compare :: VolumeBinding -> VolumeBinding -> Ordering
$ccompare :: VolumeBinding -> VolumeBinding -> Ordering
$cp1Ord :: Eq VolumeBinding
Ord, Int -> VolumeBinding -> ShowS
[VolumeBinding] -> ShowS
VolumeBinding -> String
(Int -> VolumeBinding -> ShowS)
-> (VolumeBinding -> String)
-> ([VolumeBinding] -> ShowS)
-> Show VolumeBinding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VolumeBinding] -> ShowS
$cshowList :: [VolumeBinding] -> ShowS
show :: VolumeBinding -> String
$cshow :: VolumeBinding -> String
showsPrec :: Int -> VolumeBinding -> ShowS
$cshowsPrec :: Int -> VolumeBinding -> ShowS
Show)

-- Docker tasks to perform external tasks
data DockerTask i o where
  DockerTask :: DockerTaskConfig -> DockerTask DockerTaskInput CS.Item