{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Protection
  ( SheetProtection(..)
  , fullSheetProtection
  , noSheetProtection
  , LegacyPassword
  , legacyPassword
  -- * Lenses
  , sprLegacyPassword
  , sprSheet              
  , sprObjects            
  , sprScenarios          
  , sprFormatCells        
  , sprFormatColumns      
  , sprFormatRows         
  , sprInsertColumns      
  , sprInsertRows         
  , sprInsertHyperlinks   
  , sprDeleteColumns      
  , sprDeleteRows         
  , sprSelectLockedCells  
  , sprSort               
  , sprAutoFilter         
  , sprPivotTables        
  , sprSelectUnlockedCells
  ) where

import GHC.Generics (Generic)

import Control.Arrow (first)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens (makeLenses)
#endif
import Control.DeepSeq (NFData)
import Data.Bits
import Data.Char
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder.Int (hexadecimal)

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Writer.Internal

newtype LegacyPassword =
  LegacyPassword Text
  deriving (LegacyPassword -> LegacyPassword -> Bool
(LegacyPassword -> LegacyPassword -> Bool)
-> (LegacyPassword -> LegacyPassword -> Bool) -> Eq LegacyPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegacyPassword -> LegacyPassword -> Bool
$c/= :: LegacyPassword -> LegacyPassword -> Bool
== :: LegacyPassword -> LegacyPassword -> Bool
$c== :: LegacyPassword -> LegacyPassword -> Bool
Eq, Int -> LegacyPassword -> ShowS
[LegacyPassword] -> ShowS
LegacyPassword -> String
(Int -> LegacyPassword -> ShowS)
-> (LegacyPassword -> String)
-> ([LegacyPassword] -> ShowS)
-> Show LegacyPassword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegacyPassword] -> ShowS
$cshowList :: [LegacyPassword] -> ShowS
show :: LegacyPassword -> String
$cshow :: LegacyPassword -> String
showsPrec :: Int -> LegacyPassword -> ShowS
$cshowsPrec :: Int -> LegacyPassword -> ShowS
Show, (forall x. LegacyPassword -> Rep LegacyPassword x)
-> (forall x. Rep LegacyPassword x -> LegacyPassword)
-> Generic LegacyPassword
forall x. Rep LegacyPassword x -> LegacyPassword
forall x. LegacyPassword -> Rep LegacyPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegacyPassword x -> LegacyPassword
$cfrom :: forall x. LegacyPassword -> Rep LegacyPassword x
Generic)
instance NFData LegacyPassword

