{-# LANGUAGE PackageImports #-}
{-# OPTIONS_HADDOCK hide #-}
{- HLINT ignore "Avoid restricted function" -}
-----------------------------------------------------------------------------
-- |
-- Module      :  Codec.Archive.Tar.Write
-- Copyright   :  (c) 2007 Bjorn Bringert,
--                    2008 Andrea Vezzosi,
--                    2008-2009 Duncan Coutts
-- License     :  BSD3
--
-- Maintainer  :  duncan@community.haskell.org
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Codec.Archive.Tar.Write
  ( write
  , writeEntry
  , write'
  , writeEntry'
  , writeTrailer
  ) where

import Codec.Archive.Tar.PackAscii
import Codec.Archive.Tar.Types
import Codec.Archive.Tar.Pack (defaultRead)

import Data.Bits
import Data.Char     (chr,ord)
import Data.Int
import Data.List     (foldl')
import Data.Monoid   (mempty)
import Numeric       (showOct)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.OsPath
         ( OsPath )

import qualified Data.ByteString             as BS
import qualified Data.ByteString.Char8       as BS.Char8
import qualified Data.ByteString.Lazy        as LBS
import qualified Data.ByteString.Lazy.Char8  as LBS.Char8
import "os-string" System.OsString.Posix (PosixString)
import qualified "os-string" System.OsString.Posix as PS

-- | Create the external representation of a tar archive by serialising a list
-- of tar entries.
--
-- * The conversion is done lazily.
--
write :: [Entry] -> LBS.ByteString
write :: [Entry] -> ByteString
write [Entry]
es = [ByteString] -> ByteString
LBS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Entry -> ByteString) -> [Entry] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> ByteString
writeEntry [Entry]
es [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
writeTrailer]

-- | Like 'write' but for 'GenEntry' with 'OsPath' as contents.
--
-- @since 0.7.0.0
write' :: [GenEntry OsPath TarPath LinkTarget] -> IO LBS.ByteString
write' :: [GenEntry OsPath TarPath LinkTarget] -> IO ByteString
write' [GenEntry OsPath TarPath LinkTarget]
es = [IO ByteString] -> IO ByteString
interleavedByteStringConcat ([IO ByteString] -> IO ByteString)
-> [IO ByteString] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (GenEntry OsPath TarPath LinkTarget -> IO ByteString)
-> [GenEntry OsPath TarPath LinkTarget] -> [IO ByteString]
forall a b. (a -> b) -> [a] -> [b]
map GenEntry OsPath TarPath LinkTarget -> IO ByteString
writeEntry' [GenEntry OsPath TarPath LinkTarget]
es [IO ByteString] -> [IO ByteString] -> [IO ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
writeTrailer]

-- | Standard TAR trailer of two empty blocks, put it at the end of any archive.
--
-- @since 0.7.1.0
writeTrailer :: LBS.ByteString
writeTrailer :: ByteString
writeTrailer = Int64 -> Word8 -> ByteString
LBS.replicate (Int64
512Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
2) Word8
0

interleavedByteStringConcat :: [IO LBS.ByteString] -> IO LBS.ByteString
interleavedByteStringConcat :: [IO ByteString] -> IO ByteString
interleavedByteStringConcat [] = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
LBS.empty
interleavedByteStringConcat (IO ByteString
x:[IO ByteString]
xs) = do
  ByteString
y <- IO ByteString
x
  ByteString
ys <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO ([IO ByteString] -> IO ByteString
interleavedByteStringConcat [IO ByteString]
xs)
  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
LBS.append ByteString
y ByteString
ys)

-- | Convert an entry to its representation in TAR format.
--
-- @since 0.7.1.0
writeEntry :: Entry -> LBS.ByteString
writeEntry :: Entry -> ByteString
writeEntry Entry
entry = case Entry -> GenEntryContent ByteString LinkTarget
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent Entry
entry of
  NormalFile       ByteString
content Int64
size
    -- size field is 12 bytes long, so in octal format (see 'putOct')
    -- it can hold numbers up to 8Gb
    | Int64
size Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
    , Entry -> Format
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Format
entryFormat Entry
entry Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
V7Format
    -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"writeEntry: support for files over 8Gb is a Ustar extension"
    | Bool
otherwise -> [ByteString] -> ByteString
LBS.concat [ ByteString
header, ByteString
content, Int64 -> ByteString
forall {p}. Integral p => p -> ByteString
padding Int64
size ]
  OtherEntryType Char
'K' ByteString
_ Int64
_
    | Entry -> Format
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Format
entryFormat Entry
entry Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
GnuFormat -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"writeEntry: long symlink support is a GNU extension"
  OtherEntryType Char
'L' ByteString
_ Int64
_
    | Entry -> Format
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Format
entryFormat Entry
entry Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
GnuFormat -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"writeEntry: long filename support is a GNU extension"
  OtherEntryType Char
_ ByteString
content Int64
size -> [ByteString] -> ByteString
LBS.concat [ ByteString
header, ByteString
content, Int64 -> ByteString
forall {p}. Integral p => p -> ByteString
padding Int64
size ]
  GenEntryContent ByteString LinkTarget
_                             -> ByteString
header
  where
    header :: ByteString
header       = Entry -> ByteString
putHeader Entry
entry
    padding :: p -> ByteString
padding p
size = Int64 -> Word8 -> ByteString
LBS.replicate Int64
paddingSize Word8
0
      where paddingSize :: Int64
paddingSize = p -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> p
forall a. Num a => a -> a
negate p
size p -> p -> p
forall a. Integral a => a -> a -> a
`mod` p
512)

