module Propellor.Property.Uboot where

import Propellor.Base
import Propellor.Types.Info
import Propellor.Types.Bootloader
import Propellor.Types.Container
import Propellor.Property.Mount
import qualified Propellor.Property.Apt as Apt

-- | Name of a board.
type BoardName = String

-- | Installs u-boot for Allwinner/sunxi platforms.
--
-- This includes writing it to the boot sector.
sunxi :: BoardName -> Property (HasInfo + DebianLike)
sunxi :: BoardName -> Property (HasInfo + DebianLike)
sunxi BoardName
boardname = Property Linux
-> Info
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty (Propellor Bool -> Property Linux -> Property Linux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> Propellor Bool -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContainerCapability -> Propellor Bool
hasContainerCapability ContainerCapability
FilesystemContained) Property Linux
go) Info
info
	Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
-> Property DebianLike
-> CombinedType
     (Property
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [BoardName] -> Property DebianLike
Apt.installed [BoardName
"u-boot", BoardName
"u-boot-sunxi"]
  where
	go :: Property Linux
	go :: Property Linux
go = BoardName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Propellor Result)
-> Property Linux
forall {k} (metatypes :: k).
SingI metatypes =>
BoardName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' BoardName
"u-boot installed" ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux]
  -> Propellor Result)
 -> Property Linux)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Propellor Result)
-> Property Linux
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
w -> do
		Maybe BoardName
v <- IO (Maybe BoardName) -> Propellor (Maybe BoardName)
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BoardName) -> Propellor (Maybe BoardName))
-> IO (Maybe BoardName) -> Propellor (Maybe BoardName)
forall a b. (a -> b) -> a -> b
$ BoardName -> IO (Maybe BoardName)
getMountContaining BoardName
"/boot"
		case Maybe BoardName
v of
			Maybe BoardName
Nothing -> BoardName -> Propellor Result
forall a. HasCallStack => BoardName -> a
error BoardName
"unable to determine boot device"
			Just BoardName
dev -> OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
-> Property Linux -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
w (BoardName -> BoardName -> Property Linux
dd BoardName
dev BoardName
"/")
	dd :: FilePath -> FilePath -> Property Linux
	dd :: BoardName -> BoardName -> Property Linux
dd BoardName
dev BoardName
prefix = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (untightened :: [MetaType]) (tightened :: [MetaType]).
(TightenTargetsAllowed untightened tightened, SingI tightened) =>
Property (MetaTypes untightened) -> Property (MetaTypes tightened)
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ BoardName
-> [BoardName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty BoardName
"dd"
		[ BoardName
"conv=fsync,notrunc"
		, BoardName
"if=" BoardName -> BoardName -> BoardName
forall a. [a] -> [a] -> [a]
++ BoardName
prefix BoardName -> BoardName -> BoardName
forall a. [a] -> [a] -> [a]
++ BoardName
"/usr/lib/u-boot/"
			BoardName -> BoardName -> BoardName
forall a. [a] -> [a] -> [a]
++ BoardName
boardname BoardName -> BoardName -> BoardName
forall a. [a] -> [a] -> [a]
++ BoardName
"/u-boot-sunxi-with-spl.bin"
		, BoardName
"of=" BoardName -> BoardName -> BoardName
forall a. [a] -> [a] -> [a]
++ BoardName
dev
		, BoardName
"bs=1024"
		, BoardName
"seek=8"
		]
		UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	info :: Info
info = [BootloaderInstalled] -> Info
forall v. IsInfo v => v -> Info
toInfo [(BoardName -> BoardName -> Property Linux) -> BootloaderInstalled
UbootInstalled BoardName -> BoardName -> Property Linux
dd]