-- | Creates legacy @XOR@ hashed password.
--
-- /Note:/ The implementation is known to work only for ASCII symbols,
-- if you know how to encode properly others - an email or a PR will
-- be highly apperciated
--
-- See Part 4, 14.7.1 "Legacy Password Hash Algorithm" (p. 73) and
-- Part 4, 15.2.3 "Additional attributes for workbookProtection
-- element (Part 1, §18.2.29)" (p. 220) and Par 4, 15.3.1.6
-- "Additional attribute for sheetProtection element (Part 1,
-- §18.3.1.85)" (p. 229)
legacyPassword :: Text -> LegacyPassword
legacyPassword :: Text -> LegacyPassword
legacyPassword = Text -> LegacyPassword
LegacyPassword (Text -> LegacyPassword)
-> (Text -> Text) -> Text -> LegacyPassword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
hex (Int -> Text) -> (Text -> Int) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *). Foldable t => t Int -> Int
legacyHash ([Int] -> Int) -> (Text -> [Int]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord (String -> [Int]) -> (Text -> String) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  where
    hex :: Int -> Text
hex = Text -> Text
toStrict (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (Int -> Builder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. Integral a => a -> Builder
hexadecimal
    legacyHash :: t Int -> Int
legacyHash t Int
bs =
      Int -> Int
forall a. (Bits a, Num a) => a -> a
mutHash ((Int -> Int -> Int) -> Int -> t Int -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
b Int
hash -> Int
b Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int -> Int
forall a. (Bits a, Num a) => a -> a
mutHash Int
hash) Int
0 t Int
bs) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` (t Int -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t Int
bs) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor`
      Int
0xCE4B
    mutHash :: a -> a
mutHash a
ph = ((a
ph a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
14) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1) a -> a -> a
forall a. Bits a => a -> a -> a
.|. ((a
ph a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7fff)

-- | Sheet protection options to enforce and specify that it needs to
-- be protected
--
-- TODO: algorithms specified in the spec with hashes, salts and spin
-- counts
--
-- See 18.3.1.85 "sheetProtection (Sheet Protection Options)" (p. 1694)
data SheetProtection = SheetProtection
  { SheetProtection -> Maybe LegacyPassword
_sprLegacyPassword :: Maybe LegacyPassword
    -- ^ Specifies the legacy hash of the password required for editing
    -- this worksheet.
    --
    -- See Part 4, 15.3.1.6 "Additional attribute for sheetProtection
    -- element (Part 1, §18.3.1.85)" (p. 229)
  , SheetProtection -> Bool
_sprSheet :: Bool
    -- ^ the value of this attribute dictates whether the other
    -- attributes of 'SheetProtection' should be applied
  , SheetProtection -> Bool
_sprAutoFilter :: Bool
    -- ^ AutoFilters should not be allowed to operate when the sheet
    -- is protected
  , SheetProtection -> Bool
_sprDeleteColumns :: Bool
    -- ^ deleting columns should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprDeleteRows :: Bool
    -- ^ deleting rows should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprFormatCells :: Bool
    -- ^ formatting cells should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprFormatColumns :: Bool
    -- ^ formatting columns should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprFormatRows :: Bool
    -- ^ formatting rows should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprInsertColumns :: Bool
    -- ^ inserting columns should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprInsertHyperlinks :: Bool
    -- ^ inserting hyperlinks should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprInsertRows :: Bool
    -- ^ inserting rows should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprObjects :: Bool
    -- ^ editing of objects should not be allowed when the sheet is
    -- protected
  , SheetProtection -> Bool
_sprPivotTables :: Bool
    -- ^ PivotTables should not be allowed to operate when the sheet
    -- is protected
  , SheetProtection -> Bool
_sprScenarios :: Bool
    -- ^ Scenarios should not be edited when the sheet is protected
  , SheetProtection -> Bool
_sprSelectLockedCells :: Bool
    -- ^ selection of locked cells should not be allowed when the
    -- sheet is protected
  , SheetProtection -> Bool
_sprSelectUnlockedCells :: Bool
    -- ^ selection of unlocked cells should not be allowed when the
    -- sheet is protected
  , SheetProtection -> Bool
_sprSort :: Bool
    -- ^ sorting should not be allowed when the sheet is protected
  } deriving (SheetProtection -> SheetProtection -> Bool
(SheetProtection -> SheetProtection -> Bool)
-> (SheetProtection -> SheetProtection -> Bool)
-> Eq SheetProtection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SheetProtection -> SheetProtection -> Bool
$c/= :: SheetProtection -> SheetProtection -> Bool
== :: SheetProtection -> SheetProtection -> Bool
$c== :: SheetProtection -> SheetProtection -> Bool
Eq, Int -> SheetProtection -> ShowS
[SheetProtection] -> ShowS
SheetProtection -> String
(Int -> SheetProtection -> ShowS)
-> (SheetProtection -> String)
-> ([SheetProtection] -> ShowS)
-> Show SheetProtection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SheetProtection] -> ShowS
$cshowList :: [SheetProtection] -> ShowS
show :: SheetProtection -> String
$cshow :: SheetProtection -> String
showsPrec :: Int -> SheetProtection -> ShowS
$cshowsPrec :: Int -> SheetProtection -> ShowS
Show, (forall x. SheetProtection -> Rep SheetProtection x)
-> (forall x. Rep SheetProtection x -> SheetProtection)
-> Generic SheetProtection
forall x. Rep SheetProtection x -> SheetProtection
forall x. SheetProtection -> Rep SheetProtection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SheetProtection x -> SheetProtection
$cfrom :: forall x. SheetProtection -> Rep SheetProtection x
Generic)
instance NFData SheetProtection

makeLenses ''SheetProtection

{-------------------------------------------------------------------------------
  Base instances
-------------------------------------------------------------------------------}

-- | no sheet protection at all
noSheetProtection :: SheetProtection
noSheetProtection :: SheetProtection
noSheetProtection =
  SheetProtection :: Maybe LegacyPassword
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> SheetProtection
SheetProtection
  { _sprLegacyPassword :: Maybe LegacyPassword
_sprLegacyPassword = Maybe LegacyPassword
forall a. Maybe a
Nothing
  , _sprSheet :: Bool
_sprSheet = Bool
False
  , _sprAutoFilter :: Bool
_sprAutoFilter = Bool
False
  , _sprDeleteColumns :: Bool
_sprDeleteColumns = Bool
False
  , _sprDeleteRows :: Bool
_sprDeleteRows = Bool
False
  , _sprFormatCells :: Bool
_sprFormatCells = Bool
False
  , _sprFormatColumns :: Bool
_sprFormatColumns = Bool
False
  , _sprFormatRows :: Bool
_sprFormatRows = Bool
False
  , _sprInsertColumns :: Bool
_sprInsertColumns = Bool
False
  , _sprInsertHyperlinks :: Bool
_sprInsertHyperlinks = Bool
False
  , _sprInsertRows :: Bool
_sprInsertRows = Bool
False
  , _sprObjects :: Bool
_sprObjects = Bool
False
  , _sprPivotTables :: Bool
_sprPivotTables = Bool
False
  , _sprScenarios :: Bool
_sprScenarios = Bool
False
  , _sprSelectLockedCells :: Bool
_sprSelectLockedCells = Bool
False
  , _sprSelectUnlockedCells :: Bool
_sprSelectUnlockedCells = Bool
False
  , _sprSort :: Bool
_sprSort = Bool
False
  }

-- | protection of all sheet features which could be protected
fullSheetProtection :: SheetProtection
fullSheetProtection :: SheetProtection
fullSheetProtection =
  SheetProtection :: Maybe LegacyPassword
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> SheetProtection
SheetProtection
  { _sprLegacyPassword :: Maybe LegacyPassword
_sprLegacyPassword = Maybe LegacyPassword
forall a. Maybe a
Nothing
  , _sprSheet :: Bool
_sprSheet = Bool
True
  , _sprAutoFilter :: Bool
_sprAutoFilter = Bool
True
  , _sprDeleteColumns :: Bool
_sprDeleteColumns = Bool
True
  , _sprDeleteRows :: Bool
_sprDeleteRows = Bool
True
  , _sprFormatCells :: Bool
_sprFormatCells = Bool
True
  , _sprFormatColumns :: Bool
_sprFormatColumns = Bool
True
  , _sprFormatRows :: Bool
_sprFormatRows = Bool
True
  , _sprInsertColumns :: Bool
_sprInsertColumns = Bool
True
  , _sprInsertHyperlinks :: Bool
_sprInsertHyperlinks = Bool
True
  , _sprInsertRows :: Bool
_sprInsertRows = Bool
True
  , _sprObjects :: Bool
_sprObjects = Bool
True
  , _sprPivotTables :: Bool
_sprPivotTables = Bool
True
  , _sprScenarios :: Bool
_sprScenarios = Bool
True
  , _sprSelectLockedCells :: Bool
_sprSelectLockedCells = Bool
True
  , _sprSelectUnlockedCells :: Bool
_sprSelectUnlockedCells = Bool
True
  , _sprSort :: Bool
_sprSort = Bool
True
  }

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

instance FromCursor SheetProtection where
  fromCursor :: Cursor -> [SheetProtection]
fromCursor Cursor
cur = do
    Maybe LegacyPassword
_sprLegacyPassword <- Name -> Cursor -> [Maybe LegacyPassword]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"password" Cursor
cur
    Bool
_sprSheet <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"sheet" Bool
False Cursor
cur
    Bool
_sprAutoFilter  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"autoFilter" Bool
True Cursor
cur
    Bool
_sprDeleteColumns  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"deleteColumns" Bool
True Cursor
cur
    Bool
_sprDeleteRows  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"deleteRows" Bool
True Cursor
cur
    Bool
_sprFormatCells  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"formatCells" Bool
True Cursor
cur
    Bool
_sprFormatColumns  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"formatColumns" Bool
True Cursor
cur
    Bool
_sprFormatRows  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"formatRows" Bool
True Cursor
cur
    Bool
_sprInsertColumns  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"insertColumns" Bool
True Cursor
cur
    Bool
_sprInsertHyperlinks  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"insertHyperlinks" Bool
True Cursor
cur
    Bool
_sprInsertRows  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"insertRows" Bool
True Cursor
cur
    Bool
_sprObjects  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"objects" Bool
False Cursor
cur
    Bool
_sprPivotTables  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"pivotTables" Bool
True Cursor
cur
    Bool
_sprScenarios  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"scenarios" Bool
False Cursor
cur
    Bool
_sprSelectLockedCells  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"selectLockedCells" Bool
False Cursor
cur
    Bool
_sprSelectUnlockedCells  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"selectUnlockedCells" Bool
False Cursor
cur
    Bool
_sprSort  <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"sort" Bool
True Cursor
cur    
    SheetProtection -> [SheetProtection]
forall (m :: * -> *) a. Monad m => a -> m a
return SheetProtection :: Maybe LegacyPassword
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> SheetProtection
SheetProtection {Bool
Maybe LegacyPassword
_sprSort :: Bool
_sprSelectUnlockedCells :: Bool
_sprSelectLockedCells :: Bool
_sprScenarios :: Bool
_sprPivotTables :: Bool
_sprObjects :: Bool
_sprInsertRows :: Bool
_sprInsertHyperlinks :: Bool
_sprInsertColumns :: Bool
_sprFormatRows :: Bool
_sprFormatColumns :: Bool
_sprFormatCells :: Bool
_sprDeleteRows :: Bool
_sprDeleteColumns :: Bool
_sprAutoFilter :: Bool
_sprSheet :: Bool
_sprLegacyPassword :: Maybe LegacyPassword
_sprSort :: Bool
_sprSelectUnlockedCells :: Bool
_sprSelectLockedCells :: Bool
_sprScenarios :: Bool
_sprPivotTables :: Bool
_sprObjects :: Bool
_sprInsertRows :: Bool
_sprInsertHyperlinks :: Bool
_sprInsertColumns :: Bool
_sprFormatRows :: Bool
_sprFormatColumns :: Bool
_sprFormatCells :: Bool
_sprDeleteRows :: Bool
_sprDeleteColumns :: Bool
_sprAutoFilter :: Bool
_sprSheet :: Bool
_sprLegacyPassword :: Maybe LegacyPassword
..}

instance FromXenoNode SheetProtection where
  fromXenoNode :: Node -> Either Text SheetProtection
fromXenoNode Node
root =
    Node -> AttrParser SheetProtection -> Either Text SheetProtection
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser SheetProtection -> Either Text SheetProtection)
-> AttrParser SheetProtection -> Either Text SheetProtection
forall a b. (a -> b) -> a -> b
$ do
      Maybe LegacyPassword
_sprLegacyPassword <- ByteString -> AttrParser (Maybe LegacyPassword)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"password"
      Bool
_sprSheet <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"sheet" Bool
False
      Bool
_sprAutoFilter <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"autoFilter" Bool
True
      Bool
_sprDeleteColumns <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"deleteColumns" Bool
True
      Bool
_sprDeleteRows <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"deleteRows" Bool
True
      Bool
_sprFormatCells <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"formatCells" Bool
True
      Bool
_sprFormatColumns <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"formatColumns" Bool
True
      Bool
_sprFormatRows <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"formatRows" Bool
True
      Bool
_sprInsertColumns <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"insertColumns" Bool
True
      Bool
_sprInsertHyperlinks <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"insertHyperlinks" Bool
True
      Bool
_sprInsertRows <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"insertRows" Bool
True
      Bool
_sprObjects <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"objects" Bool
False
      Bool
_sprPivotTables <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"pivotTables" Bool
True
      Bool
_sprScenarios <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"scenarios" Bool
False
      Bool
_sprSelectLockedCells <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"selectLockedCells" Bool
False
      Bool
_sprSelectUnlockedCells <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"selectUnlockedCells" Bool
False
      Bool
_sprSort <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"sort" Bool
True
      SheetProtection -> AttrParser SheetProtection
forall (m :: * -> *) a. Monad m => a -> m a
return SheetProtection :: Maybe LegacyPassword
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> SheetProtection
SheetProtection {Bool
Maybe LegacyPassword
_sprSort :: Bool
_sprSelectUnlockedCells :: Bool
_sprSelectLockedCells :: Bool
_sprScenarios :: Bool
_sprPivotTables :: Bool
_sprObjects :: Bool
_sprInsertRows :: Bool
_sprInsertHyperlinks :: Bool
_sprInsertColumns :: Bool
_sprFormatRows :: Bool
_sprFormatColumns :: Bool
_sprFormatCells :: Bool
_sprDeleteRows :: Bool
_sprDeleteColumns :: Bool
_sprAutoFilter :: Bool
_sprSheet :: Bool
_sprLegacyPassword :: Maybe LegacyPassword
_sprSort :: Bool
_sprSelectUnlockedCells :: Bool
_sprSelectLockedCells :: Bool
_sprScenarios :: Bool
_sprPivotTables :: Bool
_sprObjects :: Bool
_sprInsertRows :: Bool
_sprInsertHyperlinks :: Bool
_sprInsertColumns :: Bool
_sprFormatRows :: Bool
_sprFormatColumns :: Bool
_sprFormatCells :: Bool
_sprDeleteRows :: Bool
_sprDeleteColumns :: Bool
_sprAutoFilter :: Bool
_sprSheet :: Bool
_sprLegacyPassword :: Maybe LegacyPassword
..}

instance FromAttrVal LegacyPassword where
  fromAttrVal :: Reader LegacyPassword
fromAttrVal = ((Text, Text) -> (LegacyPassword, Text))
-> Either String (Text, Text)
-> Either String (LegacyPassword, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> LegacyPassword) -> (Text, Text) -> (LegacyPassword, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> LegacyPassword
LegacyPassword) (Either String (Text, Text)
 -> Either String (LegacyPassword, Text))
-> (Text -> Either String (Text, Text)) -> Reader LegacyPassword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Text, Text)
forall a. FromAttrVal a => Reader a
fromAttrVal