-- | Convert an entry to its representation in TAR format.
--
-- @since 0.7.1.0
writeEntry' :: GenEntry OsPath TarPath LinkTarget -> IO LBS.ByteString
writeEntry' :: GenEntry OsPath TarPath LinkTarget -> IO ByteString
writeEntry' GenEntry OsPath TarPath LinkTarget
entry' = do
  GenEntryContent ByteString LinkTarget
entryContent' <- case GenEntry OsPath TarPath LinkTarget
-> GenEntryContent OsPath LinkTarget
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent GenEntry OsPath TarPath LinkTarget
entry' of
    NormalFile OsPath
path Int64
size -> do
      ByteString
content <- Int64 -> OsPath -> IO ByteString
defaultRead Int64
size OsPath
path
      GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenEntryContent ByteString LinkTarget
 -> IO (GenEntryContent ByteString LinkTarget))
-> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> GenEntryContent ByteString LinkTarget
forall content linkTarget.
content -> Int64 -> GenEntryContent content linkTarget
NormalFile ByteString
content Int64
size

    GenEntryContent OsPath LinkTarget
Directory -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntryContent ByteString LinkTarget
forall content linkTarget. GenEntryContent content linkTarget
Directory
    SymbolicLink LinkTarget
linkTarget -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkTarget -> GenEntryContent ByteString LinkTarget
forall content linkTarget.
linkTarget -> GenEntryContent content linkTarget
SymbolicLink LinkTarget
linkTarget)
    HardLink LinkTarget
linkTarget -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkTarget -> GenEntryContent ByteString LinkTarget
forall content linkTarget.
linkTarget -> GenEntryContent content linkTarget
HardLink LinkTarget
linkTarget)
    CharacterDevice Int
devMajor Int
devMinor -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> GenEntryContent ByteString LinkTarget
forall content linkTarget.
Int -> Int -> GenEntryContent content linkTarget
CharacterDevice Int
devMajor Int
devMinor)
    BlockDevice Int
devMajor Int
devMinor -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> GenEntryContent ByteString LinkTarget
forall content linkTarget.
Int -> Int -> GenEntryContent content linkTarget
BlockDevice Int
devMajor Int
devMinor)
    GenEntryContent OsPath LinkTarget
NamedPipe -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntryContent ByteString LinkTarget
forall content linkTarget. GenEntryContent content linkTarget
NamedPipe
    OtherEntryType Char
typeCode ByteString
lbs Int64
fileSize -> GenEntryContent ByteString LinkTarget
-> IO (GenEntryContent ByteString LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
-> ByteString -> Int64 -> GenEntryContent ByteString LinkTarget
forall content linkTarget.
Char -> ByteString -> Int64 -> GenEntryContent content linkTarget
OtherEntryType Char
typeCode ByteString
lbs Int64
fileSize)

  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> ByteString
writeEntry GenEntry OsPath TarPath LinkTarget
entry' { entryContent = entryContent' })

putHeader :: Entry -> LBS.ByteString
putHeader :: Entry -> ByteString
putHeader Entry
entry =
     ByteString -> ByteString
