{-# Language ImportQualifiedPost, QuasiQuotes, ViewPatterns #-}
{-|
Module      : Main
Description : Day 25 solution
Copyright   : (c) Eric Mertens, 2020
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2020/day/25>

Brute-forcing this took me about 6 seconds, but using math makes it instant.

-}
module Main (main) where

import Advent.Format (format)
import Data.Foldable (traverse_)
import GHC.TypeNats (KnownNat, SomeNat(SomeNat), someNatVal)
import Math.NumberTheory.Moduli ((^%), Mod, cyclicGroup, discreteLogarithm, getVal, isMultElement, isPrimitiveRoot)
import Numeric.Natural (Natural)

data DHParams = DH Integer Natural -- ^ generator modulus

params :: DHParams
params :: DHParams
params = Integer -> Natural -> DHParams
DH Integer
7 Natural
20201227

-- |
-- >>> :main
-- 181800
main :: IO ()
IO ()
main =
  do (pub1,pub2) <- [format|2020 25 %lu%n%lu%n|]
     traverse_ print (hack params pub1 pub2)

hack :: DHParams -> Integer -> Integer -> Maybe Integer
hack :: DHParams -> Integer -> Integer -> Maybe Integer
hack (DH Integer
g (Natural -> SomeNat
someNatVal -> SomeNat Proxy n
n)) (Proxy n -> Integer -> Mod n
forall (m :: Natural) (proxy :: Natural -> *).
KnownNat m =>
proxy m -> Integer -> Mod m
toMod Proxy n
n -> Mod n
public1) (Proxy n -> Integer -> Mod n
forall (m :: Natural) (proxy :: Natural -> *).
KnownNat m =>
proxy m -> Integer -> Mod m
toMod Proxy n
n -> Mod n
public2) =
  do cg      <- Maybe (CyclicGroup Integer n)
forall a (m :: Natural).
(Integral a, UniqueFactorisation a, KnownNat m) =>
Maybe (CyclicGroup a m)
cyclicGroup
     subject <- isPrimitiveRoot cg (fromInteger g)
     public' <- isMultElement public1
     pure (getVal (public2 ^% discreteLogarithm cg subject public'))

toMod :: KnownNat m => proxy m -> Integer -> Mod m
toMod :: forall (m :: Natural) (proxy :: Natural -> *).
KnownNat m =>
proxy m -> Integer -> Mod m
toMod proxy m
_ = Integer -> Mod m
forall a. Num a => Integer -> a
fromInteger