instance FromAttrBs LegacyPassword where
  fromAttrBs :: ByteString -> Either Text LegacyPassword
fromAttrBs = (Text -> LegacyPassword)
-> Either Text Text -> Either Text LegacyPassword
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> LegacyPassword
LegacyPassword (Either Text Text -> Either Text LegacyPassword)
-> (ByteString -> Either Text Text)
-> ByteString
-> Either Text LegacyPassword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text Text
forall a. FromAttrBs a => ByteString -> Either Text a
fromAttrBs

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

instance ToElement SheetProtection where
  toElement :: Name -> SheetProtection -> Element
toElement Name
nm SheetProtection {Bool
Maybe LegacyPassword
_sprSort :: Bool
_sprSelectUnlockedCells :: Bool
_sprSelectLockedCells :: Bool
_sprScenarios :: Bool
_sprPivotTables :: Bool
_sprObjects :: Bool
_sprInsertRows :: Bool
_sprInsertHyperlinks :: Bool
_sprInsertColumns :: Bool
_sprFormatRows :: Bool
_sprFormatColumns :: Bool
_sprFormatCells :: Bool
_sprDeleteRows :: Bool
_sprDeleteColumns :: Bool
_sprAutoFilter :: Bool
_sprSheet :: Bool
_sprLegacyPassword :: Maybe LegacyPassword
_sprSort :: SheetProtection -> Bool
_sprSelectUnlockedCells :: SheetProtection -> Bool
_sprSelectLockedCells :: SheetProtection -> Bool
_sprScenarios :: SheetProtection -> Bool
_sprPivotTables :: SheetProtection -> Bool
_sprObjects :: SheetProtection -> Bool
_sprInsertRows :: SheetProtection -> Bool
_sprInsertHyperlinks :: SheetProtection -> Bool
_sprInsertColumns :: SheetProtection -> Bool
_sprFormatRows :: SheetProtection -> Bool
_sprFormatColumns :: SheetProtection -> Bool
_sprFormatCells :: SheetProtection -> Bool
_sprDeleteRows :: SheetProtection -> Bool
_sprDeleteColumns :: SheetProtection -> Bool
_sprAutoFilter :: SheetProtection -> Bool
_sprSheet :: SheetProtection -> Bool
_sprLegacyPassword :: SheetProtection -> Maybe LegacyPassword
..} =
    Name -> [(Name, Text)] -> Element