LBS.fromStrict
   (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
148 ByteString
block
  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct Int
7 Int
checksum
  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString -> ByteString
BS.cons Word8
0x20 (Int -> ByteString -> ByteString
BS.drop Int
156 ByteString
block)
  where
    block :: ByteString
block    = Entry -> ByteString
putHeaderNoChkSum Entry
entry
    checksum :: Int
    checksum :: Int
checksum = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Int
x Word8
y -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y) Int
0 ByteString
block

putHeaderNoChkSum :: Entry -> BS.ByteString
putHeaderNoChkSum :: Entry -> ByteString
putHeaderNoChkSum Entry {
    entryTarPath :: forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> tarPath
entryTarPath     = TarPath PosixString
name PosixString
prefix,
    entryContent :: forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent     = GenEntryContent ByteString LinkTarget
content,
    entryPermissions :: forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Permissions
entryPermissions = Permissions
permissions,
    entryOwnership :: forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Ownership
entryOwnership   = Ownership
ownership,
    entryTime :: forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Int64
entryTime        = Int64
modTime,
    entryFormat :: forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> Format
entryFormat      = Format
format
  } =

  [ByteString] -> ByteString
BS.concat
    [ Int -> PosixString -> ByteString
putPosixString Int
100 PosixString
name
    , Int -> Permissions -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct       Int
8 Permissions
permissions
    , Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct       Int
8 (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Ownership -> Int
ownerId Ownership
ownership
    , Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct       Int
8 (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Ownership -> Int
groupId Ownership
ownership
    , Int -> Int64 -> ByteString
numField    Int
12 Int64
contentSize
    , Int -> Int64 -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct      Int
12 Int64
modTime
    , Int -> Word8 -> ByteString
BS.replicate Int
8 Word8
0x20 -- dummy checksum
    , Char -> ByteString
putChar8       Char
typeCode
    , Int -> PosixString -> ByteString
putPosixString Int
100 PosixString
linkTarget
    ] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  case Format
format of
  Format
V7Format    ->
      Int -> Word8 -> ByteString
BS.replicate Int
255 Word8
0x00
  Format
UstarFormat -> [ByteString] -> ByteString
BS.concat
    [ Int -> ByteString -> ByteString
putBString   Int
8 ByteString
ustarMagic
    , Int -> [Char] -> ByteString
putString   Int
32 ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Ownership -> [Char]
ownerName Ownership
ownership
    , Int -> [Char] -> ByteString
putString   Int
32 ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Ownership -> [Char]
groupName Ownership
ownership
    , Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct       Int
8 Int
deviceMajor
    , Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct       Int
8 Int
deviceMinor
    , Int -> PosixString -> ByteString
putPosixString Int
155 PosixString
prefix
    , Int -> Word8 -> ByteString
BS.replicate   Int
12 Word8
0x00
    ]
  Format
GnuFormat -> [ByteString] -> ByteString
BS.concat
    [ Int -> ByteString -> ByteString
putBString   Int
8 ByteString
gnuMagic
    , Int -> [Char] -> ByteString
putString   Int
32 ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Ownership -> [Char]
ownerName Ownership
ownership
    , Int -> [Char] -> ByteString
putString   Int
32 ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Ownership -> [Char]
groupName Ownership
ownership
    , Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putGnuDev    Int
8 Int
deviceMajor
    , Int -> Int -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putGnuDev    Int
8 Int
deviceMinor
    , Int -> PosixString -> ByteString
putPosixString Int
155 PosixString
prefix
    , Int -> Word8 -> ByteString
BS.replicate   Int
12 Word8
0x00
    ]
  where
    numField :: FieldWidth -> Int64 -> BS.ByteString
    numField :: Int -> Int64 -> ByteString
numField Int
w Int64
n
      | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 Bool -> Bool -> Bool
&& Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
      = Int -> Int64 -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct Int
w Int64
n
      | Bool
otherwise
      = Int -> Int64 -> ByteString
forall a. (Bits a, Integral a) => Int -> a -> ByteString
putLarge Int
w Int64
n

    (Char
typeCode, Int64
contentSize, PosixString
linkTarget,
     Int
deviceMajor, Int
deviceMinor) = case GenEntryContent ByteString LinkTarget
content of
       NormalFile      ByteString
_ Int64
size            -> (Char
'0' , Int64
size, PosixString
forall a. Monoid a => a
mempty, Int
0,     Int
0)
       GenEntryContent ByteString LinkTarget
Directory                         -> (Char
'5' , Int64
0,    PosixString
forall a. Monoid a => a
mempty, Int
0,     Int
0)
       SymbolicLink    (LinkTarget PosixString
link) -> (Char
'2' , Int64
0,    PosixString
link,   Int
0,     Int
0)
       HardLink        (LinkTarget PosixString
link) -> (Char
'1' , Int64
0,    PosixString
link,   Int
0,     Int
0)
       CharacterDevice Int
major Int
minor       -> (Char
'3' , Int64
0,    PosixString
forall a. Monoid a => a
mempty, Int
major, Int
minor)
       BlockDevice     Int
major Int
minor       -> (Char
'4' , Int64
0,    PosixString
forall a. Monoid a => a
mempty, Int
major, Int
minor)
       GenEntryContent ByteString LinkTarget
NamedPipe                         -> (Char
'6' , Int64
0,    PosixString
forall a. Monoid a => a
mempty, Int
0,     Int
0)
       OtherEntryType  Char
code ByteString
_ Int64
size       -> (Char
code, Int64
size, PosixString
forall a. Monoid a => a
mempty, Int
0,     Int
0)

    putGnuDev :: Int -> a -> ByteString
putGnuDev Int
w a
n = case GenEntryContent ByteString LinkTarget
content of
      CharacterDevice Int
_ Int
_ -> Int -> a -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct Int
w a
n
      BlockDevice     Int
_ Int
_ -> Int -> a -> ByteString
forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct Int
w a
n
      GenEntryContent ByteString LinkTarget
_                   -> Int -> Word8 -> ByteString
BS.replicate Int
w Word8
0x00

ustarMagic, gnuMagic :: BS.ByteString
ustarMagic :: ByteString
ustarMagic = [Word8] -> ByteString
BS.pack [Word8
0x75, Word8
0x73, Word8
0x74, Word8
0x61, Word8
0x72, Word8
0x00, Word8
0x30, Word8
0x30]  -- ustar\NUL00
gnuMagic :: ByteString
gnuMagic   = [Word8] -> ByteString
BS.pack [Word8
0x75, Word8
0x73, Word8
0x74, Word8
0x61, Word8
0x72, Word8
0x20, Word8
0x20, Word8
0x00]  -- ustar  \NUL

-- * TAR format primitive output

type FieldWidth = Int

putBString :: FieldWidth -> BS.ByteString -> BS.ByteString
putBString :: Int -> ByteString -> ByteString
putBString Int
n ByteString
s = Int -> ByteString -> ByteString
BS.take Int
n ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
s) Word8
0x00

putPosixString :: FieldWidth -> PosixString -> BS.ByteString
putPosixString :: Int -> PosixString -> ByteString
putPosixString Int
n PosixString
s = PosixString -> ByteString
posixToByteString (Int -> PosixString -> PosixString
PS.take Int
n PosixString
s) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- PosixString -> Int
PS.length PosixString
s) Word8
0x00

