-- | Things that seem like they could be clients of this library, but
-- are instead included as part of the library.
{-# 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 ({-dropWhileEnd, intercalate,-} intersperse, map)
import Data.Map as Map (insert, insertWith, toList)
import Data.Set as Set (insert, singleton, union)
import Data.Text as Text (pack, {-Text,-} unlines)
import qualified Debian.Debianize.DebInfo as D
import Debian.Debianize.ExecAtoms (execAtoms)
import Debian.Debianize.Monad (CabalInfo, CabalT, DebianT, execCabalM)
--import Debian.Debianize.Prelude (stripWith)
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

-- | Create equals dependencies.  For each pair (A, B), use dpkg-query
-- to find out B's version number, version B.  Then write a rule into
-- P's .substvar that makes P require that that exact version of A,
-- and another that makes P conflict with any older version of A.
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

-- | Add a debian binary package to the debianization containing a cabal executable file.
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

-- | Add a debian binary package to the debianization containing a cabal executable file set up to be a server.
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

-- | Add a debian binary package to the debianization containing a cabal executable file set up to be a web site.
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

-- | Add a debian binary package to the debianization containing a cabal executable file set up to be a backup script.
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]])
       -- depends +++= (bin, Rel (BinPkgName "anacron") Nothing Nothing)

oldClckwrksSiteFlags :: D.Site -> [String]
oldClckwrksSiteFlags :: Site -> [[Char]]
oldClckwrksSiteFlags Site
x =
    [ -- According to the happstack-server documentation this needs a trailing slash.
      [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 =
    [ -- According to the happstack-server documentation this needs a trailing slash.
      [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))
          {-logrotate 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
      -- An apache site configuration file.  This is installed via a line
      -- in debianFiles.
      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)))

-- | Install configuration files to do log rotation.  This does not
-- work well with the haskell logging library, so it is no longer
-- called in siteAtoms.
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
      -- Combine two values (for insertWith) when there should only be
      -- one.  If it happens twice with different values we should
      -- really find out why.
      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]
++
                    [ -- This gets done by the #DEBHELPER# code below.
                      {- "    service " <> pack (show (pPrint b)) <> " start", -}
                      Text
"    ;;"
                    , Text
"esac"
                    , Text
""
                    , Text
"#DEBHELPER#"
                    , Text
""
                    , Text
"exit 0" ])

-- | A configuration file for the logrotate facility, installed via a line
-- in debianFiles.
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)