leafElement Name
nm ([(Name, Text)] -> Element) -> [(Name, Text)] -> Element
forall a b. (a -> b) -> a -> b
$
    [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes
      [ Name
"password" Name -> Maybe LegacyPassword -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe LegacyPassword
_sprLegacyPassword
      , Name
"sheet" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_sprSheet
      , Name
"autoFilter" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprAutoFilter
      , Name
"deleteColumns" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprDeleteColumns
      , Name
"deleteRows" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprDeleteRows
      , Name
"formatCells" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprFormatCells
      , Name
"formatColumns" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprFormatColumns
      , Name
"formatRows" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprFormatRows
      , Name
"insertColumns" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprInsertColumns
      , Name
"insertHyperlinks" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprInsertHyperlinks
      , Name
"insertRows" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprInsertRows
      , Name
"objects" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_sprObjects
      , Name
"pivotTables" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprPivotTables
      , Name
"scenarios" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_sprScenarios
      , Name
"selectLockedCells" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_sprSelectLockedCells
      , Name
"selectUnlockedCells" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_sprSelectUnlockedCells
      , Name
"sort" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_sprSort
      ]

instance ToAttrVal LegacyPassword where
  toAttrVal :: LegacyPassword -> Text
toAttrVal (LegacyPassword Text
hash) = Text
hash