{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Debian.Debianize.Goodies
( tightDependencyFixup
, expandWebsite, doWebsite
, expandServer, doServer
, expandBackups, doBackups
, doExecutable
, oldClckwrksSiteFlags
, oldClckwrksServerFlags
, siteAtoms
, logrotate
, serverAtoms
, backupAtoms
, execAtoms
) where
import Control.Lens
import Control.Monad.State (MonadState(get), modify)
import Data.List as List ( intersperse, map)
import Data.Map as Map (insert, insertWith, toList)
import Data.Set as Set (insert, singleton, union)
import Data.Text as Text (pack, unlines)
import qualified Debian.Debianize.DebInfo as D
import Debian.Debianize.ExecAtoms (execAtoms)
import Debian.Debianize.Monad (CabalInfo, CabalT, DebianT, execCabalM)
import qualified Debian.Debianize.CabalInfo as A
import qualified Debian.Debianize.BinaryDebDescription as B
import Debian.Orphans ()
import Debian.Policy (apacheAccessLog, apacheErrorLog, apacheLogDirectory, databaseDirectory, dataDirectory, serverAccessLog, serverAppLog)
import Debian.Pretty (ppText)
import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel))
import Distribution.PackageDescription as Cabal (PackageDescription)
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Prelude hiding (init, log, map, unlines, writeFile)
import System.FilePath ((</>))
showCommand :: String -> [String] -> String
showCommand :: [Char] -> [[Char]] -> [Char]
showCommand [Char]
cmd [[Char]]
args =
[[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
translate ([Char]
cmd forall a. a -> [a] -> [a]
: [[Char]]
args))
translate :: String -> String
translate :: [Char] -> [Char]
translate [Char]
str =
Char
'"' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> [Char] -> [Char]
escape [Char]
"\"" [Char]
str
where
escape :: Char -> [Char] -> [Char]
escape Char
'"' = [Char] -> [Char] -> [Char]
showString [Char]
"\\\""
escape Char
c = Char -> [Char] -> [Char]
showChar Char
c
tightDependencyFixup :: Monad m => [(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m ()
tightDependencyFixup :: forall (m :: * -> *).
Monad m =>
[(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m ()
tightDependencyFixup [] BinPkgName
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
tightDependencyFixup [(BinPkgName, BinPkgName)]
pairs BinPkgName
p =
Lens' DebInfo (Set Text)
D.rulesFragments forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.insert
([Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
([ Text
"binary-fixup/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"::"
, Text
"\techo -n 'haskell:Depends=' >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars" ] forall a. [a] -> [a] -> [a]
++
forall a. a -> [a] -> [a]
intersperse (Text
"\techo -n ', ' >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars") (forall a b. (a -> b) -> [a] -> [b]
List.map (BinPkgName, BinPkgName) -> Text
equals [(BinPkgName, BinPkgName)]
pairs) forall a. [a] -> [a] -> [a]
++
[ Text
"\techo '' >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars"
, Text
"\techo -n 'haskell:Conflicts=' >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars" ] forall a. [a] -> [a] -> [a]
++
forall a. a -> [a] -> [a]
intersperse (Text
"\techo -n ', ' >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars") (forall a b. (a -> b) -> [a] -> [b]
List.map (BinPkgName, BinPkgName) -> Text
newer [(BinPkgName, BinPkgName)]
pairs) forall a. [a] -> [a] -> [a]
++
[ Text
"\techo '' >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars" ]))
where
equals :: (BinPkgName, BinPkgName) -> Text
equals (BinPkgName
installed, BinPkgName
dependent) = Text
"\tdpkg-query -W -f='" forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
dependent forall a. Semigroup a => a -> a -> a
<> Text
" (=$${Version})' " forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
installed forall a. Semigroup a => a -> a -> a
<> Text
" >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars"
newer :: (BinPkgName, BinPkgName) -> Text
newer (BinPkgName
installed, BinPkgName
dependent) = Text
"\tdpkg-query -W -f='" forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
dependent forall a. Semigroup a => a -> a -> a
<> Text
" (>>$${Version})' " forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
installed forall a. Semigroup a => a -> a -> a
<> Text
" >> debian/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
".substvars"
name :: Text
name = BinPkgName -> Text
display' BinPkgName
p
display' :: BinPkgName -> Text
display' = forall a. Pretty (PP a) => a -> Text
ppText
doExecutable :: Monad m => BinPkgName -> D.InstallFile -> CabalT m ()
doExecutable :: forall (m :: * -> *).
Monad m =>
BinPkgName -> InstallFile -> CabalT m ()
doExecutable BinPkgName
p InstallFile
f = (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName InstallFile)
D.executable) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p InstallFile
f
doServer :: Monad m => BinPkgName -> D.Server -> CabalT m ()
doServer :: forall (m :: * -> *).
Monad m =>
BinPkgName -> Server -> CabalT m ()
doServer BinPkgName
p Server
s = (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Server)
D.serverInfo) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Server
s
doWebsite :: Monad m => BinPkgName -> D.Site -> CabalT m ()
doWebsite :: forall (m :: * -> *). Monad m => BinPkgName -> Site -> CabalT m ()
doWebsite BinPkgName
p Site
w = (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Site)
D.website) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Site
w
doBackups :: Monad m => BinPkgName -> String -> CabalT m ()
doBackups :: forall (m :: * -> *).
Monad m =>
BinPkgName -> [Char] -> CabalT m ()
doBackups BinPkgName
bin [Char]
s =
do (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName [Char])
D.backups) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
bin [Char]
s
(Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> Lens' DebInfo BinaryDebDescription
D.binaryDebDescription BinPkgName
bin forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.depends) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ [[BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
Rel ([Char] -> BinPkgName
BinPkgName [Char]
"anacron") forall a. Maybe a
Nothing forall a. Maybe a
Nothing]])
oldClckwrksSiteFlags :: D.Site -> [String]
oldClckwrksSiteFlags :: Site -> [[Char]]
oldClckwrksSiteFlags Site
x =
[
[Char]
"--base-uri", [Char]
"http://" forall a. [a] -> [a] -> [a]
++ Site -> [Char]
D.domain Site
x forall a. [a] -> [a] -> [a]
++ [Char]
"/"
, [Char]
"--http-port", forall a. Show a => a -> [Char]
show (Server -> Int
D.port (Site -> Server
D.server Site
x))]
oldClckwrksServerFlags :: D.Server -> [String]
oldClckwrksServerFlags :: Server -> [[Char]]
oldClckwrksServerFlags Server
x =
[
[Char]
"--base-uri", [Char]
"http://" forall a. [a] -> [a] -> [a]
++ Server -> [Char]
D.hostname Server
x forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Server -> Int
D.port Server
x) forall a. [a] -> [a] -> [a]
++ [Char]
"/"
, [Char]
"--http-port", forall a. Show a => a -> [Char]
show (Server -> Int
D.port Server
x)]
siteAtoms :: PackageDescription -> BinPkgName -> D.Site -> CabalInfo -> CabalInfo
siteAtoms :: PackageDescription -> BinPkgName -> Site -> CabalInfo -> CabalInfo
siteAtoms PackageDescription
pkgDesc BinPkgName
b Site
site =
forall a. CabalM a -> CabalInfo -> CabalInfo
execCabalM
(do (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Set Atom)
D.atomSet) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Ord a => a -> Set a -> Set a
Set.insert forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> Atom
D.InstallDir BinPkgName
b [Char]
"/etc/apache2/sites-available")
(Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Set Atom)
D.atomSet) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Ord a => a -> Set a -> Set a
Set.insert forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> [Char] -> Atom
D.Link BinPkgName
b ([Char]
"/etc/apache2/sites-available/" forall a. [a] -> [a] -> [a]
++ Site -> [Char]
D.domain Site
site forall a. [a] -> [a] -> [a]
++ [Char]
".conf") ([Char]
"/etc/apache2/sites-enabled/" forall a. [a] -> [a] -> [a]
++ Site -> [Char]
D.domain Site
site forall a. [a] -> [a] -> [a]
++ [Char]
".conf"))
(Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Set Atom)
D.atomSet) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Ord a => a -> Set a -> Set a
Set.insert forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> Text -> Atom
D.File BinPkgName
b ([Char]
"/etc/apache2/sites-available" [Char] -> [Char] -> [Char]
</> Site -> [Char]
D.domain Site
site forall a. [a] -> [a] -> [a]
++ [Char]
".conf") Text
apacheConfig)
(Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Set Atom)
D.atomSet) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Ord a => a -> Set a -> Set a
Set.insert forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> Atom
D.InstallDir BinPkgName
b (BinPkgName -> [Char]
apacheLogDirectory BinPkgName
b))
) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
PackageDescription
-> BinPkgName -> Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms PackageDescription
pkgDesc BinPkgName
b (Site -> Server
D.server Site
site) Bool
True
where
apacheConfig :: Text
apacheConfig =
[Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
[ Text
"<VirtualHost *:80>"
, Text
" ServerAdmin " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Site -> [Char]
D.serverAdmin Site
site)
, Text
" ServerName www." forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Site -> [Char]
D.domain Site
site)
, Text
" ServerAlias " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Site -> [Char]
D.domain Site
site)
, Text
""
, Text
" ErrorLog " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
apacheErrorLog BinPkgName
b)
, Text
" CustomLog " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
apacheAccessLog BinPkgName
b) forall a. Semigroup a => a -> a -> a
<> Text
" combined"
, Text
""
, Text
" ProxyRequests Off"
, Text
" AllowEncodedSlashes NoDecode"
, Text
""
, Text
" <Proxy *>"
, Text
" AddDefaultCharset off"
, Text
" Order deny,allow"
, Text
" #Allow from .example.com"
, Text
" Deny from all"
, Text
" #Allow from all"
, Text
" </Proxy>"
, Text
""
, Text
" <Proxy http://127.0.0.1:" forall a. Semigroup a => a -> a -> a
<> Text
port' forall a. Semigroup a => a -> a -> a
<> Text
"/*>"
, Text
" AddDefaultCharset off"
, Text
" Order deny,allow"
, Text
" #Allow from .example.com"
, Text
" #Deny from all"
, Text
" Allow from all"
, Text
" </Proxy>"
, Text
""
, Text
" SetEnv proxy-sendcl 1"
, Text
""
, Text
" ProxyPass / http://127.0.0.1:" forall a. Semigroup a => a -> a -> a
<> Text
port' forall a. Semigroup a => a -> a -> a
<> Text
"/ nocanon"
, Text
" ProxyPassReverse / http://127.0.0.1:" forall a. Semigroup a => a -> a -> a
<> Text
port' forall a. Semigroup a => a -> a -> a
<> Text
"/"
, Text
"</VirtualHost>" ]
port' :: Text
port' = [Char] -> Text
pack (forall a. Show a => a -> [Char]
show (Server -> Int
D.port (Site -> Server
D.server Site
site)))
logrotate :: MonadState CabalInfo m => BinPkgName -> m ()
logrotate :: forall (m :: * -> *). MonadState CabalInfo m => BinPkgName -> m ()
logrotate BinPkgName
b = do
(Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Monoid a => a -> a -> a
mappend BinPkgName
b
(forall a. a -> Set a
singleton
([Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
apacheAccessLog BinPkgName
b) forall a. Semigroup a => a -> a -> a
<> Text
" {"
, Text
" weekly"
, Text
" rotate 5"
, Text
" compress"
, Text
" missingok"
, Text
"}"]))
(Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Monoid a => a -> a -> a
mappend BinPkgName
b
(forall a. a -> Set a
singleton
([Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
apacheErrorLog BinPkgName
b) forall a. Semigroup a => a -> a -> a
<> Text
" {"
, Text
" weekly"
, Text
" rotate 5"
, Text
" compress"
, Text
" missingok"
, Text
"}" ]))
serverAtoms :: PackageDescription -> BinPkgName -> D.Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms :: PackageDescription
-> BinPkgName -> Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms PackageDescription
pkgDesc BinPkgName
b Server
server' Bool
isSite =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Text)
D.postInst) (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith forall {a}. (Eq a, Show a) => a -> a -> a
failOnMismatch BinPkgName
b Text
debianPostinst) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Text)
D.installInit) (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall {a}. (Eq a, Show a) => a -> a -> a
failOnMismatch BinPkgName
b Text
debianInit) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
BinPkgName -> CabalInfo -> CabalInfo
serverLogrotate' BinPkgName
b forall b c a. (b -> c) -> (a -> b) -> a -> c
.
BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
execAtoms BinPkgName
b InstallFile
exec
where
failOnMismatch :: a -> a -> a
failOnMismatch a
old a
new = if a
old forall a. Eq a => a -> a -> Bool
/= a
new then forall a. HasCallStack => [Char] -> a
error ([Char]
"serverAtoms: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
old forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
new) else a
old
exec :: InstallFile
exec = Server -> InstallFile
D.installFile Server
server'
debianInit :: Text
debianInit =
[Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
[ Text
"#! /bin/sh -e"
, Text
""
, Text
". /lib/lsb/init-functions"
, Text
"test -f /etc/default/" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) forall a. Semigroup a => a -> a -> a
<> Text
" && . /etc/default/" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec)
, Text
""
, Text
"case \"$1\" in"
, Text
" start)"
, Text
" test -x /usr/bin/" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) forall a. Semigroup a => a -> a -> a
<> Text
" || exit 0"
, Text
" log_begin_msg \"Starting " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) forall a. Semigroup a => a -> a -> a
<> Text
"...\""
, Text
" mkdir -p " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
databaseDirectory BinPkgName
b)
, Text
" export " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (PackageDescription -> [Char] -> [Char]
pkgPathEnvVar PackageDescription
pkgDesc [Char]
"datadir") forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (PackageDescription -> [Char]
dataDirectory PackageDescription
pkgDesc)
, Text
" " forall a. Semigroup a => a -> a -> a
<> Text
startCommand
, Text
" log_end_msg $?"
, Text
" ;;"
, Text
" stop)"
, Text
" log_begin_msg \"Stopping " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) forall a. Semigroup a => a -> a -> a
<> Text
"...\""
, Text
" " forall a. Semigroup a => a -> a -> a
<> Text
stopCommand
, Text
" log_end_msg $?"
, Text
" ;;"
, Text
" *)"
, Text
" log_success_msg \"Usage: ${0} {start|stop}\""
, Text
" exit 1"
, Text
"esac"
, Text
""
, Text
"exit 0" ]
startCommand :: Text
startCommand = [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
showCommand [Char]
"start-stop-daemon" ([[Char]]
startOptions forall a. [a] -> [a] -> [a]
++ [[Char]]
commonOptions forall a. [a] -> [a] -> [a]
++ [[Char]
"--"] forall a. [a] -> [a] -> [a]
++ Server -> [[Char]]
D.serverFlags Server
server')
stopCommand :: Text
stopCommand = [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
showCommand [Char]
"start-stop-daemon" ([[Char]]
stopOptions forall a. [a] -> [a] -> [a]
++ [[Char]]
commonOptions)
commonOptions :: [[Char]]
commonOptions = [[Char]
"--pidfile", [Char]
"/var/run/" forall a. [a] -> [a] -> [a]
++ InstallFile -> [Char]
D.destName InstallFile
exec]
startOptions :: [[Char]]
startOptions = [[Char]
"--start", [Char]
"-b", [Char]
"--make-pidfile", [Char]
"-d", BinPkgName -> [Char]
databaseDirectory BinPkgName
b, [Char]
"--exec", [Char]
"/usr/bin" [Char] -> [Char] -> [Char]
</> InstallFile -> [Char]
D.destName InstallFile
exec]
stopOptions :: [[Char]]
stopOptions = [[Char]
"--stop", [Char]
"--oknodo"] forall a. [a] -> [a] -> [a]
++ if Server -> [Char]
D.retry Server
server' forall a. Eq a => a -> a -> Bool
/= [Char]
"" then [[Char]
"--retry=" forall a. [a] -> [a] -> [a]
++ Server -> [Char]
D.retry Server
server' ] else []
debianPostinst :: Text
debianPostinst =
[Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
([ Text
"#!/bin/sh"
, Text
""
, Text
"case \"$1\" in"
, Text
" configure)" ] forall a. [a] -> [a] -> [a]
++
(if Bool
isSite
then [ Text
" # Apache won't start if this directory doesn't exist"
, Text
" mkdir -p " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
apacheLogDirectory BinPkgName
b)
, Text
" # Restart apache so it sees the new file in /etc/apache2/sites-enabled"
, Text
" /usr/sbin/a2enmod proxy"
, Text
" /usr/sbin/a2enmod proxy_http"
, Text
" service apache2 restart" ]
else []) forall a. [a] -> [a] -> [a]
++
[
Text
" ;;"
, Text
"esac"
, Text
""
, Text
"#DEBHELPER#"
, Text
""
, Text
"exit 0" ])
serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo
serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo
serverLogrotate' BinPkgName
b =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith forall a. Ord a => Set a -> Set a -> Set a
Set.union BinPkgName
b (forall a. a -> Set a
singleton ([Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
serverAccessLog BinPkgName
b) forall a. Semigroup a => a -> a -> a
<> Text
" {"
, Text
" weekly"
, Text
" rotate 5"
, Text
" compress"
, Text
" missingok"
, Text
"}" ]))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith forall a. Ord a => Set a -> Set a -> Set a
Set.union BinPkgName
b (forall a. a -> Set a
singleton ([Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
serverAppLog BinPkgName
b) forall a. Semigroup a => a -> a -> a
<> Text
" {"
, Text
" weekly"
, Text
" rotate 5"
, Text
" compress"
, Text
" missingok"
, Text
"}" ])))
backupAtoms :: BinPkgName -> String -> CabalInfo -> CabalInfo
backupAtoms :: BinPkgName -> [Char] -> CabalInfo -> CabalInfo
backupAtoms BinPkgName
b [Char]
name =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Text)
D.postInst) (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith (\ Text
old Text
new -> if Text
old forall a. Eq a => a -> a -> Bool
/= Text
new then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"backupAtoms: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
old forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
new else Text
old) BinPkgName
b
([Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
[ Text
"#!/bin/sh"
, Text
""
, Text
"case \"$1\" in"
, Text
" configure)"
, Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack ([Char]
"/etc/cron.hourly" [Char] -> [Char] -> [Char]
</> [Char]
name) forall a. Semigroup a => a -> a -> a
<> Text
" --initialize"
, Text
" ;;"
, Text
"esac" ])) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
execAtoms BinPkgName
b (D.InstallFile { execName :: [Char]
D.execName = [Char]
name
, destName :: [Char]
D.destName = [Char]
name
, sourceDir :: Maybe [Char]
D.sourceDir = forall a. Maybe a
Nothing
, destDir :: Maybe [Char]
D.destDir = forall a. a -> Maybe a
Just [Char]
"/etc/cron.hourly" })
expandWebsite :: Monad m => CabalT m ()
expandWebsite :: forall (m :: * -> *). Monad m => CabalT m ()
expandWebsite =
do Map BinPkgName Site
mp <- forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Site)
D.website)
PackageDescription
pkgDesc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo PackageDescription
A.packageDescription
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (BinPkgName
b, Site
site) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (PackageDescription -> BinPkgName -> Site -> CabalInfo -> CabalInfo
siteAtoms PackageDescription
pkgDesc BinPkgName
b Site
site)) (forall k a. Map k a -> [(k, a)]
Map.toList Map BinPkgName Site
mp)
expandServer :: Monad m => CabalT m ()
expandServer :: forall (m :: * -> *). Monad m => CabalT m ()
expandServer =
do Map BinPkgName Server
mp <- forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName Server)
D.serverInfo)
PackageDescription
pkgDesc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo PackageDescription
A.packageDescription
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (BinPkgName
b, Server
x) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (PackageDescription
-> BinPkgName -> Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms PackageDescription
pkgDesc BinPkgName
b Server
x Bool
False)) (forall k a. Map k a -> [(k, a)]
Map.toList Map BinPkgName Server
mp)
expandBackups :: Monad m => CabalT m ()
expandBackups :: forall (m :: * -> *). Monad m => CabalT m ()
expandBackups =
do Map BinPkgName [Char]
mp <- forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map BinPkgName [Char])
D.backups)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (BinPkgName
b, [Char]
name) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (BinPkgName -> [Char] -> CabalInfo -> CabalInfo
backupAtoms BinPkgName
b [Char]
name)) (forall k a. Map k a -> [(k, a)]
Map.toList Map BinPkgName [Char]
mp)