putString :: FieldWidth -> String -> BS.ByteString
putString :: Int -> [Char] -> ByteString
putString Int
n [Char]
s = Int -> ByteString -> ByteString
BS.take Int
n (HasCallStack => [Char] -> ByteString
[Char] -> ByteString
packAscii [Char]
s) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Word8
0x00

{-# SPECIALISE putLarge :: FieldWidth -> Int64 -> BS.ByteString #-}
putLarge :: (Bits a, Integral a) => FieldWidth -> a -> BS.ByteString
putLarge :: forall a. (Bits a, Integral a) => Int -> a -> ByteString
putLarge Int
n0 a
x0 = [Char] -> ByteString
BS.Char8.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Char
'\x80' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
forall a. [a] -> [a]
reverse (Int -> a -> [Char]
forall {t} {t}.
(Integral t, Bits t, Num t, Eq t) =>
t -> t -> [Char]
go (Int
n0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
x0)
  where go :: t -> t -> [Char]
go t
0 t
_ = []
        go t
n t
x = Int -> Char
chr (t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t
x t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
0xff)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: t -> t -> [Char]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

putOct :: (Integral a, Show a) => FieldWidth -> a -> BS.ByteString
putOct :: forall a. (Integral a, Show a) => Int -> a -> ByteString
putOct Int
n a
x =
  let octStr :: ByteString
octStr = Int -> ByteString -> ByteString
BS.take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.Char8.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showOct a
x [Char]
""
   in Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
octStr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
0x30
   ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
octStr
   ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BS.singleton Word8
0x00

putChar8 :: Char -> BS.ByteString
putChar8 :: Char -> ByteString
putChar8 = Char -> ByteString
BS.Char8.singleton